Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/88707c73870457e9d5e4e9096a782188312db1dc >--------------------------------------------------------------- commit 88707c73870457e9d5e4e9096a782188312db1dc Author: bjorn <[email protected]> Date: Sat Oct 6 15:31:22 2007 +0000 Added extraction to the simple TAR implementation. >--------------------------------------------------------------- .../src/Network/Hackage/CabalInstall/Config.hs | 8 +- .../src/Network/Hackage/CabalInstall/Tar.hs | 94 ++++++++++++++++++-- 2 files changed, 90 insertions(+), 12 deletions(-) diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs index e9b1c7f..da752e6 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs @@ -45,7 +45,7 @@ import Distribution.Verbosity import System.FilePath ((</>), takeExtension, (<.>)) import System.Directory -import Network.Hackage.CabalInstall.Tar (readTarArchive) +import Network.Hackage.CabalInstall.Tar (readTarArchive, tarFileName) import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen(..), PkgInfo (..), Repo(..)) import Paths_cabal_install (getDataDir) @@ -118,14 +118,14 @@ readRepoIndex cfg repo = parseRepoIndex :: Repo -> ByteString -> [PkgInfo] parseRepoIndex repo s = - do (name, content) <- readTarArchive s - if takeExtension name == ".cabal" + do (hdr, content) <- readTarArchive s + if takeExtension (tarFileName hdr) == ".cabal" then case parsePackageDescription (BS.unpack content) of ParseOk _ descr -> return $ PkgInfo { pkgRepo = repo, pkgDesc = descr } - _ -> error $ "Couldn't read cabal file " ++ show name + _ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr) else fail "Not a .cabal file" getKnownServers :: ConfigFlags -> IO [Repo] diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Tar.hs b/cabal-install/src/Network/Hackage/CabalInstall/Tar.hs index 119d376..3f9a848 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Tar.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Tar.hs @@ -1,42 +1,120 @@ -- | Simplistic TAR archive reading. Only gets the file names and file contents. -module Network.Hackage.CabalInstall.Tar (readTarArchive) where +module Network.Hackage.CabalInstall.Tar (TarHeader(..), TarFileType(..), + readTarArchive, extractTarArchive) where import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) +import Data.Bits ((.&.)) import Data.Char (ord) import Data.Int (Int8, Int64) import Data.List (unfoldr) import Data.Maybe (catMaybes) import Numeric (readOct) - - -readTarArchive :: ByteString -> [(FilePath,ByteString)] +import System.Directory (Permissions(..), setPermissions, createDirectoryIfMissing, copyFile) +import System.FilePath ((</>), isValid, isAbsolute) +import System.Posix.Types (FileMode) + +data TarHeader = TarHeader { + tarFileName :: FilePath, + tarFileMode :: FileMode, + tarFileType :: TarFileType, + tarLinkTarget :: FilePath + } + +data TarFileType = + TarNormalFile + | TarHardLink + | TarSymbolicLink + | TarDirectory + | TarOther Char + deriving (Eq,Show) + +readTarArchive :: ByteString -> [(TarHeader,ByteString)] readTarArchive = catMaybes . unfoldr getTarEntry -getTarEntry :: ByteString -> Maybe (Maybe (FilePath,ByteString), ByteString) +extractTarArchive :: Maybe FilePath -> [(TarHeader,ByteString)] -> IO () +extractTarArchive mdir = mapM_ (uncurry (extractEntry mdir)) + +-- +-- * Extracting +-- + +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 + case tarFileType hdr of + TarNormalFile -> BS.writeFile path cnt >> setPerms + TarHardLink -> copyLinked >> setPerms + TarSymbolicLink -> copyLinked + TarDirectory -> createDirectoryIfMissing False path >> setPerms + TarOther _ -> return () -- FIXME: warning? + +relativizePath :: Monad m => Maybe FilePath -> FilePath -> m FilePath +relativizePath mdir file + | isAbsolute file = fail $ "Absolute file name in TAR archive: " ++ show file + | not (isValid file) = fail $ "Invalid file name in TAR archive: " ++ show file + | otherwise = return $ maybe file (</> file) mdir + +fileModeToPermissions :: FileMode -> Permissions +fileModeToPermissions m = + Permissions { + readable = m .&. ownerReadMode /= 0, + writable = m .&. ownerWriteMode /= 0, + executable = m .&. ownerExecuteMode /= 0, + searchable = m .&. ownerExecuteMode /= 0 + } + +ownerReadMode :: FileMode +ownerReadMode = 0o000400 + +ownerWriteMode :: FileMode +ownerWriteMode = 0o000200 + +ownerExecuteMode :: FileMode +ownerExecuteMode = 0o000100 + +-- +-- * Reading +-- + +getTarEntry :: ByteString -> Maybe (Maybe (TarHeader,ByteString), ByteString) getTarEntry bs | endBlock = Nothing | BS.length hdr < 512 = error "Truncated TAR archive." | not (checkChkSum hdr chkSum) = error "TAR checksum error." - | not normalFile = Just (Nothing, bs''') - | otherwise = Just (Just (path, cnt), bs''') + | otherwise = Just (Just (info, cnt), bs''') where (hdr,bs') = BS.splitAt 512 bs endBlock = getByte 0 hdr == '\0' fileSuffix = getString 0 100 hdr + mode = getOct 100 8 hdr chkSum = getOct 148 8 hdr typ = getByte 156 hdr size = getOct 124 12 hdr + linkTarget = getString 157 100 hdr filePrefix = getString 345 155 hdr - normalFile = typ == '0' || typ == '\0' - path = filePrefix ++ fileSuffix - padding = (512 - size) `mod` 512 (cnt,bs'') = BS.splitAt size bs' bs''' = BS.drop padding bs'' + fileType = case typ of + '\0'-> TarNormalFile + '0' -> TarNormalFile + '1' -> TarHardLink + '2' -> TarSymbolicLink + '5' -> TarDirectory + c -> TarOther c + + path = filePrefix ++ fileSuffix + info = TarHeader { tarFileName = path, + tarFileMode = mode, + tarFileType = fileType, + tarLinkTarget = linkTarget } + checkChkSum :: ByteString -> Int -> Bool checkChkSum hdr s = s == chkSum hdr' || s == signedChkSum hdr' where _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
