raco pkg install: change interpretation of archive with a single directory

When an archive used as a package source has all of its content
within a single top-level directory, then treat that directory's
content as the package content, instead of treating the directory
itself as the package content.

The change makes "x.zip" created with

  zip -r x.zip x

work the same as "x" as a package source. It also makes a ".zip"
for a package's GitHub repository (from clicking the "Download ZIP"
button) work the same as the repository.

This change is backward incompatible, but it's unlikely to break
any working package (since that would be a single-collection package
that provides only a subcollection).
This commit is contained in:
Matthew Flatt 2014-06-04 15:22:12 +01:00
parent 0ed142b78f
commit 8828865c79
4 changed files with 66 additions and 15 deletions

View File

@ -124,20 +124,28 @@ is the basename of the archive file. The @tech{checksum} for archive
The valid archive formats
are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz},
@filepath{.tar.gz}, and
@filepath{.plt}, each of which represents package content analogous
to a directory,
but the @filepath{.plt} format does not accommodate a
@filepath{.plt}.
For example, @filepath{~/tic-tac-toe.zip} is an archive package
source, and its @tech{checksum} would be inside
@filepath{~/tic-tac-toe.zip.CHECKSUM}.
An archive represents package content analogous to a directory, but if
the archive's content is contained within a single top-level
directory, then the directory's content (as opposed to the overall
archive content) is used as the package content. The @filepath{.plt}
format does not accommodate either an extra directory layer or a
@tech{single-collection package} representation.
For
example, @filepath{~/tic-tac-toe.zip}'s @tech{checksum} would be inside
@filepath{~/tic-tac-toe.zip.CHECKSUM}.
A package source is inferred to refer to a file
A package source is inferred to refer to an archive file
only when it has a suffix matching a valid archive format
and when it starts with @litchar{file://} or does not start
with alphabetic characters followed by @litchar{://}. The inferred
package name is the filename without its suffix.}
package name is the filename without its suffix.
@history[#:changed "6.0.1.12"
@elem{Changed treatment of an archive that contains all
content within a top-level directory.}]}
@item{a local directory (as a plain path or @litchar{file://} URL)
--- The name of the package is the name of the

View File

@ -8,6 +8,8 @@
racket/runtime-path
racket/path
racket/list
file/zip
file/unzip
net/url
pkg/util
"shelly.rkt"
@ -36,6 +38,18 @@
"--copy "
(url->string (path->url (path->complete-path "test-pkgs/pkg-test1")))))
;; Check ".zip" file with extra directory layer:
(let ([dir (make-temporary-file "zip~a" 'directory)]
[orig-dir (current-directory)])
(define-values (base name dir?) (split-path dir))
(parameterize ([current-directory base])
(parameterize ([current-directory name])
(unzip (build-path orig-dir "test-pkgs/pkg-test1.zip")))
(zip (build-path dir "pkg-test1.zip") name))
(shelly-install "local package (zip, extra layer)"
(build-path dir "pkg-test1.zip"))
(delete-directory/files dir))
(with-fake-root
(shelly-case
"local package (old plt)"

View File

@ -1284,14 +1284,18 @@
(match pkg-format
[#"tgz"
(untar pkg-path pkg-dir)]
(untar pkg-path pkg-dir)
(remove-extra-directory-layer pkg-dir)]
[#"tar"
(untar pkg-path pkg-dir)]
(untar pkg-path pkg-dir)
(remove-extra-directory-layer pkg-dir)]
[#"gz" ; assuming .tar.gz
(untar pkg-path pkg-dir)]
(untar pkg-path pkg-dir)
(remove-extra-directory-layer pkg-dir)]
[#"zip"
(unzip pkg-path (make-filesystem-entry-reader #:dest pkg-dir)
#:preserve-timestamps? #t)]
#:preserve-timestamps? #t)
(remove-extra-directory-layer pkg-dir)]
[#"plt"
(make-directory* pkg-dir)
(unpack pkg-path pkg-dir
@ -2621,6 +2625,15 @@
(if dest-dir
pkg/complete
pkg)))
(define (add-directory-layer? content)
;; We need to add a layer for zip/tgz if the package content
;; is a single directory, which is an unlikely case.
;; That mode is not compatble with Racket v60.0.1.12 and earlier.
;; When only Racket v6.0.1.12 is later is relevant,
;; we might prefer to always add a layer for consistency and
;; because it's nicer for manual unpacking.
(and (= 1 (length content))
(directory-exists? (car content))))
(match create:format
['tgz
(when (file-exists? pkg/complete)
@ -2630,7 +2643,10 @@
(when (file-exists? pkg/complete)
(delete-file pkg/complete))
(raise exn))])
(apply tar-gzip pkg/complete (directory-list)
(define content (directory-list))
(apply tar-gzip pkg/complete content
#:path-prefix (and (add-directory-layer? content)
pkg-name)
#:get-timestamp file-or-directory-timestamp)))]
['zip
(when (file-exists? pkg/complete)
@ -2640,7 +2656,10 @@
(when (file-exists? pkg/complete)
(delete-file pkg/complete))
(raise exn))])
(apply zip pkg/complete (directory-list)
(define content (directory-list))
(apply zip pkg/complete content
#:path-prefix (and (add-directory-layer? content)
pkg-name)
#:get-timestamp file-or-directory-timestamp)))]
['plt
(define dest pkg/complete)

View File

@ -195,4 +195,14 @@
;; Remove directory that we moved files out of:
(delete-directory/files (build-path pkg-dir sub)))
(define (remove-extra-directory-layer pkg-dir)
;; Treat a single directory produced in `pkg-dir`
;; as having the content of the package, instead of
;; being included itself in the package content.
(define l (directory-list pkg-dir))
(when (= 1 (length l))
(define orig-sub (car l))
(when (directory-exists? (build-path pkg-dir orig-sub))
(lift-directory-content pkg-dir (list orig-sub)))))
(provide (all-defined-out))