From 381d9d84d6a90e5ca502809be0964d6a5cfaa0d1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 30 Nov 2012 06:02:52 -0700 Subject: [PATCH] raco pkg: switch from "METADATA.rktd" to "info.rkt" For now, "METADATA.rktd" is still recognized as a fallback. Also, rewrite package source type and name inference, make ".zip" the default format for `raco pkg create', and many doc edits. --- .../meta/planet2-index/planet-compat/main.rkt | 9 +- collects/planet2/info.rkt | 1 - collects/planet2/lib.rkt | 689 +++++++++--------- collects/planet2/main.rkt | 16 +- collects/planet2/name.rkt | 103 +++ collects/planet2/scribblings/planet2.scrbl | 280 ++++--- .../test-pkgs/pkg-b-second/METADATA.rktd | 1 - .../planet2/test-pkgs/pkg-b-second/info.rkt | 3 + .../test-pkgs/planet2-test2/METADATA.rktd | 1 - .../planet2/test-pkgs/planet2-test2/info.rkt | 3 + collects/tests/planet2/test.rkt | 1 + collects/tests/planet2/tests-install.rkt | 13 +- collects/tests/planet2/tests-name.rkt | 75 ++ collects/tests/planet2/tests-overwrite.rkt | 2 +- 14 files changed, 734 insertions(+), 463 deletions(-) create mode 100644 collects/planet2/name.rkt delete mode 100644 collects/tests/planet2/test-pkgs/pkg-b-second/METADATA.rktd create mode 100644 collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt delete mode 100644 collects/tests/planet2/test-pkgs/planet2-test2/METADATA.rktd create mode 100644 collects/tests/planet2/test-pkgs/planet2-test2/info.rkt create mode 100644 collects/tests/planet2/tests-name.rkt diff --git a/collects/meta/planet2-index/planet-compat/main.rkt b/collects/meta/planet2-index/planet-compat/main.rkt index 65cba53712..ff7471257e 100644 --- a/collects/meta/planet2-index/planet-compat/main.rkt +++ b/collects/meta/planet2-index/planet-compat/main.rkt @@ -334,9 +334,12 @@ all-deps))) (printf "\tdeps ~a\n" deps) - (write-to-file - `((dependency ,@deps)) - (build-path pkg-dir "METADATA.rktd")))) + (call-with-output-file* + (build-path pkg-dir "info.rkt.rktd") + (lambda (o) + (fprintf o "#lang setup/infotab\n") + (write `(define deps ',deps) o))))) + (define pkg-pth (build-path pkg-depo pkg-depo-dir pkg-name.plt)) (when-delete? diff --git a/collects/planet2/info.rkt b/collects/planet2/info.rkt index f76ebb6b67..46f73d0400 100644 --- a/collects/planet2/info.rkt +++ b/collects/planet2/info.rkt @@ -1,6 +1,5 @@ #lang setup/infotab -(define name "Planet2") (define scribblings '(("scribblings/planet2.scrbl" (multi-page) (tool 100)))) (define raco-commands diff --git a/collects/planet2/lib.rkt b/collects/planet2/lib.rkt index 40c6a9977e..d973bfb346 100644 --- a/collects/planet2/lib.rkt +++ b/collects/planet2/lib.rkt @@ -21,11 +21,16 @@ file/tar file/zip file/unzip + setup/getinfo + setup/dirs + "name.rkt" "util.rkt") (define current-install-system-wide? (make-parameter #f)) +(struct pkg-desc (source type name auto?)) + (define (file->value* pth def) (with-handlers ([exn:fail? (λ (x) def)]) (file->value pth))) @@ -42,11 +47,6 @@ (define (directory-path-no-slash pkg) (bytes->path (regexp-replace* #rx#"/$" (path->bytes* pkg) #""))) -(define (absolute-collects-dir) - (path->complete-path - (find-system-path 'collects-dir) - (path-only (find-executable-path (find-system-path 'exec-file))))) - (define (directory-list* d) (append-map (λ (pp) @@ -95,6 +95,46 @@ (for-each make-directory* (list (pkg-dir) (pkg-installed-dir))) + +(define (make-metadata-namespace) + (make-base-empty-namespace)) + +(define (get-metadata metadata-ns pkg-dir key default + #:checker [checker void]) + (define get-info (get-info/full pkg-dir #:namespace metadata-ns)) + (define v + (if get-info + (get-info key (lambda () default)) + ;; during a transition period, also check for "METADATA.rktd": + (and (eq? key 'deps) + (dict-ref (file->value* (build-path pkg-dir "METADATA.rktd") empty) + 'dependency default)))) + (checker v) + v) + +(define (package-collections pkg-dir metadata-ns) + (for/list ([d (directory-list pkg-dir)] + #:when (directory-exists? (build-path pkg-dir d)) + #:when (std-filter d)) + d)) + +(define (package-collection-directories pkg-dir metadata-ns) + (for/list ([c (in-list (package-collections pkg-dir metadata-ns))]) + (build-path pkg-dir c))) + +(define (collection-equal? a b) + (equal? (if (path? a) a (string->path a)) + (if (path? b) b (string->path b)))) + +(define (check-dependencies deps) + (unless (and (list? deps) + (for/and ([dep (in-list deps)]) + (and (string? dep) + (package-source->name dep)))) + (error 'pkg + "invalid `dependencies' specification\n specification: ~e" + deps))) + (define (with-package-lock* t) (make-directory* (pkg-dir)) (call-with-file-lock/timeout @@ -134,7 +174,7 @@ (define (read-file-hash file) (define the-db - (with-handlers ([exn? (λ (x) (hash))]) + (with-handlers ([exn:fail? (λ (x) (hash))]) (file->value file))) the-db) (define (write-file-hash! file new-db) @@ -221,6 +261,7 @@ (hash-keys db)) (define all-pkgs-set (list->set all-pkgs)) + (define metadata-ns (make-metadata-namespace)) (define pkgs (if auto? (set->list @@ -230,7 +271,7 @@ (λ (p) (pkg-info-auto? (hash-ref db p))) all-pkgs)) (list->set - (append-map package-dependencies + (append-map (package-dependencies metadata-ns) all-pkgs)))) in-pkgs)) (unless force? @@ -242,7 +283,7 @@ (set-intersect pkgs-set (list->set - (append-map package-dependencies + (append-map (package-dependencies metadata-ns) (set->list remaining-pkg-db-set))))) (unless (set-empty? deps-to-be-removed) @@ -252,284 +293,262 @@ (define (install-packages #:old-infos [old-infos empty] - #:old-auto+pkgs [old-auto+pkgs empty] + #:old-descs [old-descs empty] #:pre-succeed [pre-succeed void] #:dep-behavior [dep-behavior #f] #:updating? [updating? #f] #:ignore-checksums? [ignore-checksums? #f] - #:link? [link? #f] - #:type [type #f] #:force? [force? #f] - auto+pkgs) - (define (path-match? path-ok? rx path) - (define str (if (path? path) - (and path-ok? (path->bytes path)) - path)) - (and str (regexp-match? rx str))) + descs) (define check-sums? (not ignore-checksums?)) - (define (install-package pkg - #:type [type type] - #:pkg-name [given-pkg-name #f]) + (define (install-package pkg given-type given-pkg-name) + (define-values (inferred-pkg-name type) + (if (path? pkg) + (package-source->name+type (path->string pkg) + (or given-type + (if (directory-exists? pkg) + 'dir + 'file))) + (package-source->name+type pkg given-type))) + (define pkg-name (or given-pkg-name inferred-pkg-name)) + (when (and type (not pkg-name)) + (error 'pkg "count not infer package name from source\n source: ~e" pkg)) (cond - [(and (eq? type 'github) - (not (path-match? #f #rx"^github://" pkg))) - ;; Add "github://github.com/" - (install-package (string-append "github://github.com/" pkg))] - [(if type - (or (eq? type 'url) (eq? type 'github)) - (path-match? #f #rx"^(https?|github)://" pkg)) - (let () - (define pkg-url (string->url pkg)) - (define scheme (url-scheme pkg-url)) + [(and (eq? type 'github) + (not (regexp-match? #rx"^github://" pkg))) + ;; Add "github://github.com/" + (install-package (string-append "github://github.com/" pkg) type + pkg-name)] + [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) + (define pkg-url (string->url pkg)) + (define scheme (url-scheme pkg-url)) - (define orig-pkg `(url ,pkg)) - (define checksum (remote-package-checksum orig-pkg)) - (define info - (update-install-info-orig-pkg - (match scheme - ["github" - (match-define (list* user repo branch path) - (map path/param-path (url-path/no-slash pkg-url))) - (define new-url - (url "https" #f "github.com" #f #t - (map (λ (x) (path/param x empty)) - (list user repo "tarball" branch)) - empty - #f)) - (define tmp.tgz - (make-temporary-file - (string-append - "~a-" - (format "~a.~a.tgz" repo branch)) - #f)) - (delete-file tmp.tgz) - (define tmp-dir - (make-temporary-file - (string-append - "~a-" - (format "~a.~a" repo branch)) - 'directory)) - (define package-path - (apply build-path tmp-dir path)) + (define orig-pkg `(url ,pkg)) + (define checksum (remote-package-checksum orig-pkg)) + (define info + (update-install-info-orig-pkg + (match type + ['github + (match-define (list* user repo branch path) + (map path/param-path (url-path/no-slash pkg-url))) + (define new-url + (url "https" #f "github.com" #f #t + (map (λ (x) (path/param x empty)) + (list user repo "tarball" branch)) + empty + #f)) + (define tmp.tgz + (make-temporary-file + (string-append + "~a-" + (format "~a.~a.tgz" repo branch)) + #f)) + (delete-file tmp.tgz) + (define tmp-dir + (make-temporary-file + (string-append + "~a-" + (format "~a.~a" repo branch)) + 'directory)) + (define package-path + (apply build-path tmp-dir path)) - (dynamic-wind - void - (λ () - (download-file! new-url tmp.tgz) - (dynamic-wind - void - (λ () - (untar tmp.tgz tmp-dir #:strip-components 1) - (install-package (path->string package-path) - #:type 'dir - #:pkg-name given-pkg-name)) - (λ () - (delete-directory/files tmp-dir)))) - (λ () - (delete-directory/files tmp.tgz)))] - [_ - (define url-last-component - (path/param-path (last (url-path pkg-url)))) - (define url-looks-like-directory? - (string=? "" url-last-component)) - (define-values - (package-path package-name download-type download-package!) - (cond - [url-looks-like-directory? - (define package-name - (path/param-path - (second (reverse (url-path pkg-url))))) - (define package-path - (make-temporary-file - (string-append - "~a-" - package-name) - 'directory)) - (define (path-like f) - (build-path package-path f)) - (define (url-like f) - (combine-url/relative pkg-url f)) - (values package-path - package-name - 'dir - (λ () - (printf "\tCloning remote directory\n") - (make-directory* package-path) - (define manifest - (call/input-url+200 - (url-like "MANIFEST") - port->lines)) - (for ([f (in-list manifest)]) - (download-file! (url-like f) - (path-like f)))))] - [else - (define package-path - (make-temporary-file - (string-append - "~a-" - url-last-component) - #f)) - (delete-file package-path) - (values package-path - (regexp-replace - #rx"\\.[^.]+$" - url-last-component - "") - 'file - (λ () - (dprintf "\tAssuming URL names a file\n") - (download-file! pkg-url package-path)))])) - (dynamic-wind - void - (λ () - (download-package!) - (define pkg-name - (or given-pkg-name - package-name)) - (dprintf "\tDownloading done, installing ~a as ~a\n" - package-path pkg-name) - (install-package package-path - #:type download-type - #:pkg-name - pkg-name)) - (λ () - (when (or (file-exists? package-path) - (directory-exists? package-path)) - (delete-directory/files package-path))))]) - orig-pkg)) - (when (and check-sums? - (install-info-checksum info) - (not checksum)) - (error 'planet2 "Remote package ~a had no checksum" - pkg)) - (when (and checksum - (install-info-checksum info) - check-sums? - (not (equal? (install-info-checksum info) checksum))) - (error 'planet2 "Incorrect checksum on package ~e: expected ~e, got ~e" - pkg - (install-info-checksum info) checksum)) - (update-install-info-checksum - info - checksum))] - [(and (not type) - (path-match? #f #rx"^[a-zA-Z]*://" pkg)) - (error 'pkg "unrecognized scheme for package source\n given: ~e\n" pkg)] - [(if type - (eq? type 'file) - (or - (path-match? #t #rx"[.](plt|zip|tar|tgz|tar[.]gz)$" pkg) - (and (path? pkg) (not (directory-exists? pkg))))) - (unless (file-exists? pkg) - (error 'pkg "no such file\n path: ~e" pkg)) - (define checksum-pth (format "~a.CHECKSUM" pkg)) - (define expected-checksum - (and (file-exists? checksum-pth) - check-sums? - (file->string checksum-pth))) - (define actual-checksum - (with-input-from-file pkg - (λ () + (dynamic-wind + void + (λ () + (download-file! new-url tmp.tgz) + (dynamic-wind + void + (λ () + (untar tmp.tgz tmp-dir #:strip-components 1) + (install-package (path->string package-path) + 'dir + pkg-name)) + (λ () + (delete-directory/files tmp-dir)))) + (λ () + (delete-directory/files tmp.tgz)))] + [_ + (define url-last-component + (path/param-path (last (url-path pkg-url)))) + (define url-looks-like-directory? (eq? type 'dir-url)) + (define-values + (package-path download-type download-package!) + (cond + [url-looks-like-directory? + (define package-path + (make-temporary-file + (string-append + "~a-" + pkg-name) + 'directory)) + (define (path-like f) + (build-path package-path f)) + (define (url-like f) + (if (and (pair? (url-path pkg-url)) + (equal? "" (path/param-path (last (url-path pkg-url))))) + ;; normal relative path: + (combine-url/relative pkg-url f) + ;; we're assuming that the last path element is + ;; a directory, so just add f: + (struct-copy url pkg-url [path + (append + (url-path pkg-url) + (list (path/param f null)))]))) + (values package-path + 'dir + (λ () + (printf "\tCloning remote directory\n") + (make-directory* package-path) + (define manifest + (call/input-url+200 + (url-like "MANIFEST") + port->lines)) + (unless manifest + (error 'pkg "could not find MANIFEST for package source\n source: ~e" + pkg)) + (for ([f (in-list manifest)]) + (download-file! (url-like f) + (path-like f)))))] + [else + (define package-path + (make-temporary-file + (string-append + "~a-" + url-last-component) + #f)) + (delete-file package-path) + (values package-path + 'file + (λ () + (dprintf "\tAssuming URL names a file\n") + (download-file! pkg-url package-path)))])) + (dynamic-wind + void + (λ () + (download-package!) + (dprintf "\tDownloading done, installing ~a as ~a\n" + package-path pkg-name) + (install-package package-path + download-type + pkg-name)) + (λ () + (when (or (file-exists? package-path) + (directory-exists? package-path)) + (delete-directory/files package-path))))]) + orig-pkg)) + (when (and check-sums? + (install-info-checksum info) + (not checksum)) + (error 'planet2 "Remote package ~a had no checksum" + pkg)) + (when (and checksum + (install-info-checksum info) + check-sums? + (not (equal? (install-info-checksum info) checksum))) + (error 'planet2 "Incorrect checksum on package ~e: expected ~e, got ~e" + pkg + (install-info-checksum info) checksum)) + (update-install-info-checksum + info + checksum)] + [(eq? type 'file) + (unless (file-exists? pkg) + (error 'pkg "no such file\n path: ~e" pkg)) + (define checksum-pth (format "~a.CHECKSUM" pkg)) + (define expected-checksum + (and (file-exists? checksum-pth) + check-sums? + (file->string checksum-pth))) + (define actual-checksum + (with-input-from-file pkg + (λ () (sha1 (current-input-port))))) - (unless (or (not expected-checksum) - (string=? expected-checksum actual-checksum)) - (error 'pkg "Incorrect checksum on package: expected ~e, got ~e" - expected-checksum actual-checksum)) - (define checksum - actual-checksum) - (define pkg-format (filename-extension pkg)) - (define pkg-name - (or given-pkg-name - (regexp-replace - (regexp - (format "~a$" (regexp-quote (format ".~a" pkg-format)))) - (path->string (file-name-from-path pkg)) - ""))) - (define pkg-dir - (make-temporary-file (string-append "~a-" pkg-name) - 'directory)) - (dynamic-wind - void - (λ () + (unless (or (not expected-checksum) + (string=? expected-checksum actual-checksum)) + (error 'pkg "Incorrect checksum on package: expected ~e, got ~e" + expected-checksum actual-checksum)) + (define checksum + actual-checksum) + (define pkg-format (filename-extension pkg)) + (define pkg-dir + (make-temporary-file (string-append "~a-" pkg-name) + 'directory)) + (dynamic-wind + void + (λ () + (make-directory* pkg-dir) + + (match pkg-format + [#"tgz" + (untar pkg pkg-dir)] + [#"tar" + (untar pkg pkg-dir)] + [#"gz" ; assuming .tar.gz + (untar pkg pkg-dir)] + [#"zip" + (unzip pkg (make-filesystem-entry-reader #:dest pkg-dir))] + [#"plt" (make-directory* pkg-dir) + (unpack pkg pkg-dir + (lambda (x) (printf "~a\n" x)) + (lambda () pkg-dir) + #f + (lambda (auto-dir main-dir file) pkg-dir))] + [x + (error 'pkg "Invalid package format: ~e" x)]) - (match pkg-format - [#"tgz" - (untar pkg pkg-dir)] - [#"tar" - (untar pkg pkg-dir)] - [#"gz" ; assuming .tar.gz - (untar pkg pkg-dir)] - [#"zip" - (unzip pkg (make-filesystem-entry-reader #:dest pkg-dir))] - [#"plt" - (make-directory* pkg-dir) - (unpack pkg pkg-dir - (lambda (x) (printf "~a\n" x)) - (lambda () pkg-dir) - #f - (lambda (auto-dir main-dir file) pkg-dir))] - [x - (error 'pkg "Invalid package format: ~e" x)]) - - (update-install-info-checksum - (update-install-info-orig-pkg - (install-package pkg-dir - #:type 'dir - #:pkg-name pkg-name) - `(file ,(simple-form-path* pkg))) - checksum)) - (λ () - (delete-directory/files pkg-dir)))] - [(if type - (eq? type 'dir) - (or - (path-match? #t #rx"/$" pkg) - (and (path? pkg) (directory-exists? pkg)))) - (unless (directory-exists? pkg) - (error 'pkg "no such directory\n path: ~e" pkg)) - (let ([pkg (directory-path-no-slash pkg)]) - (define pkg-name - (or given-pkg-name (path->string (file-name-from-path pkg)))) - (cond - [link? - (install-info pkg-name - `(link ,(simple-form-path* pkg)) - pkg - #f #f)] - [else - (define pkg-dir - (make-temporary-file "pkg~a" 'directory)) - (delete-directory pkg-dir) - (make-parent-directory* pkg-dir) - (copy-directory/files pkg pkg-dir) - (install-info pkg-name - `(dir ,(simple-form-path* pkg)) - pkg-dir - #t #f)]))] - [(if type - (eq? type 'name) - (path-match? #f #rx"^[-_a-zA-Z0-9]*$" pkg)) - (define index-info (package-index-lookup pkg)) - (define source (hash-ref index-info 'source)) - (define checksum (hash-ref index-info 'checksum)) - (define info (install-package source - #:pkg-name (or given-pkg-name pkg))) - (when (and (install-info-checksum info) - check-sums? - (not (equal? (install-info-checksum info) checksum))) - (error 'planet2 "Incorrect checksum on package: ~e" pkg)) - (update-install-info-orig-pkg - (update-install-info-checksum - info - checksum) - `(pns ,pkg))] - [else - (error 'pkg "cannot infer package source type\n given: ~e\n" pkg)])) + (update-install-info-checksum + (update-install-info-orig-pkg + (install-package pkg-dir + 'dir + pkg-name) + `(file ,(simple-form-path* pkg))) + checksum)) + (λ () + (delete-directory/files pkg-dir)))] + [(or (eq? type 'dir) + (eq? type 'link)) + (unless (directory-exists? pkg) + (error 'pkg "no such directory\n path: ~e" pkg)) + (let ([pkg (directory-path-no-slash pkg)]) + (cond + [(eq? type 'link) + (install-info pkg-name + `(link ,(simple-form-path* pkg)) + pkg + #f #f)] + [else + (define pkg-dir + (make-temporary-file "pkg~a" 'directory)) + (delete-directory pkg-dir) + (make-parent-directory* pkg-dir) + (copy-directory/files pkg pkg-dir) + (install-info pkg-name + `(dir ,(simple-form-path* pkg)) + pkg-dir + #t #f)]))] + [(eq? type 'name) + (define index-info (package-index-lookup pkg)) + (define source (hash-ref index-info 'source)) + (define checksum (hash-ref index-info 'checksum)) + (define info (install-package source + #f + pkg-name)) + (when (and (install-info-checksum info) + check-sums? + (not (equal? (install-info-checksum info) checksum))) + (error 'planet2 "Incorrect checksum on package: ~e" pkg)) + (update-install-info-orig-pkg + (update-install-info-checksum + info + checksum) + `(pns ,pkg))] + [else + (error 'pkg "cannot infer package source type\n given: ~e" pkg)])) (define db (read-pkg-db)) - (define (install-package/outer infos auto+pkg info) - (match-define (cons auto? pkg) - auto+pkg) + (define (install-package/outer infos desc info) + (match-define (pkg-desc pkg type orig-name auto?) desc) (match-define (install-info pkg-name orig-pkg pkg-dir clean? checksum) info) @@ -545,38 +564,51 @@ (error 'planet2 "~e is already installed" pkg-name)] [(and (not force?) - (for/or ([f (in-list (directory-list* pkg-dir))] + (for/or ([c (in-list (package-collections pkg-dir metadata-ns))] + [d (in-list (package-collection-directories pkg-dir metadata-ns))] + #:when #t + [f (in-list (directory-list* d))] #:when (member (filename-extension f) (list #"rkt" #"ss"))) + (define (has-collection-file? other-pkg-dir) + (for/or ([other-c (in-list (package-collections other-pkg-dir metadata-ns))] + [other-d (in-list (package-collection-directories other-pkg-dir metadata-ns))]) + (and (collection-equal? c other-c) + (file-exists? (build-path other-d f))))) (or - ;; Compare with Racket - (and (file-exists? (build-path (absolute-collects-dir) f)) - (cons "racket" f)) + ;; Compare with main installation's collections + (and (file-exists? (build-path (find-collects-dir) c f)) + (cons "racket" (build-path c f))) ;; Compare with installed packages (for/or ([other-pkg (in-hash-keys db)] #:unless (and updating? (equal? other-pkg pkg-name))) - (define p (build-path (package-directory other-pkg) f)) - (and (file-exists? p) - (cons other-pkg f))) + (and (has-collection-file? (package-directory other-pkg)) + (cons other-pkg (build-path c f)))) ;; Compare with simultaneous installs (for/or ([other-pkg-info (in-list infos)] #:unless (eq? other-pkg-info info)) - (define p (build-path (install-info-directory other-pkg-info) f)) - (and (file-exists? p) - (cons (install-info-name other-pkg-info) f)))))) + (and (has-collection-file? (install-info-directory other-pkg-info)) + (cons (install-info-name other-pkg-info) (build-path c f))))))) => (λ (conflicting-pkg*file) (clean!) (match-define (cons conflicting-pkg file) conflicting-pkg*file) - (error 'planet2 "~e conflicts with ~e: ~e" pkg conflicting-pkg file))] + (error 'planet2 (string-append + "packages conflict\n" + " package: ~a\n" + " package: ~a\n" + " file: ~a") + pkg conflicting-pkg file))] [(and (not (eq? dep-behavior 'force)) (let () - (define meta (file->value* (build-path pkg-dir "METADATA.rktd") empty)) - (define deps (dict-ref meta 'dependency empty)) + (define deps (get-metadata metadata-ns pkg-dir + 'deps empty + #:checker check-dependencies)) (define unsatisfied-deps (filter-not (λ (dep) - (or (set-member? simultaneous-installs dep) + (or (set-member? simultaneous-installs + (package-source->name dep)) (hash-has-key? db dep))) deps)) (and (not (empty? unsatisfied-deps)) @@ -592,7 +624,9 @@ (clean!) (error 'planet2 "missing dependencies: ~e" unsatisfied-deps)] ['search-auto - (printf "The following packages are listed as dependencies, but are not currently installed, so we will automatically install them.\n") + (printf (string-append + "The following packages are listed as dependencies, but are not currently installed,\n" + "so we will automatically install them:\n")) (printf "\t") (for ([p (in-list unsatisfied-deps)]) (printf "~a " p)) @@ -636,53 +670,47 @@ (pkg-info orig-pkg checksum auto?)) (dprintf "updating db with ~e to ~e" pkg-name this-pkg-info) (update-pkg-db! pkg-name this-pkg-info))])) + (define metadata-ns (make-metadata-namespace)) (define infos - (map install-package (map cdr auto+pkgs))) + (for/list ([v (in-list descs)]) + (install-package (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v)))) (define do-its (map (curry install-package/outer (append old-infos infos)) - (append old-auto+pkgs auto+pkgs) + (append old-descs descs) (append old-infos infos))) (pre-succeed) (for-each (λ (t) (t)) do-its)) -(define (install-cmd pkgs +(define (install-cmd descs #:old-infos [old-infos empty] - #:old-auto+pkgs [old-auto+pkgs empty] + #:old-auto+pkgs [old-descs empty] #:force? [force #f] - #:link? [link #f] - #:type [type #f] #:ignore-checksums? [ignore-checksums #f] #:pre-succeed [pre-succeed void] #:dep-behavior [dep-behavior #f] #:updating? [updating? #f]) - (with-handlers ([vector? - (match-lambda - [(vector new-infos deps) - (dprintf "\nInstallation failed with new deps: ~a\n\n" - deps) - - (install-cmd - #:old-infos new-infos - #:old-auto+pkgs (append old-auto+pkgs pkgs) - #:force? force - #:link? link - #:type type - #:ignore-checksums? ignore-checksums - #:dep-behavior dep-behavior - #:pre-succeed pre-succeed - #:updating? updating? - (map (curry cons #t) deps))])]) + (with-handlers* ([vector? + (match-lambda + [(vector new-infos deps) + (install-cmd + #:old-infos new-infos + #:old-auto+pkgs (append old-descs descs) + #:force? force + #:ignore-checksums? ignore-checksums + #:dep-behavior dep-behavior + #:pre-succeed pre-succeed + #:updating? updating? + (for/list ([dep (in-list deps)]) + (pkg-desc dep #f #f #t)))])]) (install-packages #:old-infos old-infos - #:old-auto+pkgs old-auto+pkgs + #:old-descs old-descs #:force? force - #:link? link - #:type type #:ignore-checksums? ignore-checksums #:dep-behavior dep-behavior #:pre-succeed pre-succeed #:updating? updating? - pkgs))) + descs))) (define (update-is-possible? pkg-name) (match-define (pkg-info orig-pkg checksum _) @@ -704,29 +732,32 @@ [`(file ,_) (error 'planet2 "Cannot update packages installed locally. (~e was installed via a local file.)" pkg-name)] - [`(,_ ,orig-pkg-desc) + [`(,_ ,orig-pkg-source) (define new-checksum (remote-package-checksum orig-pkg)) (and new-checksum (not (equal? checksum new-checksum)) - (cons pkg-name (cons auto? orig-pkg-desc)))])) + ;; FIXME: the type shouldn't be #f here; it should be + ;; preseved form instal time: + (pkg-desc orig-pkg-source #f pkg-name auto?))])) -(define (package-dependencies pkg-name) - (define pkg-dir (package-directory pkg-name)) - (define meta (file->value* (build-path pkg-dir "METADATA.rktd") empty)) - (dict-ref meta 'dependency empty)) +(define ((package-dependencies metadata-ns) pkg-name) + (get-metadata metadata-ns (package-directory pkg-name) + 'deps empty + #:checker check-dependencies)) (define (update-packages in-pkgs #:all? [all? #f] #:dep-behavior [dep-behavior #f] #:deps? [deps? #f]) + (define metadata-ns (make-metadata-namespace)) (define pkgs (cond [(and all? (empty? in-pkgs)) (filter update-is-possible? (hash-keys (read-pkg-db)))] [deps? (append-map - package-dependencies + (package-dependencies metadata-ns) in-pkgs)] [else in-pkgs])) @@ -738,9 +769,9 @@ [else (install-cmd #:updating? #t - #:pre-succeed (λ () (for-each (compose remove-package car) to-update)) + #:pre-succeed (λ () (for-each (compose remove-package pkg-desc-name) to-update)) #:dep-behavior dep-behavior - (map cdr to-update)) + to-update) #t])) (define (show-cmd) @@ -852,6 +883,12 @@ (contract-out [current-install-system-wide? (parameter/c boolean?)] + [pkg-desc + (-> string? + (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name) + (or/c string? #f) + boolean? + pkg-desc?)] [config-cmd (-> boolean? list? void)] @@ -872,10 +909,8 @@ [show-cmd (-> void)] [install-cmd - (->* ((listof (cons/c boolean? path-string?))) + (->* ((listof pkg-desc?)) (#:dep-behavior dep-behavior/c #:force? boolean? - #:link? boolean? - #:type (or/c #f 'file 'dir 'url 'github 'name) #:ignore-checksums? boolean?) void)])) diff --git a/collects/planet2/main.rkt b/collects/planet2/main.rkt index 0995aebf99..172ded188d 100644 --- a/collects/planet2/main.rkt +++ b/collects/planet2/main.rkt @@ -14,8 +14,10 @@ [install "Install packages" [(#:sym #f) type ("-t") ("Type of ;" - "options are: file, dir, url, github, or name;" + "options are: file, dir, file-url, dir-url, github, or name;" "if not specified, the type is inferred syntactically")] + [(#:str #f) name ("-n") ("Name of package, instead of inferred" + "(makes sense only when a single is given)")] [#:bool no-setup () ("Don't run 'raco setup' after changing packages" "(generally not a good idea)")] [#:bool installation ("-i") "Operate on the installation-wide package database"] @@ -39,11 +41,9 @@ (with-package-lock (install-cmd #:dep-behavior deps #:force? force - #:link? link #:ignore-checksums? ignore-checksums - #:type (or (and link 'dir) - type) - (map (curry cons #f) pkg-source)) + (for/list ([p (in-list pkg-source)]) + (pkg-desc p (or (and link 'link) type) name #f))) (setup no-setup)))] [update "Update packages" @@ -104,9 +104,7 @@ "Bundle a new package" [(#:str #f) format () ("Select the format of the package to be created;" - "options are: tgz, zip, plt")] + "options are: zip (the default), tgz, plt")] [#:bool manifest () "Creates a manifest file for a directory, rather than an archive"] #:args (maybe-dir) - (unless (or manifest format) - (error 'planet2 "You must specify an archive format")) - (create-cmd (if manifest "MANIFEST" format) maybe-dir)]) + (create-cmd (if manifest "MANIFEST" (or format "zip")) maybe-dir)]) diff --git a/collects/planet2/name.rkt b/collects/planet2/name.rkt new file mode 100644 index 0000000000..f7d2ab1ad0 --- /dev/null +++ b/collects/planet2/name.rkt @@ -0,0 +1,103 @@ +#lang racket/base +(require racket/list + net/url) + +(provide package-source->name+type + package-source->name) + +(define rx:package-name #rx"^[-_a-zA-Z0-9]+$") +(define rx:archive #rx"[.](plt|zip|tar|tgz|tar[.]gz)$") + +(define (validate-name name) + (and name + (regexp-match? rx:package-name name) + name)) + +(define (extract-archive-name name+ext) + (validate-name + (path->string + (if (regexp-match #rx#"[.]tar[.]gz$" (if (path? name+ext) + (path->bytes name+ext) + name+ext)) + (path-replace-suffix (path-replace-suffix name+ext #"") #"") + (path-replace-suffix name+ext #""))))) + +(define (last-non-empty p) + (cond + [(null? p) #f] + [else (or (last-non-empty (cdr p)) + (and (not (equal? "" (path/param-path (car p)))) + (car p)))])) + +(define (package-source->name+type s type) + ;; returns (values inferred-name inferred-type); + ;; if `type' is given it should be returned, but name can be #f; + ;; type should not be #f for a non-#f name + (cond + [(if type + (eq? type 'name) + (regexp-match? rx:package-name s)) + (values (and (regexp-match? rx:package-name s) s) 'name)] + [(and (eq? type 'github) + (not (regexp-match? #rx"^github://" s))) + (package-source->name+type + (string-append "github://github.com/" s) + 'github)] + [(if type + (or (eq? type 'github) + (eq? type 'file-url) + (eq? type 'dir-url)) + (regexp-match? #rx"^(https?|github)://" s)) + (define url (with-handlers ([exn:fail? (lambda (exn) #f)]) + (string->url s))) + (define-values (name name-type) + (if url + (let ([p (url-path url)]) + (cond + [(if type + (eq? type 'github) + (equal? (url-scheme url) "github")) + (define name + (and (pair? p) + (let ([p (if (equal? "" (path/param-path (last p))) + (reverse (cdr (reverse p))) + p)]) + (and ((length p) . >= . 3) + (validate-name + (if (= (length p) 3) + (path/param-path (second (reverse p))) + (path/param-path (last-non-empty p)))))))) + (values name (or type (and name 'github)))] + [(if type + (eq? type 'file-url) + (and (pair? p) + (regexp-match? rx:archive (path/param-path (last p))))) + (values (and (pair? p) + (extract-archive-name (path/param-path (last-non-empty p)))) + 'file-url)] + [else + (values (validate-name (path/param-path (last-non-empty p))) 'dir-url)])) + (values #f #f))) + (values (validate-name name) (or type (and name name-type)))] + [(and (not type) + (regexp-match? #rx"^[a-zA-Z]*://" s)) + (values #f #f)] + [(if type + (eq? type 'file) + (and (path-string? s) + (regexp-match rx:archive s))) + (define-values (base name+ext dir?) (split-path s)) + (define name (extract-archive-name name+ext)) + (values name 'file)] + [(if type + (or (eq? type 'dir) (eq? type 'link)) + (path-string? s)) + (define-values (base name dir?) (split-path s)) + (define dir-name (and (path? name) (path->string name))) + (values (validate-name dir-name) (or type (and dir-name 'dir)))] + [else + (values #f #f)])) + +(define (package-source->name s) + (define-values (name type) (package-source->name+type s #f)) + name) diff --git a/collects/planet2/scribblings/planet2.scrbl b/collects/planet2/scribblings/planet2.scrbl index 4aab0a3f93..1b6a43439d 100644 --- a/collects/planet2/scribblings/planet2.scrbl +++ b/collects/planet2/scribblings/planet2.scrbl @@ -1,23 +1,33 @@ #lang scribble/manual @(require scribble/bnf) +@(define Planet2 "Planet2") +@(define @|Planet1| @|PLaneT|) + @(define pkgname onscreen) @(define reponame litchar) -@title{Planet 2: Package Distribution (Beta)} -@author[@author+email["Jay McCarthy" "jay@racket-lang.org"]] - @(define package-name-chars @list{@litchar{a} through @litchar{z}, @litchar{A} through @litchar{Z}, @litchar{_}, and @litchar{-}}) -Planet 2 is a system for managing the use of external code packages in +@(define (inset . c) + (cons (hspace 2) c)) + +@; ---------------------------------------- + +@title{@|Planet2|: Package Management (Beta)} +@author[@author+email["Jay McCarthy" "jay@racket-lang.org"]] + +@|Planet2| is a system for managing the use of external code packages in your Racket installation. @table-of-contents[] -@section{Planet 2 Concepts} +@; ---------------------------------------- + +@section{Package Concepts} A @deftech{package} is a set of modules from some number of collections. @tech{Packages} also have associated @tech{package @@ -31,12 +41,9 @@ metadata}. ] A @tech{package} is typically represented by a directory with the same -name as the package which contains a file named -@filepath{METADATA.rktd} formatted as: -@verbatim{ - ((dependency "dependency1" ... "dependencyn")) -} -The checksum is typically left implicit. +name as the package. The checksum is typically left implicit. +If the package depends on other packages, the directory can +contain a file named @filepath{info.rkt} (see @secref["metadata"]). A @deftech{package source} identifies a @tech{package} representation. Each package source type has a different way of @@ -56,16 +63,18 @@ are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz}, A package source is inferred to refer to a file only when it has a suffix matching a valid archive format and when it does not start -with alphabetic characters followed by @litchar{://}.} +with alphabetic characters followed by @litchar{://}. The inferred +package name is the filename without its suffix.} @item{a local directory -- The name of the package is the name of the directory. The checksum is not present. For example, @filepath{~/tic-tac-toe/}. A package source is inferred to refer -to a directory only when it ends with a directory separator - and when it does not start -with alphabetic characters followed by @litchar{://}.} +to a directory only when it does not have a file-archive suffix, does +not match the grammar of a package name, and does not start +with alphabetic characters followed by @litchar{://}. The inferred +package name is the directory name.} @item{a remote URL naming an archive -- This type follows the same rules as a local file path, but the archive and checksum files are @@ -74,7 +83,11 @@ accessed via HTTP(S). For example, @filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}. A package source is inferred to be a URL only when it -starts with @litchar{http://} or @litchar{https://}.} +starts with @litchar{http://} or @litchar{https://}, and it +is inferred to be a file URL when the URL ends with a path element +that could be inferred as a file archive. +The inferred package name is from the URL's file name in the same +way as for a file package source.} @item{a remote URL naming a directory -- The remote directory must contain a file named @filepath{MANIFEST} that lists all the contingent @@ -85,15 +98,16 @@ to determine the checksum. For example, @filepath{http://game.com/tic-tac-toe/} and @filepath{http://game.com/tic-tac-toe/.CHECKSUM}. -A package source -is inferred to be a URL the same for a directory or file; the -interpretation is determined by the URL's resolution.} +A package source is inferred to be a URL the same for a directory or +file, and it is treated as a directory URL when it does not end with a +path element that has an archive file suffix. The inferred package name +is the directory name.} @item{a remote URL naming a GitHub repository -- The format for such URLs is: -@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repository}@; -@exec{/}@nonterm{branch}@exec{/}@nonterm{optional-subpath} +@inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repository}@; +@exec{/}@nonterm{branch}@exec{/}@nonterm{optional-subpath}} For example, @filepath{github://github.com/game/tic-tac-toe/master/}. @@ -105,7 +119,9 @@ checksum is the hash identifying the branch. A package source is inferred to be a GitHub reference when it starts with @litchar{github://}; a package source that is otherwise specified as a GitHub reference is automatically prefixed with -@filepath{github://github.com/}.} +@filepath{github://github.com/}. The inferred package name +is the last element of @nonterm{optional-subpath} if it is +non-empty, otherwise the inferred name is @nonterm{repository}.} @item{a bare package name -- The local list of @tech{package name services} is consulted to determine the source and checksum for the @@ -118,15 +134,15 @@ means that it has only the characters @|package-name-chars|.} ] A @deftech{package name service} (@deftech{PNS}) is a string representing a URL, -such that appending @exec{/pkg/}@nonterm{package-name} to the URL responds +such that appending @exec{/pkg/}@nonterm{package} to the URL responds with a @racket[read]-able hash table with the keys: @racket['source] bound to the source and @racket['checksum] bound to the checksum. Typically, the source will be a remote URL string. PLT supports two @tech{package name services}, which are enabled by -default: @filepath{https://plt-etc.byu.edu:9004} for new Planet 2 -packages and @filepath{https://plt-etc.byu.edu:9003} for -automatically generated Planet 2 packages for old Planet 1 +default: @url{https://plt-etc.byu.edu:9004} for new @|Planet2| +packages and @url{https://plt-etc.byu.edu:9003} for +automatically generated @|Planet2| packages for old @|PLaneT| packages. Anyone may host their own @tech{package name service}. The source for the PLT-hosted servers is in the @racket[(build-path (find-collects-dir) "meta" "planet2-index")] @@ -153,9 +169,11 @@ Package A is a @deftech{package update} of Package B if (1) B is installed, (2) A and B have the same name, and (3) A's checksum is different than B's. -@section{Using Planet 2} +@; ---------------------------------------- -Planet 2 has two user interfaces: a command line @exec{raco} +@section{Using Packages} + +The Racket package manager has two user interfaces: a command line @exec{raco} sub-command and a library. They have the exact same capabilities, as the command line interface invokes the library functions and reprovides all their options. @@ -177,6 +195,10 @@ sub-sub-commands: where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{url}, @exec{github}, or @exec{name}.} + @item{@DFlag{name} @nonterm{pkg} or @Flag{n} @nonterm{pkg} --- specifies the name of the package, + which makes sense only when a single @nonterm{pkg-source} is provided. The name is normally + inferred for each @nonterm{pkg-source}.} + @item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the environment variable @envvar{PLT_PLANET2_NOSETUP} is set to @exec{1}.} @@ -239,7 +261,7 @@ listed, this command fails atomically. It accepts the following @nonterm{option} } @item{@exec{config} @nonterm{option} ... @nonterm{key} @nonterm{val} ... --- -View and modify Planet 2 configuration options. It accepts the following @nonterm{option}s: +View and modify package configuration options. It accepts the following @nonterm{option}s: @itemlist[ @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.} @@ -257,7 +279,7 @@ View and modify Planet 2 configuration options. It accepts the following @nonter @itemlist[ @item{@DFlag{format} @nonterm{format} --- Specifies the archive format. - The allowed @nonterm{format}s are: @exec{tgz}, @exec{zip}, and @exec{plt}. + The allowed @nonterm{format}s are: @exec{zip} (the default), @exec{tgz}, and @exec{plt}. This option must be specified if @DFlag{manifest} is not present.} @item{@DFlag{manifest} --- Creates a manifest file for a directory, rather than an archive.} ] @@ -287,32 +309,35 @@ argument as a string. All other options accept booleans, where Duplicates the command line interface. } -@section{Developing Planet 2 Packages} +@; ---------------------------------------- -This section walks through the setup for a basic Planet 2 package. +@section{Developing Packages} -First, make a directory for your package and select its name: +To create a package, first make a directory for your package and +select its name, @nonterm{package}: -@commandline{mkdir } +@commandline{mkdir @nonterm{package}} Next, link your development directory to your local package repository: -@commandline{raco pkg install --link } +@commandline{raco pkg install --link @nonterm{package}} -Next, enter your directory and create a basic @tech{package metadata} -file: +Optionally, enter your directory and create a basic @filepath{info.rkt} file: -@commandline{cd } -@commandline{echo "((dependency))" > METADATA.rktd} +@commandline{cd @nonterm{package}} +@commandline{echo "#lang setup/infotab" > info.rkt} +@commandline{echo "(define deps (list))" >> info.rkt} -This metadata file is not necessary if you have no dependencies, but +The @filepath{info.rkt} file is not necessary if you have no dependencies, but you may wish to create it to simplify adding dependencies in the future. -Next, inside this directory, create directories for the collections -and modules that your package will provide. For example, -the developer of @pkgname{tic-tac-toe} might do: +Next, inside the @nonterm{package} directory, create directories for +the collections and modules that your package will provide. For +example, the developer of @pkgname{tic-tac-toe} package that provides +@racketidfont{games/tic-tac-toe/main} and @racketidfont{data/matrix} +libraries might create directories and files like this: @commandline{mkdir -p games/tic-tac-toe} @commandline{touch games/tic-tac-toe/info.rkt} @@ -320,62 +345,63 @@ the developer of @pkgname{tic-tac-toe} might do: @commandline{mkdir -p data} @commandline{touch data/matrix.rkt} -After your package is ready to deploy choose one of the following -options: +After your package is ready to deploy, choose either @secref["github-deploy"] +or @secref["manual-deploy"]. -@subsection{Github Deployment} +@subsection[#:tag "github-deploy"]{GitHub Deployment} -First, create a free account on -Github (@link["https://github.com/signup/free"]{signup here}). Then -create a repository for your -package (@link["https://github.com/new"]{here} (@link["https://help.github.com/articles/create-a-repo"]{documentation}).) -Then initialize the Git repository locally and do your first push: +First, @link["https://github.com/signup/free"]{create a free account} on GitHub, +then @link["https://github.com/new"]{create a repository for your +package} (@link["https://help.github.com/articles/create-a-repo"]{documentation}). +Initialize the Git repository locally and do your first push like this: @commandline{git init} @commandline{git add *} @commandline{git commit -m "First commit"} -@commandline{git remote add origin https://github.com//.git} +@commandline{git remote add origin https://github.com/@nonterm{user}/@nonterm{package}.git} @commandline{git push -u origin master} Now, publish your package source as: -@exec{github://github.com///} +@inset{@exec{github://github.com/@nonterm{user}/@nonterm{package}/@nonterm{branch}}} -(Typically, will be @litchar{master}, but you may wish to use -different branches for releases and development.) +Typically, @nonterm{branch} will be @exec{master}, but you may wish to use +different branches for releases and development. -Now, whenever you +Whenever you @commandline{git push} -Your changes will automatically be discovered by those who used your -package source. +your changes will automatically be discovered by those who used your +package source when they use @exec{raco pkg update}. -@subsection{Manual Deployment} +@subsection[#:tag "manual-deploy"]{Manual Deployment} Alternatively, you can deploy your package by publishing it on a URL you control. If you do this, it is preferable to create an archive first: -@commandline{raco pkg create } +@commandline{raco pkg create @nonterm{package}} And then upload the archive and its checksum to your site: -@commandline{scp .plt .plt.CHECKSUM your-host:public_html/} +@commandline{scp @nonterm{package}.zip @nonterm{package}.zip.CHECKSUM your-host:public_html/} Now, publish your package source as: -@exec{http://your-host/~/.plt} +@inset{@exec{http://your-host/~@nonterm{user}/@nonterm{package}.zip}} -Now, whenever you want to release a new version, recreate and reupload -the package archive (and checksum). Your changes will automatically be -discovered by those who used your package source. +Whenever you want to release a new version, recreate and reupload the +package archive (and checksum). Your changes will automatically be +discovered by those who used your package source when they use +@exec{raco pkg update}. @subsection{Helping Others Discover Your Package} By using either of the above deployment techniques, anyone will be -able to use your package. However, they will not be able to refer to -it by name until it is listed on a @tech{package name service}. +able to use your package by referring to your @tech{package source}. +However, they will not be able to refer to +it by a simple name until it is listed on a @tech{package name service}. If you'd like to use the official @tech{package name service}, browse to @@ -387,9 +413,9 @@ You only need to go to this site @emph{once} to list your package. The server will periodically check the package source you designate for updates. -If you use this server, and use Github for deployment, then you will -never need to open a Web browser to update your package for end -users. You just need to push to your Github repository, then within 24 +If you use this server, and use GitHub for deployment, then you will +never need to open a web browser to update your package for end +users. You just need to push to your GitHub repository, then within 24 hours, the official @tech{package name service} will notice, and @exec{raco pkg update} will work on your user's machines. @@ -438,50 +464,85 @@ PLT curation.} ] -@section{Planet 1 Compatibility} +@; ---------------------------------------- -PLT maintains a Planet 1 compatibility @tech{package name service} at -@link["https://plt-etc.byu.edu:9003/"]{https://plt-etc.byu.edu:9003/}. This -PNS is included by default in the Planet search path. +@section[#:tag "metadata"]{Package Metadata} -Planet 2 copies of Planet 1 packages are automatically created by this +Package metadata, including dependencies on thar packages, is reported +by an @filepath{info.rkt} module within the package. This module must be +implemented in the @racketmodname[setup/infotab] language. + +The following fields are used by the package manager: + +@itemlist[ + + @item{@racketidfont{deps} --- a list of @tech{package source} strings. + Each string determines a dependency on the @tech{package} whose name + is inferred from the @tech{package source} (i.e., dependencies are + on package names, not package sources), while the @tech{package source} indicates + where to get the package if needed to satisfy the dependency.} + +] + +For example, a basic @filepath{info.rkt} file might be + +@codeblock{ +#lang setup/infotab +(define deps (list _package-source-string ...)) +} + +@; ---------------------------------------- + +@section{@|Planet1| Compatibility} + +PLT maintains a @tech{package name service} to serve packages that +were developed using the original @seclink[#:doc '(lib +"planet/planet.scrbl") "top"]{@|Planet1|} package system. This +compatibility service is at +@link["https://plt-etc.byu.edu:9003/"]{https://plt-etc.byu.edu:9003/}, +which is included by default in the @|Planet2| search path. + +@|Planet2| copies of @|Planet1| packages are automatically created by the server according to the following system: for all packages that are in -the @litchar{4.x} Planet 1 repository, the latest minor version of -@tt{/.plt/} will be available as -@pkgname{planet--}. For example, +the @litchar{4.x} @|Planet1| repository, the latest minor version of +@tt{@nonterm{user}/@nonterm{package}.plt/@nonterm{major-version}} will be available as +@pkgname{planet-@nonterm{user}-@nonterm{package}@nonterm{major-version}}. For example, @tt{jaymccarthy/opencl.plt/1} minor version @tt{2}, will be available as @pkgname{planet-jaymccarthy-opencl1}. The contents of these copies is a single collection with the name -@filepath{/} with all the files from the -original Planet 1 package in it. +@filepath{@nonterm{user}/@nonterm{package}@nonterm{major-version}} with all the files from the +original @|Planet1| package in it. Each file has been transliterated to use direct Racket-style requires -rather than Planet 1-style requires. For example, if any file contains +rather than @|Planet1|-style requires. For example, if any file contains @racket[(planet jaymccarthy/opencl/module)], then it is transliterated to @racket[jaymccarthy/opencl1/module]. @emph{This transliteration is purely syntactic and is trivial to confuse, but works for most packages, in practice.} Any transliterations that occurred are automatically added as -dependencies for the Planet 2 compatibility package. +dependencies for the @|Planet2| compatibility package. We do not intend to improve this compatibility system much more over time, because it is simply a stop-gap as developers port their -packages to Planet 2. Additionally, the existence of this is not meant -to imply that we will be removing Planet 1 from existence in the near +packages to @|Planet2|. Additionally, the existence of the compatibility +server is not meant +to imply that we will be removing @|Planet1| from existence in the near future. -@section{FAQ} +@; ---------------------------------------- + +@section[#:style 'quiet]{FAQ} This section answers anticipated frequently asked questions about -Planet 2. +@|Planet2|. @subsection{Are package installations versioned with respect to the Racket version?} -No. When you install a Planet 2 package, it is installed for all -versions of Racket until you remove it. (In contrast, Planet 1 +No. When you install a @|Planet2| package, it is installed for all +versions of Racket until you remove it. (In contrast, @|Planet1| requires reinstallation of all packages every version change.) @subsection{Where and how are packages installed?} @@ -521,26 +582,26 @@ and I need an old version?} In such a situation, the author of the package has released a backwards incompatible edition of a package. It is not possible in -Planet 2 to deal with this situation. (Other than, of course, not +@|Planet2| to deal with this situation. (Other than, of course, not installing the "update".) Therefore, package authors should not make backwards incompatible changes to packages. Instead, they should release a new package with a new name. For example, package @pkgname{libgtk} might become @pkgname{libgtk2}. These packages should be designed to not conflict with each other, as well. -@subsection{Why is Planet 2 so different than Planet 1?} +@subsection{Why is @|Planet2| so different than @|Planet1|?} -There are two fundamental differences between Planet 1 and Planet 2. +There are two fundamental differences between @|Planet1| and @|Planet2|. -The first is that Planet 1 uses "internal linking" whereas Planet 2 +The first is that @|Planet1| uses "internal linking" whereas @|Planet2| uses "external linking". For example, an individual module requires a -Planet 1 package directly in a require statement: +@|Planet1| package directly in a require statement: @racketblock[ (require (planet game/tic-tac-toe/data/matrix)) ] -whereas in Planet 2, the module would simply require the module of +whereas in @|Planet2|, the module would simply require the module of interest: @racketblock[ @@ -557,12 +618,12 @@ can easily be split up, combined, or taken over by other authors, etc. This change is bad because it makes the meaning of your program dependent on the state of the system. (This is already true of Racket code in general, because there's no way to make the required core -version explicit, but the problem will be exacerbated by Planet 2.) +version explicit, but the problem will be exacerbated by @|Planet2|.) -The second major difference is that Planet 1 is committed to +The second major difference is that @|Planet1| is committed to guaranteeing that packages that never conflict with one another, so that any number of major and minor versions of the same package can be -installed and used simultaneously. Planet 2 does not share this +installed and used simultaneously. @|Planet2| does not share this commitment, so package authors and users must be mindful of potential conflicts and plan around them. @@ -571,32 +632,27 @@ maintenance (provided most packages don't conflict.) The change is bad because users must plan around potential conflicts. -In general, the goal of Planet 2 is to be a lower-level package +In general, the goal of @|Planet2| is to be a lower-level package system, more like the package systems used by operating systems. The -goals of Planet 1 are not bad, but we believe they are needed -infrequently and a system like Planet 1 could be more easily built -atop Planet 2 than the reverse. +goals of @|Planet1| are not bad, but we believe they are needed +infrequently and a system like @|Planet1| could be more easily built +atop @|Planet2| than the reverse. In particular, our plans to mitigate the downsides of these changes are documented in @secref["short-term"]. +@; ---------------------------------------- + @section{Future Plans} @subsection[#:tag "short-term"]{Short Term} -This section lists some short term plans for Planet 2. These are -important, but didn't block its release. Planet 2 will be considered +This section lists some short term plans for @|Planet2|. These are +important, but didn't block its release. @|Planet2| will be considered out of beta when these are completed. @itemlist[ -@item{It has not been tested on Windows or Mac OS X. If you would like -to test it, please run @exec{racket -collects/tests/planet2/test.rkt}. It is recommended that you run this -with the environment variable @envvar{PLT_PLANET2_NOSETUP} set to -@exec{1}. (The tests that require @exec{raco setup} to run -explicitly ignore the environment of the test script.)} - @item{The official PNS will divide packages into three categories: @reponame{planet}, @reponame{solar-system}, and @reponame{galaxy}. The definitions for these categories are: @@ -640,7 +696,7 @@ category will have more benefits, such as automatic regression testing on DrDr, testing during releases, provided binaries, and advertisement during installation. -The Planet 1 compatibility packages will also be included in +The @|Planet1| compatibility packages will also be included in the @reponame{solar-system} category, automatically. } @@ -669,7 +725,7 @@ different policies.} @subsection{Long Term} -This section lists some long term plans for Planet 2. Many of these +This section lists some long term plans for @|Planet2|. Many of these require a lot of cross-Racket integration. @itemlist[ diff --git a/collects/tests/planet2/test-pkgs/pkg-b-second/METADATA.rktd b/collects/tests/planet2/test-pkgs/pkg-b-second/METADATA.rktd deleted file mode 100644 index 34258a69ae..0000000000 --- a/collects/tests/planet2/test-pkgs/pkg-b-second/METADATA.rktd +++ /dev/null @@ -1 +0,0 @@ -((dependency "pkg-a")) diff --git a/collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt b/collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt new file mode 100644 index 0000000000..cbb86e9372 --- /dev/null +++ b/collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt @@ -0,0 +1,3 @@ +#lang setup/infotab + +(define deps '("pkg-a")) diff --git a/collects/tests/planet2/test-pkgs/planet2-test2/METADATA.rktd b/collects/tests/planet2/test-pkgs/planet2-test2/METADATA.rktd deleted file mode 100644 index cc2ddba876..0000000000 --- a/collects/tests/planet2/test-pkgs/planet2-test2/METADATA.rktd +++ /dev/null @@ -1 +0,0 @@ -((dependency "planet2-test1")) diff --git a/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt b/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt new file mode 100644 index 0000000000..62819cf0e9 --- /dev/null +++ b/collects/tests/planet2/test-pkgs/planet2-test2/info.rkt @@ -0,0 +1,3 @@ +#lang setup/infotab + +(define deps '("planet2-test1")) diff --git a/collects/tests/planet2/test.rkt b/collects/tests/planet2/test.rkt index f2e8423b8b..7178db8b21 100644 --- a/collects/tests/planet2/test.rkt +++ b/collects/tests/planet2/test.rkt @@ -28,6 +28,7 @@ (for-each (λ (x) (x)) l))))) (run-tests + "name" "basic" "create" "install" "network" "conflicts" "checksums" "deps" "update" diff --git a/collects/tests/planet2/tests-install.rkt b/collects/tests/planet2/tests-install.rkt index bbcf3d23db..5be9eda51d 100644 --- a/collects/tests/planet2/tests-install.rkt +++ b/collects/tests/planet2/tests-install.rkt @@ -39,13 +39,10 @@ "local directory name fails because not inferred as such (inferred as package name)" $ "raco pkg install test-pkgs" =exit> 1) (shelly-case - "local directory name fails because not inferred as such (no default inference)" - $ "raco pkg install test-pkgs/pkg-a-first" =exit> 1) - (shelly-case - "local file name with bad suffix and not a package name" + "local file name with bad suffix and not a package name or directory" $ "raco pkg install tests-install.rkt" =exit> 1) (shelly-case - "not a file, directory, or valid package name" + "not a valid (inferred) package name" $ "raco pkg install 1+2" =exit> 1) (shelly-case @@ -63,13 +60,13 @@ $ "raco pkg install http://localhost:9999/planet2-test1.rar" =exit> 1) (shelly-case "remote/URL/http directory, no manifest fail" - $ "raco pkg install http://localhost:9999/planet2-test1/planet2-test1" + $ "raco pkg install http://localhost:9999/planet2-test1/planet2-test1/" =exit> 1 - =stderr> #rx"Invalid package format") + =stderr> #rx"could not find MANIFEST") (shelly-case "remote/URL/http directory, bad manifest" ;; XXX why does this error now? - $ "raco pkg install http://localhost:9999/planet2-test1-manifest-error" =exit> 1) + $ "raco pkg install http://localhost:9999/planet2-test1-manifest-error/" =exit> 1) (shelly-case "local directory fails when not there" diff --git a/collects/tests/planet2/tests-name.rkt b/collects/tests/planet2/tests-name.rkt new file mode 100644 index 0000000000..d36f7e18fc --- /dev/null +++ b/collects/tests/planet2/tests-name.rkt @@ -0,0 +1,75 @@ +#lang racket/base +(require rackunit + planet2/name + "util.rkt") + +(define-syntax check-equal-values? + (syntax-rules (values) + [(_ expr (values a ...)) + (check-equal? (call-with-values (lambda () expr) list) (list a ...))])) + +(define (run-pkg-tests) + (check-equal-values? (package-source->name+type "" #f) (values #f #f)) + + (check-equal-values? (package-source->name+type "fish" #f) (values "fish" 'name)) + (check-equal-values? (package-source->name+type "fish" 'name) (values "fish" 'name)) + (check-equal-values? (package-source->name+type "fish!" 'name) (values #f 'name)) + (check-equal-values? (package-source->name+type "fish/" 'name) (values #f 'name)) + (check-equal-values? (package-source->name+type "fish123A_B-C" #f) (values "fish123A_B-C" 'name)) + (check-equal-values? (package-source->name+type "fish123A_B-C!" 'name) (values #f 'name)) + + (check-equal-values? (package-source->name+type "fish.plt" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.zip" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.tar" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.tgz" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.tar.gz" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "ocean/fish.tar.gz" #f) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.plt" 'file) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.tar.gz" 'file) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish.other" 'file) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish" 'file) (values "fish" 'file)) + (check-equal-values? (package-source->name+type "fish!" 'file) (values #f 'file)) + + (check-equal-values? (package-source->name+type "fish/" #f) (values "fish" 'dir)) + (check-equal-values? (package-source->name+type "./fish" #f) (values "fish" 'dir)) + (check-equal-values? (package-source->name+type "sub/fish" #f) (values "fish" 'dir)) + (check-equal-values? (package-source->name+type "fish/" 'dir) (values "fish" 'dir)) + (check-equal-values? (package-source->name+type "fish/" 'link) (values "fish" 'link)) + (check-equal-values? (package-source->name+type "fish" 'dir) (values "fish" 'dir)) + (check-equal-values? (package-source->name+type "fish!/" 'dir) (values #f 'dir)) + + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" #f) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "https://racket-lang.org/fish.plt" #f) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish.tar.gz" #f) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish" 'file-url) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "fish" 'file-url) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "dir/fish" 'file-url) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "fish/" 'file-url) (values "fish" 'file-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish!" 'file-url) (values #f 'file-url)) + + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish/" #f) (values "fish" 'dir-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish/" 'dir-url) (values "fish" 'dir-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish" 'dir-url) (values "fish" 'dir-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" 'dir-url) (values #f 'dir-url)) + (check-equal-values? (package-source->name+type "http://racket-lang.org/fish" #f) (values "fish" 'dir-url)) + + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" #f) (values "fish" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release" #f) (values "fish" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish" #f) (values "catfish" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/" #f) (values "catfish" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/bill" #f) (values "bill" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" 'github) (values "fish" 'github)) + (check-equal-values? (package-source->name+type "racket/fish/master" 'github) (values "fish" 'github)) + (check-equal-values? (package-source->name+type "racket/fish/master/" 'github) (values "fish" 'github)) + (check-equal-values? (package-source->name+type "github://github.com/fish/master" 'github) (values #f 'github)) + (check-equal-values? (package-source->name+type "fish/master" 'github) (values #f 'github)) + (check-equal-values? (package-source->name+type "github://github.com/racket/fish.more/release" 'github) (values #f 'github)) + + (check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f)) + + (void)) + +(provide run-pkg-tests) + +(module+ main + (run-pkg-tests* run-pkg-tests)) diff --git a/collects/tests/planet2/tests-overwrite.rkt b/collects/tests/planet2/tests-overwrite.rkt index 1a44d93269..7e068df49a 100644 --- a/collects/tests/planet2/tests-overwrite.rkt +++ b/collects/tests/planet2/tests-overwrite.rkt @@ -10,7 +10,7 @@ ;; Step 1. Try to install a package that will fail $ "raco pkg install test-pkgs/planet2-test1.zip test-pkgs/planet2-test1.zip" =exit> 1 - =stderr> #rx"conflicts with \"planet2-test1\"" + =stderr> #rx"packages conflict" ;; Step 2. Try to install safely $ "raco pkg install test-pkgs/planet2-test1.zip")))