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

Cabal.cabal

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

Distribution/Compat/CopyFile.hs

@@ -0,0 +1,89 @@
+{-# 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

Makefile

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