From ba4fbc200cdc4f8ac82641d97a20fe1e79f25609 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 3 Apr 2016 16:20:58 +0200
Subject: [PATCH] LIB: fix throwDestinationInSource

We now examine device+file IDs, so this check works reliably
with mountpoints too.
---
 3rdparty/hpath                |  2 +-
 src/HSFM/FileSystem/Errors.hs | 24 +++++++++++++++++-------
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/3rdparty/hpath b/3rdparty/hpath
index 3c3a2d2..3a52a9e 160000
--- a/3rdparty/hpath
+++ b/3rdparty/hpath
@@ -1 +1 @@
-Subproject commit 3c3a2d276646f6530970f675ef32c6089c1e56d4
+Subproject commit 3a52a9ea4b3b693785364e3f899775cbdc78befc
diff --git a/src/HSFM/FileSystem/Errors.hs b/src/HSFM/FileSystem/Errors.hs
index ada6afb..d125c0b 100644
--- a/src/HSFM/FileSystem/Errors.hs
+++ b/src/HSFM/FileSystem/Errors.hs
@@ -27,6 +27,7 @@ import Control.Exception
 import Control.Monad
   (
     when
+  , forM
   )
 import Data.Typeable
 import Foreign.C.Error
@@ -110,15 +111,24 @@ throwSameFile fp1 fp2 = do
   when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
 
 
-throwDestinationInSource :: Path Abs -- ^ will be canonicalized
-                         -> Path Abs -- ^ `dirname dest` will be canonicalized
+-- |Checks whether the destination directory is contained
+-- within the source directory by comparing the device+file ID of the
+-- source directory with all device+file IDs of the parent directories
+-- of the destination.
+throwDestinationInSource :: Path Abs -- ^ source dir
+                         -> Path Abs -- ^ full destination, `basename dest`
+                                     --   must exist
                          -> IO ()
 throwDestinationInSource source dest = do
-  source'   <- P.canonicalizePath source
-  cDestbase <- P.canonicalizePath $ P.dirname dest
-  let dest' = cDestbase P.</> P.basename dest
-  when (source' `P.isParentOf` dest')
-       (throw $ DestinationInSource (P.fromAbs dest') (P.fromAbs source'))
+  source' <- P.canonicalizePath source
+  dest'   <- (P.</> P.basename dest) <$> (P.canonicalizePath $ P.dirname dest)
+  dids <- forM (P.getAllParents dest') $ \p -> do
+          fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
+          return (PF.deviceID fs, PF.fileID fs)
+  sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
+              $ PF.getSymbolicLinkStatus (P.fromAbs source')
+  when (elem sid dids)
+       (throw $ DestinationInSource (P.fromAbs dest) (P.fromAbs source))
 
 
 -- |Checks if the given file exists and is not a directory. This follows