suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg: switch from "METADATA.rktd" to "info.rkt"

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2012-11-30 06:02:52 -07:00
parent d94d479f15
commit 381d9d84d6
14 changed files with 734 additions and 463 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/meta/planet2-index/planet-compat/main.rkt
View File

@ -334,9 +334,12 @@
all-deps))) all-deps)))
(printf "\tdeps ~a\n" deps) (printf "\tdeps ~a\n" deps)
(write-to-file (call-with-output-file*
`((dependency ,@deps)) (build-path pkg-dir "info.rkt.rktd")
(build-path pkg-dir "METADATA.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)) (define pkg-pth (build-path pkg-depo pkg-depo-dir pkg-name.plt))
(when-delete? (when-delete?

1
collects/planet2/info.rkt
View File

@ -1,6 +1,5 @@
#lang setup/infotab #lang setup/infotab
(define name "Planet2")
(define scribblings (define scribblings
'(("scribblings/planet2.scrbl" (multi-page) (tool 100)))) '(("scribblings/planet2.scrbl" (multi-page) (tool 100))))
(define raco-commands (define raco-commands

689
collects/planet2/lib.rkt
View File

@ -21,11 +21,16 @@
file/tar file/tar
file/zip file/zip
file/unzip file/unzip
setup/getinfo
setup/dirs
"name.rkt"
"util.rkt") "util.rkt")
(define current-install-system-wide? (define current-install-system-wide?
(make-parameter #f)) (make-parameter #f))
(struct pkg-desc (source type name auto?))
(define (file->value* pth def) (define (file->value* pth def)
(with-handlers ([exn:fail? (λ (x) def)]) (with-handlers ([exn:fail? (λ (x) def)])
(file->value pth))) (file->value pth)))
@ -42,11 +47,6 @@
(define (directory-path-no-slash pkg) (define (directory-path-no-slash pkg)
(bytes->path (regexp-replace* #rx#"/$" (path->bytes* 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) (define (directory-list* d)
(append-map (append-map
(λ (pp) (λ (pp)
@ -95,6 +95,46 @@
(for-each make-directory* (for-each make-directory*
(list (pkg-dir) (pkg-installed-dir))) (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) (define (with-package-lock* t)
(make-directory* (pkg-dir)) (make-directory* (pkg-dir))
(call-with-file-lock/timeout (call-with-file-lock/timeout
@ -134,7 +174,7 @@
(define (read-file-hash file) (define (read-file-hash file)
(define the-db (define the-db
(with-handlers ([exn? (λ (x) (hash))]) (with-handlers ([exn:fail? (λ (x) (hash))])
(file->value file))) (file->value file)))
the-db) the-db)
(define (write-file-hash! file new-db) (define (write-file-hash! file new-db)
@ -221,6 +261,7 @@
(hash-keys db)) (hash-keys db))
(define all-pkgs-set (define all-pkgs-set
(list->set all-pkgs)) (list->set all-pkgs))
(define metadata-ns (make-metadata-namespace))
(define pkgs (define pkgs
(if auto? (if auto?
(set->list (set->list
@ -230,7 +271,7 @@
(λ (p) (pkg-info-auto? (hash-ref db p))) (λ (p) (pkg-info-auto? (hash-ref db p)))
all-pkgs)) all-pkgs))
(list->set (list->set
(append-map package-dependencies (append-map (package-dependencies metadata-ns)
all-pkgs)))) all-pkgs))))
in-pkgs)) in-pkgs))
(unless force? (unless force?
@ -242,7 +283,7 @@
(set-intersect (set-intersect
pkgs-set pkgs-set
(list->set (list->set
(append-map package-dependencies (append-map (package-dependencies metadata-ns)
(set->list (set->list
remaining-pkg-db-set))))) remaining-pkg-db-set)))))
(unless (set-empty? deps-to-be-removed) (unless (set-empty? deps-to-be-removed)
@ -252,284 +293,262 @@
(define (install-packages (define (install-packages
#:old-infos [old-infos empty] #:old-infos [old-infos empty]
#:old-auto+pkgs [old-auto+pkgs empty] #:old-descs [old-descs empty]
#:pre-succeed [pre-succeed void] #:pre-succeed [pre-succeed void]
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:updating? [updating? #f] #:updating? [updating? #f]
#:ignore-checksums? [ignore-checksums? #f] #:ignore-checksums? [ignore-checksums? #f]
#:link? [link? #f]
#:type [type #f]
#:force? [force? #f] #:force? [force? #f]
auto+pkgs) descs)
(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)))
(define check-sums? (not ignore-checksums?)) (define check-sums? (not ignore-checksums?))
(define (install-package pkg (define (install-package pkg given-type given-pkg-name)
#:type [type type] (define-values (inferred-pkg-name type)
#:pkg-name [given-pkg-name #f]) (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 (cond
[(and (eq? type 'github) [(and (eq? type 'github)
(not (path-match? #f #rx"^github://" pkg))) (not (regexp-match? #rx"^github://" pkg)))
;; Add "github://github.com/" ;; Add "github://github.com/"
(install-package (string-append "github://github.com/" pkg))] (install-package (string-append "github://github.com/" pkg) type
[(if type pkg-name)]
(or (eq? type 'url) (eq? type 'github)) [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github))
(path-match? #f #rx"^(https?|github)://" pkg)) (define pkg-url (string->url pkg))
(let () (define scheme (url-scheme pkg-url))
(define pkg-url (string->url pkg))
(define scheme (url-scheme pkg-url))
(define orig-pkg `(url ,pkg)) (define orig-pkg `(url ,pkg))
(define checksum (remote-package-checksum orig-pkg)) (define checksum (remote-package-checksum orig-pkg))
(define info (define info
(update-install-info-orig-pkg (update-install-info-orig-pkg
(match scheme (match type
["github" ['github
(match-define (list* user repo branch path) (match-define (list* user repo branch path)
(map path/param-path (url-path/no-slash pkg-url))) (map path/param-path (url-path/no-slash pkg-url)))
(define new-url (define new-url
(url "https" #f "github.com" #f #t (url "https" #f "github.com" #f #t
(map (λ (x) (path/param x empty)) (map (λ (x) (path/param x empty))
(list user repo "tarball" branch)) (list user repo "tarball" branch))
empty empty
#f)) #f))
(define tmp.tgz (define tmp.tgz
(make-temporary-file (make-temporary-file
(string-append (string-append
"~a-" "~a-"
(format "~a.~a.tgz" repo branch)) (format "~a.~a.tgz" repo branch))
#f)) #f))
(delete-file tmp.tgz) (delete-file tmp.tgz)
(define tmp-dir (define tmp-dir
(make-temporary-file (make-temporary-file
(string-append (string-append
"~a-" "~a-"
(format "~a.~a" repo branch)) (format "~a.~a" repo branch))
'directory)) 'directory))
(define package-path (define package-path
(apply build-path tmp-dir path)) (apply build-path tmp-dir path))
(dynamic-wind (dynamic-wind
void void
(λ () (λ ()
(download-file! new-url tmp.tgz) (download-file! new-url tmp.tgz)
(dynamic-wind (dynamic-wind
void void
(λ () (λ ()
(untar tmp.tgz tmp-dir #:strip-components 1) (untar tmp.tgz tmp-dir #:strip-components 1)
(install-package (path->string package-path) (install-package (path->string package-path)
#:type 'dir 'dir
#:pkg-name given-pkg-name)) pkg-name))
(λ () (λ ()
(delete-directory/files tmp-dir)))) (delete-directory/files tmp-dir))))
(λ () (λ ()
(delete-directory/files tmp.tgz)))] (delete-directory/files tmp.tgz)))]
[_ [_
(define url-last-component (define url-last-component
(path/param-path (last (url-path pkg-url)))) (path/param-path (last (url-path pkg-url))))
(define url-looks-like-directory? (define url-looks-like-directory? (eq? type 'dir-url))
(string=? "" url-last-component)) (define-values
(define-values (package-path download-type download-package!)
(package-path package-name download-type download-package!) (cond
(cond [url-looks-like-directory?
[url-looks-like-directory? (define package-path
(define package-name (make-temporary-file
(path/param-path (string-append
(second (reverse (url-path pkg-url))))) "~a-"
(define package-path pkg-name)
(make-temporary-file 'directory))
(string-append (define (path-like f)
"~a-" (build-path package-path f))
package-name) (define (url-like f)
'directory)) (if (and (pair? (url-path pkg-url))
(define (path-like f) (equal? "" (path/param-path (last (url-path pkg-url)))))
(build-path package-path f)) ;; normal relative path:
(define (url-like f) (combine-url/relative pkg-url f)
(combine-url/relative pkg-url f)) ;; we're assuming that the last path element is
(values package-path ;; a directory, so just add f:
package-name (struct-copy url pkg-url [path
'dir (append
(λ () (url-path pkg-url)
(printf "\tCloning remote directory\n") (list (path/param f null)))])))
(make-directory* package-path) (values package-path
(define manifest 'dir
(call/input-url+200 (λ ()
(url-like "MANIFEST") (printf "\tCloning remote directory\n")
port->lines)) (make-directory* package-path)
(for ([f (in-list manifest)]) (define manifest
(download-file! (url-like f) (call/input-url+200
(path-like f)))))] (url-like "MANIFEST")
[else port->lines))
(define package-path (unless manifest
(make-temporary-file (error 'pkg "could not find MANIFEST for package source\n source: ~e"
(string-append pkg))
"~a-" (for ([f (in-list manifest)])
url-last-component) (download-file! (url-like f)
#f)) (path-like f)))))]
(delete-file package-path) [else
(values package-path (define package-path
(regexp-replace (make-temporary-file
#rx"\\.[^.]+$" (string-append
url-last-component "~a-"
"") url-last-component)
'file #f))
(λ () (delete-file package-path)
(dprintf "\tAssuming URL names a file\n") (values package-path
(download-file! pkg-url package-path)))])) 'file
(dynamic-wind (λ ()
void (dprintf "\tAssuming URL names a file\n")
(λ () (download-file! pkg-url package-path)))]))
(download-package!) (dynamic-wind
(define pkg-name void
(or given-pkg-name (λ ()
package-name)) (download-package!)
(dprintf "\tDownloading done, installing ~a as ~a\n" (dprintf "\tDownloading done, installing ~a as ~a\n"
package-path pkg-name) package-path pkg-name)
(install-package package-path (install-package package-path
#:type download-type download-type
#:pkg-name pkg-name))
pkg-name)) (λ ()
(λ () (when (or (file-exists? package-path)
(when (or (file-exists? package-path) (directory-exists? package-path))
(directory-exists? package-path)) (delete-directory/files package-path))))])
(delete-directory/files package-path))))]) orig-pkg))
orig-pkg)) (when (and check-sums?
(when (and check-sums? (install-info-checksum info)
(install-info-checksum info) (not checksum))
(not checksum)) (error 'planet2 "Remote package ~a had no checksum"
(error 'planet2 "Remote package ~a had no checksum" pkg))
pkg)) (when (and checksum
(when (and checksum (install-info-checksum info)
(install-info-checksum info) check-sums?
check-sums? (not (equal? (install-info-checksum info) checksum)))
(not (equal? (install-info-checksum info) checksum))) (error 'planet2 "Incorrect checksum on package ~e: expected ~e, got ~e"
(error 'planet2 "Incorrect checksum on package ~e: expected ~e, got ~e" pkg
pkg (install-info-checksum info) checksum))
(install-info-checksum info) checksum)) (update-install-info-checksum
(update-install-info-checksum info
info checksum)]
checksum))] [(eq? type 'file)
[(and (not type) (unless (file-exists? pkg)
(path-match? #f #rx"^[a-zA-Z]*://" pkg)) (error 'pkg "no such file\n path: ~e" pkg))
(error 'pkg "unrecognized scheme for package source\n given: ~e\n" pkg)] (define checksum-pth (format "~a.CHECKSUM" pkg))
[(if type (define expected-checksum
(eq? type 'file) (and (file-exists? checksum-pth)
(or check-sums?
(path-match? #t #rx"[.](plt|zip|tar|tgz|tar[.]gz)$" pkg) (file->string checksum-pth)))
(and (path? pkg) (not (directory-exists? pkg))))) (define actual-checksum
(unless (file-exists? pkg) (with-input-from-file 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))))) (sha1 (current-input-port)))))
(unless (or (not expected-checksum) (unless (or (not expected-checksum)
(string=? expected-checksum actual-checksum)) (string=? expected-checksum actual-checksum))
(error 'pkg "Incorrect checksum on package: expected ~e, got ~e" (error 'pkg "Incorrect checksum on package: expected ~e, got ~e"
expected-checksum actual-checksum)) expected-checksum actual-checksum))
(define checksum (define checksum
actual-checksum) actual-checksum)
(define pkg-format (filename-extension pkg)) (define pkg-format (filename-extension pkg))
(define pkg-name (define pkg-dir
(or given-pkg-name (make-temporary-file (string-append "~a-" pkg-name)
(regexp-replace 'directory))
(regexp (dynamic-wind
(format "~a$" (regexp-quote (format ".~a" pkg-format)))) void
(path->string (file-name-from-path pkg)) (λ ()
""))) (make-directory* pkg-dir)
(define pkg-dir
(make-temporary-file (string-append "~a-" pkg-name) (match pkg-format
'directory)) [#"tgz"
(dynamic-wind (untar pkg pkg-dir)]
void [#"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) (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 (update-install-info-checksum
[#"tgz" (update-install-info-orig-pkg
(untar pkg pkg-dir)] (install-package pkg-dir
[#"tar" 'dir
(untar pkg pkg-dir)] pkg-name)
[#"gz" ; assuming .tar.gz `(file ,(simple-form-path* pkg)))
(untar pkg pkg-dir)] checksum))
[#"zip" (λ ()
(unzip pkg (make-filesystem-entry-reader #:dest pkg-dir))] (delete-directory/files pkg-dir)))]
[#"plt" [(or (eq? type 'dir)
(make-directory* pkg-dir) (eq? type 'link))
(unpack pkg pkg-dir (unless (directory-exists? pkg)
(lambda (x) (printf "~a\n" x)) (error 'pkg "no such directory\n path: ~e" pkg))
(lambda () pkg-dir) (let ([pkg (directory-path-no-slash pkg)])
#f (cond
(lambda (auto-dir main-dir file) pkg-dir))] [(eq? type 'link)
[x (install-info pkg-name
(error 'pkg "Invalid package format: ~e" x)]) `(link ,(simple-form-path* pkg))
pkg
(update-install-info-checksum #f #f)]
(update-install-info-orig-pkg [else
(install-package pkg-dir (define pkg-dir
#:type 'dir (make-temporary-file "pkg~a" 'directory))
#:pkg-name pkg-name) (delete-directory pkg-dir)
`(file ,(simple-form-path* pkg))) (make-parent-directory* pkg-dir)
checksum)) (copy-directory/files pkg pkg-dir)
(λ () (install-info pkg-name
(delete-directory/files pkg-dir)))] `(dir ,(simple-form-path* pkg))
[(if type pkg-dir
(eq? type 'dir) #t #f)]))]
(or [(eq? type 'name)
(path-match? #t #rx"/$" pkg) (define index-info (package-index-lookup pkg))
(and (path? pkg) (directory-exists? pkg)))) (define source (hash-ref index-info 'source))
(unless (directory-exists? pkg) (define checksum (hash-ref index-info 'checksum))
(error 'pkg "no such directory\n path: ~e" pkg)) (define info (install-package source
(let ([pkg (directory-path-no-slash pkg)]) #f
(define pkg-name pkg-name))
(or given-pkg-name (path->string (file-name-from-path pkg)))) (when (and (install-info-checksum info)
(cond check-sums?
[link? (not (equal? (install-info-checksum info) checksum)))
(install-info pkg-name (error 'planet2 "Incorrect checksum on package: ~e" pkg))
`(link ,(simple-form-path* pkg)) (update-install-info-orig-pkg
pkg (update-install-info-checksum
#f #f)] info
[else checksum)
(define pkg-dir `(pns ,pkg))]
(make-temporary-file "pkg~a" 'directory)) [else
(delete-directory pkg-dir) (error 'pkg "cannot infer package source type\n given: ~e" pkg)]))
(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)]))
(define db (read-pkg-db)) (define db (read-pkg-db))
(define (install-package/outer infos auto+pkg info) (define (install-package/outer infos desc info)
(match-define (cons auto? pkg) (match-define (pkg-desc pkg type orig-name auto?) desc)
auto+pkg)
(match-define (match-define
(install-info pkg-name orig-pkg pkg-dir clean? checksum) (install-info pkg-name orig-pkg pkg-dir clean? checksum)
info) info)
@ -545,38 +564,51 @@
(error 'planet2 "~e is already installed" pkg-name)] (error 'planet2 "~e is already installed" pkg-name)]
[(and [(and
(not force?) (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) #:when (member (filename-extension f)
(list #"rkt" #"ss"))) (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 (or
;; Compare with Racket ;; Compare with main installation's collections
(and (file-exists? (build-path (absolute-collects-dir) f)) (and (file-exists? (build-path (find-collects-dir) c f))
(cons "racket" f)) (cons "racket" (build-path c f)))
;; Compare with installed packages ;; Compare with installed packages
(for/or ([other-pkg (in-hash-keys db)] (for/or ([other-pkg (in-hash-keys db)]
#:unless (and updating? (equal? other-pkg pkg-name))) #:unless (and updating? (equal? other-pkg pkg-name)))
(define p (build-path (package-directory other-pkg) f)) (and (has-collection-file? (package-directory other-pkg))
(and (file-exists? p) (cons other-pkg (build-path c f))))
(cons other-pkg f)))
;; Compare with simultaneous installs ;; Compare with simultaneous installs
(for/or ([other-pkg-info (in-list infos)] (for/or ([other-pkg-info (in-list infos)]
#:unless (eq? other-pkg-info info)) #:unless (eq? other-pkg-info info))
(define p (build-path (install-info-directory other-pkg-info) f)) (and (has-collection-file? (install-info-directory other-pkg-info))
(and (file-exists? p) (cons (install-info-name other-pkg-info) (build-path c f)))))))
(cons (install-info-name other-pkg-info) f))))))
=> =>
(λ (conflicting-pkg*file) (λ (conflicting-pkg*file)
(clean!) (clean!)
(match-define (cons conflicting-pkg file) conflicting-pkg*file) (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 [(and
(not (eq? dep-behavior 'force)) (not (eq? dep-behavior 'force))
(let () (let ()
(define meta (file->value* (build-path pkg-dir "METADATA.rktd") empty)) (define deps (get-metadata metadata-ns pkg-dir
(define deps (dict-ref meta 'dependency empty)) 'deps empty
#:checker check-dependencies))
(define unsatisfied-deps (define unsatisfied-deps
(filter-not (λ (dep) (filter-not (λ (dep)
(or (set-member? simultaneous-installs dep) (or (set-member? simultaneous-installs
(package-source->name dep))
(hash-has-key? db dep))) (hash-has-key? db dep)))
deps)) deps))
(and (not (empty? unsatisfied-deps)) (and (not (empty? unsatisfied-deps))
@ -592,7 +624,9 @@
(clean!) (clean!)
(error 'planet2 "missing dependencies: ~e" unsatisfied-deps)] (error 'planet2 "missing dependencies: ~e" unsatisfied-deps)]
['search-auto ['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") (printf "\t")
(for ([p (in-list unsatisfied-deps)]) (for ([p (in-list unsatisfied-deps)])
(printf "~a " p)) (printf "~a " p))
@ -636,53 +670,47 @@
(pkg-info orig-pkg checksum auto?)) (pkg-info orig-pkg checksum auto?))
(dprintf "updating db with ~e to ~e" pkg-name this-pkg-info) (dprintf "updating db with ~e to ~e" pkg-name this-pkg-info)
(update-pkg-db! pkg-name this-pkg-info))])) (update-pkg-db! pkg-name this-pkg-info))]))
(define metadata-ns (make-metadata-namespace))
(define infos (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 (define do-its
(map (curry install-package/outer (append old-infos infos)) (map (curry install-package/outer (append old-infos infos))
(append old-auto+pkgs auto+pkgs) (append old-descs descs)
(append old-infos infos))) (append old-infos infos)))
(pre-succeed) (pre-succeed)
(for-each (λ (t) (t)) do-its)) (for-each (λ (t) (t)) do-its))
(define (install-cmd pkgs (define (install-cmd descs
#:old-infos [old-infos empty] #:old-infos [old-infos empty]
#:old-auto+pkgs [old-auto+pkgs empty] #:old-auto+pkgs [old-descs empty]
#:force? [force #f] #:force? [force #f]
#:link? [link #f]
#:type [type #f]
#:ignore-checksums? [ignore-checksums #f] #:ignore-checksums? [ignore-checksums #f]
#:pre-succeed [pre-succeed void] #:pre-succeed [pre-succeed void]
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:updating? [updating? #f]) #:updating? [updating? #f])
(with-handlers ([vector? (with-handlers* ([vector?
(match-lambda (match-lambda
[(vector new-infos deps) [(vector new-infos deps)
(dprintf "\nInstallation failed with new deps: ~a\n\n" (install-cmd
deps) #:old-infos new-infos
#:old-auto+pkgs (append old-descs descs)
(install-cmd #:force? force
#:old-infos new-infos #:ignore-checksums? ignore-checksums
#:old-auto+pkgs (append old-auto+pkgs pkgs) #:dep-behavior dep-behavior
#:force? force #:pre-succeed pre-succeed
#:link? link #:updating? updating?
#:type type (for/list ([dep (in-list deps)])
#:ignore-checksums? ignore-checksums (pkg-desc dep #f #f #t)))])])
#:dep-behavior dep-behavior
#:pre-succeed pre-succeed
#:updating? updating?
(map (curry cons #t) deps))])])
(install-packages (install-packages
#:old-infos old-infos #:old-infos old-infos
#:old-auto+pkgs old-auto+pkgs #:old-descs old-descs
#:force? force #:force? force
#:link? link
#:type type
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:pre-succeed pre-succeed #:pre-succeed pre-succeed
#:updating? updating? #:updating? updating?
pkgs))) descs)))
(define (update-is-possible? pkg-name) (define (update-is-possible? pkg-name)
(match-define (pkg-info orig-pkg checksum _) (match-define (pkg-info orig-pkg checksum _)
@ -704,29 +732,32 @@
[`(file ,_) [`(file ,_)
(error 'planet2 "Cannot update packages installed locally. (~e was installed via a local file.)" (error 'planet2 "Cannot update packages installed locally. (~e was installed via a local file.)"
pkg-name)] pkg-name)]
[`(,_ ,orig-pkg-desc) [`(,_ ,orig-pkg-source)
(define new-checksum (define new-checksum
(remote-package-checksum orig-pkg)) (remote-package-checksum orig-pkg))
(and new-checksum (and new-checksum
(not (equal? checksum 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 ((package-dependencies metadata-ns) pkg-name)
(define pkg-dir (package-directory pkg-name)) (get-metadata metadata-ns (package-directory pkg-name)
(define meta (file->value* (build-path pkg-dir "METADATA.rktd") empty)) 'deps empty
(dict-ref meta 'dependency empty)) #:checker check-dependencies))
(define (update-packages in-pkgs (define (update-packages in-pkgs
#:all? [all? #f] #:all? [all? #f]
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:deps? [deps? #f]) #:deps? [deps? #f])
(define metadata-ns (make-metadata-namespace))
(define pkgs (define pkgs
(cond (cond
[(and all? (empty? in-pkgs)) [(and all? (empty? in-pkgs))
(filter update-is-possible? (hash-keys (read-pkg-db)))] (filter update-is-possible? (hash-keys (read-pkg-db)))]
[deps? [deps?
(append-map (append-map
package-dependencies (package-dependencies metadata-ns)
in-pkgs)] in-pkgs)]
[else [else
in-pkgs])) in-pkgs]))
@ -738,9 +769,9 @@
[else [else
(install-cmd (install-cmd
#:updating? #t #: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 #:dep-behavior dep-behavior
(map cdr to-update)) to-update)
#t])) #t]))
(define (show-cmd) (define (show-cmd)
@ -852,6 +883,12 @@
(contract-out (contract-out
[current-install-system-wide? [current-install-system-wide?
(parameter/c boolean?)] (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 [config-cmd
(-> boolean? list? (-> boolean? list?
void)] void)]
@ -872,10 +909,8 @@
[show-cmd [show-cmd
(-> void)] (-> void)]
[install-cmd [install-cmd
(->* ((listof (cons/c boolean? path-string?))) (->* ((listof pkg-desc?))
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:force? boolean? #:force? boolean?
#:link? boolean?
#:type (or/c #f 'file 'dir 'url 'github 'name)
#:ignore-checksums? boolean?) #:ignore-checksums? boolean?)
void)])) void)]))

16
collects/planet2/main.rkt
View File

@ -14,8 +14,10 @@
[install [install
"Install packages" "Install packages"
[(#:sym #f) type ("-t") ("Type of <pkg-source>;" [(#:sym #f) type ("-t") ("Type of <pkg-source>;"
"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")] "if not specified, the type is inferred syntactically")]
[(#:str #f) name ("-n") ("Name of package, instead of inferred"
"(makes sense only when a single <pkg-source> is given)")]
[#:bool no-setup () ("Don't run 'raco setup' after changing packages" [#:bool no-setup () ("Don't run 'raco setup' after changing packages"
"(generally not a good idea)")] "(generally not a good idea)")]
[#:bool installation ("-i") "Operate on the installation-wide package database"] [#:bool installation ("-i") "Operate on the installation-wide package database"]
@ -39,11 +41,9 @@
(with-package-lock (with-package-lock
(install-cmd #:dep-behavior deps (install-cmd #:dep-behavior deps
#:force? force #:force? force
#:link? link
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:type (or (and link 'dir) (for/list ([p (in-list pkg-source)])
type) (pkg-desc p (or (and link 'link) type) name #f)))
(map (curry cons #f) pkg-source))
(setup no-setup)))] (setup no-setup)))]
[update [update
"Update packages" "Update packages"
@ -104,9 +104,7 @@
"Bundle a new package" "Bundle a new package"
[(#:str #f) format () [(#:str #f) format ()
("Select the format of the package to be created;" ("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"] [#:bool manifest () "Creates a manifest file for a directory, rather than an archive"]
#:args (maybe-dir) #:args (maybe-dir)
(unless (or manifest format) (create-cmd (if manifest "MANIFEST" (or format "zip")) maybe-dir)])
(error 'planet2 "You must specify an archive format"))
(create-cmd (if manifest "MANIFEST" format) maybe-dir)])

103
collects/planet2/name.rkt Normal file
View File

@ -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)

280
collects/planet2/scribblings/planet2.scrbl
View File

@ -1,23 +1,33 @@
#lang scribble/manual #lang scribble/manual
@(require scribble/bnf) @(require scribble/bnf)
@(define Planet2 "Planet2")
@(define @|Planet1| @|PLaneT|)
@(define pkgname onscreen) @(define pkgname onscreen)
@(define reponame litchar) @(define reponame litchar)
@title{Planet 2: Package Distribution (Beta)}
@author[@author+email["Jay McCarthy" "jay@racket-lang.org"]]
@(define package-name-chars @(define package-name-chars
@list{@litchar{a} through @litchar{z}, @list{@litchar{a} through @litchar{z},
@litchar{A} through @litchar{Z}, @litchar{A} through @litchar{Z},
@litchar{_}, and @litchar{-}}) @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. your Racket installation.
@table-of-contents[] @table-of-contents[]
@section{Planet 2 Concepts} @; ----------------------------------------
@section{Package Concepts}
A @deftech{package} is a set of modules from some number of A @deftech{package} is a set of modules from some number of
collections. @tech{Packages} also have associated @tech{package 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 A @tech{package} is typically represented by a directory with the same
name as the package which contains a file named name as the package. The checksum is typically left implicit.
@filepath{METADATA.rktd} formatted as: If the package depends on other packages, the directory can
@verbatim{ contain a file named @filepath{info.rkt} (see @secref["metadata"]).
((dependency "dependency1" ... "dependencyn"))
}
The checksum is typically left implicit.
A @deftech{package source} identifies a @tech{package} A @deftech{package source} identifies a @tech{package}
representation. Each package source type has a different way of 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 A package source is inferred to refer to a file
only when it has a suffix matching a valid archive format only when it has a suffix matching a valid archive format
and when it does not start 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 @item{a local directory -- The name of the package is the name of the
directory. The checksum is not present. For example, directory. The checksum is not present. For example,
@filepath{~/tic-tac-toe/}. @filepath{~/tic-tac-toe/}.
A package source is inferred to refer A package source is inferred to refer
to a directory only when it ends with a directory separator to a directory only when it does not have a file-archive suffix, does
and when it does not start not match the grammar of a package name, and does not start
with alphabetic characters followed by @litchar{://}.} 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 @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 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}. @filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}.
A package source is inferred to be a URL only when it 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 @item{a remote URL naming a directory -- The remote directory must
contain a file named @filepath{MANIFEST} that lists all the contingent 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/} and
@filepath{http://game.com/tic-tac-toe/.CHECKSUM}. @filepath{http://game.com/tic-tac-toe/.CHECKSUM}.
A package source A package source is inferred to be a URL the same for a directory or
is inferred to be a URL the same for a directory or file; the file, and it is treated as a directory URL when it does not end with a
interpretation is determined by the URL's resolution.} 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 @item{a remote URL naming a GitHub repository -- The format for such
URLs is: URLs is:
@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repository}@; @inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repository}@;
@exec{/}@nonterm{branch}@exec{/}@nonterm{optional-subpath} @exec{/}@nonterm{branch}@exec{/}@nonterm{optional-subpath}}
For example, For example,
@filepath{github://github.com/game/tic-tac-toe/master/}. @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 A package source is inferred to be a GitHub reference when it
starts with @litchar{github://}; a package source that is otherwise starts with @litchar{github://}; a package source that is otherwise
specified as a GitHub reference is automatically prefixed with 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 @item{a bare package name -- The local list of @tech{package name
services} is consulted to determine the source and checksum for the 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, 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] with a @racket[read]-able hash table with the keys: @racket['source]
bound to the source and @racket['checksum] bound to the bound to the source and @racket['checksum] bound to the
checksum. Typically, the source will be a remote URL string. checksum. Typically, the source will be a remote URL string.
PLT supports two @tech{package name services}, which are enabled by PLT supports two @tech{package name services}, which are enabled by
default: @filepath{https://plt-etc.byu.edu:9004} for new Planet 2 default: @url{https://plt-etc.byu.edu:9004} for new @|Planet2|
packages and @filepath{https://plt-etc.byu.edu:9003} for packages and @url{https://plt-etc.byu.edu:9003} for
automatically generated Planet 2 packages for old Planet 1 automatically generated @|Planet2| packages for old @|PLaneT|
packages. Anyone may host their own @tech{package name service}. The packages. Anyone may host their own @tech{package name service}. The
source for the PLT-hosted servers is in the source for the PLT-hosted servers is in the
@racket[(build-path (find-collects-dir) "meta" "planet2-index")] @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 installed, (2) A and B have the same name, and (3) A's checksum is
different than B's. 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 sub-command and a library. They have the exact same capabilities, as
the command line interface invokes the library functions and the command line interface invokes the library functions and
reprovides all their options. reprovides all their options.
@ -177,6 +195,10 @@ sub-sub-commands:
where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{url}, @exec{github}, where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{url}, @exec{github},
or @exec{name}.} 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 @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}.} 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} ... --- @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[ @itemlist[
@item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.} @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[ @itemlist[
@item{@DFlag{format} @nonterm{format} --- Specifies the archive format. @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.} 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.} @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. 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 <package-name>} @commandline{mkdir @nonterm{package}}
Next, link your development directory to your local package Next, link your development directory to your local package
repository: repository:
@commandline{raco pkg install --link <package-name>} @commandline{raco pkg install --link @nonterm{package}}
Next, enter your directory and create a basic @tech{package metadata} Optionally, enter your directory and create a basic @filepath{info.rkt} file:
file:
@commandline{cd <package-name>} @commandline{cd @nonterm{package}}
@commandline{echo "((dependency))" > METADATA.rktd} @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 you may wish to create it to simplify adding dependencies in the
future. future.
Next, inside this directory, create directories for the collections Next, inside the @nonterm{package} directory, create directories for
and modules that your package will provide. For example, the collections and modules that your package will provide. For
the developer of @pkgname{tic-tac-toe} might do: 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{mkdir -p games/tic-tac-toe}
@commandline{touch games/tic-tac-toe/info.rkt} @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{mkdir -p data}
@commandline{touch data/matrix.rkt} @commandline{touch data/matrix.rkt}
After your package is ready to deploy choose one of the following After your package is ready to deploy, choose either @secref["github-deploy"]
options: or @secref["manual-deploy"].
@subsection{Github Deployment} @subsection[#:tag "github-deploy"]{GitHub Deployment}
First, create a free account on First, @link["https://github.com/signup/free"]{create a free account} on GitHub,
Github (@link["https://github.com/signup/free"]{signup here}). Then then @link["https://github.com/new"]{create a repository for your
create a repository for your package} (@link["https://help.github.com/articles/create-a-repo"]{documentation}).
package (@link["https://github.com/new"]{here} (@link["https://help.github.com/articles/create-a-repo"]{documentation}).) Initialize the Git repository locally and do your first push like this:
Then initialize the Git repository locally and do your first push:
@commandline{git init} @commandline{git init}
@commandline{git add *} @commandline{git add *}
@commandline{git commit -m "First commit"} @commandline{git commit -m "First commit"}
@commandline{git remote add origin https://github.com/<username>/<package-name>.git} @commandline{git remote add origin https://github.com/@nonterm{user}/@nonterm{package}.git}
@commandline{git push -u origin master} @commandline{git push -u origin master}
Now, publish your package source as: Now, publish your package source as:
@exec{github://github.com/<username>/<package-name>/<branch>} @inset{@exec{github://github.com/@nonterm{user}/@nonterm{package}/@nonterm{branch}}}
(Typically, <branch> will be @litchar{master}, but you may wish to use Typically, @nonterm{branch} will be @exec{master}, but you may wish to use
different branches for releases and development.) different branches for releases and development.
Now, whenever you Whenever you
@commandline{git push} @commandline{git push}
Your changes will automatically be discovered by those who used your your changes will automatically be discovered by those who used your
package source. 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 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 you control. If you do this, it is preferable to create an archive
first: first:
@commandline{raco pkg create <package-name>} @commandline{raco pkg create @nonterm{package}}
And then upload the archive and its checksum to your site: And then upload the archive and its checksum to your site:
@commandline{scp <package-name>.plt <package-name>.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: Now, publish your package source as:
@exec{http://your-host/~<username>/<package-name>.plt} @inset{@exec{http://your-host/~@nonterm{user}/@nonterm{package}.zip}}
Now, whenever you want to release a new version, recreate and reupload Whenever you want to release a new version, recreate and reupload the
the package archive (and checksum). Your changes will automatically be package archive (and checksum). Your changes will automatically be
discovered by those who used your package source. discovered by those who used your package source when they use
@exec{raco pkg update}.
@subsection{Helping Others Discover Your Package} @subsection{Helping Others Discover Your Package}
By using either of the above deployment techniques, anyone will be 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 able to use your package by referring to your @tech{package source}.
it by name until it is listed on a @tech{package name service}. 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 If you'd like to use the official @tech{package name service}, browse
to 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 server will periodically check the package source you designate for
updates. updates.
If you use this server, and use Github for deployment, then you will 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 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 users. You just need to push to your GitHub repository, then within 24
hours, the official @tech{package name service} will notice, and hours, the official @tech{package name service} will notice, and
@exec{raco pkg update} will work on your user's machines. @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 @section[#:tag "metadata"]{Package Metadata}
@link["https://plt-etc.byu.edu:9003/"]{https://plt-etc.byu.edu:9003/}. This
PNS is included by default in the Planet search path.
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 server according to the following system: for all packages that are in
the @litchar{4.x} Planet 1 repository, the latest minor version of the @litchar{4.x} @|Planet1| repository, the latest minor version of
@tt{<user>/<package>.plt/<major-version>} will be available as @tt{@nonterm{user}/@nonterm{package}.plt/@nonterm{major-version}} will be available as
@pkgname{planet-<user>-<package><major-version>}. For example, @pkgname{planet-@nonterm{user}-@nonterm{package}@nonterm{major-version}}. For example,
@tt{jaymccarthy/opencl.plt/1} minor version @tt{2}, will be available as @tt{jaymccarthy/opencl.plt/1} minor version @tt{2}, will be available as
@pkgname{planet-jaymccarthy-opencl1}. @pkgname{planet-jaymccarthy-opencl1}.
The contents of these copies is a single collection with the name The contents of these copies is a single collection with the name
@filepath{<user>/<package><major-version>} with all the files from the @filepath{@nonterm{user}/@nonterm{package}@nonterm{major-version}} with all the files from the
original Planet 1 package in it. original @|Planet1| package in it.
Each file has been transliterated to use direct Racket-style requires 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 @racket[(planet jaymccarthy/opencl/module)], then it is transliterated
to @racket[jaymccarthy/opencl1/module]. @emph{This transliteration is to @racket[jaymccarthy/opencl1/module]. @emph{This transliteration is
purely syntactic and is trivial to confuse, but works for most purely syntactic and is trivial to confuse, but works for most
packages, in practice.} packages, in practice.}
Any transliterations that occurred are automatically added as 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 We do not intend to improve this compatibility system much more over
time, because it is simply a stop-gap as developers port their time, because it is simply a stop-gap as developers port their
packages to Planet 2. Additionally, the existence of this is not meant packages to @|Planet2|. Additionally, the existence of the compatibility
to imply that we will be removing Planet 1 from existence in the near server is not meant
to imply that we will be removing @|Planet1| from existence in the near
future. future.
@section{FAQ} @; ----------------------------------------
@section[#:style 'quiet]{FAQ}
This section answers anticipated frequently asked questions about This section answers anticipated frequently asked questions about
Planet 2. @|Planet2|.
@subsection{Are package installations versioned with respect to the @subsection{Are package installations versioned with respect to the
Racket version?} Racket version?}
No. When you install a Planet 2 package, it is installed for all No. When you install a @|Planet2| package, it is installed for all
versions of Racket until you remove it. (In contrast, Planet 1 versions of Racket until you remove it. (In contrast, @|Planet1|
requires reinstallation of all packages every version change.) requires reinstallation of all packages every version change.)
@subsection{Where and how are packages installed?} @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 In such a situation, the author of the package has released a
backwards incompatible edition of a package. It is not possible in 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 installing the "update".) Therefore, package authors should not make
backwards incompatible changes to packages. Instead, they should backwards incompatible changes to packages. Instead, they should
release a new package with a new name. For example, package release a new package with a new name. For example, package
@pkgname{libgtk} might become @pkgname{libgtk2}. These packages @pkgname{libgtk} might become @pkgname{libgtk2}. These packages
should be designed to not conflict with each other, as well. 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 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[ @racketblock[
(require (planet game/tic-tac-toe/data/matrix)) (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: interest:
@racketblock[ @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 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 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 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 guaranteeing that packages that never conflict with one another, so
that any number of major and minor versions of the same package can be 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 commitment, so package authors and users must be mindful of potential
conflicts and plan around them. 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. 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 system, more like the package systems used by operating systems. The
goals of Planet 1 are not bad, but we believe they are needed goals of @|Planet1| are not bad, but we believe they are needed
infrequently and a system like Planet 1 could be more easily built infrequently and a system like @|Planet1| could be more easily built
atop Planet 2 than the reverse. atop @|Planet2| than the reverse.
In particular, our plans to mitigate the downsides of these changes In particular, our plans to mitigate the downsides of these changes
are documented in @secref["short-term"]. are documented in @secref["short-term"].
@; ----------------------------------------
@section{Future Plans} @section{Future Plans}
@subsection[#:tag "short-term"]{Short Term} @subsection[#:tag "short-term"]{Short Term}
This section lists some short term plans for Planet 2. These are This section lists some short term plans for @|Planet2|. These are
important, but didn't block its release. Planet 2 will be considered important, but didn't block its release. @|Planet2| will be considered
out of beta when these are completed. out of beta when these are completed.
@itemlist[ @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 @item{The official PNS will divide packages into three
categories: @reponame{planet}, @reponame{solar-system}, and @reponame{galaxy}. The definitions categories: @reponame{planet}, @reponame{solar-system}, and @reponame{galaxy}. The definitions
for these categories are: 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 on DrDr, testing during releases, provided binaries, and advertisement
during installation. 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. the @reponame{solar-system} category, automatically.
} }
@ -669,7 +725,7 @@ different policies.}
@subsection{Long Term} @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. require a lot of cross-Racket integration.
@itemlist[ @itemlist[

1
collects/tests/planet2/test-pkgs/pkg-b-second/METADATA.rktd
View File

@ -1 +0,0 @@
((dependency "pkg-a"))

3
collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang setup/infotab
(define deps '("pkg-a"))

1
collects/tests/planet2/test-pkgs/planet2-test2/METADATA.rktd
View File

@ -1 +0,0 @@
((dependency "planet2-test1"))

3
collects/tests/planet2/test-pkgs/planet2-test2/info.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang setup/infotab
(define deps '("planet2-test1"))

1
collects/tests/planet2/test.rkt
View File

@ -28,6 +28,7 @@
(for-each (λ (x) (x)) l))))) (for-each (λ (x) (x)) l)))))
(run-tests (run-tests
"name"
"basic" "create" "install" "basic" "create" "install"
"network" "conflicts" "checksums" "network" "conflicts" "checksums"
"deps" "update" "deps" "update"

13
collects/tests/planet2/tests-install.rkt
View File

@ -39,13 +39,10 @@
"local directory name fails because not inferred as such (inferred as package name)" "local directory name fails because not inferred as such (inferred as package name)"
$ "raco pkg install test-pkgs" =exit> 1) $ "raco pkg install test-pkgs" =exit> 1)
(shelly-case (shelly-case
"local directory name fails because not inferred as such (no default inference)" "local file name with bad suffix and not a package name or directory"
$ "raco pkg install test-pkgs/pkg-a-first" =exit> 1)
(shelly-case
"local file name with bad suffix and not a package name"
$ "raco pkg install tests-install.rkt" =exit> 1) $ "raco pkg install tests-install.rkt" =exit> 1)
(shelly-case (shelly-case
"not a file, directory, or valid package name" "not a valid (inferred) package name"
$ "raco pkg install 1+2" =exit> 1) $ "raco pkg install 1+2" =exit> 1)
(shelly-case (shelly-case
@ -63,13 +60,13 @@
$ "raco pkg install http://localhost:9999/planet2-test1.rar" =exit> 1) $ "raco pkg install http://localhost:9999/planet2-test1.rar" =exit> 1)
(shelly-case (shelly-case
"remote/URL/http directory, no manifest fail" "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 =exit> 1
=stderr> #rx"Invalid package format") =stderr> #rx"could not find MANIFEST")
(shelly-case (shelly-case
"remote/URL/http directory, bad manifest" "remote/URL/http directory, bad manifest"
;; XXX why does this error now? ;; 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 (shelly-case
"local directory fails when not there" "local directory fails when not there"

75
collects/tests/planet2/tests-name.rkt Normal file
View File

@ -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))

2
collects/tests/planet2/tests-overwrite.rkt
View File

@ -10,7 +10,7 @@
;; Step 1. Try to install a package that will fail ;; Step 1. Try to install a package that will fail
$ "raco pkg install test-pkgs/planet2-test1.zip test-pkgs/planet2-test1.zip" $ "raco pkg install test-pkgs/planet2-test1.zip test-pkgs/planet2-test1.zip"
=exit> 1 =exit> 1
=stderr> #rx"conflicts with \"planet2-test1\"" =stderr> #rx"packages conflict"
;; Step 2. Try to install safely ;; Step 2. Try to install safely
$ "raco pkg install test-pkgs/planet2-test1.zip"))) $ "raco pkg install test-pkgs/planet2-test1.zip")))