From 15cbfa1947b6d49ca9c005c517a6f6b11817b78e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Nov 2012 11:16:14 -0700 Subject: [PATCH] `raco pkg': fixes for package source inference and handling Also, test additions and documentation adjustments. --- collects/planet2/lib.rkt | 286 +++++++++++---------- collects/planet2/main.rkt | 4 +- collects/planet2/scribblings/planet2.scrbl | 163 +++++++----- collects/planet2/util-plt.rkt | 46 ---- collects/tests/planet2/tests-conflicts.rkt | 4 +- collects/tests/planet2/tests-install.rkt | 33 ++- collects/tests/planet2/tests-network.rkt | 4 +- collects/tests/planet2/tests-raco.rkt | 8 +- collects/tests/planet2/tests-update.rkt | 2 +- 9 files changed, 281 insertions(+), 269 deletions(-) delete mode 100644 collects/planet2/util-plt.rkt diff --git a/collects/planet2/lib.rkt b/collects/planet2/lib.rkt index 4facf31451..40c6a9977e 100644 --- a/collects/planet2/lib.rkt +++ b/collects/planet2/lib.rkt @@ -271,6 +271,150 @@ #:type [type type] #:pkg-name [given-pkg-name #f]) (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 (eq? type 'file) (or @@ -363,147 +507,9 @@ `(dir ,(simple-form-path* pkg)) pkg-dir #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 (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 source (hash-ref index-info 'source)) (define checksum (hash-ref index-info 'checksum)) @@ -519,7 +525,7 @@ checksum) `(pns ,pkg))] [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 (install-package/outer infos auto+pkg info) (match-define (cons auto? pkg) diff --git a/collects/planet2/main.rkt b/collects/planet2/main.rkt index 3c38aa19a7..0995aebf99 100644 --- a/collects/planet2/main.rkt +++ b/collects/planet2/main.rkt @@ -41,8 +41,8 @@ #:force? force #:link? link #:ignore-checksums? ignore-checksums - #:type (or type - (and link 'dir)) + #:type (or (and link 'dir) + type) (map (curry cons #f) pkg-source)) (setup no-setup)))] [update diff --git a/collects/planet2/scribblings/planet2.scrbl b/collects/planet2/scribblings/planet2.scrbl index d3f97fa5fc..4aab0a3f93 100644 --- a/collects/planet2/scribblings/planet2.scrbl +++ b/collects/planet2/scribblings/planet2.scrbl @@ -10,7 +10,7 @@ @(define package-name-chars @list{@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 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 are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz}, @filepath{.tar.gz}, and -@filepath{.plt}; a package source is inferred to refer to a file -only when it has one of those suffixes. } +@filepath{.plt}. + +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 directory. The checksum is not present. For example, -@filepath{~/tic-tac-toe/}. A package source is inferred to refer -to a directory on when it ends with a directory separator.} +@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{://}.} @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 accessed via HTTP(S). For example, @filepath{http://game.com/tic-tac-toe.zip} and @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://}, @litchar{https://}, or @litchar{file://}.} +starts with @litchar{http://} or @litchar{https://}.} @item{a remote URL naming a directory -- The remote directory must 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 to determine the checksum. For example, @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 interpretation is determined by the URL's resolution.} @item{a remote URL naming a GitHub repository -- The format for such URLs is: -@filepath{github://github.com///////}. The -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. For example, + +@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/}. + +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 starts with @litchar{github://}; a package source that is otherwise 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 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 -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, -such that appending @filepath{/pkg/} 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] bound to the source and @racket['checksum] bound to the 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 contains @filepath{racket/list.rkt} is in conflict with Racket. For 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 installed, (2) A and B have the same name, and (3) A's checksum is @@ -148,93 +167,99 @@ sub-sub-commands: @itemlist[ -@item{@exec{install pkg ...} -- Installs the list of @tech{package -sources}. It -accepts the following options: +@item{@exec{install} @nonterm{option} ... @nonterm{pkg-source} ... + --- Installs the given @tech{package sources} with the given + @nonterm{option}s: @itemlist[ - @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}, - or @litchar{name} (to be resolve through a @tech{PNS}).} + @item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} --- specifies an interpretation of the package source, + where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{url}, @exec{github}, + 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} @exec{dep-behavior} -- Selects the behavior for dependencies. The options are: + @item{@DFlag{deps} @nonterm{behavior} --- Selects the behavior for dependencies, where @nonterm{behavior} is one of @itemlist[ - @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{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{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{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{@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 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[ - @item{@DFlag{dont-setup} -- Same as for @exec{install}.} - @item{@DFlag{installation} -- Same as for @exec{install}.} - @item{@Flag{i} -- Same as for @exec{install}.} - @item{@DFlag{deps} @exec{dep-behavior} -- Same as for @exec{install}.} - @item{@DFlag{all} -- Update all packages, if no packages are given in the argument list.} - @item{@Flag{a} -- Alias for @DFlag{all}.} - @item{@DFlag{update-deps} -- Checks the named packages, and their dependencies (transitively) for updates.} + @item{@DFlag{no-setup} --- Same as for @exec{install}.} + @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.} + @item{@DFlag{deps} @nonterm{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{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[ - @item{@DFlag{dont-setup} -- Same as for @exec{install}.} - @item{@DFlag{installation} -- Same as for @exec{install}.} - @item{@Flag{i} -- Same as for @exec{install}.} - @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{no-setup} --- Same as for @exec{install}.} + @item{@DFlag{installation} or @Flag{i} --- Same as for @exec{install}.} + @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{@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[ - @item{@DFlag{installation} -- Same as for @exec{install}.} - @item{@Flag{i} -- Same as for @exec{install}.} + @item{@DFlag{installation} or @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[ - @item{@DFlag{installation} -- 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{installation} or @Flag{i} --- Same as for @exec{install}.} + @item{@DFlag{set} --- Sets an option, rather than printing it.} ] The valid keys are: @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[ - @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{manifest} -- Creates a manifest file for a directory, rather than an archive.} + @item{@DFlag{format} @nonterm{format} --- Specifies the archive format. + 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] -The @racketmodname[planet2] module provides a programmatic interface to -the command sub-sub-commands. Each long form option is keyword -argument. @DFlag{deps} accepts its argument as a symbol and -@DFlag{format} accepts its argument as a string. All other options -accept booleans, where @racket[#t] is equivalent to the presence of -the option. +The @racketmodname[planet2] module provides a programmatic interface +to the command sub-sub-commands. Each long form option is keyword +argument. An argument corresponding to @DFlag{type} or @DFlag{deps} +accepts its argument as a symbol, and @DFlag{format} accepts its +argument as a string. All other options accept booleans, where +@racket[#t] is equivalent to the presence of the option. @deftogether[ (@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 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_DONTSETUP} set to -@litchar{1}. (The tests that require @exec{raco setup} to run +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 @@ -578,12 +603,12 @@ for these categories are: @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}.} - @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 responsive about fixing regressions against changes in Racket, etc.} diff --git a/collects/planet2/util-plt.rkt b/collects/planet2/util-plt.rkt deleted file mode 100644 index 12fecaa8c5..0000000000 --- a/collects/planet2/util-plt.rkt +++ /dev/null @@ -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?)])) diff --git a/collects/tests/planet2/tests-conflicts.rkt b/collects/tests/planet2/tests-conflicts.rkt index 977f231650..cedc5bdbfa 100644 --- a/collects/tests/planet2/tests-conflicts.rkt +++ b/collects/tests/planet2/tests-conflicts.rkt @@ -17,8 +17,8 @@ (shelly-begin (initialize-indexes) - $ "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/" + $ "raco pkg create --format plt test-pkgs/planet2-test1-not-conflict/" (shelly-install "only modules are considered for conflicts" "test-pkgs/planet2-test1.plt" $ "raco pkg install test-pkgs/planet2-test1-not-conflict.plt") diff --git a/collects/tests/planet2/tests-install.rkt b/collects/tests/planet2/tests-install.rkt index a18bd6c453..bbcf3d23db 100644 --- a/collects/tests/planet2/tests-install.rkt +++ b/collects/tests/planet2/tests-install.rkt @@ -32,6 +32,32 @@ (shelly-install "remote/URL/http package (directory)" "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 "remote/URL/http directory, non-existant file" $ "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) (shelly-case - "local directory fails when not there (because interpreted as package name that isn't there)" - $ "raco pkg install test-pkgs/planet2-test1-not-there" =exit> 1) + "local directory fails when not there" + $ "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 with slash)" "test-pkgs/planet2-test1/") + (shelly-install "local package (directory)" "test-pkgs/planet2-test1/") (with-fake-root (shelly-case diff --git a/collects/tests/planet2/tests-network.rkt b/collects/tests/planet2/tests-network.rkt index 279a8545e8..6c618f5e40 100644 --- a/collects/tests/planet2/tests-network.rkt +++ b/collects/tests/planet2/tests-network.rkt @@ -18,4 +18,6 @@ (shelly-install "remote/github" "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1") (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/"))) diff --git a/collects/tests/planet2/tests-raco.rkt b/collects/tests/planet2/tests-raco.rkt index 072e412a91..428a1a7f3d 100644 --- a/collects/tests/planet2/tests-raco.rkt +++ b/collects/tests/planet2/tests-raco.rkt @@ -8,18 +8,18 @@ "raco install/update uses raco setup, unless you turn it off (cmdline)" $ "raco pkg create --format plt test-pkgs/raco-pkg" $ "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)) (with-fake-root (shelly-case "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 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 - (putenv "PLT_PLANET2_DONTSETUP" ""))) + (putenv "PLT_PLANET2_NOSETUP" ""))) (with-fake-root (shelly-case diff --git a/collects/tests/planet2/tests-update.rkt b/collects/tests/planet2/tests-update.rkt index 458541d938..04225bbe9d 100644 --- a/collects/tests/planet2/tests-update.rkt +++ b/collects/tests/planet2/tests-update.rkt @@ -23,7 +23,7 @@ "test-pkgs/planet2-test1.zip" $ "raco pkg update planet2-test1" =exit> 1) (shelly-install "local packages can't be updated (directory)" - "test-pkgs/planet2-test1" + "test-pkgs/planet2-test1/" $ "raco pkg update planet2-test1" =exit> 1) (shelly-wind $ "mkdir -p test-pkgs/update-test"