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
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.}
@defproc[(tar [tar-file path-string?]
[path path-string?] ...
[#:follow-links? follow-links? any/c #f]
[#:exists-ok? exists-ok? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#: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
@racket[path], its ancestor directories are also added to the
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
@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.
@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?)]
[out output-port? (current-output-port)]
[#:follow-links? follow-links? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp
(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
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?]
[paths path-string?] ...
[#:follow-links? follow-links? any/c #f]
[#:exists-ok? exists-ok? any/c #f]
[#:path-prefix path-prefix (or/c #f path-string?) #f]
[#:get-timestamp get-timestamp
@ -81,4 +87,5 @@ without parent directories.
Like @racket[tar], but compresses the resulting file with @racket[gzip].
@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.}]}

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

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