diff --git a/collects/file/scribblings/file.scrbl b/collects/file/scribblings/file.scrbl index 4657dfa69f..664871ce6e 100644 --- a/collects/file/scribblings/file.scrbl +++ b/collects/file/scribblings/file.scrbl @@ -11,6 +11,7 @@ @include-section["zip.scrbl"] @include-section["tar.scrbl"] @include-section["untar.scrbl"] +@include-section["untgz.scrbl"] @include-section["md5.scrbl"] @include-section["sha1.scrbl"] @include-section["gif.scrbl"] diff --git a/collects/file/scribblings/untgz.scrbl b/collects/file/scribblings/untgz.scrbl new file mode 100644 index 0000000000..4be9ee0ed0 --- /dev/null +++ b/collects/file/scribblings/untgz.scrbl @@ -0,0 +1,24 @@ +#lang scribble/doc +@(require "common.rkt" (for-label file/untgz + file/untar + file/gunzip)) + +@title[#:tag "untgz"]{@exec{tar}+@exec{gzip} File Extraction} + +@defmodule[file/untgz]{The @racketmodname[file/untgz] library provides +a function to extract items from a possible @exec{gzip}ped TAR/USTAR archive.} + +@defproc[(untgz [in (or/c path-string? input-port?)] + [#:dest dest-path (or/c path-string? #f) #f] + [#:strip-count strip-count exact-nonnegative-integer? 0] + [#:filter filter-proc + (path? (or/c path? #f) + symbol? exact-integer? (or/c path? #f) + exact-nonnegative-integer? + exact-nonnegative-integer? + . -> . any/c) + (lambda args #t)]) + void?]{ + +The same as @racket[untar], but if @racket[in] is in @exec{gzip} form, +it is @racket[gunzip]ped as it is unpacked.} diff --git a/collects/file/untgz.rkt b/collects/file/untgz.rkt new file mode 100644 index 0000000000..08e6461a5f --- /dev/null +++ b/collects/file/untgz.rkt @@ -0,0 +1,45 @@ +#lang racket/base +(require racket/file + "untar.rkt" + "gunzip.rkt" + racket/contract/base) + +(provide + (contract-out + [untgz (->* ((or/c path-string? input-port?)) + (#:dest + (or/c #f path-string?) + #:strip-count exact-nonnegative-integer? + #:filter (path? (or/c path? #f) + symbol? exact-integer? (or/c path? #f) + exact-nonnegative-integer? exact-nonnegative-integer? + . -> . any/c)) + void?)])) + +(define (untgz in + #:dest [dest #f] + #:strip-count [strip-count 0] + #:filter [filter void]) + ((if (input-port? in) + (lambda (in f) (f in)) + call-with-input-file*) + in + (lambda (in) + (define in2 + (cond + [(and (= (peek-byte in 0) #o037) + (= (peek-byte in 1) #o213)) + (define-values (in2 out) (make-pipe 4096)) + (thread + (lambda () + (dynamic-wind + (lambda () (void)) + (lambda () (gunzip-through-ports in out)) + (lambda () (close-output-port out))))) + in2] + [else in])) + (untar in2 #:dest dest #:strip-count strip-count #:filter filter)))) + + + + diff --git a/collects/tests/file/untar.rkt b/collects/tests/file/untar.rkt index 114239d3ae..9f1a46d408 100644 --- a/collects/tests/file/untar.rkt +++ b/collects/tests/file/untar.rkt @@ -1,10 +1,12 @@ #lang racket/base (require file/untar + file/untgz racket/file racket/system) (define tmp (find-system-path 'temp-dir)) (define tar-exe (find-executable-path "tar")) +(define gzip-exe (find-executable-path "gzip")) (define work-dir (build-path tmp (format "untar-testing~a" (random 1000)))) (printf "Working in ~a\n" work-dir) @@ -100,10 +102,21 @@ (diff ex1-dir (build-path sub-dir "ex1")) (delete-directory/files sub-dir) +(parameterize ([current-directory work-dir]) + (untgz a.tar #:dest "sub")) +(diff ex1-dir (build-path sub-dir "ex1")) +(delete-directory/files sub-dir) + (parameterize ([current-directory work-dir]) (untar a.tar #:dest "sub" #:filter (lambda args #f))) (when (directory-exists? sub-dir) (error "should not have been unpacked")) +(void (system* gzip-exe a.tar)) +(parameterize ([current-directory work-dir]) + (untgz (path-replace-suffix a.tar #".tar.gz") #:dest "sub")) +(diff ex1-dir (build-path sub-dir "ex1")) +(delete-directory/files sub-dir) + (file-or-directory-permissions* more-dir '(read execute write)) (delete-directory/files work-dir) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index a26b6afe4e..d53858f183 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,5 +1,6 @@ Version 5.3.1.8 file/untar: added +file/untgz: added Version 5.3.1.7 compiler/zo-structs: generalize flonum? field to type