add file/untgz

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"]

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.}

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))))
+
+      
+       
+  

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)

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