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

file/untar: handle unknown extensions by skipping

Browse Source 
Also, add/improve logging.
This commit is contained in:
Matthew Flatt 2013-03-31 06:59:12 -06:00
parent bfc9c41358
commit e93f977603
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/file/untar.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/file (require racket/file
racket/contract/base racket/contract/base
racket/port
"private/strip-prefix.rkt") "private/strip-prefix.rkt")
(provide (provide
@ -15,6 +16,8 @@
. -> . any/c)) . -> . any/c))
void?)])) void?)]))
(define-logger untar)
(define (untar in (define (untar in
#:dest [dest #f] #:dest [dest #f]
#:strip-count [strip-count 0] #:strip-count [strip-count 0]
@ -88,7 +91,8 @@
(cond (cond
[(and filename create?) [(and filename create?)
(case type (case type
[(dir) [(dir)
(log-untar-info "directory: ~a" filename)
(make-directory* filename) (make-directory* filename)
(cons (cons
;; delay directory meta-data updates until after any contained ;; delay directory meta-data updates until after any contained
@ -102,6 +106,7 @@
(file-or-directory-modify-seconds* filename mod-time #t)))) (file-or-directory-modify-seconds* filename mod-time #t))))
delays)] delays)]
[(file) [(file)
(log-untar-info "file: ~a" filename)
(define-values (base name dir?) (split-path filename)) (define-values (base name dir?) (split-path filename))
(make-directory* base) (make-directory* base)
(call-with-output-file* (call-with-output-file*
@ -118,13 +123,16 @@
(copy-bytes (- total-len size) in #f) (copy-bytes (- total-len size) in #f)
delays] delays]
[(link) [(link)
(log-untar-info "link: ~a" filename)
(define-values (base name dir?) (split-path filename)) (define-values (base name dir?) (split-path filename))
(make-directory* base) (make-directory* base)
(when (file-exists? filename) (delete-file filename)) (when (file-exists? filename) (delete-file filename))
(make-file-or-directory-link link-target filename) (make-file-or-directory-link link-target filename)
delays] delays]
[else [else
(error 'untar "cannot handle block type: ~a" type)])] (log-untar-info "ignored ~a: ~a" type filename)
(copy-bytes total-len in #f)
delays])]
[else [else
(copy-bytes total-len in #f) (copy-bytes total-len in #f)
delays])) delays]))
@ -172,7 +180,7 @@
(define (try-file-op thunk) (define (try-file-op thunk)
(with-handlers ([exn:fail:filesystem? (with-handlers ([exn:fail:filesystem?
(lambda (exn) (lambda (exn)
(log-error "untar: ~a" (exn-message exn)) (log-untar-error (exn-message exn))
(void))]) (void))])
(thunk))) (thunk)))