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 2012-11-30 06:02:52 -07:00
parent d94d479f15
commit 381d9d84d6
14 changed files with 734 additions and 463 deletions

View File

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

View File

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

View File

@ -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,33 +293,33 @@
(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)))
(not (regexp-match? #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 ()
(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))
@ -286,8 +327,8 @@
(define checksum (remote-package-checksum orig-pkg))
(define info
(update-install-info-orig-pkg
(match scheme
["github"
(match type
['github
(match-define (list* user repo branch path)
(map path/param-path (url-path/no-slash pkg-url)))
(define new-url
@ -321,8 +362,8 @@
(λ ()
(untar tmp.tgz tmp-dir #:strip-components 1)
(install-package (path->string package-path)
#:type 'dir
#:pkg-name given-pkg-name))
'dir
pkg-name))
(λ ()
(delete-directory/files tmp-dir))))
(λ ()
@ -330,27 +371,31 @@
[_
(define url-last-component
(path/param-path (last (url-path pkg-url))))
(define url-looks-like-directory?
(string=? "" url-last-component))
(define url-looks-like-directory? (eq? type 'dir-url))
(define-values
(package-path package-name download-type download-package!)
(package-path 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)
pkg-name)
'directory))
(define (path-like f)
(build-path package-path f))
(define (url-like f)
(combine-url/relative pkg-url 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
package-name
'dir
(λ ()
(printf "\tCloning remote directory\n")
@ -359,6 +404,9 @@
(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)))))]
@ -371,10 +419,6 @@
#f))
(delete-file package-path)
(values package-path
(regexp-replace
#rx"\\.[^.]+$"
url-last-component
"")
'file
(λ ()
(dprintf "\tAssuming URL names a file\n")
@ -383,14 +427,10 @@
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
download-type
pkg-name))
(λ ()
(when (or (file-exists? package-path)
@ -411,15 +451,8 @@
(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)))))
checksum)]
[(eq? type 'file)
(unless (file-exists? pkg)
(error 'pkg "no such file\n path: ~e" pkg))
(define checksum-pth (format "~a.CHECKSUM" pkg))
@ -438,13 +471,6 @@
(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))
@ -475,24 +501,19 @@
(update-install-info-checksum
(update-install-info-orig-pkg
(install-package pkg-dir
#:type 'dir
#:pkg-name pkg-name)
'dir
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))))
[(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)])
(define pkg-name
(or given-pkg-name (path->string (file-name-from-path pkg))))
(cond
[link?
[(eq? type 'link)
(install-info pkg-name
`(link ,(simple-form-path* pkg))
pkg
@ -507,14 +528,13 @@
`(dir ,(simple-form-path* pkg))
pkg-dir
#t #f)]))]
[(if type
(eq? type 'name)
(path-match? #f #rx"^[-_a-zA-Z0-9]*$" pkg))
[(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
#:pkg-name (or given-pkg-name pkg)))
#f
pkg-name))
(when (and (install-info-checksum info)
check-sums?
(not (equal? (install-info-checksum info) checksum)))
@ -525,11 +545,10 @@
checksum)
`(pns ,pkg))]
[else
(error 'pkg "cannot infer package source type\n given: ~e\n" pkg)]))
(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?
(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)
#:old-auto+pkgs (append old-descs descs)
#: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))])])
(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)]))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

View File

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