Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/008d656861389abe1ad406462e6ccdd29a53cbfc >--------------------------------------------------------------- commit 008d656861389abe1ad406462e6ccdd29a53cbfc Author: Lennart Kolmodin <[email protected]> Date: Tue Mar 4 19:42:55 2008 +0000 Fix defect when unpacking tar files containing links There were two issues; * Unpacking links that point to files not yet unpacked * Used the link target as absolute path, but it's relative This patch addresses both issues, which is ticket #246. There may still be errors if a link refer to another link which has not been unpacked yet. >--------------------------------------------------------------- cabal-install/Hackage/Tar.hs | 22 +++++++++++++++------- 1 files changed, 15 insertions(+), 7 deletions(-) diff --git a/cabal-install/Hackage/Tar.hs b/cabal-install/Hackage/Tar.hs index 3420eb1..4221190 100644 --- a/cabal-install/Hackage/Tar.hs +++ b/cabal-install/Hackage/Tar.hs @@ -9,11 +9,11 @@ import Data.ByteString.Lazy (ByteString) import Data.Bits ((.&.)) import Data.Char (ord) import Data.Int (Int8, Int64) -import Data.List (unfoldr) +import Data.List (unfoldr,partition) import Data.Maybe (catMaybes) import Numeric (readOct) import System.Directory (Permissions(..), setPermissions, createDirectoryIfMissing, copyFile) -import System.FilePath ((</>), isValid, isAbsolute) +import System.FilePath ((</>), isValid, isAbsolute, splitFileName) import System.Posix.Types (FileMode) -- GNU gzip @@ -43,7 +43,14 @@ readTarArchive :: ByteString -> [(TarHeader,ByteString)] readTarArchive = catMaybes . unfoldr getTarEntry extractTarArchive :: Maybe FilePath -> [(TarHeader,ByteString)] -> IO () -extractTarArchive mdir = mapM_ (uncurry (extractEntry mdir)) +extractTarArchive mdir tar = extract files >> extract links + where + extract = mapM_ (uncurry (extractEntry mdir)) + -- TODO: does this cause a memory leak? + (files, links) = partition (not . isLink . tarFileType . fst) tar + isLink TarHardLink = True + isLink TarSymbolicLink = True + isLink _ = False extractTarGzFile :: Maybe FilePath -- ^ Destination directory -> FilePath -- ^ Tarball @@ -59,13 +66,14 @@ extractEntry :: Maybe FilePath -> TarHeader -> ByteString -> IO () extractEntry mdir hdr cnt = do path <- relativizePath mdir (tarFileName hdr) let setPerms = setPermissions path (fileModeToPermissions (tarFileMode hdr)) - copyLinked = relativizePath mdir (tarLinkTarget hdr) >>= copyFile path + copyLinked = + let (base, _) = splitFileName path + sourceName = base </> tarLinkTarget hdr + in copyFile sourceName path case tarFileType hdr of TarNormalFile -> BS.writeFile path cnt >> setPerms TarHardLink -> copyLinked >> setPerms - TarSymbolicLink -> copyLinked --FIXME: what if the other file has not - --been unpacked yet? Perhaps collect all - --links and do them at the end. + TarSymbolicLink -> copyLinked TarDirectory -> createDirectoryIfMissing False path >> setPerms TarOther _ -> return () -- FIXME: warning? _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
