From 484566b3f2d54333190505fdcf91317c26e414f4 Mon Sep 17 00:00:00 2001 From: Ossi Herrala Date: Sat, 4 Jun 2016 21:22:53 +0300 Subject: [PATCH 1/7] Clarify error message for createLink, createSymbolicLink and rename POSIX's ENOENT error doesn't specify if the problem was with source or destination path. Throw error mentioning both paths instead of only first one. Fixes #60 --- System/Posix/Files.hsc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 949abf7c..195f07f2 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -228,7 +228,7 @@ createLink :: FilePath -> FilePath -> IO () createLink name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2) + throwErrnoIfMinus1_ ("createLink "++name1++" to "++name2) (c_link s1 s2) -- | @removeLink path@ removes the link named @path@. -- @@ -252,7 +252,7 @@ createSymbolicLink :: FilePath -> FilePath -> IO () createSymbolicLink file1 file2 = withFilePath file1 $ \s1 -> withFilePath file2 $ \s2 -> - throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2) + throwErrnoIfMinus1_ ("createSymbolicLink "++file1++" to "++file2) (c_symlink s1 s2) foreign import ccall unsafe "symlink" c_symlink :: CString -> CString -> IO CInt @@ -290,7 +290,7 @@ rename :: FilePath -> FilePath -> IO () rename name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2) + throwErrnoIfMinus1_ ("rename "++name1++" to "++name2) (c_rename s1 s2) foreign import ccall unsafe "rename" c_rename :: CString -> CString -> IO CInt From 652608eced3af6efb696147f2c4a9e9bee917ecf Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Sun, 11 Nov 2018 15:04:57 +0100 Subject: [PATCH 2/7] Disambiguate createLink/createSymbolicLink errors Per the comments on PR #65, it should be unambiguous. --- System/Posix/Files.hsc | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 195f07f2..a0a102da 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -228,7 +228,7 @@ createLink :: FilePath -> FilePath -> IO () createLink name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoIfMinus1_ ("createLink "++name1++" to "++name2) (c_link s1 s2) + throwErrnoIfMinus1_ ("createLink (target: "++name1++") (linkpath: "++name2++")") (c_link s1 s2) -- | @removeLink path@ removes the link named @path@. -- @@ -241,18 +241,18 @@ removeLink name = -- ----------------------------------------------------------------------------- -- Symbolic Links --- | @createSymbolicLink file1 file2@ creates a symbolic link named @file2@ --- which points to the file @file1@. +-- | @createSymbolicLink name1 name2@ creates a symbolic link named @name2@ +-- which points to the file @name1@. -- -- Symbolic links are interpreted at run-time as if the contents of the link -- had been substituted into the path being followed to find a file or directory. -- -- Note: calls @symlink@. createSymbolicLink :: FilePath -> FilePath -> IO () -createSymbolicLink file1 file2 = - withFilePath file1 $ \s1 -> - withFilePath file2 $ \s2 -> - throwErrnoIfMinus1_ ("createSymbolicLink "++file1++" to "++file2) (c_symlink s1 s2) +createSymbolicLink name1 name2 = + withFilePath name1 $ \s1 -> + withFilePath name2 $ \s2 -> + throwErrnoIfMinus1_ ("createSymbolicLink (target: "++name1++") (linkpath: "++name2++")") (c_symlink s1 s2) foreign import ccall unsafe "symlink" c_symlink :: CString -> CString -> IO CInt From 1a120a0bf5d43938373198fe87170121c79814d2 Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Mon, 22 Feb 2021 11:27:19 +0800 Subject: [PATCH 3/7] Add a test for createLink Very basic, but tests that the created link is a hard link and points to the original file --- tests/FileStatus.hs | 41 ++++++++++++++++++++++++++++++++++------- 1 file changed, 34 insertions(+), 7 deletions(-) diff --git a/tests/FileStatus.hs b/tests/FileStatus.hs index bdd5f043..58a1ec51 100644 --- a/tests/FileStatus.hs +++ b/tests/FileStatus.hs @@ -16,12 +16,14 @@ main = do fs <- testRegular ds <- testDir testSymlink fs ds + testLink cleanup -regular = "regular" -dir = "dir" -link_regular = "link-regular" -link_dir = "link-dir" +regular = "regular" +dir = "dir" +slink_regular = "link-regular-symlink" +hlink_regular = "link-regular-hardlink" +link_dir = "link-dir" testRegular = do _ <- createFile regular ownerReadMode @@ -42,9 +44,9 @@ testDir = do return ds testSymlink fs ds = do - createSymbolicLink regular link_regular + createSymbolicLink regular slink_regular createSymbolicLink dir link_dir - (fs', ls) <- getStatus link_regular + (fs', ls) <- getStatus slink_regular (ds', lds) <- getStatus link_dir let expected = (False,False,False,False,False,True,False) @@ -63,10 +65,35 @@ testSymlink fs ds = do when (statusElements ds /= statusElements ds') $ fail "status for a directory does not match when it's accessed via a symlink" + +testLink = do + createLink regular hlink_regular + (fs, _) <- getStatus regular -- we need to retrieve it again as creating the link causes it to change! + (fs', ls) <- getStatus hlink_regular + let expected = ( + False, -- isBlockDevice + False, -- isCharacterDevice + False, -- isNamedPipe + True, -- isRegularFile + False, -- isDirectory + False, -- isSymbolicLink + False) -- isSocket + actualF = snd (statusElements ls) + + when (actualF /= expected) $ + fail "unexpected file status bits for hard link to regular file" + + when (linkCount fs' /= 2) $ + fail "newly created hard link was expected to contain have a link count of 2" + + when (statusElements fs /= statusElements fs') $ + fail "status for a file does not match when it's accessed via a link" + + cleanup = do ignoreIOExceptions $ removeDirectory dir mapM_ (ignoreIOExceptions . removeLink) - [regular, link_regular, link_dir] + [regular, hlink_regular, slink_regular, link_dir] ignoreIOExceptions io = io `E.catch` ((\_ -> return ()) :: IOException -> IO ()) From bb7bb1c717e32c99ab3877cb66ed74ed0fc1fd32 Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Mon, 22 Feb 2021 15:32:42 +0800 Subject: [PATCH 4/7] Improve tests by using newer APIs --- tests/FileStatus.hs | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/tests/FileStatus.hs b/tests/FileStatus.hs index 58a1ec51..88a4f25c 100644 --- a/tests/FileStatus.hs +++ b/tests/FileStatus.hs @@ -10,6 +10,7 @@ import System.Posix.Directory import System.Posix.IO import Control.Exception as E import Control.Monad +import Test.Tasty.HUnit main = do cleanup @@ -70,7 +71,7 @@ testLink = do createLink regular hlink_regular (fs, _) <- getStatus regular -- we need to retrieve it again as creating the link causes it to change! (fs', ls) <- getStatus hlink_regular - let expected = ( + snd (statusElements ls) @?= ( False, -- isBlockDevice False, -- isCharacterDevice False, -- isNamedPipe @@ -78,16 +79,8 @@ testLink = do False, -- isDirectory False, -- isSymbolicLink False) -- isSocket - actualF = snd (statusElements ls) - - when (actualF /= expected) $ - fail "unexpected file status bits for hard link to regular file" - - when (linkCount fs' /= 2) $ - fail "newly created hard link was expected to contain have a link count of 2" - - when (statusElements fs /= statusElements fs') $ - fail "status for a file does not match when it's accessed via a link" + linkCount fs' == 2 @? "Newly created hard link was expected to have a link count of 2" + statusElements fs @?= statusElements fs' -- status for a file should match when accessed via a link cleanup = do From d92e4823826fc93bb6488b68eca30a92a3cfb563 Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Mon, 22 Feb 2021 15:42:37 +0800 Subject: [PATCH 5/7] Refactor by introducing throwErrnoTwoPathsIfMinus1_ Suggested in #122 discussion --- System/Posix/Files.hsc | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index a0a102da..2e8789a8 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -104,6 +104,12 @@ import System.Posix.Internals import Data.Time.Clock.POSIX (POSIXTime) +-- throwErrnoTwoPathsIfMinus1_ +-- +-- | For operations that require two paths (e.g., renaming a file) +throwErrnoTwoPathsIfMinus1_ loc path1 path2 = + throwErrnoIfMinus1_ (loc ++ " '" ++ path1 ++ "' to '" ++ path2 ++ "'") + -- ----------------------------------------------------------------------------- -- chmod() @@ -228,7 +234,7 @@ createLink :: FilePath -> FilePath -> IO () createLink name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoIfMinus1_ ("createLink (target: "++name1++") (linkpath: "++name2++")") (c_link s1 s2) + throwErrnoTwoPathsIfMinus1_ "createLink" name1 name2 (c_link s1 s2) -- | @removeLink path@ removes the link named @path@. -- @@ -252,7 +258,7 @@ createSymbolicLink :: FilePath -> FilePath -> IO () createSymbolicLink name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoIfMinus1_ ("createSymbolicLink (target: "++name1++") (linkpath: "++name2++")") (c_symlink s1 s2) + throwErrnoTwoPathsIfMinus1_ "createSymbolicLink" name1 name2 (c_symlink s1 s2) foreign import ccall unsafe "symlink" c_symlink :: CString -> CString -> IO CInt @@ -290,7 +296,7 @@ rename :: FilePath -> FilePath -> IO () rename name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoIfMinus1_ ("rename "++name1++" to "++name2) (c_rename s1 s2) + throwErrnoTwoPathsIfMinus1_ "rename" name1 name2 (c_rename s1 s2) foreign import ccall unsafe "rename" c_rename :: CString -> CString -> IO CInt From 3dae5ac04d22a0a0c22729544f7d30d3e3eb268b Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Tue, 23 Feb 2021 10:19:25 +0800 Subject: [PATCH 6/7] Use the more polymorphic <> to concatenate strings Just in case we ever move a String type that is not a [Char], but something more like UTF-8 text. The more polymorphic <> should work even if String is no longer a list. Also, add a signature to throwErrnoTwoPathsIfMinus1_ Co-authored-by: Viktor Dukhovni --- System/Posix/Files.hsc | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 2e8789a8..3cf963df 100644 --- a/System/Posix/Files.hsc +++ b/System/Posix/Files.hsc @@ -102,13 +102,18 @@ import System.Posix.Files.Common import System.Posix.Error import System.Posix.Internals +#if !MIN_VERSION_base(4, 11, 0) +import Data.Monoid ((<>)) +#endif + import Data.Time.Clock.POSIX (POSIXTime) -- throwErrnoTwoPathsIfMinus1_ -- -- | For operations that require two paths (e.g., renaming a file) +throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> FilePath -> FilePath -> IO a -> IO () throwErrnoTwoPathsIfMinus1_ loc path1 path2 = - throwErrnoIfMinus1_ (loc ++ " '" ++ path1 ++ "' to '" ++ path2 ++ "'") + throwErrnoIfMinus1_ (loc <> " '" <> path1 <> "' to '" <> path2 <> "'") -- ----------------------------------------------------------------------------- -- chmod() From a37b6385d2be4d458ced1e85a88b65d99787e11e Mon Sep 17 00:00:00 2001 From: Luis Pedro Coelho Date: Tue, 23 Feb 2021 13:35:26 +0800 Subject: [PATCH 7/7] Improve errors for 2-argument ByteString functions Same as done for FilePath versions in 484566b3f2d54333190505fdcf91317c26e414f4 --- System/Posix/ByteString/FilePath.hsc | 12 +++++++++- System/Posix/Files/ByteString.hsc | 12 +++++----- tests/FileStatusByteString.hs | 33 ++++++++++++++++++++++------ 3 files changed, 43 insertions(+), 14 deletions(-) diff --git a/System/Posix/ByteString/FilePath.hsc b/System/Posix/ByteString/FilePath.hsc index 9c487a52..1e49546e 100644 --- a/System/Posix/ByteString/FilePath.hsc +++ b/System/Posix/ByteString/FilePath.hsc @@ -25,7 +25,8 @@ module System.Posix.ByteString.FilePath ( throwErrnoPathIf_, throwErrnoPathIfNull, throwErrnoPathIfMinus1, - throwErrnoPathIfMinus1_ + throwErrnoPathIfMinus1_, + throwErrnoTwoPathsIfMinus1_ ) where import Foreign hiding ( void ) @@ -41,6 +42,9 @@ import Control.Monad import Data.ByteString import Data.ByteString.Char8 as BC import Prelude hiding (FilePath) +#if !MIN_VERSION_base(4, 11, 0) +import Data.Monoid ((<>)) +#endif -- | A literal POSIX file path type RawFilePath = ByteString @@ -121,3 +125,9 @@ throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1) -- throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO () throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) + +-- | as 'throwErrnoTwoPathsIfMinus1_', but exceptions include two paths when appropriate. +-- +throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> RawFilePath -> IO a -> IO () +throwErrnoTwoPathsIfMinus1_ loc path1 path2 = + throwErrnoIfMinus1_ (loc <> " '" <> BC.unpack path1 <> "' to '" <> BC.unpack path2 <> "'") diff --git a/System/Posix/Files/ByteString.hsc b/System/Posix/Files/ByteString.hsc index d808e86e..deb83da8 100644 --- a/System/Posix/Files/ByteString.hsc +++ b/System/Posix/Files/ByteString.hsc @@ -234,7 +234,7 @@ createLink :: RawFilePath -> RawFilePath -> IO () createLink name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2) + throwErrnoTwoPathsIfMinus1_ "createLink" name1 name2 (c_link s1 s2) -- | @removeLink path@ removes the link named @path@. -- @@ -255,10 +255,10 @@ removeLink name = -- -- Note: calls @symlink@. createSymbolicLink :: RawFilePath -> RawFilePath -> IO () -createSymbolicLink file1 file2 = - withFilePath file1 $ \s1 -> - withFilePath file2 $ \s2 -> - throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2) +createSymbolicLink name1 name2 = + withFilePath name1 $ \s1 -> + withFilePath name2 $ \s2 -> + throwErrnoTwoPathsIfMinus1_ "createSymbolicLink" name1 name2 (c_symlink s1 s2) foreign import ccall unsafe "symlink" c_symlink :: CString -> CString -> IO CInt @@ -296,7 +296,7 @@ rename :: RawFilePath -> RawFilePath -> IO () rename name1 name2 = withFilePath name1 $ \s1 -> withFilePath name2 $ \s2 -> - throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2) + throwErrnoTwoPathsIfMinus1_ "rename" name1 name2 (c_rename s1 s2) foreign import ccall unsafe "rename" c_rename :: CString -> CString -> IO CInt diff --git a/tests/FileStatusByteString.hs b/tests/FileStatusByteString.hs index ed8bbd8e..65908e51 100644 --- a/tests/FileStatusByteString.hs +++ b/tests/FileStatusByteString.hs @@ -9,18 +9,21 @@ module FileStatusByteString (main) where import System.Posix.ByteString import Control.Exception as E import Control.Monad +import Test.Tasty.HUnit main = do cleanup fs <- testRegular ds <- testDir testSymlink fs ds + testLink cleanup -regular = "regular2" -dir = "dir2" -link_regular = "link-regular2" -link_dir = "link-dir2" +regular = "regular2" +dir = "dir2" +hlink_regular = "hlink-regular2" +slink_regular = "slink-regular2" +link_dir = "link-dir2" testRegular = do _ <- createFile regular ownerReadMode @@ -41,9 +44,9 @@ testDir = do return ds testSymlink fs ds = do - createSymbolicLink regular link_regular + createSymbolicLink regular slink_regular createSymbolicLink dir link_dir - (fs', ls) <- getStatus link_regular + (fs', ls) <- getStatus slink_regular (ds', lds) <- getStatus link_dir let expected = (False,False,False,False,False,True,False) @@ -62,10 +65,26 @@ testSymlink fs ds = do when (statusElements ds /= statusElements ds') $ fail "status for a directory does not match when it's accessed via a symlink" +testLink = do + createLink regular hlink_regular + (fs, _) <- getStatus regular -- we need to retrieve it again as creating the link causes it to change! + (fs', ls) <- getStatus hlink_regular + snd (statusElements ls) @?= ( + False, -- isBlockDevice + False, -- isCharacterDevice + False, -- isNamedPipe + True, -- isRegularFile + False, -- isDirectory + False, -- isSymbolicLink + False) -- isSocket + linkCount fs' == 2 @? "Newly created hard link was expected to have a link count of 2" + statusElements fs @?= statusElements fs' -- status for a file should match when accessed via a link + + cleanup = do ignoreIOExceptions $ removeDirectory dir mapM_ (ignoreIOExceptions . removeLink) - [regular, link_regular, link_dir] + [regular, hlink_regular, slink_regular, link_dir] ignoreIOExceptions io = io `E.catch` ((\_ -> return ()) :: IOException -> IO ())