steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tar: Fix pax_global_header. Make symlinks work, do them at the end. Untars the linux kernel again.

db4
Doug Coleman 2012-10-24 18:58:11 -07:00
parent 04e783a886
commit 12df557b11
1 changed files with 40 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
extra/tar/tar.factor
View File

@ -10,6 +10,11 @@ IN: tar
CONSTANT: zero-checksum 256 CONSTANT: zero-checksum 256
CONSTANT: block-size 512 CONSTANT: block-size 512
SYMBOL: to-link
: save-link ( link -- )
to-link get push ;
TUPLE: tar-header name mode uid gid size mtime checksum typeflag TUPLE: tar-header name mode uid gid size mtime checksum typeflag
linkname magic version uname gname devmajor devminor prefix ; linkname magic version uname gname devmajor devminor prefix ;
@ -85,19 +90,21 @@ M: unknown-typeflag summary ( obj -- str )
! Normal file ! Normal file
: typeflag-0 ( header -- ) : typeflag-0 ( header -- )
dup name>> dup "global_pax_header" = [ dup name>> prepend-current-directory read/write-blocks ;
drop [ read-data-blocks ] with-string-writer drop
] [
prepend-current-directory read/write-blocks
] if ;
! Hard link TUPLE: hard-link linkname name ;
C: <hard-link> hard-link
TUPLE: symbolic-link linkname name ;
C: <symbolic-link> symbolic-link
! Hard link, don't call normalize-path
: typeflag-1 ( header -- ) : typeflag-1 ( header -- )
[ name>> ] [ linkname>> ] bi make-hard-link ; [ linkname>> ] [ name>> ] bi <hard-link> save-link ;
! Symlink ! Symlink, don't call normalize-path
: typeflag-2 ( header -- ) : typeflag-2 ( header -- )
[ name>> ] [ linkname>> ] bi make-link ; [ linkname>> ] [ name>> ] bi <symbolic-link> save-link ;
! character special ! character special
: typeflag-3 ( header -- ) unknown-typeflag ; : typeflag-3 ( header -- ) unknown-typeflag ;
@ -122,7 +129,10 @@ M: unknown-typeflag summary ( obj -- str )
: typeflag-9 ( header -- ) unknown-typeflag ; : typeflag-9 ( header -- ) unknown-typeflag ;
! Global POSIX header ! Global POSIX header
: typeflag-g ( header -- ) typeflag-0 ; : typeflag-g ( header -- )
! Read something like: 52 comment=9f2a940965286754f3a34d5737c3097c05db8725
! and drop it
[ read-data-blocks ] with-string-writer drop ;
! Extended POSIX header ! Extended POSIX header
: typeflag-x ( header -- ) unknown-typeflag ; : typeflag-x ( header -- ) unknown-typeflag ;
@ -198,7 +208,26 @@ M: unknown-typeflag summary ( obj -- str )
drop drop
] if ; ] if ;
GENERIC: do-link ( object -- )
M: hard-link do-link
[ linkname>> ]
[ name>> prepend-current-directory ] bi make-hard-link ;
M: symbolic-link do-link
[ linkname>> ]
[ name>> prepend-current-directory ] bi make-link ;
! FIXME: linux tar calls unlinkat and makelinkat
: make-links ( -- )
to-link get [
[ name>> delete-file ] [ do-link ] bi
] each ;
: untar ( path -- ) : untar ( path -- )
normalize-path dup parent-directory [ normalize-path dup parent-directory [
V{ } clone to-link [
binary [ parse-tar ] with-file-reader binary [ parse-tar ] with-file-reader
make-links
] with-variable
] with-directory ; ] with-directory ;