From 0e29815a13cf34dc6f4722f38b22af87e4e767da Mon Sep 17 00:00:00 2001
From: Vanessa McHale <vanessa.mchale@iohk.io>
Date: Tue, 5 Feb 2019 12:05:42 -0600
Subject: [PATCH 1/4] Bump bounds appropriately

---
 htar/htar.cabal | 2 +-
 tar.cabal       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/htar/htar.cabal b/htar/htar.cabal
index 505db07..5965d2b 100644
--- a/htar/htar.cabal
+++ b/htar/htar.cabal
@@ -30,7 +30,7 @@ executable htar
     directory  >= 1.0,
     filepath   >= 1.0,
     bytestring >= 0.9,
-    tar        == 0.4.* && >= 0.4.2,
+    tar        >= 0.4.2 && < 0.7,
     zlib       >= 0.4 && < 0.7,
     bzlib      >= 0.4 && < 0.7
 
diff --git a/tar.cabal b/tar.cabal
index 6ea23a4..4b36e34 100644
--- a/tar.cabal
+++ b/tar.cabal
@@ -41,7 +41,7 @@ library
   build-depends: base       == 4.*,
                  filepath             < 1.5,
                  array                < 0.6,
-                 containers >= 0.2 && < 0.6,
+                 containers >= 0.2 && < 0.7,
                  deepseq    >= 1.1 && < 1.5
 
   if flag(old-time)

From e7617dd47dfb6774c8e58cc9ebdb0665fb9b9c0f Mon Sep 17 00:00:00 2001
From: Vanessa McHale <vanessa.mchale@iohk.io>
Date: Tue, 5 Feb 2019 12:08:03 -0600
Subject: [PATCH 2/4] Bump test bounds

---
 tar.cabal | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tar.cabal b/tar.cabal
index 4b36e34..5327395 100644
--- a/tar.cabal
+++ b/tar.cabal
@@ -91,8 +91,8 @@ test-suite properties
                  deepseq,
                  bytestring-handle,
                  QuickCheck       == 2.*,
-                 tasty            >= 0.10 && <0.12,
-                 tasty-quickcheck == 0.8.*
+                 tasty            >= 0.10 && <1.2,
+                 tasty-quickcheck >= 0.8 && <0.11
 
   if flag(old-time)
     build-depends: directory < 1.2, old-time

From 2f1f458c359a7078f42902915e34dcddb13d553e Mon Sep 17 00:00:00 2001
From: Vanessa McHale <vanessa.mchale@iohk.io>
Date: Tue, 5 Feb 2019 20:45:03 -0600
Subject: [PATCH 3/4] Add cabal.project file

---
 cabal.project | 2 ++
 1 file changed, 2 insertions(+)
 create mode 100644 cabal.project

diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..b2ffdb2
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,2 @@
+packages: ./
+        , htar

From f77be3d18e90a0a35bd9f2477b265981797d07a1 Mon Sep 17 00:00:00 2001
From: Vanessa McHale <vanessa.mchale@iohk.io>
Date: Sat, 16 Feb 2019 14:59:47 -0600
Subject: [PATCH 4/4] Fix issue with symlinks

---
 Codec/Archive/Tar/Check.hs | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

diff --git a/Codec/Archive/Tar/Check.hs b/Codec/Archive/Tar/Check.hs
index e95e560..0c09a61 100644
--- a/Codec/Archive/Tar/Check.hs
+++ b/Codec/Archive/Tar/Check.hs
@@ -65,24 +65,46 @@ checkSecurity = checkEntries checkEntrySecurity
 checkEntrySecurity :: Entry -> Maybe FileNameError
 checkEntrySecurity entry = case entryContent entry of
     HardLink     link -> check (entryPath entry)
-                 `mplus` check (fromLinkTarget link)
+                 `mplus` checkLink (entryPath entry) (fromLinkTarget link)
     SymbolicLink link -> check (entryPath entry)
-                 `mplus` check (fromLinkTarget link)
+                 `mplus` checkLink (entryPath entry) (fromLinkTarget link)
     _                 -> check (entryPath entry)
 
   where
+
+    checkCommon name =
+        FilePath.Native.isAbsolute name || not (FilePath.Native.isValid name)
+
     check name
-      | FilePath.Native.isAbsolute name
+      | checkCommon name
       = Just $ AbsoluteFileName name
 
-      | not (FilePath.Native.isValid name)
+      | any (=="..") (FilePath.Native.splitDirectories name)
       = Just $ InvalidFileName name
 
-      | any (=="..") (FilePath.Native.splitDirectories name)
+      | otherwise = Nothing
+
+    -- checkLink introduced to handle https://github.com/haskell/tar/issues/32
+    checkLink name link
+      | checkCommon name
+      = Just $ AbsoluteFileName name
+
+      | linkDepth link name > 0
       = Just $ InvalidFileName name
 
       | otherwise = Nothing
 
+linkDepth :: FilePath -- ^ Name of link
+          -> FilePath -- ^ Contents of link
+          -> Int
+linkDepth link name =
+  let allPaths = FilePath.Native.splitDirectories link ++ FilePath.Native.splitDirectories name
+  in getDepth allPaths
+
+  where getDepth []         = 0
+        getDepth ("..":fps) = 1 + getDepth fps
+        getDepth (_:fps)    = getDepth fps - 1
+
 -- | Errors arising from tar file names being in some way invalid or dangerous
 data FileNameError
   = InvalidFileName FilePath