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.
This commit is contained in:
Matthew Flatt
parent
d94d479f15
commit
381d9d84d6
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define name "Planet2")
|
||||
(define scribblings
|
||||
'(("scribblings/planet2.scrbl" (multi-page) (tool 100))))
|
||||
(define raco-commands
|
||||
|
|
|
|||
|
|
@ -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)]))
|
||||
|
|
|
|||
|
|
@ -14,8 +14,10 @@
|
|||
[install
|
||||
"Install packages"
|
||||
[(#: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")]
|
||||
[(#: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"
|
||||
"(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)])
|
||||
|
|
|
|||
103
collects/planet2/name.rkt
Normal file
103
collects/planet2/name.rkt
Normal 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)
|
||||
|
|
@ -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 <package-name>}
|
||||
@commandline{mkdir @nonterm{package}}
|
||||
|
||||
Next, link your development directory to your local package
|
||||
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}
|
||||
file:
|
||||
Optionally, enter your directory and create a basic @filepath{info.rkt} file:
|
||||
|
||||
@commandline{cd <package-name>}
|
||||
@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/<username>/<package-name>.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/<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
|
||||
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 <package-name>}
|
||||
@commandline{raco pkg create @nonterm{package}}
|
||||
|
||||
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:
|
||||
|
||||
@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
|
||||
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{<user>/<package>.plt/<major-version>} will be available as
|
||||
@pkgname{planet-<user>-<package><major-version>}. 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{<user>/<package><major-version>} 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[
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
((dependency "pkg-a"))
|
||||
3
collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt
Normal file
3
collects/tests/planet2/test-pkgs/pkg-b-second/info.rkt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define deps '("pkg-a"))
|
||||
|
|
@ -1 +0,0 @@
|
|||
((dependency "planet2-test1"))
|
||||
3
collects/tests/planet2/test-pkgs/planet2-test2/info.rkt
Normal file
3
collects/tests/planet2/test-pkgs/planet2-test2/info.rkt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define deps '("planet2-test1"))
|
||||
|
|
@ -28,6 +28,7 @@
|
|||
(for-each (λ (x) (x)) l)))))
|
||||
|
||||
(run-tests
|
||||
"name"
|
||||
"basic" "create" "install"
|
||||
"network" "conflicts" "checksums"
|
||||
"deps" "update"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
75
collects/tests/planet2/tests-name.rkt
Normal file
75
collects/tests/planet2/tests-name.rkt
Normal 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))
|
||||
|
|
@ -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")))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user