From 0bb1bab059a07e598219ab310efd8ec6181c719e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 15 Jul 2014 16:51:48 +0100
Subject: [PATCH] file/tar: don't try to read link permissions or timestamp

Links don't (normally) have those properties, and attempting to
read them makes a link fail when its target does not exist.
---
 pkgs/racket-pkgs/racket-test/tests/file/packers.rkt | 10 ++++++++--
 racket/collects/file/tar.rkt                        | 12 ++++++++++--
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/file/packers.rkt b/pkgs/racket-pkgs/racket-test/tests/file/packers.rkt
index c2aa9b6424..2bc77569f4 100644
--- a/pkgs/racket-pkgs/racket-test/tests/file/packers.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/file/packers.rkt
@@ -63,7 +63,8 @@
 
 (define (zip-tests zip unzip timestamps?
                    #:dir-name [ex1 "ex1"]
-                   #:file-name [f2 "f2"])
+                   #:file-name [f2 "f2"]
+                   #:links? [links? #f])
   (make-directory* ex1)
   (make-file (build-path ex1 "f1"))
   (make-file (build-path ex1 f2))
@@ -71,6 +72,10 @@
   (define more-dir (build-path ex1 "more"))
   (make-directory* more-dir)
   (make-file (build-path more-dir "f4"))
+  (when links?
+    (make-file-or-directory-link "f1" (build-path ex1 "f1-link"))
+    (make-file-or-directory-link "more" (build-path ex1 "more-link"))
+    (make-file-or-directory-link "no" (build-path ex1 "no-link")))
 
   (zip "a.zip" ex1)
   (when timestamps? (sleep 3)) ; at least 2 seconds, plus 1 to likely change parity
@@ -111,8 +116,9 @@
   (zip-tests zip unzip #f)
   (zip-tests (make-zip #f) (make-unzip #f) 'file)
   (zip-tests (make-zip #t) (make-unzip #t) 'file)
-  (zip-tests tar untar #t)
+  (zip-tests tar untar #t #:links? #t)
   (zip-tests tar untar #t
+             #:links? #t
              #:dir-name (make-string 64 #\d)
              #:file-name (make-string 64 #\f)))
 
diff --git a/racket/collects/file/tar.rkt b/racket/collects/file/tar.rkt
index 98bd639dec..f052a0e574 100644
--- a/racket/collects/file/tar.rkt
+++ b/racket/collects/file/tar.rkt
@@ -76,13 +76,21 @@
             (set! cksum (+ cksum d))
             (loop (sub1 q) (quotient n 8)))))
       (advance len))
+    (define attrib-path
+      (if link?
+          ;; For a link, use attributes of the containing directory:
+          (let-values ([(base name dir?) (split-path path)])
+            (or (and (path? base)
+                     base)
+                (current-directory)))
+          path))
     ;; see http://www.mkssoftware.com/docs/man4/tar.4.asp for format spec
     (write-block tar-name-length file-name)
-    (write-octal   8 (path-attributes path dir?))
+    (write-octal   8 (path-attributes attrib-path dir?))
     (write-octal   8 0)          ; always root (uid)
     (write-octal   8 0)          ; always root (gid)
     (write-octal  12 size)
-    (write-octal  12 (get-timestamp path))
+    (write-octal  12 (get-timestamp attrib-path))
     ;; set checksum later, consider it "all blanks" for cksum
     (set! cksum-p p) (set! cksum (+ cksum (* 8 32))) (advance 8)
     (write-block*  1 (if link? #"2" (if dir? #"5" #"0"))) ; type-flag: dir/file (no symlinks)