Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0fea026bf4f15cf92069ed990e441cc885d63b39 >--------------------------------------------------------------- commit 0fea026bf4f15cf92069ed990e441cc885d63b39 Author: Duncan Coutts <[email protected]> Date: Wed Dec 10 22:36:33 2008 +0000 Tidy up the unpack code Also fix a bug for tar files that contain entries for files without preceding entries for the directories they are in. >--------------------------------------------------------------- cabal-install/Distribution/Client/Tar.hs | 38 ++++++++++++++++++----------- 1 files changed, 23 insertions(+), 15 deletions(-) diff --git a/cabal-install/Distribution/Client/Tar.hs b/cabal-install/Distribution/Client/Tar.hs index 3eb8503..955441e 100644 --- a/cabal-install/Distribution/Client/Tar.hs +++ b/cabal-install/Distribution/Client/Tar.hs @@ -618,29 +618,37 @@ fill n c = replicate n c -- unpack :: FilePath -> Entries -> IO () -unpack dir entries = extractLinks =<< extractFiles [] entries +unpack baseDir entries = extractLinks =<< extractFiles [] entries where extractFiles _ (Fail err) = Prelude.fail err extractFiles links Done = return links extractFiles links (Next entry entries') = case fileType entry of - NormalFile -> BS.writeFile (dir </> fileName entry) (fileContent entry) - >> extractFiles links entries' - HardLink -> saveLink - SymbolicLink -> saveLink - Directory -> createDirectoryIfMissing False (dir </> fileName entry) - >> extractFiles links entries' + NormalFile -> extractFile entry >> extractFiles links entries' + HardLink -> extractFiles (saveLink entry links) entries' + SymbolicLink -> extractFiles (saveLink entry links) entries' + Directory -> extractDir entry >> extractFiles links entries' _ -> extractFiles links entries' -- FIXME: warning? + + extractFile entry = do + createDirectoryIfMissing False fileDir + BS.writeFile fullPath (fileContent entry) + where + fileDir = baseDir </> FilePath.Native.takeDirectory (fileName entry) + fullPath = baseDir </> fileName entry + + extractDir entry = + createDirectoryIfMissing False (baseDir </> fileName entry) + + saveLink entry links = seq (length name) + $ seq (length name) + $ link:links where - saveLink = seq (length name) - $ seq (length name) - $ extractFiles (link:links) entries' - where - name = fileName entry - target = linkTarget entry - link = (name, target) + name = fileName entry + target = linkTarget entry + link = (name, target) extractLinks = mapM_ $ \(name, target) -> - let path = dir </> name + let path = baseDir </> name in copyFile (FilePath.Native.takeDirectory path </> target) path -- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
