Stopping after trailing 2 empty tar headers.

This commit is contained in:
Alex Shinn 2014-04-02 07:02:02 +09:00
parent 5f7e5acb3e
commit 250ae4f02e

View file

@ -76,21 +76,24 @@
(let ((in (cond ((string? src) (open-binary-input-file src)) (let ((in (cond ((string? src) (open-binary-input-file src))
((bytevector? src) (open-input-bytevector src)) ((bytevector? src) (open-input-bytevector src))
(else src)))) (else src))))
(let lp ((acc knil)) (let lp ((acc knil) (empty 0))
(cond (cond
((eof-object? (peek-u8 in)) ((or (eof-object? (peek-u8 in)) (>= empty 2))
(close-input-port in) (close-input-port in)
acc) acc)
(else (else
(let* ((tar (read-tar in)) (let ((tar (read-tar in)))
(bv (read-modulo-bytevector in (tar-size tar) 512))) (if (and (equal? "" (tar-path tar)) (zero? (tar-size tar)))
(lp (kons tar bv acc)))))))) (lp acc (+ empty 1))
(let ((bv (read-modulo-bytevector in (tar-size tar) 512)))
(lp (kons tar bv acc) 0)))))))))
;; not a tar-bomb and no absolute paths ;; not a tar-bomb and no absolute paths
(define (tar-safe? tarball) (define (tar-safe? tarball)
(define (path-top path) (define (path-top path)
(substring path 0 (string-find path #\/))) (substring path 0 (string-find path #\/)))
(let ((files (map path-normalize (tar-files tarball)))) (let ((files (map path-normalize (tar-files tarball))))
(log-error "files: " files)
(and (every path-relative? files) (and (every path-relative? files)
(or (< (length files) 2) (or (< (length files) 2)
(let ((dir (path-top (car files)))) (let ((dir (path-top (car files))))