         drop
     ] 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 -- )
     normalize-path dup parent-directory [
-         binary [ parse-tar ] with-file-reader
+        V{ } clone to-link [
+            binary [ parse-tar ] with-file-reader
+            make-links
+        ] with-variable
     ] with-directory ;


CONSTANT: zero-checksum 256
CONSTANT: block-size 512

TUPLE: tar-header name mode uid gid size mtime checksum typeflag
linkname magic version uname gname devmajor devminor prefix ;


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

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 -- )
    [ linkname>> ] [ name>> ] bi <hard-link> save-link ;

! Symlink, don't call normalize-path
: typeflag-2 ( header -- )
    [ linkname>> ] [ name>> ] bi <symbolic-link> save-link ;

! character special
: typeflag-3 ( header -- ) unknown-typeflag ;
