From 5522d66d11fc9bdbfc40c3d246033ec017ece13c Mon Sep 17 00:00:00 2001 From: Paul Capron Date: Wed, 7 Oct 2015 15:09:44 +0200 Subject: [PATCH] Make `mv` work accross filesystems MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This commit fixes Gabriel439/Haskell-Turtle-Library#37 On a POSIX OS, Prelude.mv would fail if the two given paths are not on the same filesystem. That’s because under the hood mv simply calls Filesystem.rename[1], which on POSIX forwards to the rename syscall[2], and (most implementations of) rename don’t work with files on different filesystems. This commit makes mv catch any error returned by Filesystem.rename and, when an error is triggered because one tries to do an across-filesystem move, resort to using a (non-atomic) "Filesystem.copyFile followed by Filesystem.removeFile" combo to move the file. That way Prelude.mv behaves similarly to POSIX mv[3]. Note however that, unlike POSIX mv, an across-fs *directory* moving is (still) not supported. Detecting why exactly Filesystem.rename failed is the tricky part. On error, it returns a standard IOError[4], which is an opaque type. We can get the error type[5] of this error. But the standard 2010 Haskell only defines a limited set of common error types (EOF, already exists, …), which does not cover the failure we are interested in (i.e.: rename syscall returned EXDEV[6] “Invalid cross-device link”). Hence in our case, Filesystem.rename throws an IOError with an unclassified type that we cannot for sure relate to an across-fs issue. We can get more precision about IO errors if we are willing to depend on GHC-only stuff. Given that GHC is de facto *the* Haskell compiler, we are OK to trade compiler-independance for much better handling of our case. GHC exports a bunch of new IOErrorType on top of the standard ones. For the failure we are concerned with, the IOErrorType is UnsupportedOperation. This type is also used by GHC for a bunch of other unusual errors[7], but among the possible errors returned by rename (according to the POSIX spec and most implementations man pages), only EXDEV is mapped to UnsupportedOperation (according to Foreign.C.Error source code). Hence if we get an UnsupportedOperation from Filesystem.rename, we can assume that it is because of an across-fs issue. Note that we could be absolutely sure that the IOError is caused by EXDEV if we were willing to be even less portable/more brittle: import Foreign.C.Error (Errno(Errno), eXDEV) import GHC.IO.Exception (ioe_errno) mv oldPath newPath = liftIO $ catchIOError (Filesystem.rename oldPath newPath) (\ioe -> if fmap Errno (ioe_errno ioe) == Just eXDEV then do Filesystem.copyFile oldPath newPath Filesystem.removeFile oldPath else ioError ioe) But it seems that as-precise-as-possible error diagnostic at the price of such dependence on GHC internals and low-level stuff is not worth it. Checking against UnsupportedOperation, while not theoretically perfect, seems good enough. 1: https://hackage.haskell.org/package/system-fileio-0.3.16.3/docs/Filesystem.html#v:rename 2: http://pubs.opengroup.org/onlinepubs/9699919799/functions/rename.html 3: http://pubs.opengroup.org/onlinepubs/9699919799/utilities/mv.html 4: https://hackage.haskell.org/package/base-4.7.0.1/docs/System-IO-Error.html#t:IOError 5: https://hackage.haskell.org/package/base-4.7.0.1/docs/System-IO-Error.html#t:IOErrorType 6: http://pubs.opengroup.org/onlinepubs/009695399/functions/xsh_chap02_03.html 7: https://hackage.haskell.org/package/base-4.7.0.0/docs/src/Foreign-C-Error.html#errnoToIOError --- src/Turtle/Prelude.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Turtle/Prelude.hs b/src/Turtle/Prelude.hs index 4747395..5cd8e7c 100644 --- a/src/Turtle/Prelude.hs +++ b/src/Turtle/Prelude.hs @@ -236,6 +236,7 @@ import qualified Data.Text.IO as Text import qualified Filesystem import Filesystem.Path.CurrentOS (FilePath, ()) import qualified Filesystem.Path.CurrentOS as Filesystem +import GHC.IO.Exception (IOErrorType(UnsupportedOperation)) import Network.HostName (getHostName) import System.Clock (Clock(..), TimeSpec(..), getTime) import System.Environment ( @@ -254,6 +255,7 @@ import System.Exit (ExitCode(..), exitWith) import System.IO (Handle, hClose) import qualified System.IO as IO import System.IO.Temp (withTempDirectory, withTempFile) +import System.IO.Error (catchIOError, ioeGetErrorType) import qualified System.Process as Process #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 @@ -623,9 +625,19 @@ lsif predicate path = do else return child else return child --- | Move a file or directory +{-| Move a file or directory + + Works if the two paths are on the same filesystem. + If not, @mv@ will still work when dealing with a regular file, + but the operation will not be atomic +-} mv :: MonadIO io => FilePath -> FilePath -> io () -mv oldPath newPath = liftIO (Filesystem.rename oldPath newPath) +mv oldPath newPath = liftIO $ catchIOError (Filesystem.rename oldPath newPath) + (\ioe -> if ioeGetErrorType ioe == UnsupportedOperation -- certainly EXDEV + then do + Filesystem.copyFile oldPath newPath + Filesystem.removeFile oldPath + else ioError ioe) {-| Create a directory