Make mv work accross filesystems

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
This commit is contained in:
Paul Capron 2015-10-07 15:09:44 +02:00
parent 3e6ac8e49f
commit 5522d66d11

View file

@ -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