andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

tar: Handle extracting of directories. 

* gash/ustar.scm (read-ustar-file): Do not dump content of directory.
Size is 0; do not start by reading 512 bytes.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-29 07:40:57 +01:00
parent 1fd796bad7
commit b463aa32bc
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gash/ustar.scm
View File

@ -460,18 +460,25 @@
(file-name (ustar-header-file-name header))
(dir (dirname file-name))
(thunk (lambda _
(let loop ((record (read-ustar-record port)) (wrote 0))
(let* ((read (+ wrote 512))
(block (if (< read size) record
(sub-bytevector record 0 (- size wrote)))))
(when extract?
(display (bv->ustar-0string block "block")))
(and (not (eof-object? record))
(< read size)
(loop (read-ustar-record port) read)))))))
(let loop ((read 0))
(and (< read size)
(let ((record (read-ustar-record port)))
(and record
(let* ((read (+ read 512))
(block (if (< read size) record
(sub-bytevector record 0 (- size -512 read)))))
(when extract?
(display (bv->ustar-0string block "block")))
(loop read)))))))))
(when extract?
(mkdir-p dir))
(if extract? (with-output-to-file file-name thunk)
(if extract?
(case (ustar-header-type header)
((regular)
(if (file-exists? file-name) (delete-file file-name))
(with-output-to-file file-name thunk))
((directory) (mkdir-p file-name))
((symlink) (throw 'todo "symlink")))
(thunk))
(when extract?
(chmod file-name (ustar-header-mode header))