 
 TUPLE: tar-header name mode uid gid size mtime checksum typeflag
 linkname magic version uname gname devmajor devminor prefix ;
+
 ERROR: checksum-error ;
 
-SYMBOLS: base-dir filename ;
-
-: tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ;
-
-: read-c-string* ( n -- str/f )
+: trim-string ( seq -- newseq ) [ "\0 " member? ] trim ;
+
+: read-c-string ( n -- str/f )
     read [ zero? ] trim-tail [ f ] when-empty ;
 
 : read-tar-header ( -- obj )
     \ tar-header new
-    100 read-c-string* >>name
-    8 read-c-string* tar-trim oct> >>mode
-    8 read-c-string* tar-trim oct> >>uid
-    8 read-c-string* tar-trim oct> >>gid
-    12 read-c-string* tar-trim oct> >>size
-    12 read-c-string* tar-trim oct> >>mtime
-    8 read-c-string* tar-trim oct> >>checksum
-    read1 >>typeflag
-    100 read-c-string* >>linkname
-    6 read >>magic
-    2 read >>version
-    32 read-c-string* >>uname
-    32 read-c-string* >>gname
-    8 read tar-trim oct> >>devmajor
-    8 read tar-trim oct> >>devminor
-    155 read-c-string* >>prefix ;
-
-: header-checksum ( seq -- x )
-    148 cut-slice 8 tail-slice
-    [ sum ] bi@ + 256 + ;
+        100 read-c-string >>name
+        8 read-c-string trim-string oct> >>mode
+        8 read-c-string trim-string oct> >>uid
+        8 read-c-string trim-string oct> >>gid
+        12 read-c-string trim-string oct> >>size
+        12 read-c-string trim-string oct> >>mtime
+        8 read-c-string trim-string oct> >>checksum
+        read1 >>typeflag
+        100 read-c-string >>linkname
+        6 read >>magic
+        2 read >>version
+        32 read-c-string >>uname
+        32 read-c-string >>gname
+        8 read trim-string oct> >>devmajor
+        8 read trim-string oct> >>devminor
+        155 read-c-string >>prefix ;
+
+: checksum-header ( seq -- n )
+    148 cut-slice 8 tail-slice [ sum ] bi@ + 256 + ;
 
 : read-data-blocks ( tar-header -- )
     dup size>> 0 > [

    ] if ;

: parse-tar-header ( seq -- obj )
    [ header-checksum ] keep over zero-checksum = [
        2drop
        \ tar-header new
            0 >>size
            0 >>checksum
    ] [
        [ read-tar-header ] with-string-reader
        [ checksum>> = [ checksum-error ] unless ] keep
    ] if ;

ERROR: unknown-typeflag ch ;
M: unknown-typeflag summary ( obj -- str )
    ch>> 1string "Unknown typeflag: " prepend ;

: tar-prepend-path ( path -- newpath )
    base-dir get prepend-path ;

: read/write-blocks ( tar-header path -- )
    binary [ read-data-blocks ] with-file-writer ;

! Normal file
: typeflag-0 ( header -- )
    dup name>> tar-prepend-path read/write-blocks ;

! Hard link
: typeflag-1 ( header -- ) unknown-typeflag ;

    drop ;
    ! <string-writer> [ read-data-blocks ] keep
    ! >string [ zero? ] trim-tail filename set
    ! filename get prepend-current-directory make-directories ;

! Multi volume continuation entry
: typeflag-M ( header -- ) unknown-typeflag ;
