file/unzip: support preserving timestamps
This commit is contained in:
Matthew Flatt
parent
edc8bbf6b4
commit
ff6b4efb17
|
|
@ -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?]{
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user