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

file/zip, file/tar: add #:get-timestamp argument

Browse Source 
Allows the recorded timestamp to be adjusted in a general way.
This commit is contained in:
Matthew Flatt 2014-03-10 13:57:07 -06:00
parent ff6b4efb17
commit ce6b8b8d5c
5 changed files with 94 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/distro-build-pkgs/distro-build-server/pack-and-catalog.rkt
View File

@ -100,7 +100,8 @@
(apply zip dest-zip (directory-list)
;; Use a constant timestamp so that the checksum does
;; not depend on timestamps:
#:timestamp 1359788400))
#:timestamp 1359788400
#:system-type 'unix))
(delete-directory/files tmp-dir)
(call-with-output-file*
dest-sum

38
pkgs/racket-pkgs/racket-doc/file/scribblings/tar.scrbl
View File

@ -14,9 +14,15 @@ is always ``root.''
Symbolic links (on Unix and Mac OS X) are not followed, and the path
in a link must be less than 100 bytes.}
@defproc[(tar [tar-file path-string?]
[path path-string?] ...
[#:path-prefix path-prefix (or/c #f path-string?) #f])
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp
(path? . -> . exact-integer?)
(if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)])
exact-nonnegative-integer?]{
Creates @racket[tar-file], which holds the complete content of all
@ -28,23 +34,43 @@ resulting tar file, up to the current directory (using
@racket[pathlist-closure]).
If @racket[path-prefix] is not @racket[#f], then it is prefixed to
each path in the archive.}
each path in the archive.
The @racket[get-timestamp] function is used to obtain the modification
date to record in the archive for each file or directory.
@history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}]}
@defproc[(tar->output [paths (listof path?)]
[out output-port? (current-output-port)]
[#:path-prefix path-prefix (or/c #f path-string?) #f])
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp
(path? . -> . exact-integer?)
(if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)])
exact-nonnegative-integer?]{
Packages each of the given @racket[paths] in a @exec{tar} format
archive that is written directly to the @racket[out]. The specified
@racket[paths] are included as-is (except for adding @racket[path-prefix], if any); if a directory is specified, its
content is not automatically added, and nested directories are added
without parent directories.}
without parent directories.
@history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}]}
@defproc[(tar-gzip [tar-file path-string?]
[paths path-string?] ...
[#:path-prefix path-prefix (or/c #f path-string?) #f])
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp
(path? . -> . exact-integer?)
(if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)])
void?]{
Like @racket[tar], but compresses the resulting file with @racket[gzip].
}
@history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}]}

30
pkgs/racket-pkgs/racket-doc/file/scribblings/zip.scrbl
View File

@ -9,7 +9,13 @@ with both Windows and Unix (including Mac OS X) unpacking. The actual
compression is implemented by @racket[deflate].}
@defproc[(zip [zip-file path-string?] [path path-string?] ...
[#:timestamp timestamp (or/c #f exact-integer?) #f])
[#:timestamp timestamp (or/c #f exact-integer?) #f]
[#:get-timestamp get-timestamp
(path? . -> . exact-integer?)
(if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)]
[#:system-type sys-type symbol? (system-type)])
void?]{
Creates @racket[zip-file], which holds the complete content of all
@ -29,21 +35,33 @@ Files are packaged as usual for
distinction between owner/group/other permissions. Also, symbolic
links are always followed.
If @racket[timestamp] is not @racket[#f], it is used as the
modification date for each file, instead of the result of
@racket[file-or-directory-modify-seconds].}
The @racket[get-timestamp] function is used to obtain the modification
date to record in the archive for a file or directory, while
@racket[sys-type] determines the system type recorded in the archive.
@history[#:changed "6.0.0.3"
@elem{Added the @racket[#:get-timestamp] and @racket[#:system-type] arguments.}]}
@defproc[(zip->output [paths (listof path-string?)]
[out output-port? (current-output-port)]
[#:timestamp timestamp (or/c #f exact-integer?) #f])
[#:timestamp timestamp (or/c #f exact-integer?) #f]
[#:get-timestamp get-timestamp
(path? . -> . exact-integer?)
(if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)]
[#:system-type sys-type symbol? (system-type)])
void?]{
Zips each of the given @racket[paths], and packages it as a zip
``file'' that is written directly to @racket[out]. Unlike
@racket[zip], the specified @racket[paths] are included as-is; if a
directory is specified, its content is not automatically added, and
nested directories are added without parent directories.}
nested directories are added without parent directories.
@history[#:changed "6.0.0.3"
@elem{Added the @racket[#:get-timestamp] and @racket[#:system-type] arguments.}]}
@defboolparam[zip-verbose on?]{

13
racket/collects/file/tar.rkt
View File

@ -43,7 +43,7 @@
(define 0-byte (char->integer #\0))
(define ((tar-one-entry buf prefix) path)
(define ((tar-one-entry buf prefix get-timestamp) path)
(let* ([link? (link-exists? path)]
[dir? (and (not link?) (directory-exists? path))]
[size (if (or dir? link?) 0 (file-size path))]
@ -82,7 +82,7 @@
(write-octal 8 0) ; always root (uid)
(write-octal 8 0) ; always root (gid)
(write-octal 12 size)
(write-octal 12 (file-or-directory-modify-seconds path))
(write-octal 12 (get-timestamp path))
;; set checksum later, consider it "all blanks" for cksum
(set! cksum-p p) (set! cksum (+ cksum (* 8 32))) (advance 8)
(write-block* 1 (if link? #"2" (if dir? #"5" #"0"))) ; type-flag: dir/file (no symlinks)
@ -130,9 +130,10 @@
;; writes a tar file to current-output-port
(provide tar->output)
(define (tar->output files [out (current-output-port)]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds]
#:path-prefix [prefix #f])
(parameterize ([current-output-port out])
(let* ([buf (new-block)] [entry (tar-one-entry buf prefix)])
(let* ([buf (new-block)] [entry (tar-one-entry buf prefix get-timestamp)])
(for-each entry files)
;; two null blocks end-marker
(write-bytes buf) (write-bytes buf))))
@ -141,16 +142,19 @@
(provide tar)
(define (tar tar-file
#:path-prefix [prefix #f]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds]
. paths)
(when (null? paths) (error 'tar "no paths specified"))
(with-output-to-file tar-file
(lambda () (tar->output (pathlist-closure paths #:follow-links? #f)
#:get-timestamp get-timestamp
#:path-prefix prefix))))
;; tar-gzip : output-file paths ->
(provide tar-gzip)
(define (tar-gzip tgz-file
#:path-prefix [prefix #f]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds]
. paths)
(when (null? paths) (error 'tar-gzip "no paths specified"))
(with-output-to-file tgz-file
@ -158,7 +162,8 @@
(let-values ([(i o) (make-pipe (* 1024 1024 32))])
(thread (lambda ()
(tar->output (pathlist-closure paths #:follow-links? #f) o
#:path-prefix prefix)
#:path-prefix prefix
#:get-timestamp get-timestamp)
(close-output-port o)))
(gzip-through-ports
i (current-output-port)

47
racket/collects/file/zip.rkt
View File

@ -39,12 +39,12 @@
(define *zip64-end-of-central-directory-locator* #x07064b50)
(define *end-of-central-directory-record* #x06054b50)
(define *system*
(case (system-type)
[(unix oskit) 3]
(define (get-system-id type)
(case type
[(windows) 0]
[(macos) 7]
[(macosx) 19]))
[(macosx) 19]
[else 3]))
(define *os-specific-separator-regexp*
(case (system-type)
[(unix macosx oskit) #rx"/"]
@ -142,8 +142,8 @@
(write-int comment-length 2)
(write-bytes *zip-comment*)))
;; write-central-directory : (listof header) (or/c #f exact-integer?) ->
(define (write-central-directory headers timestamp)
;; write-central-directory : (listof header) symbol? ->
(define (write-central-directory headers sys-type)
(let ([count (length headers)])
(let loop ([headers headers] [offset 0] [size 0])
(if (null? headers)
@ -155,9 +155,7 @@
[attributes (metadata-attributes metadata)]
[compression (metadata-compression metadata)]
[version (bitwise-ior *spec-version*
(arithmetic-shift (if timestamp
3
*system*)
(arithmetic-shift (get-system-id sys-type)
8))])
(write-int #x02014b50 4)
(write-int version 2)
@ -227,10 +225,9 @@
(define (with-slash-separator bytes)
(regexp-replace* *os-specific-separator-regexp* bytes #"/"))
;; build-metadata : relative-path (or/c #f exact-integer?) -> metadata
(define (build-metadata path timestamp)
(let* ([mod (seconds->date (or timestamp
(file-or-directory-modify-seconds path)))]
;; build-metadata : relative-path (relative-path . -> . exact-integer?) -> metadata
(define (build-metadata path get-timestamp)
(let* ([mod (seconds->date (get-timestamp path))]
[dir? (directory-exists? path)]
[path (cond [(path? path) path]
[(string? path) (string->path path)]
@ -251,26 +248,36 @@
;; writes a zip file to current-output-port
(provide zip->output)
(define (zip->output files [out (current-output-port)]
#:timestamp [timestamp #f])
#:timestamp [timestamp #f]
#:get-timestamp [get-timestamp (if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)]
#:system-type [sys-type (system-type)])
(parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))]
[headers ; note: Racket's `map' is always left-to-right
(map (lambda (file)
(zip-one-entry (build-metadata file timestamp) seekable?))
(zip-one-entry (build-metadata file get-timestamp) seekable?))
files)])
(when (zip-verbose)
(eprintf "zip: writing headers...\n"))
(write-central-directory headers timestamp))
(write-central-directory headers get-timestamp))
(when (zip-verbose)
(eprintf "zip: done.\n"))))
;; zip : output-file paths ->
(provide zip)
(define (zip zip-file #:timestamp [timestamp #f]
(define (zip zip-file
#:timestamp [timestamp #f]
#:get-timestamp [get-timestamp (if timestamp
(lambda (p) timestamp)
file-or-directory-modify-seconds)]
#:system-type [sys-type (system-type)]
. paths)
;; (when (null? paths) (error 'zip "no paths specified"))
(with-output-to-file zip-file
(lambda () (zip->output (pathlist-closure paths)
#:timestamp timestamp))))
(lambda () (zip->output (pathlist-closure paths)
#:get-timestamp get-timestamp
#:system-type sys-type))))
)