Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch :
http://hackage.haskell.org/trac/ghc/changeset/70ea3c21a203d6b90ee5fad2c52cae6ab1d0b778 >--------------------------------------------------------------- commit 70ea3c21a203d6b90ee5fad2c52cae6ab1d0b778 Author: Duncan Coutts <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
