From ff6b4efb17d4c12d3e533dbc9ffb1c707c67280e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 10 Mar 2014 10:19:57 -0600 Subject: [PATCH] file/unzip: support preserving timestamps --- .../racket-doc/file/scribblings/unzip.scrbl | 40 +++++++++---- .../racket-test/tests/file/unpackers.rkt | 27 +++++---- racket/collects/file/unzip.rkt | 57 +++++++++++++------ 3 files changed, 87 insertions(+), 37 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/file/scribblings/unzip.scrbl b/pkgs/racket-pkgs/racket-doc/file/scribblings/unzip.scrbl index efd341ef90..ba2d49e8f7 100644 --- a/pkgs/racket-pkgs/racket-doc/file/scribblings/unzip.scrbl +++ b/pkgs/racket-pkgs/racket-doc/file/scribblings/unzip.scrbl @@ -8,19 +8,27 @@ a function to extract items from a @exec{zip} archive.} @defproc[(unzip [in (or/c path-string? input-port)] - [entry-reader (bytes? boolean? input-port? . -> . any) - (make-filesystem-entry-reader)]) + [entry-reader (if preserve-timestamps? + (bytes? boolean? input-port? (or/c #f exact-integer?) + . -> . any) + (bytes? boolean? input-port? . -> . any)) + (make-filesystem-entry-reader)] + [#:preserve-timestamps? preserve-timestamps? any/c #f]) void?]{ Unzips an entire @exec{zip} archive from @racket[in]. For each entry in the archive, the @racket[entry-reader] procedure is -called with three arguments: the byte string representing the entry +called with three or four arguments: the byte string representing the entry name, a boolean flag indicating whether the entry represents a -directory, and an input port containing the inflated contents of the -entry. The default @racket[entry-reader] unpacks entries to the +directory, an input port containing the inflated contents of the +entry, and (if @racket[preserve-timestamps?]) @racket[#f] or a timestamp +for a file. The default @racket[entry-reader] unpacks entries to the filesystem; call @racket[make-filesystem-entry-reader] to configure -aspects of the unpacking, such as the destination directory.} +aspects of the unpacking, such as the destination directory. + +@history[#:changed "6.0.0.3" @elem{Added the @racket[#:preserve-timestamps?] argument.}]} + @defproc[(make-filesystem-entry-reader [#:dest dest-path (or/c path-string? #f) #f] @@ -29,7 +37,8 @@ aspects of the unpacking, such as the destination directory.} 'truncate/replace 'append 'update 'can-update 'must-truncate) 'error]) - (bytes? boolean? input-port? . -> . any)]{ + ((bytes? boolean? input-port?) ((or/c #f exact-integer?)) + . ->* . any)]{ Creates a @exec{zip} entry reader that can be used with either @racket[unzip] or @racket[unzip-entry] and whose behavior is to save @@ -49,7 +58,10 @@ contains @racket[strip-count] elements, then it is not extracted. If @racket[exists] is @racket['skip] and the file for an entry already exists, then the entry is skipped. Otherwise, @racket[exists] is passed on to @racket[open-output-file] for writing the entry's -inflated content.} +inflated content. + +@history[#:changed "6.0.0.3" + @elem{Added support for the optional timestamp argument in the result function.}]} @defproc[(read-zip-directory [in (or/c path-string? input-port?)]) zip-directory?]{ @@ -99,8 +111,12 @@ itself or as the containing directory of other entries. If @defproc[(unzip-entry [in (or/c path-string? input-port?)] [zipdir zip-directory?] [entry (or/c bytes? path-string?)] - [entry-reader (bytes? boolean? input-port? . -> . any) - (make-filesystem-entry-reader)]) + [entry-reader (if preserve-timestamps? + (bytes? boolean? input-port? (or/c #f exact-integer?) + . -> . any) + (bytes? boolean? input-port? . -> . any)) + (make-filesystem-entry-reader)] + [#:preserve-timestamps? preserve-timestamps? any/c #f]) void?]{ Unzips a single entry from a @exec{zip} archive based on a previously @@ -116,7 +132,9 @@ The @racket[read-entry] argument is used to read the contents of the zip entry in the same way as for @racket[unzip]. If @racket[entry] is not in @racket[zipdir], an -@racket[exn:fail:unzip:no-such-entry] exception is raised.} +@racket[exn:fail:unzip:no-such-entry] exception is raised. + +@history[#:changed "6.0.0.3" @elem{Added the @racket[#:preserve-timestamps?] argument.}]} @defproc[(path->zip-path [path path-string?]) bytes?]{ diff --git a/pkgs/racket-pkgs/racket-test/tests/file/unpackers.rkt b/pkgs/racket-pkgs/racket-test/tests/file/unpackers.rkt index a87e0ccf6d..23d0fc7a36 100644 --- a/pkgs/racket-pkgs/racket-test/tests/file/unpackers.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/file/unpackers.rkt @@ -114,7 +114,7 @@ (delete-file "L1c") (delete-file "helper.rkt")) -(define (unzip-tests*) +(define ((make-unzip-tests* preserve-timestamps?)) (make-directory* "ex1") (make-file (build-path "ex1" "f1")) (make-file (build-path "ex1" "f2")) @@ -123,11 +123,15 @@ (make-file (build-path more-dir "f4")) (zip "ex1" a.zip) (make-directory* "sub") - (parameterize ([current-directory "sub"]) (unzip a.zip)) - (diff "ex1" (build-path "sub" "ex1") #f) + (parameterize ([current-directory "sub"]) + (if preserve-timestamps? + (unzip a.zip #:preserve-timestamps? #t) + (unzip a.zip))) + (diff "ex1" (build-path "sub" "ex1") preserve-timestamps?) (delete-directory/files "sub") - (unzip a.zip (make-filesystem-entry-reader #:dest "sub")) - (diff "ex1" (build-path "sub" "ex1") #f) + (unzip a.zip (make-filesystem-entry-reader #:dest "sub") + #:preserve-timestamps? preserve-timestamps?) + (diff "ex1" (build-path "sub" "ex1") preserve-timestamps?) (delete-directory/files "sub") (unzip a.zip (lambda (bytes dir? in) (void))) (when (directory-exists? "sub") (error "should not have been unpacked")) @@ -145,12 +149,13 @@ (lambda (exn) (test (exn:fail:unzip:no-such-entry-entry exn) => (if (bytes? p) p (path->zip-path p))))]) - (unzip-entry src zd p))) + (unzip-entry src zd p #:preserve-timestamps? preserve-timestamps?))) (check-not-there #"f1") (for ([entry (in-list (zip-directory-entries zd))]) (parameterize ([current-directory work-dir]) - (unzip-entry src zd entry (make-filesystem-entry-reader #:dest "sub")))) - (diff "ex1" (build-path "sub" "ex1") #f) + (unzip-entry src zd entry (make-filesystem-entry-reader #:dest "sub") + #:preserve-timestamps? preserve-timestamps?))) + (diff "ex1" (build-path "sub" "ex1") preserve-timestamps?) (delete-directory/files "sub")) (directory-test a.zip) (call-with-input-file a.zip directory-test)) @@ -166,9 +171,11 @@ cleanup)) (define (untar-tests) (when tar-exe (test do (run-tests untar-tests*)))) -(define (unzip-tests) (when zip-exe (test do (run-tests unzip-tests*)))) +(define (unzip-tests [preserve-timestamps? #f]) + (when zip-exe (test do (run-tests (make-unzip-tests* preserve-timestamps?))))) (module+ main (tests)) (define (tests) (test do (untar-tests) - do (unzip-tests))) + do (unzip-tests) + do (unzip-tests #t))) diff --git a/racket/collects/file/unzip.rkt b/racket/collects/file/unzip.rkt index 8d7c426513..cc7105e1c3 100644 --- a/racket/collects/file/unzip.rkt +++ b/racket/collects/file/unzip.rkt @@ -2,6 +2,7 @@ (require racket/contract/base racket/port racket/file + racket/date file/gunzip "private/strip-prefix.rkt") @@ -10,9 +11,14 @@ (contract-out [unzip (((or/c path-string? input-port?)) - ((bytes? boolean? input-port? . -> . any)) - . ->* . any)] - + ((or/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 3)) + ;; More precisely (but unimplementable): + #; + (or/c (bytes? boolean? input-port? (or/c #f exact-integer?) . -> . any) + (bytes? boolean? input-port? . -> . any)) + #:preserve-timestamps? any/c) + . ->* . any)] + [make-filesystem-entry-reader (() (#:dest (or/c #f path-string?) #:strip-count @@ -22,7 +28,9 @@ 'error 'replace 'truncate 'truncate/replace 'append 'update 'can-update 'must-truncate)) . ->* . - (bytes? boolean? input-port? . -> . any))] + ((bytes? boolean? input-port?) + ((or/c #f exact-integer?)) + . ->* . any))] [read-zip-directory ((or/c path-string? input-port?) . -> . zip-directory?)] [zip-directory? (any/c . -> . boolean?)] @@ -30,7 +38,8 @@ [zip-directory-contains? (zip-directory? (or/c path-string? bytes?) . -> . boolean?)] [zip-directory-includes-directory? (zip-directory? (or/c path-string? input-port?) . -> . boolean?)] [unzip-entry (((or/c path-string? input-port?) zip-directory? bytes?) - ((bytes? boolean? input-port? . -> . any)) + ((or/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 3)) + #:preserve-timestamps? any/c) . ->* . any)] @@ -155,8 +164,8 @@ (read-bytes amt in) (void)) -;; unzip-one-entry : input-port (bytes boolean input-port -> a) -> a -(define (unzip-one-entry in read-entry) +;; unzip-one-entry : input-port (bytes boolean input-port [exact-integer?] -> a) -> a +(define (unzip-one-entry in read-entry preserve-timestamps?) (let ([read-int (lambda (count) (read-integer count #f in #f))]) (let* ([signature (read-int 4)] [version (read-bytes 2 in)] @@ -186,8 +195,11 @@ (if (zero? compression) (values in0 #f) (make-filter-input-port inflate in0))) - - (read-entry filename dir? in) + + (if preserve-timestamps? + (read-entry filename dir? in (and (not dir?) + (msdos-date+time->seconds date time))) + (read-entry filename dir? in)) (when t (kill-thread t))) (lambda () @@ -253,6 +265,15 @@ (skip-bytes (+ extra-length comment-length) in) (cons filename (make-zip-entry relative-offset dir?))))))))) +(define (msdos-date+time->seconds date time) + (with-handlers ([exn:fail? (lambda (exn) #f)]) + (find-seconds (* 2 (bitwise-and #x1F time)) + (bitwise-and #x3F (arithmetic-shift time -5)) + (bitwise-and #x1F (arithmetic-shift time -11)) + (bitwise-and #x1F date) + (bitwise-and #xF (arithmetic-shift date -5)) + (+ (bitwise-and #x7F (arithmetic-shift date -9)) 1980)))) + ;; =========================================================================== ;; FRONT END ;; =========================================================================== @@ -266,13 +287,14 @@ ;; unzip : [(or/c path-string? input-port) (bytes boolean input-port -> any)] -> any (define unzip - (lambda (in [read-entry (make-filesystem-entry-reader)]) + (lambda (in [read-entry (make-filesystem-entry-reader)] + #:preserve-timestamps? [preserve-timestamps? #f]) (call-with-input in (lambda (in) (when (= (peek-integer 4 #f in #f) *local-file-header*) - (unzip-one-entry in read-entry) - (unzip in read-entry)))))) + (unzip-one-entry in read-entry preserve-timestamps?) + (unzip in read-entry #:preserve-timestamps? preserve-timestamps?)))))) (define (input-size in) (file-position in eof) @@ -291,7 +313,8 @@ ;; unzip-entry : (union string path) zip-directory bytes [(bytes boolean input-port -> a)] -> a (define unzip-entry - (lambda (in dir entry-name [read-entry (make-filesystem-entry-reader)]) + (lambda (in dir entry-name [read-entry (make-filesystem-entry-reader)] + #:preserve-timestamps? [preserve-timestamps? #f]) (cond [(zip-directory-lookup entry-name dir) => (lambda (entry) @@ -299,7 +322,7 @@ in (lambda (in) (file-position in (zip-entry-offset entry)) - (unzip-one-entry in read-entry))))] + (unzip-one-entry in read-entry preserve-timestamps?))))] [else (raise-entry-not-found entry-name)]))) ;; =========================================================================== @@ -309,7 +332,7 @@ ;; make-filesystem-entry-reader : [output-flag] -> (bytes boolean input-port -> any) (define make-filesystem-entry-reader (lambda (#:dest [dest-dir #f] #:strip-count [strip-count 0] #:exists [flag 'error]) - (lambda (name dir? in) + (lambda (name dir? in [timestamp #f]) (let* ([base-path (strip-prefix (bytes->path name) strip-count)] [path (and base-path (if dest-dir @@ -327,7 +350,9 @@ (with-output-to-file path #:exists flag (lambda () - (copy-port in (current-output-port)))))))))))) + (copy-port in (current-output-port)))) + (when timestamp + (file-or-directory-modify-seconds path timestamp)))))))))) (define (dirname p) (define-values (base name dir?) (split-path p))