Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-12 07:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Stopping after trailing 2 empty tar headers.

Browse source
This commit is contained in:
Alex Shinn 2014-04-02 07:02:02 +09:00
parent 5f7e5acb3e
commit 250ae4f02e
1 changed files with 8 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/chibi/tar.scm
View file

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