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

12
collects/file/untar.rkt
View File

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