forked from haskell/cabal
/
CopyFile.hs
94 lines (85 loc) · 3.18 KB
/
CopyFile.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Distribution.Compat.CopyFile (
copyFile,
filesEqual,
copyOrdinaryFile,
copyExecutableFile,
setFileOrdinary,
setFileExecutable,
setDirOrdinary,
) where
import Control.Applicative
( (<$>), (<*>) )
import Control.Monad
( when )
import Control.Exception
( bracket, bracketOnError, evaluate, throwIO )
import qualified Data.ByteString.Lazy as BSL
import Distribution.Compat.Exception
( catchIO )
import System.IO.Error
( ioeSetLocation )
import System.Directory
( renameFile, removeFile )
import Distribution.Compat.TempFile
( openBinaryTempFile )
import System.FilePath
( takeDirectory )
import System.IO
( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf
, withBinaryFile )
import Foreign
( allocaBytes )
#ifndef mingw32_HOST_OS
import System.Posix.Internals (withFilePath)
import System.Posix.Types
( FileMode )
import System.Posix.Internals
( c_chmod )
import Foreign.C
( throwErrnoPathIfMinus1_ )
#endif /* mingw32_HOST_OS */
copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO ()
copyOrdinaryFile src dest = copyFile src dest >> setFileOrdinary dest
copyExecutableFile src dest = copyFile src dest >> setFileExecutable dest
setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> IO ()
#ifndef mingw32_HOST_OS
setFileOrdinary path = setFileMode path 0o644 -- file perms -rw-r--r--
setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x
setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m =
withFilePath name $ \s -> do
throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
#else
setFileOrdinary _ = return ()
setFileExecutable _ = return ()
#endif
-- This happens to be true on Unix and currently on Windows too:
setDirOrdinary = setFileExecutable
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
copy
`catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile"))
where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
do allocaBytes bufferSize $ copyContents hFrom hTmp
hClose hTmp
renameFile tmpFPath toFPath
openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
cleanTmp (tmpFPath, hTmp) = do
hClose hTmp `catchIO` \_ -> return ()
removeFile tmpFPath `catchIO` \_ -> return ()
bufferSize = 4096
copyContents hFrom hTo buffer = do
count <- hGetBuf hFrom buffer bufferSize
when (count > 0) $ do
hPutBuf hTo buffer count
copyContents hFrom hTo buffer
-- | Checks if two files are byte-identical.
-- Returns False if either of the files do not exist.
filesEqual :: FilePath -> FilePath -> IO Bool
filesEqual f1 f2 = (`catchIO` \ _ -> return False) $ do
withBinaryFile f1 ReadMode $ \ h1 -> do
withBinaryFile f2 ReadMode $ \ h2 -> do
evaluate =<< (==) <$> BSL.hGetContents h1 <*> BSL.hGetContents h2