[commit: Cabal] : Preserve executable permissions on unpack (70ea3c2)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/70ea3c21a203d6b90ee5fad2c52cae6ab1d0b778

>---------------------------------------------------------------

commit 70ea3c21a203d6b90ee5fad2c52cae6ab1d0b778
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Mon Jan 17 14:49:00 2011 +0000

    Preserve executable permissions on unpack

>---------------------------------------------------------------

 cabal-install/Distribution/Client/Tar.hs       |   15 ++++++--
 cabal-install/Distribution/Compat/FilePerms.hs |   40 ++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 4 deletions(-)

diff --git a/cabal-install/Distribution/Client/Tar.hs b/cabal-install/Distribution/Client/Tar.hs
index f80509f..1d83340 100644
--- a/cabal-install/Distribution/Client/Tar.hs
+++ b/cabal-install/Distribution/Client/Tar.hs
@@ -59,10 +59,10 @@ module Distribution.Client.Tar (
 
 import Data.Char     (ord)
 import Data.Int      (Int64)
-import Data.Bits     (Bits, shiftL)
+import Data.Bits     (Bits, shiftL, testBit)
 import Data.List     (foldl')
 import Numeric       (readOct, showOct)
-import Control.Monad (MonadPlus(mplus))
+import Control.Monad (MonadPlus(mplus), when)
 
 import qualified Data.ByteString.Lazy as BS
 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -80,6 +80,8 @@ import System.Directory
          , getPermissions, createDirectoryIfMissing, copyFile )
 import qualified System.Directory as Permissions
          ( Permissions(executable) )
+import Distribution.Compat.FilePerms
+         ( setFileExecutable )
 import System.Posix.Types
          ( FileMode )
 import System.Time
@@ -213,6 +215,9 @@ executableFilePermissions = 0o0755
 directoryPermissions :: Permissions
 directoryPermissions  = 0o0755
 
+isExecutable :: Permissions -> Bool
+isExecutable p = testBit p 0 || testBit p 6 -- user or other exectuable
+
 -- | An 'Entry' with all default values except for the file name and type. It
 -- uses the portable USTAR/POSIX format (see 'UstarHeader').
 --
@@ -741,7 +746,7 @@ unpack baseDir entries = unpackEntries [] (checkSecurity entries)
     unpackEntries _     (Fail err)      = fail err
     unpackEntries links Done            = return links
     unpackEntries links (Next entry es) = case entryContent entry of
-      NormalFile file _ -> extractFile path file
+      NormalFile file _ -> extractFile entry path file
                         >> unpackEntries links es
       Directory         -> extractDir path
                         >> unpackEntries links es
@@ -751,12 +756,14 @@ unpack baseDir entries = unpackEntries [] (checkSecurity entries)
       where
         path = entryPath entry
 
-    extractFile path content = do
+    extractFile entry path content = do
       -- Note that tar archives do not make sure each directory is created
       -- before files they contain, indeed we may have to create several
       -- levels of directory.
       createDirectoryIfMissing True absDir
       BS.writeFile absPath content
+      when (isExecutable (entryPermissions entry))
+           (setFileExecutable absPath)
       where
         absDir  = baseDir </> FilePath.Native.takeDirectory path
         absPath = baseDir </> path
diff --git a/cabal-install/Distribution/Compat/FilePerms.hs b/cabal-install/Distribution/Compat/FilePerms.hs
new file mode 100644
index 0000000..692d7a1
--- /dev/null
+++ b/cabal-install/Distribution/Compat/FilePerms.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE CPP #-}
+-- #hide
+module Distribution.Compat.FilePerms (
+  setFileOrdinary,
+  setFileExecutable,
+  ) where
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Types
+         ( FileMode )
+import System.Posix.Internals
+         ( c_chmod )
+import Foreign.C
+         ( withCString )
+#if MIN_VERSION_base(4,0,0)
+import Foreign.C
+         ( throwErrnoPathIfMinus1_ )
+#else
+import Foreign.C
+         ( throwErrnoIfMinus1_ )
+#endif
+#endif /* mingw32_HOST_OS */
+
+setFileOrdinary,  setFileExecutable  :: 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 =
+  withCString name $ \s -> do
+#if __GLASGOW_HASKELL__ >= 608
+    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
+#else
+    throwErrnoIfMinus1_                   name (c_chmod s m)
+#endif
+#else
+setFileOrdinary   _ = return ()
+setFileExecutable _ = return ()
+#endif