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

`raco pkg': fixes for package source inference and handling

Browse Source 
Also, test additions and documentation adjustments.
This commit is contained in:
Matthew Flatt 2012-11-28 11:16:14 -07:00
parent b16679266a
commit 15cbfa1947
9 changed files with 281 additions and 269 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

286
collects/planet2/lib.rkt
View File

@ -271,6 +271,150 @@
#:type [type type] #:type [type type]
#:pkg-name [given-pkg-name #f]) #:pkg-name [given-pkg-name #f])
(cond (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))
(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))
(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 [(if type
(eq? type 'file) (eq? type 'file)
(or (or
@ -363,147 +507,9 @@
`(dir ,(simple-form-path* pkg)) `(dir ,(simple-form-path* pkg))
pkg-dir pkg-dir
#t #f)]))] #t #f)]))]
[(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
(eq? type 'url)
(path-match? #f #rx"^(https?|file|github)://" pkg))
(let ()
(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))
(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-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
(λ ()
(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
"")
(λ ()
(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
#: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))]
[(if type [(if type
(eq? type 'name) (eq? type 'name)
(path-match? #f #rx"^[-+_a-zA-Z0-9]*$" pkg)) (path-match? #f #rx"^[-_a-zA-Z0-9]*$" pkg))
(define index-info (package-index-lookup pkg)) (define index-info (package-index-lookup pkg))
(define source (hash-ref index-info 'source)) (define source (hash-ref index-info 'source))
(define checksum (hash-ref index-info 'checksum)) (define checksum (hash-ref index-info 'checksum))
@ -519,7 +525,7 @@
checksum) checksum)
`(pns ,pkg))] `(pns ,pkg))]
[else [else
(error 'pkg "cannot infer package-name type\n name: ~e\n" pkg)])) (error 'pkg "cannot infer package source type\n given: ~e\n" pkg)]))
(define db (read-pkg-db)) (define db (read-pkg-db))
(define (install-package/outer infos auto+pkg info) (define (install-package/outer infos auto+pkg info)
(match-define (cons auto? pkg) (match-define (cons auto? pkg)

4
collects/planet2/main.rkt
View File

@ -41,8 +41,8 @@
#:force? force #:force? force
#:link? link #:link? link
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:type (or type #:type (or (and link 'dir)
(and link 'dir)) type)
(map (curry cons #f) pkg-source)) (map (curry cons #f) pkg-source))
(setup no-setup)))] (setup no-setup)))]
[update [update

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

@ -10,7 +10,7 @@
@(define package-name-chars @(define package-name-chars
@list{@litchar{a} through @litchar{z}, @list{@litchar{a} through @litchar{z},
@litchar{A} through @litchar{Z}, @litchar{A} through @litchar{Z},
@litchar{_}, @litchar{-}, and @litchar{+}}) @litchar{_}, and @litchar{-}})
Planet 2 is a system for managing the use of external code packages in Planet 2 is a system for managing the use of external code packages in
your Racket installation. your Racket installation.
@ -51,21 +51,30 @@ example, @filepath{~/tic-tac-toe.zip}'s checksum would be inside
@filepath{~/tic-tac-toe.zip.CHECKSUM}. The valid archive formats @filepath{~/tic-tac-toe.zip.CHECKSUM}. The valid archive formats
are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz}, are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz},
@filepath{.tar.gz}, and @filepath{.tar.gz}, and
@filepath{.plt}; a package source is inferred to refer to a file @filepath{.plt}.
only when it has one of those suffixes. }
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{://}.}
@item{a local directory -- The name of the package is the name of the @item{a local directory -- The name of the package is the name of the
directory. The checksum is not present. For example, directory. The checksum is not present. For example,
@filepath{~/tic-tac-toe/}. A package source is inferred to refer @filepath{~/tic-tac-toe/}.
to a directory on when it ends with a directory separator.}
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{://}.}
@item{a remote URL naming an archive -- This type follows the same @item{a remote URL naming an archive -- This type follows the same
rules as a local file path, but the archive and checksum files are rules as a local file path, but the archive and checksum files are
accessed via HTTP(S). For example, accessed via HTTP(S). For example,
@filepath{http://game.com/tic-tac-toe.zip} and @filepath{http://game.com/tic-tac-toe.zip} and
@filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}. @filepath{http://game.com/tic-tac-toe.zip.CHECKSUM}.
A package source is inferred to be a URL only when it A package source is inferred to be a URL only when it
starts with @litchar{http://}, @litchar{https://}, or @litchar{file://}.} starts with @litchar{http://} or @litchar{https://}.}
@item{a remote URL naming a directory -- The remote directory must @item{a remote URL naming a directory -- The remote directory must
contain a file named @filepath{MANIFEST} that lists all the contingent contain a file named @filepath{MANIFEST} that lists all the contingent
@ -74,17 +83,25 @@ for local directory paths are followed. However, if the remote
directory contains a file named @filepath{.CHECKSUM}, then it is used directory contains a file named @filepath{.CHECKSUM}, then it is used
to determine the checksum. For example, to determine the checksum. For example,
@filepath{http://game.com/tic-tac-toe/} and @filepath{http://game.com/tic-tac-toe/} and
@filepath{http://game.com/tic-tac-toe/.CHECKSUM}. A package name @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 is inferred to be a URL the same for a directory or file; the
interpretation is determined by the URL's resolution.} interpretation is determined by the URL's resolution.}
@item{a remote URL naming a GitHub repository -- The format for such @item{a remote URL naming a GitHub repository -- The format for such
URLs is: URLs is:
@filepath{github://github.com/<user>/<repository>/<branch>/<path>/<to>/<package>/<directory>}. The
Zip formatted archive for the repository (generated by GitHub for @exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repository}@;
every branch) is used as a remote URL archive path, except the @exec{/}@nonterm{branch}@exec{/}@nonterm{optional-subpath}
checksum is the hash identifying the branch. For example,
For example,
@filepath{github://github.com/game/tic-tac-toe/master/}. @filepath{github://github.com/game/tic-tac-toe/master/}.
The @exec{zip}-formatted archive for the repository (generated by GitHub for
every branch) is used as a remote URL archive path, except the
checksum is the hash identifying the branch.
A package source is inferred to be a GitHub reference when it A package source is inferred to be a GitHub reference when it
starts with @litchar{github://}; a package source that is otherwise starts with @litchar{github://}; a package source that is otherwise
specified as a GitHub reference is automatically prefixed with specified as a GitHub reference is automatically prefixed with
@ -92,14 +109,16 @@ specified as a GitHub reference is automatically prefixed with
@item{a bare package name -- The local list of @tech{package name @item{a bare package name -- The local list of @tech{package name
services} is consulted to determine the source and checksum for the services} is consulted to determine the source and checksum for the
package. For example, @pkgname{tic-tac-toe}. A package source is inferred package. For example, @exec{tic-tac-toe}.
A package source is inferred
to be a package name when it fits the grammar of package names, which to be a package name when it fits the grammar of package names, which
emans that it has only the characters @|package-name-chars|.} means that it has only the characters @|package-name-chars|.}
] ]
A @deftech{package name service} (@deftech{PNS}) is a string representing a URL, A @deftech{package name service} (@deftech{PNS}) is a string representing a URL,
such that appending @filepath{/pkg/<package-name>} to it will respond such that appending @exec{/pkg/}@nonterm{package-name} to the URL responds
with a @racket[read]-able hash table with the keys: @racket['source] with a @racket[read]-able hash table with the keys: @racket['source]
bound to the source and @racket['checksum] bound to the bound to the source and @racket['checksum] bound to the
checksum. Typically, the source will be a remote URL string. checksum. Typically, the source will be a remote URL string.
@ -128,7 +147,7 @@ conflict with Racket itself, if it contains a module file that is part
of the core Racket distribution. For example, any package that of the core Racket distribution. For example, any package that
contains @filepath{racket/list.rkt} is in conflict with Racket. For contains @filepath{racket/list.rkt} is in conflict with Racket. For
the purposes of conflicts, a module is a file that ends in the purposes of conflicts, a module is a file that ends in
@litchar{.rkt} or @litchar{.ss}. @filepath{.rkt} or @filepath{.ss}.
Package A is a @deftech{package update} of Package B if (1) B is Package A is a @deftech{package update} of Package B if (1) B is
installed, (2) A and B have the same name, and (3) A's checksum is installed, (2) A and B have the same name, and (3) A's checksum is
@ -148,93 +167,99 @@ sub-sub-commands:
@itemlist[ @itemlist[
@item{@exec{install pkg ...} -- Installs the list of @tech{package @item{@exec{install} @nonterm{option} ... @nonterm{pkg-source} ...
sources}. It --- Installs the given @tech{package sources} with the given
accepts the following options: @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} -- specifies an interpretation of the package source, @item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} --- specifies an interpretation of the package source,
where @nonterm{type} is either @litchar{file}, @litchar{dir}, @litchar{url}, @litchar{github}, where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{url}, @exec{github},
or @litchar{name} (to be resolve through a @tech{PNS}).} or @exec{name}.}
@item{@DFlag{dont-setup} -- Does not run @exec{raco setup} after installation. This behavior is also the case if the environment variable @envvar{PLT_PLANET2_DONTSETUP} is set to @litchar{1}.} @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}.}
@item{@DFlag{installation} -- Install system-wide rather than user-local.} @item{@DFlag{installation} or @Flag{i} --- Install system-wide rather than user-local.}
@item{@Flag{i} -- Alias for @DFlag{installation}.} @item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of
@item{@DFlag{deps} @exec{dep-behavior} -- Selects the behavior for dependencies. The options are:
@itemlist[ @itemlist[
@item{@exec{fail} -- Cancels the installation if dependencies are unmet (default for most packages)} @item{@exec{fail} --- Cancels the installation if dependencies are unmet (default for most packages)}
@item{@exec{force} -- Installs the package(s) despite missing dependencies (unsafe)} @item{@exec{force} --- Installs the package(s) despite missing dependencies (unsafe)}
@item{@exec{search-ask} -- Looks for the dependencies on the configured @tech{package name services} (default if the dependency is an indexed name) but asks if you would like it installed.} @item{@exec{search-ask} --- Looks for the dependencies on the configured @tech{package name services}
(default if the dependency is an indexed name) but asks if you would like it installed.}
@item{@exec{search-auto} --- Like @exec{search-ask}, but does not ask for permission to install.} @item{@exec{search-auto} --- Like @exec{search-ask}, but does not ask for permission to install.}
]} ]}
@item{@DFlag{force} -- Ignores conflicts (unsafe.)} @item{@DFlag{force} --- Ignores conflicts (unsafe)}
@item{@DFlag{ignore-checksums} -- Ignores errors verifying package checksums (unsafe.)} @item{@DFlag{ignore-checksums} --- Ignores errors verifying package checksums (unsafe.)}
@item{@DFlag{link} -- When used with a directory package, leave the directory in place, but add a link to it in the package directory. This is a global setting for all installs for this command instance, which means it affects dependencies... so make sure the dependencies exist first.} @item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
and links the existing directory as an installed package.
This option affects all installs for the command, which means it affects dependencies...
so make sure the dependencies exist first.}
] ]
} }
@item{@exec{update pkg ...} -- Checks the list of packages for @item{@exec{update} @nonterm{option} ... @nonterm{pkg} ...
--- Checks the specified packages for
@tech{package updates}. If an update is found, but it cannot be @tech{package updates}. If an update is found, but it cannot be
installed (e.g. it is conflicted with another installed package), then installed (e.g. it is conflicted with another installed package), then
this command fails atomically. It accepts the following options: this command fails atomically. The @exec{update} sub-command accepts
the following @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{dont-setup} -- Same as for @exec{install}.} @item{@DFlag{no-setup} --- Same as for @exec{install}.}
@item{@DFlag{installation} -- Same as for @exec{install}.} @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
@item{@Flag{i} -- Same as for @exec{install}.} @item{@DFlag{deps} @nonterm{behavior} --- Same as for @exec{install}.}
@item{@DFlag{deps} @exec{dep-behavior} -- Same as for @exec{install}.} @item{@DFlag{all} or @Flag{a} --- Update all packages, if no packages are given in the argument list.}
@item{@DFlag{all} -- Update all packages, if no packages are given in the argument list.} @item{@DFlag{update-deps} --- Checks the named packages, and their dependencies (transitively) for updates.}
@item{@Flag{a} -- Alias for @DFlag{all}.}
@item{@DFlag{update-deps} -- Checks the named packages, and their dependencies (transitively) for updates.}
] ]
} }
@item{@exec{remove pkg ...} -- Attempts to remove the packages. If a package is the dependency of another package that is not listed, this command fails atomically. It accepts the following options: @item{@exec{remove} @nonterm{option} ... @nonterm{pkg} ...
--- Attempts to remove the given packages. If a package is the dependency of another package that is not
listed, this command fails atomically. It accepts the following @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{dont-setup} -- Same as for @exec{install}.} @item{@DFlag{no-setup} --- Same as for @exec{install}.}
@item{@DFlag{installation} -- Same as for @exec{install}.} @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
@item{@Flag{i} -- Same as for @exec{install}.} @item{@DFlag{force} --- Ignore dependencies when removing packages.}
@item{@DFlag{force} -- Ignore dependencies when removing packages.} @item{@DFlag{auto} --- Remove packages that were installed by the @exec{search-auto} and @exec{search-ask} dependency behavior that are no longer required.}
@item{@DFlag{auto} -- Remove packages that were installed by the @exec{search-auto} and @exec{search-ask} dependency behavior that are no longer required.}
] ]
} }
@item{@exec{show} -- Print information about currently installed packages. It accepts the following options: @item{@exec{show} @nonterm{option} ... --- Print information about currently installed packages. It accepts the following @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{installation} -- Same as for @exec{install}.} @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
@item{@Flag{i} -- Same as for @exec{install}.}
] ]
} }
@item{@exec{config key val ...} -- View and modify Planet 2 configuration options. It accepts the following options: @item{@exec{config} @nonterm{option} ... @nonterm{key} @nonterm{val} ... ---
View and modify Planet 2 configuration options. It accepts the following @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{installation} -- Same as for @exec{install}.} @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.}
@item{@Flag{i} -- Same as for @exec{install}.} @item{@DFlag{set} --- Sets an option, rather than printing it.}
@item{@DFlag{set} -- Sets an option, rather than printing it.}
] ]
The valid keys are: The valid keys are:
@itemlist[ @itemlist[
@item{@exec{indexes} -- A list of URLs for @tech{package name services}.} @item{@exec{indexes} --- A list of URLs for @tech{package name services}.}
] ]
} }
@item{@exec{create package-directory} -- Bundles a package. It accepts the following options: @item{@exec{create} @nonterm{option} ... @nonterm{package-directory}
--- Bundles a package. It accepts the following @nonterm{option}s:
@itemlist[ @itemlist[
@item{@DFlag{format str} -- Specifies the archive format. The options are: @exec{tgz}, @exec{zip}, and @exec{plt}. This must be specified if @DFlag{manifest} is not present.} @item{@DFlag{format} @nonterm{format} --- Specifies the archive format.
@item{@DFlag{manifest} -- Creates a manifest file for a directory, rather than an archive.} The allowed @nonterm{format}s are: @exec{tgz}, @exec{zip}, 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.}
] ]
} }
] ]
@ -244,12 +269,12 @@ this command fails atomically. It accepts the following options:
@defmodule[planet2] @defmodule[planet2]
The @racketmodname[planet2] module provides a programmatic interface to The @racketmodname[planet2] module provides a programmatic interface
the command sub-sub-commands. Each long form option is keyword to the command sub-sub-commands. Each long form option is keyword
argument. @DFlag{deps} accepts its argument as a symbol and argument. An argument corresponding to @DFlag{type} or @DFlag{deps}
@DFlag{format} accepts its argument as a string. All other options accepts its argument as a symbol, and @DFlag{format} accepts its
accept booleans, where @racket[#t] is equivalent to the presence of argument as a string. All other options accept booleans, where
the option. @racket[#t] is equivalent to the presence of the option.
@deftogether[ @deftogether[
(@defthing[install procedure?] (@defthing[install procedure?]
@ -568,8 +593,8 @@ out of beta when these are completed.
@item{It has not been tested on Windows or Mac OS X. If you would like @item{It has not been tested on Windows or Mac OS X. If you would like
to test it, please run @exec{racket to test it, please run @exec{racket
collects/tests/planet2/test.rkt}. It is recommended that you run this collects/tests/planet2/test.rkt}. It is recommended that you run this
with the environment variable @envvar{PLT_PLANET2_DONTSETUP} set to with the environment variable @envvar{PLT_PLANET2_NOSETUP} set to
@litchar{1}. (The tests that require @exec{raco setup} to run @exec{1}. (The tests that require @exec{raco setup} to run
explicitly ignore the environment of the test script.)} explicitly ignore the environment of the test script.)}
@item{The official PNS will divide packages into three @item{The official PNS will divide packages into three
@ -578,12 +603,12 @@ for these categories are:
@itemlist[ @itemlist[
@item{@reponame{galaxy} -- No restrictions.} @item{@reponame{galaxy} --- No restrictions.}
@item{@reponame{solar-system} -- Must not conflict any package @item{@reponame{solar-system} --- Must not conflict any package
in @reponame{solar-system} or @reponame{planet}.} in @reponame{solar-system} or @reponame{planet}.}
@item{@reponame{planet} -- Must not conflict any package in @reponame{solar-system} @item{@reponame{planet} --- Must not conflict any package in @reponame{solar-system}
or @reponame{planet}. Must have documentation and tests. The author must be or @reponame{planet}. Must have documentation and tests. The author must be
responsive about fixing regressions against changes in Racket, etc.} responsive about fixing regressions against changes in Racket, etc.}

46
collects/planet2/util-plt.rkt
View File

@ -1,46 +0,0 @@
#lang racket/base
(require racket/list
racket/port
racket/file
racket/contract
setup/unpack)
;; After PR12904 is fixed, hopefully I won't need this.
(define (unplt pkg pkg-dir)
(define (path-descriptor->path pd)
(if (or (eq? 'same pd)
(path? pd))
pd
(second pd)))
(define (write-file file* content-p)
(define file (path-descriptor->path file*))
#;(printf "\twriting ~a\n" file)
(with-output-to-file
(build-path pkg-dir file)
(λ () (copy-port content-p (current-output-port)))))
(fold-plt-archive pkg
void
void
(λ (dir* _a)
(define dir (path-descriptor->path dir*))
#;(printf "\tmaking ~a\n" dir)
(define new-dir
(build-path pkg-dir
dir))
(unless (or (equal? (build-path 'same)
dir)
(directory-exists? new-dir))
(make-directory* new-dir)))
(case-lambda
[(file content-p _a)
(write-file file content-p)]
[(file content-p _m _a)
(write-file file content-p)])
(void)))
(provide
(contract-out
[unplt (-> path-string? path-string?
void?)]))

4
collects/tests/planet2/tests-conflicts.rkt
View File

@ -17,8 +17,8 @@
(shelly-begin (shelly-begin
(initialize-indexes) (initialize-indexes)
$ "raco pkg create --format plt test-pkgs/planet2-test1" $ "raco pkg create --format plt test-pkgs/planet2-test1/"
$ "raco pkg create --format plt test-pkgs/planet2-test1-not-conflict" $ "raco pkg create --format plt test-pkgs/planet2-test1-not-conflict/"
(shelly-install "only modules are considered for conflicts" (shelly-install "only modules are considered for conflicts"
"test-pkgs/planet2-test1.plt" "test-pkgs/planet2-test1.plt"
$ "raco pkg install test-pkgs/planet2-test1-not-conflict.plt") $ "raco pkg install test-pkgs/planet2-test1-not-conflict.plt")

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

@ -32,6 +32,32 @@
(shelly-install "remote/URL/http package (directory)" (shelly-install "remote/URL/http package (directory)"
"http://localhost:9999/planet2-test1/") "http://localhost:9999/planet2-test1/")
(shelly-case
"fails due to unrecognized scheme"
$ "raco pkg install magic://download" =exit> 1)
(shelly-case
"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"
$ "raco pkg install tests-install.rkt" =exit> 1)
(shelly-case
"not a file, directory, or valid package name"
$ "raco pkg install 1+2" =exit> 1)
(shelly-case
"local file fails because called a directory"
$ "raco pkg install --type dir test-pkgs/pkg-a-first.plt" =exit> 1)
(shelly-case
"local directory name fails because called a file"
$ "raco pkg install --type file test-pkgs/pkg-a-first/" =exit> 1)
(shelly-case
"local directory name fails because called a URL"
$ "raco pkg install --type url test-pkgs/pkg-a-first/" =exit> 1)
(shelly-case (shelly-case
"remote/URL/http directory, non-existant file" "remote/URL/http directory, non-existant file"
$ "raco pkg install http://localhost:9999/planet2-test1.rar" =exit> 1) $ "raco pkg install http://localhost:9999/planet2-test1.rar" =exit> 1)
@ -46,11 +72,10 @@
$ "raco pkg install http://localhost:9999/planet2-test1-manifest-error" =exit> 1) $ "raco pkg install http://localhost:9999/planet2-test1-manifest-error" =exit> 1)
(shelly-case (shelly-case
"local directory fails when not there (because interpreted as package name that isn't there)" "local directory fails when not there"
$ "raco pkg install test-pkgs/planet2-test1-not-there" =exit> 1) $ "raco pkg install test-pkgs/planet2-test1-not-there/" =exit> 1)
(shelly-install "local package (directory)" "test-pkgs/planet2-test1") (shelly-install "local package (directory)" "test-pkgs/planet2-test1/")
(shelly-install "local package (directory with slash)" "test-pkgs/planet2-test1/")
(with-fake-root (with-fake-root
(shelly-case (shelly-case

4
collects/tests/planet2/tests-network.rkt
View File

@ -18,4 +18,6 @@
(shelly-install "remote/github" (shelly-install "remote/github"
"github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1") "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1")
(shelly-install "remote/github with slash" (shelly-install "remote/github with slash"
"github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/"))) "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")
(shelly-install "remote/github with auto prefix"
"--type github jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")))

8
collects/tests/planet2/tests-raco.rkt
View File

@ -8,18 +8,18 @@
"raco install/update uses raco setup, unless you turn it off (cmdline)" "raco install/update uses raco setup, unless you turn it off (cmdline)"
$ "raco pkg create --format plt test-pkgs/raco-pkg" $ "raco pkg create --format plt test-pkgs/raco-pkg"
$ "raco raco-pkg" =exit> 1 $ "raco raco-pkg" =exit> 1
$ "raco pkg install --dont-setup test-pkgs/raco-pkg.plt" $ "raco pkg install --no-setup test-pkgs/raco-pkg.plt"
$ "raco raco-pkg" =exit> 1)) $ "raco raco-pkg" =exit> 1))
(with-fake-root (with-fake-root
(shelly-case (shelly-case
"raco install/update uses raco setup, unless you turn it off (env)" "raco install/update uses raco setup, unless you turn it off (env)"
(putenv "PLT_PLANET2_DONTSETUP" "1") (putenv "PLT_PLANET2_NOSETUP" "1")
$ "raco pkg create --format plt test-pkgs/raco-pkg" $ "raco pkg create --format plt test-pkgs/raco-pkg"
$ "raco raco-pkg" =exit> 1 $ "raco raco-pkg" =exit> 1
$ "raco pkg install --dont-setup test-pkgs/raco-pkg.plt" $ "raco pkg install --no-setup test-pkgs/raco-pkg.plt"
$ "raco raco-pkg" =exit> 1 $ "raco raco-pkg" =exit> 1
(putenv "PLT_PLANET2_DONTSETUP" ""))) (putenv "PLT_PLANET2_NOSETUP" "")))
(with-fake-root (with-fake-root
(shelly-case (shelly-case

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

@ -23,7 +23,7 @@
"test-pkgs/planet2-test1.zip" "test-pkgs/planet2-test1.zip"
$ "raco pkg update planet2-test1" =exit> 1) $ "raco pkg update planet2-test1" =exit> 1)
(shelly-install "local packages can't be updated (directory)" (shelly-install "local packages can't be updated (directory)"
"test-pkgs/planet2-test1" "test-pkgs/planet2-test1/"
$ "raco pkg update planet2-test1" =exit> 1) $ "raco pkg update planet2-test1" =exit> 1)
(shelly-wind (shelly-wind
$ "mkdir -p test-pkgs/update-test" $ "mkdir -p test-pkgs/update-test"