From f5f2cd9345a63751ce282494c6a2d867ac7f4612 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@cs.indiana.edu>
Date: Thu, 14 May 2020 09:54:22 -0400
Subject: [PATCH] Improve error message for disallowed links.

---
 racket/collects/file/private/check-path.rkt | 7 ++++---
 racket/collects/file/untar.rkt              | 2 +-
 racket/collects/net/git-checkout.rkt        | 2 +-
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/racket/collects/file/private/check-path.rkt b/racket/collects/file/private/check-path.rkt
index 15e1ef10a6..bf8e226b91 100644
--- a/racket/collects/file/private/check-path.rkt
+++ b/racket/collects/file/private/check-path.rkt
@@ -3,10 +3,11 @@
 (provide check-unpack-path)
 
 (define (check-unpack-path who filename
-                           #:allow-up? [allow-up? #f])
+                           #:allow-up? [allow-up? #f]
+                           #:kind [kind "file"])
   (when (absolute-path? filename)
-    (error who "won't extract a file with an absolute path\n  path: ~e" filename))
+    (error who "won't extract a ~a with an absolute path\n  path: ~e" kind filename))
   (unless allow-up?
     (for ([e (in-list (explode-path filename))])
       (when (eq? e 'up)
-        (error who "won't extract a file with an up-directory element\n  path: ~e" filename)))))
+        (error who "won't extract a ~a with an up-directory element\n  path: ~e" kind filename)))))
diff --git a/racket/collects/file/untar.rkt b/racket/collects/file/untar.rkt
index 4fd1f545c1..aba5e4bc3c 100644
--- a/racket/collects/file/untar.rkt
+++ b/racket/collects/file/untar.rkt
@@ -101,7 +101,7 @@
                            (or link-target-from-extended-attributes
                                (bytes->path (nul-terminated link-target-bytes)))))
   (when (and link-target (not permissive?))
-    (check-unpack-path 'untar link-target))
+    (check-unpack-path 'untar link-target #:kind "link"))
   (read-bytes* 12 in) ; padding
   (define create?
     (filter base-filename filename type size link-target mod-time mode))
diff --git a/racket/collects/net/git-checkout.rkt b/racket/collects/net/git-checkout.rkt
index c2213569c0..50f4f30e06 100644
--- a/racket/collects/net/git-checkout.rkt
+++ b/racket/collects/net/git-checkout.rkt
@@ -730,7 +730,7 @@
           [(#"120000")
            (define target (bytes->path (object->bytes tmp (this-object-location))))
            (when strict-links?
-             (check-unpack-path 'git-checkout target))
+             (check-unpack-path 'git-checkout target #:kind "link"))
            (make-file-or-directory-link target (build-path dest-dir fn))]
           [(#"160000")
            ;; submodule; just make a directory placeholder