diff --git a/pkgs/racket-doc/file/scribblings/tar.scrbl b/pkgs/racket-doc/file/scribblings/tar.scrbl index 3f2232f65a..76d4d78d9e 100644 --- a/pkgs/racket-doc/file/scribblings/tar.scrbl +++ b/pkgs/racket-doc/file/scribblings/tar.scrbl @@ -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.}]} diff --git a/racket/collects/file/tar.rkt b/racket/collects/file/tar.rkt index 14b9c7e79b..e0b1dde501 100644 --- a/racket/collects/file/tar.rkt +++ b/racket/collects/file/tar.rkt @@ -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