Commit 6d245562 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add Distribution.Compat.CopyFile module

This is to work around the file permissions problems with the
standard System.Directory.copyFile function. When installing
files we do not want to copy permissions or attributes from the
source files. On unix we want to use specific permissions and
on windows we want to inherit default permissions. On unix:
copyOrdinaryFile   sets the permissions to -rw-r--r--
copyExecutableFile sets the permissions to -rwxr-xr-x
parent 1cc4ca32
......@@ -105,6 +105,7 @@ Library
Other-Modules:
Distribution.GetOpt,
Distribution.Compat.Exception,
Distribution.Compat.CopyFile,
Distribution.Compat.Permissions,
Distribution.Compat.TempFile,
Distribution.Simple.GHC.Makefile,
......
{-# OPTIONS -cpp #-}
-- OPTIONS required for ghc-6.4.x compat, and must appear first
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-- #hide
module Distribution.Compat.CopyFile (
copyFile,
copyOrdinaryFile,
copyExecutableFile
) where
#ifdef __GLASGOW_HASKELL__
import Prelude hiding ( catch )
import Control.Monad
( when )
import Control.Exception
( throw, try, catch, bracket, bracketOnError, Exception(IOException) )
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 )
import Foreign
( allocaBytes )
#ifndef mingw32_HOST_OS
import System.Posix.Types
( FileMode )
import System.Posix.Internals
( c_chmod )
import Foreign.C
( withCString, throwErrnoPathIfMinus1_ )
#endif
#endif
copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO ()
#if defined(__GLASGOW_HASKELL__) && !defined(mingw32_HOST_OS)
copyOrdinaryFile fromFPath toFPath = do
copyFile fromFPath toFPath
setFileMode toFPath 0o644 -- file perms -rw-r--r--
copyExecutableFile fromFPath toFPath = do
copyFile fromFPath toFPath
setFileMode toFPath 0o755 -- file perms -rwxr-xr-x
setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m =
withCString name $ \s -> do
throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
#else
copyOrdinaryFile = copyFile
copyExecutableFile = copyFile
#endif
copyFile :: FilePath -> FilePath -> IO ()
#ifdef __GLASGOW_HASKELL__
copyFile fromFPath toFPath =
copy `catch` (\e -> case e of
IOException ioe ->
throw $ IOException $ ioeSetLocation ioe "copyFile"
_ -> throw e)
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 try $ hClose hTmp
try $ removeFile tmpFPath
bufferSize = 4096
copyContents hFrom hTo buffer = do
count <- hGetBuf hFrom buffer bufferSize
when (count > 0) $ do
hPutBuf hTo buffer count
copyContents hFrom hTo buffer
#else
copyFile fromFPath toFPath = readFile fromFPath >>= writeFile toFPath
#endif
......@@ -13,7 +13,7 @@ all: build
# build the library itself
SOURCES=Distribution/*.hs Distribution/Simple/*.hs Distribution/PackageDescription/*.hs Distribution/Simple/GHC/*.hs Distribution/Simple/Build/*.hs
SOURCES=Distribution/*.hs Distribution/Simple/*.hs Distribution/PackageDescription/*.hs Distribution/Simple/GHC/*.hs Distribution/Simple/Build/*.hs Distribution/Compat/*.hs
CONFIG_STAMP=dist/setup-config
BUILD_STAMP=dist/build/libHSCabal-$(VERSION).a
HADDOCK_STAMP=dist/doc/html/Cabal/index.html
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment