From ca99db414cabc766dc900ba3571dec74ee7ebf39 Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Thu, 23 Jul 2015 14:42:59 +0100 Subject: [PATCH] Preserve file permissions when unpacking sources MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The `tar` package, in name of portability, doesn't preserve file permissions when creating and unpacking archives. A sample package which relies on permissions to be kept as they were packed with is `ghc-parser` which executes a bash script as part of its build process. Before this patch we'd get ``` /run/user/1000/stack26234/ghc-parser-0.1.7.0/Setup.hs:2:1: Warning: Module ‘System.Cmd’ is deprecated: Use "System.Process" instead /bin/sh: ./build-parser.sh: Permission denied Configuring ghc-parser-0.1.7.0... Warning: 'hs-source-dirs: src-7.8.3' directory does not exist. ``` but now the package builds fine. --- src/Stack/Fetch.hs | 14 +++++++++++++- stack.cabal | 1 + 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Stack/Fetch.hs b/src/Stack/Fetch.hs index e17d796e3f..fe3d4835a8 100644 --- a/src/Stack/Fetch.hs +++ b/src/Stack/Fetch.hs @@ -24,6 +24,7 @@ module Stack.Fetch import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Check as Tar +import qualified Codec.Archive.Tar.Entry as Tar import Codec.Compression.GZip (decompress) import Control.Applicative import Control.Concurrent.Async (Concurrently (..)) @@ -52,7 +53,7 @@ import Data.IORef (newIORef, readIORef, import Data.List (intercalate, intersperse) import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList, catMaybes) import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set @@ -76,6 +77,7 @@ import qualified System.FilePath as FP import System.IO (IOMode (ReadMode), SeekMode (AbsoluteSeek), hSeek, withBinaryFile) +import System.PosixCompat (setFileMode) data FetchException = Couldn'tReadIndexTarball FilePath Tar.FormatError @@ -456,7 +458,17 @@ fetchPackages' mdistDir toFetchAll = do wrap :: Exception e => e -> FetchException wrap = Couldn'tReadPackageTarball fp . toException identStr = packageIdentifierString ident + + getPerms :: Tar.Entry -> (FilePath, Tar.Permissions) + getPerms e = (dest FP. Tar.fromTarPath (Tar.entryTarPath e), + Tar.entryPermissions e) + + filePerms :: [(FilePath, Tar.Permissions)] + filePerms = catMaybes $ Tar.foldEntries (\e -> (:) (Just $ getPerms e)) + [] (const []) entries Tar.unpack dest entries + -- Reset file permissions as they were in the tarball + mapM_ (\(fp', perm) -> setFileMode fp' perm) filePerms case mdistDir of Nothing -> return () diff --git a/stack.cabal b/stack.cabal index c1f113eca1..1137333c5b 100644 --- a/stack.cabal +++ b/stack.cabal @@ -153,6 +153,7 @@ library , time >= 1.4.2 , transformers >= 0.3.0.0 , transformers-base >= 0.4.4 + , unix-compat , unordered-containers >= 0.2.5.1 , vector >= 0.10.12.3 , vector-binary-instances