Commit b204fbeb authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Use our native Haskell tar implementation to extract code from tarballs. We...

Use our native Haskell tar implementation to extract code from tarballs. We now don't use an external tar program for anything.
parent 88707c73
......@@ -36,7 +36,6 @@ Other-Modules:
Network.Hackage.CabalInstall.Main
Network.Hackage.CabalInstall.Setup
Network.Hackage.CabalInstall.Tar
Network.Hackage.CabalInstall.TarUtils
Network.Hackage.CabalInstall.Types
Network.Hackage.CabalInstall.Update
Network.Hackage.CabalInstall.Utils
......
......@@ -23,13 +23,14 @@ import Control.Exception (bracket_)
import Network.Hackage.CabalInstall.Dependency (getPackages, resolveDependencies
, listInstalledPackages)
import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile, fetchPackage)
import Network.Hackage.CabalInstall.Tar (extractTarGzFile)
import Network.Hackage.CabalInstall.Types (ConfigFlags(..), UnresolvedDependency(..)
,OutputGen(..), Repo(..))
import Network.Hackage.CabalInstall.TarUtils
import Distribution.Simple.SetupWrapper (setupWrapper)
import Distribution.Package (showPackageId, PackageIdentifier)
import Distribution.Verbosity
import System.FilePath ((</>), splitFileName)
import Data.Maybe (fromMaybe, maybeToList)
......@@ -99,7 +100,6 @@ installPkg cfg globalArgs (pkg,ops,repo)
= do pkgPath <- downloadPkg cfg pkg repo
tmp <- getTemporaryDirectory
let tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId pkg)
tmpPkgPath = tmpDirPath </> printf "TAR%s.tgz" (showPackageId pkg)
setup cmd
= let cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
path = tmpDirPath </> showPackageId pkg
......@@ -108,30 +108,23 @@ installPkg cfg globalArgs (pkg,ops,repo)
setupWrapper (cmd:cmdOps) (Just path)
bracket_ (createDirectoryIfMissing True tmpDirPath)
(removeDirectoryRecursive tmpDirPath)
(do copyFile pkgPath tmpPkgPath
message output deafening (printf "Extracting %s..." tmpPkgPath)
extractTarFile tarProg tmpPkgPath
installUnpackedPkg cfg pkg tmpPkgPath setup
(do message output deafening (printf "Extracting %s..." pkgPath)
extractTarGzFile (Just tmpDirPath) pkgPath
installUnpackedPkg cfg pkg setup
return ())
where tarProg = configTarPath cfg
output = configOutputGen cfg
installUnpackedPkg :: ConfigFlags -> PackageIdentifier -> FilePath
installUnpackedPkg :: ConfigFlags -> PackageIdentifier
-> (String -> IO ()) -> IO ()
installUnpackedPkg cfg pkgId tarFile setup
= do tarFiles <- tarballGetFiles tarProg tarFile
let cabalFile = locateFileExt tarFiles "cabal"
case cabalFile of
Just f -> let (path,_) = splitFileName f
in do buildingPkg output pkgId
stepConfigPkg output pkgId
setup "configure"
stepBuildPkg output pkgId
setup "build"
stepInstallPkg output pkgId
setup "install"
stepFinishedPkg output pkgId
return ()
Nothing -> noCabalFile output pkgId
installUnpackedPkg cfg pkgId setup
= do buildingPkg output pkgId
stepConfigPkg output pkgId
setup "configure"
stepBuildPkg output pkgId
setup "build"
stepInstallPkg output pkgId
setup "install"
stepFinishedPkg output pkgId
return ()
where output = configOutputGen cfg
tarProg = configTarPath cfg
-- | Simplistic TAR archive reading. Only gets the file names and file contents.
module Network.Hackage.CabalInstall.Tar (TarHeader(..), TarFileType(..),
readTarArchive, extractTarArchive) where
readTarArchive, extractTarArchive,
extractTarGzFile) where
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
......@@ -14,12 +15,15 @@ import System.Directory (Permissions(..), setPermissions, createDirectoryIfMissi
import System.FilePath ((</>), isValid, isAbsolute)
import System.Posix.Types (FileMode)
import Codec.Compression.GZip (decompress)
data TarHeader = TarHeader {
tarFileName :: FilePath,
tarFileMode :: FileMode,
tarFileType :: TarFileType,
tarLinkTarget :: FilePath
}
deriving (Show)
data TarFileType =
TarNormalFile
......@@ -35,6 +39,12 @@ readTarArchive = catMaybes . unfoldr getTarEntry
extractTarArchive :: Maybe FilePath -> [(TarHeader,ByteString)] -> IO ()
extractTarArchive mdir = mapM_ (uncurry (extractEntry mdir))
extractTarGzFile :: Maybe FilePath -- ^ Destination directory
-> FilePath -- ^ Tarball
-> IO ()
extractTarGzFile mdir file =
BS.readFile file >>= extractTarArchive mdir . readTarArchive . decompress
--
-- * Extracting
--
......
-----------------------------------------------------------------------------
-- |
-- Module : Network.Hackage.CabalInstall.TarUtils
-- Copyright : (c) David Himmelstrup 2005
-- License : BSD-like
--
-- Maintainer : lemmih@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Utility functions for manipulating tar archives.
-----------------------------------------------------------------------------
module Network.Hackage.CabalInstall.TarUtils
( tarballGetFiles
, locateFile
, locateFileExt
, extractTarFile
) where
import Data.Char (isSpace)
import System.FilePath
import System.IO (hClose, hGetContents)
import System.Process (runInteractiveProcess, runProcess, waitForProcess)
import System.Exit (ExitCode(..))
import Text.Printf (printf)
import Data.List (find, sortBy)
import Data.Maybe (listToMaybe)
-- |List the files in a gzipped tar archive. Throwing an exception on failure.
tarballGetFiles :: FilePath -- ^Path to the 'tar' binary.
-> FilePath -- ^Path to the .tgz archive.
-> IO [FilePath]
tarballGetFiles tarProg tarFile
= do (inch,out,_,handle) <- runInteractiveProcess tarProg args Nothing Nothing
hClose inch
files <- hGetContents out
length files `seq` hClose out
eCode <- waitForProcess handle
case eCode of
ExitFailure err -> error $ printf "Failed to get filelist from '%s': %s." tarFile (show err)
_ -> return (map trim $ lines files)
where args = ["--list"
,"--gunzip"
,"--file"
,tarFile]
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace --slow'y
{-|
Find a file in a given directory.
@
locateFile [\"somedir\/jalla.txt\"] \"somedir\" [\"jalla.txt\"]
=> Just \"somedir\/jalla.txt\"
locateFile [\"somepkg\/pkg.cabal\", \"somepkg\/Setup.hs\"] \"somepkg\" [\"Setup.lhs\", \"Setup.hs\"]
=> Just \"somedir\/Setup.hs\"
@
-}
locateFile :: [FilePath] -- ^File list.
-> FilePath -- ^Base directory.
-> [FilePath] -- ^List of filenames to locate.
-> Maybe FilePath
locateFile files dir names
= find findFile files
where findFile file
= let (root,name) = splitFileName file
in root == dir && name `elem` names
{-|
Locate all files with a given extension and return the shortest result.
@
locateFileExt [\"somedir\/test.cabal\"] \"cabal\"
=> Just \"somedir\/test.cabal\"
@
-}
locateFileExt :: [FilePath] -> String -> Maybe FilePath
locateFileExt files fileExt
= let okExts = filter ((== fileExt) . tailNotNull . takeExtension) files
in (listToMaybe (sortBy sortFn okExts))
where comparing f a b = f a `compare` f b
sortFn = comparing (length.splitPath)
tailNotNull [] = []
tailNotNull x = tail x
-- |Extract a given archive in the directory where it's placed.
extractTarFile :: FilePath -- ^Path to the 'tar' binary.
-> FilePath -- ^Path to the .tgz archive.
-> IO ()
extractTarFile tarProg tarFile
= do tarHandle <- runProcess tarProg args (Just dir) Nothing Nothing Nothing Nothing
eCode <- waitForProcess tarHandle
case eCode of
ExitFailure err -> error $ printf "Failed to extract tar file '%s': %s with command '%s' in directory '%s'" tarFile (show err) (tarProg ++ " " ++ (show args)) dir
_ -> return ()
where args = ["-xzf",fileName]
(dir,fileName) = splitFileName tarFile
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment