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

file/tar: add #:follow-links? option

Browse Source
This commit is contained in:
Matthew Flatt 2015-11-10 10:40:01 -07:00
parent 4c6750286a
commit 596b05146c
2 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,12 +11,13 @@ directories, files, and symbolic links, and owner
information is not preserved; the owner that is stored in the archive information is not preserved; the owner that is stored in the archive
is always ``root.'' is always ``root.''
Symbolic links (on Unix and Mac OS X) are not followed, and the path Symbolic links (on Unix and Mac OS X) are not followed by default, and the path
in a link must be less than 100 bytes.} in a link must be less than 100 bytes.}
@defproc[(tar [tar-file path-string?] @defproc[(tar [tar-file path-string?]
[path path-string?] ... [path path-string?] ...
[#:follow-links? follow-links? any/c #f]
[#:exists-ok? exists-ok? any/c #f] [#:exists-ok? exists-ok? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f] [#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp [#:get-timestamp get-timestamp
@ -32,7 +33,8 @@ relative paths for existing directories and files (i.e., relative
to the current directory). If a nested path is provided as a to the current directory). If a nested path is provided as a
@racket[path], its ancestor directories are also added to the @racket[path], its ancestor directories are also added to the
resulting tar file, up to the current directory (using resulting tar file, up to the current directory (using
@racket[pathlist-closure]). @racket[pathlist-closure]). If @racket[follow-links?] is false, then
symbolic links are included in the resulting tar file as links.
If @racket[exists-ok?] is @racket[#f], then an exception is raised if If @racket[exists-ok?] is @racket[#f], then an exception is raised if
@racket[tar-file] exists already. If @racket[exists-ok?] is true, then @racket[tar-file] exists already. If @racket[exists-ok?] is true, then
@ -45,11 +47,13 @@ The @racket[get-timestamp] function is used to obtain the modification
date to record in the archive for each file or directory. date to record in the archive for each file or directory.
@history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.} @history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}
#:changed "6.1.1.1" @elem{Added the @racket[#:exists-ok?] argument.}]} #:changed "6.1.1.1" @elem{Added the @racket[#:exists-ok?] argument.}
#:changed "6.3.0.3" @elem{Added the @racket[#:follow-links?] argument.}]}
@defproc[(tar->output [paths (listof path?)] @defproc[(tar->output [paths (listof path?)]
[out output-port? (current-output-port)] [out output-port? (current-output-port)]
[#:follow-links? follow-links? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f] [#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp [#:get-timestamp get-timestamp
(path? . -> . exact-integer?) (path? . -> . exact-integer?)
@ -64,11 +68,13 @@ archive that is written directly to the @racket[out]. The specified
content is not automatically added, and nested directories are added 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.}]} @history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}
#:changed "6.3.0.3" @elem{Added the @racket[#:follow-links?] argument.}]}
@defproc[(tar-gzip [tar-file path-string?] @defproc[(tar-gzip [tar-file path-string?]
[paths path-string?] ... [paths path-string?] ...
[#:follow-links? follow-links? any/c #f]
[#:exists-ok? exists-ok? any/c #f] [#:exists-ok? exists-ok? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f] [#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp [#:get-timestamp get-timestamp
@ -81,4 +87,5 @@ without parent directories.
Like @racket[tar], but compresses the resulting file with @racket[gzip]. Like @racket[tar], but compresses the resulting file with @racket[gzip].
@history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.} @history[#:changed "6.0.0.3" @elem{Added the @racket[#:get-timestamp] argument.}
#:changed "6.1.1.1" @elem{Added the @racket[#:exists-ok?] argument.}]} #:changed "6.1.1.1" @elem{Added the @racket[#:exists-ok?] argument.}
#:changed "6.3.0.3" @elem{Added the @racket[#:follow-links?] argument.}]}

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

@ -43,8 +43,8 @@
(define 0-byte (char->integer #\0)) (define 0-byte (char->integer #\0))
(define ((tar-one-entry buf prefix get-timestamp) path) (define ((tar-one-entry buf prefix get-timestamp follow-links?) path)
(let* ([link? (link-exists? path)] (let* ([link? (and (not follow-links?) (link-exists? path))]
[dir? (and (not link?) (directory-exists? path))] [dir? (and (not link?) (directory-exists? path))]
[size (if (or dir? link?) 0 (file-size path))] [size (if (or dir? link?) 0 (file-size path))]
[p 0] ; write pointer [p 0] ; write pointer
@ -139,9 +139,10 @@
(provide tar->output) (provide tar->output)
(define (tar->output files [out (current-output-port)] (define (tar->output files [out (current-output-port)]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds] #:get-timestamp [get-timestamp file-or-directory-modify-seconds]
#:path-prefix [prefix #f]) #:path-prefix [prefix #f]
#:follow-links? [follow-links? #f])
(parameterize ([current-output-port out]) (parameterize ([current-output-port out])
(let* ([buf (new-block)] [entry (tar-one-entry buf prefix get-timestamp)]) (let* ([buf (new-block)] [entry (tar-one-entry buf prefix get-timestamp follow-links?)])
(for-each entry files) (for-each entry files)
;; two null blocks end-marker ;; two null blocks end-marker
(write-bytes buf) (write-bytes buf)))) (write-bytes buf) (write-bytes buf))))
@ -151,20 +152,23 @@
(define (tar tar-file (define (tar tar-file
#:exists-ok? [exists-ok? #f] #:exists-ok? [exists-ok? #f]
#:path-prefix [prefix #f] #:path-prefix [prefix #f]
#:follow-links? [follow-links? #f]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds] #:get-timestamp [get-timestamp file-or-directory-modify-seconds]
. paths) . paths)
(when (null? paths) (error 'tar "no paths specified")) (when (null? paths) (error 'tar "no paths specified"))
(with-output-to-file tar-file (with-output-to-file tar-file
#:exists (if exists-ok? 'truncate/replace 'error) #:exists (if exists-ok? 'truncate/replace 'error)
(lambda () (tar->output (pathlist-closure paths #:follow-links? #f) (lambda () (tar->output (pathlist-closure paths #:follow-links? follow-links?)
#:get-timestamp get-timestamp #:get-timestamp get-timestamp
#:path-prefix prefix)))) #:path-prefix prefix
#:follow-links? follow-links?))))
;; tar-gzip : output-file paths -> ;; tar-gzip : output-file paths ->
(provide tar-gzip) (provide tar-gzip)
(define (tar-gzip tgz-file (define (tar-gzip tgz-file
#:exists-ok? [exists-ok? #f] #:exists-ok? [exists-ok? #f]
#:path-prefix [prefix #f] #:path-prefix [prefix #f]
#:follow-links? [follow-links? #f]
#:get-timestamp [get-timestamp file-or-directory-modify-seconds] #:get-timestamp [get-timestamp file-or-directory-modify-seconds]
. paths) . paths)
(when (null? paths) (error 'tar-gzip "no paths specified")) (when (null? paths) (error 'tar-gzip "no paths specified"))
@ -173,8 +177,9 @@
(lambda () (lambda ()
(let-values ([(i o) (make-pipe (* 1024 1024 32))]) (let-values ([(i o) (make-pipe (* 1024 1024 32))])
(thread (lambda () (thread (lambda ()
(tar->output (pathlist-closure paths #:follow-links? #f) o (tar->output (pathlist-closure paths #:follow-links? follow-links?) o
#:path-prefix prefix #:path-prefix prefix
#:follow-links? follow-links?
#:get-timestamp get-timestamp) #:get-timestamp get-timestamp)
(close-output-port o))) (close-output-port o)))
(gzip-through-ports (gzip-through-ports