diff --git a/Codec/Archive/Tar.hs b/Codec/Archive/Tar.hs --- a/Codec/Archive/Tar.hs +++ b/Codec/Archive/Tar.hs @@ -1,89 +1,208 @@ --- | This is a library for reading and writing TAR archives. +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +-- Reading, writing and manipulating \"@.tar@\" archive files. +-- +-- This module uses common names and so is designed to be imported qualified: +-- +-- > import qualified Codec.Archive.Tar as Tar +-- +----------------------------------------------------------------------------- module Codec.Archive.Tar ( - -- * TAR archive types - TarArchive(..), - TarEntry(..), - TarHeader(..), - TarFileType(..), - -- * Creating TAR archives - createTarFile, - createTarData, - createTarArchive, - createTarEntry, - recurseDirectories, - -- * Writing TAR archives - writeTarArchive, - writeTarFile, - -- * Extracting TAR archives - extractTarFile, - extractTarData, - extractTarArchive, - extractTarEntry, - -- * Reading TAR archives - readTarArchive, - readTarFile - ) where -import Codec.Archive.Tar.Create -import Codec.Archive.Tar.Extract -import Codec.Archive.Tar.Read -import Codec.Archive.Tar.Types -import Codec.Archive.Tar.Write + -- | Tar archive files are used to store a collection of other files in a + -- single file. They consists of a sequence of entries. Each entry describes + -- a file or directory (or some other special kind of file). The entry stores + -- a little bit of meta-data, in particular the file or directory name. + -- + -- Unlike some other archive formats, a tar file contains no index. The + -- information about each entry is stored next to the entry. Because of this, + -- tar files are almost always processed linearly rather than in a + -- random-access fashion. + -- + -- The functions in this package are designed for working on tar files + -- linearly and lazily. This makes it possible to do many operations in + -- constant space rather than having to load the entire archive into memory. + -- + -- It can read and write standard POSIX tar files and also the GNU and old + -- Unix V7 tar formats. The convenience functions that are provided in the + -- "Codec.Archive.Tar.Entry" module for creating achive entries are primarily + -- designed for standard portable archives. If you need to construct GNU + -- format archives or exactly preserve file ownership and permissions then + -- you will need to write some extra helper functions. + -- + -- This module contains just the simple high level operations without + -- exposing the all the details of tar files. If you need to inspect tar + -- entries in more detail or construct them directly then you also need + -- the module "Codec.Archive.Tar.Entry". -import Control.Monad (liftM) -import qualified Data.ByteString.Lazy.Char8 as L -import Data.ByteString.Lazy (ByteString) -import System.IO + -- * High level \"all in one\" operations + create, + extract, + -- * Notes + -- ** Compressed tar archives + -- | Tar files are commonly used in conjuction with gzip compression, as in + -- \"@.tar.gz@\" or \"@.tar.bz2@\" files. This module does not directly + -- handle compressed tar files however they can be handled easily by + -- composing functions from this module and the modules + -- "Codec.Compression.GZip" or "Codec.Compression.BZip". + -- + -- Creating a compressed \"@.tar.gz@\" file is just a minor variation on the + -- 'create' function, but where throw compression into the pipeline: + -- + -- > BS.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base dir + -- + -- Similarly, extracting a compressed \"@.tar.gz@\" is just a minor variation + -- on the 'extract' function where we use decompression in the pipeline: + -- + -- > Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar + -- --- | Creates a TAR archive containing a number of files --- and directories, and write the archive to a file. --- --- See 'createTarArchive' and 'writeTarArchive' for more information. -createTarFile :: FilePath -- ^ File to write the archive to. - -> [FilePath] -- ^ Files and directories to include in the archive. - -> IO () -createTarFile f fs = createTarData fs >>= L.writeFile f + -- ** Tarbombs + -- | A \"tarbomb\" is a @.tar@ file where not all entries are in a + -- subdirectory but instead files extract into the top level directory. The + -- 'extract' function does not check for these however if you want to do + -- that you can use the 'checkTarbomb' function like so: + -- + -- > Tar.unpack dir . Tar.checkTarbomb expectedDir + -- > . Tar.read =<< BS.readFile tar + -- + -- In this case extraction will fail if any file is outside of @expectedDir@. --- | Creates a TAR archive containing a number of files --- and directories, and returns the archive as a lazy ByteString. --- --- See 'createTarArchive' and 'writeTarArchive' for more information. -createTarData :: [FilePath] -- ^ Files and directories to include in the archive. - -> IO ByteString -createTarData = liftM writeTarArchive . createTarArchive + -- ** Security + -- | This is pretty important. A maliciously constructed tar archives could + -- contain entries that specify bad file names. It could specify absolute + -- file names like \"@\/etc\/passwd@\" or relative files outside of the + -- archive like \"..\/..\/..\/something\". This security problem is commonly + -- called a \"directory traversal vulnerability\". Historically, such + -- vulnerabilites have been common in packages handling tar archives. + -- + -- The 'extract' and 'unpack' functions check for bad file names. See the + -- 'checkSecurity' function for more detials. If you need to do any custom + -- unpacking then you should use this. --- | Writes a TAR archive to a file. --- --- See 'writeTarArchive' for more information. -writeTarFile :: FilePath -- ^ The file to write the archive to. - -> TarArchive -- ^ The archive to write out. - -> IO () -writeTarFile f = L.writeFile f . writeTarArchive + -- * Converting between internal and external representation + -- | Note, you cannot expect @write . read@ to give exactly the same output + -- as input. You can expect the information to be preserved exactly however. + -- This is because 'read' accepts common format variations while 'write' + -- produces the standard format. + read, + write, + -- * Packing and unpacking files to\/from internal representation + -- | These functions are for packing and unpacking portable archives. They + -- are not suitable in cases where it is important to preserve file ownership + -- and permissions or to archive special files like named pipes and unix + -- device files. + pack, + unpack, --- | Reads a TAR archive from a file. --- --- See 'readTarArchive' for more information. -readTarFile :: FilePath -- ^ File to read the archive from. - -> IO TarArchive -readTarFile = liftM readTarArchive . L.readFile + -- * Types + -- ** Tar entry type + -- | This module provides only very simple and limited read-only access to + -- the 'Entry' type. If you need access to the details or if you need to + -- construct your own entries then also import "Codec.Archive.Tar.Entry". + Entry, + entryPath, + entryContent, + EntryContent(..), + -- ** Sequences of tar entries + Entries(..), + mapEntries, + foldEntries, + unfoldEntries, --- | Reads a TAR archive from a file and extracts its contents into --- the current directory. --- --- See 'readTarArchive' and 'extractTarArchive' for more information. -extractTarFile :: FilePath -- ^ File from which the archive is read. - -> IO () -extractTarFile f = L.readFile f >>= extractTarData + ) where --- | Reads a TAR archive from a lazy ByteString and extracts its contents into --- the current directory. --- --- See 'readTarArchive' and 'extractTarArchive' for more information. -extractTarData :: ByteString -- ^ Data from which the archive is read. - -> IO () -extractTarData = extractTarArchive . readTarArchive +import Codec.Archive.Tar.Types +import Codec.Archive.Tar.Read +import Codec.Archive.Tar.Write +import Codec.Archive.Tar.Pack +import Codec.Archive.Tar.Unpack + +import Codec.Archive.Tar.Check + +import qualified Data.ByteString.Lazy as BS +import Prelude hiding (read) + +-- | Create a new @\".tar\"@ file from a directory of files. +-- +-- It is equivalent to calling the standard @tar@ program like so: +-- +-- @$ tar -f tarball.tar -C base -c dir@ +-- +-- This assumes a directory @.\/base\/dir@ with files inside, eg +-- @./base/dir/foo.txt@. The file names inside the resulting tar file will be +-- relative to @dir@, eg @dir/foo.txt@. +-- +-- This is a high level \"all in one\" operation. Since you may need variations +-- on this function it is instructive to see how it is written. It is just: +-- +-- > BS.writeFile tar . Tar.write =<< Tar.pack base paths +-- +-- Notes: +-- +-- The files and directories must not change during this operation or the +-- result is not well defined. +-- +-- The intention of this function is to create tarballs that are portable +-- between systems. It is /not/ suitable for doing file system backups because +-- file ownership and permissions are not fully preserved. File ownership is +-- not preserved at all. File permissions are set to simple portable values: +-- +-- * @rw-r--r--@ for normal files +-- +-- * @rwxr-xr-x@ for executable files +-- +-- * @rwxr-xr-x@ for directories +-- +create :: FilePath -- ^ Path of the \".tar\" file to write. + -> FilePath -- ^ Base directory + -> [FilePath] -- ^ Files and directories to archive, relative to base dir + -> IO () +create tar base paths = BS.writeFile tar . write =<< pack base paths + +-- | Extract all the files contained in a @\".tar\"@ file. +-- +-- It is equivalent to calling the standard @tar@ program like so: +-- +-- @$ tar -x -f tarball.tar -C dir@ +-- +-- So for example if the @tarball.tar@ file contains @foo/bar.txt@ then this +-- will extract it to @dir/foo/bar.txt@. +-- +-- This is a high level \"all in one\" operation. Since you may need variations +-- on this function it is instructive to see how it is written. It is just: +-- +-- > Tar.unpack dir . Tar.read =<< BS.readFile tar +-- +-- Notes: +-- +-- Extracting can fail for a number of reasons. The tarball may be incorrectly +-- formatted. There may be IO or permission errors. In such cases an exception +-- will be thrown and extraction will not continue. +-- +-- Since the extraction may fail part way through it is not atomic. For this +-- reason you may want to extract into an empty directory and, if the +-- extraction fails, recursively delete the directory. +-- +-- Security: only files inside the target directory will be written. Tarballs +-- containing entries that point outside of the tarball (either absolute paths +-- or relative paths) will be caught and an exception will be thrown. +-- +extract :: FilePath -- ^ Destination directory + -> FilePath -- ^ Tarball + -> IO () +extract dir tar = unpack dir . read =<< BS.readFile tar diff --git a/Codec/Archive/Tar/Check.hs b/Codec/Archive/Tar/Check.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Check.hs @@ -0,0 +1,128 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar +-- Copyright : (c) 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +-- Perform various checks on tar file entries. +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Check ( + checkSecurity, + checkTarbomb, + checkPortability, + ) where + +import Codec.Archive.Tar.Types + +import Control.Monad (MonadPlus(mplus)) +import qualified System.FilePath as FilePath.Native + ( splitDirectories, isAbsolute, isValid ) + +import qualified System.FilePath.Windows as FilePath.Windows +import qualified System.FilePath.Posix as FilePath.Posix + +-- | This function checks a sequence of tar entries for file name security +-- problems. It checks that: +-- +-- * file paths are not absolute +-- +-- * file paths do not contain any path components that are \"@..@\" +-- +-- * file names are valid +-- +-- These checks are from the perspective of the current OS. That means we check +-- for \"@C:\blah@\" files on Windows and \"\/blah\" files on unix. For archive +-- entry types 'HardLink' and 'SymbolicLink' the same checks are done for the +-- link target. A failure in any entry terminates the sequence of entries with +-- an error. +-- +checkSecurity :: Entries -> Entries +checkSecurity = checkEntries checkEntrySecurity + +checkTarbomb :: FilePath -> Entries -> Entries +checkTarbomb expectedTopDir = checkEntries (checkEntryTarbomb expectedTopDir) + +checkPortability :: Entries -> Entries +checkPortability = checkEntries checkEntryPortability + + +checkEntrySecurity :: Entry -> Maybe String +checkEntrySecurity entry = case entryContent entry of + HardLink link -> check (entryPath entry) + `mplus` check (fromLinkTarget link) + SymbolicLink link -> check (entryPath entry) + `mplus` check (fromLinkTarget link) + _ -> check (entryPath entry) + + where + check name + | FilePath.Native.isAbsolute name + = Just $ "Absolute file name in tar archive: " ++ show name + + | not (FilePath.Native.isValid name) + = Just $ "Invalid file name in tar archive: " ++ show name + + | any (=="..") (FilePath.Native.splitDirectories name) + = Just $ "Invalid file name in tar archive: " ++ show name + + | otherwise = Nothing + +checkEntryTarbomb :: FilePath -> Entry -> Maybe String +checkEntryTarbomb expectedTopDir entry = + case FilePath.Native.splitDirectories (entryPath entry) of + (topDir:_) | topDir == expectedTopDir -> Nothing + _ -> Just $ "File in tar archive is not in the expected directory " + ++ show expectedTopDir + +checkEntryPortability :: Entry -> Maybe String +checkEntryPortability entry + | entryFormat entry == V7Format + = Just "Archive is in the old Unix V7 tar format" + + | entryFormat entry == GnuFormat + = Just "Archive is in the GNU tar format" + + | not (portableFileType (entryContent entry)) + = Just "Non-portable file type in archive" + + | not (all portableChar posixPath) + = Just $ "Non-portable character in archive entry name: " ++ show posixPath + + | not (FilePath.Posix.isValid posixPath) + = Just $ "Invalid unix file name in tar archive: " ++ show posixPath + | not (FilePath.Windows.isValid windowsPath) + = Just $ "Invalid windows file name in tar archive: " ++ show windowsPath + + | not (FilePath.Posix.isAbsolute posixPath) + = Just $ "Absolute unix file name in tar archive: " ++ show posixPath + | not (FilePath.Windows.isAbsolute windowsPath) + = Just $ "Absolute windows file name in tar archive: " ++ show windowsPath + + | any (=="..") (FilePath.Posix.splitDirectories posixPath) + = Just $ "Invalid unix file name in tar archive: " ++ show posixPath + | any (=="..") (FilePath.Windows.splitDirectories windowsPath) + = Just $ "Invalid windows file name in tar archive: " ++ show windowsPath + + | otherwise = Nothing + + where + posixPath = fromTarPathToPosixPath (entryTarPath entry) + windowsPath = fromTarPathToWindowsPath (entryTarPath entry) + + portableFileType ftype = case ftype of + NormalFile {} -> True + HardLink {} -> True + SymbolicLink {} -> True + Directory -> True + _ -> False + + portableChar c = c <= '\127' + + +checkEntries :: (Entry -> Maybe String) -> Entries -> Entries +checkEntries checkEntry = + mapEntries (\entry -> maybe (Right entry) Left (checkEntry entry)) diff --git a/Codec/Archive/Tar/Create.hs b/Codec/Archive/Tar/Create.hs deleted file mode 100644 --- a/Codec/Archive/Tar/Create.hs +++ /dev/null @@ -1,130 +0,0 @@ -module Codec.Archive.Tar.Create ( - -- * Creating TAR archives from files - createTarArchive, createTarEntry, - recurseDirectories, - -- * Creating TAR archives from scratch - mkTarHeader) where - -import Codec.Archive.Tar.Types -import Codec.Archive.Tar.Util - -import System.PosixCompat.Extensions -import System.PosixCompat.Files - -import Control.Monad -import qualified Data.ByteString.Lazy as L -import Data.List -import System.Directory -import System.IO -import System.IO.Unsafe (unsafeInterleaveIO) - - --- | Creates a TAR archive containing a number of files --- and directories taken from the file system. In the list --- of paths, any directory --- should come before any files in that directory. --- Only files and directories mentioned in the list are included, --- this function does not recurse into the directories. -createTarArchive :: [FilePath] -- ^ Files and directories to include in the archive. - -> IO TarArchive -createTarArchive = liftM TarArchive . mapM createTarEntry - --- | Creates a TAR archive entry for a file or directory. --- The meta-data and file contents are taken from the given file. -createTarEntry :: FilePath -> IO TarEntry -createTarEntry path = - do stat <- getSymbolicLinkStatus path - let t = fileType stat - path' <- sanitizePath t path - target <- case t of - TarSymbolicLink -> readSymbolicLink path - _ -> return "" - let (major,minor) = if t == TarCharacterDevice || t == TarBlockDevice - then let dev = deviceID stat - in (deviceMajor dev, deviceMinor dev) - else (0,0) - -- FIXME: don't work on OS X - -- FIXME: if it fails, return nil - owner <- return "" --liftM userName $ getUserEntryForID $ fileOwner stat - grp <- return "" --liftM groupName $ getGroupEntryForID $ fileGroup stat - let hdr = TarHeader { - tarFileName = path', - tarFileMode = fileMode stat, - tarOwnerID = fileOwner stat, - tarGroupID = fileGroup stat, - tarFileSize = fromIntegral $ fileSize stat, - tarModTime = modificationTime stat, - tarFileType = t, - tarLinkTarget = target, - tarOwnerName = owner, - tarGroupName = grp, - tarDeviceMajor = major, - tarDeviceMinor = minor - } - cnt <- case t of - TarNormalFile -> L.readFile path -- FIXME: warn if size has changed? - _ -> return L.empty - return $ TarEntry hdr cnt - -fileType :: FileStatus -> TarFileType -fileType stat | isRegularFile stat = TarNormalFile - | isSymbolicLink stat = TarSymbolicLink - | isCharacterDevice stat = TarCharacterDevice - | isBlockDevice stat = TarBlockDevice - | isDirectory stat = TarDirectory - | isNamedPipe stat = TarFIFO - | otherwise = error "Unknown file type." - --- | Creates a TAR header for a normal file with the given path. --- Does not consult the file system. --- All meta-data is set to default values. -mkTarHeader :: FilePath -> TarHeader -mkTarHeader path = TarHeader { - tarFileName = path, - tarFileMode = stdFileMode, - tarOwnerID = 0, - tarGroupID = 0, - tarFileSize = 0, - tarModTime = 0, - tarFileType = TarNormalFile, - tarLinkTarget = "", - tarOwnerName = "", - tarGroupName = "", - tarDeviceMajor = 0, - tarDeviceMinor = 0 - } - --- * Path and file stuff - --- FIXME: normalize paths? -sanitizePath :: TarFileType -> FilePath -> IO FilePath -sanitizePath t path = - do path' <- liftM (removeDuplSep . addTrailingSep) $ forceRelativePath path - when (null path' || length path' > 255) $ - fail $ "Path too long: " ++ show path' -- FIXME: warn instead? - return path' - where - addTrailingSep = if t == TarDirectory then (++[pathSep]) else id - removeDuplSep = - concat . map (\g -> if all (==pathSep) g then [pathSep] else g) . group - --- | Recurses through a list of files and directories --- in depth-first order. --- Each of the given paths are returned, and each path which --- refers to a directory is followed by its descendants. --- The output is suitable for feeding to the --- TAR archive creation functions. -recurseDirectories :: [FilePath] -> IO [FilePath] -recurseDirectories = - liftM concat . mapM (\p -> liftM (p:) $ unsafeInterleaveIO $ descendants p) - where - descendants path = - do d <- doesDirectoryExist path - if d then do cs <- getDirectoryContents path - let cs' = [path++[pathSep]++c | c <- cs, includeDir c] - ds <- recurseDirectories cs' - return ds - else return [] - where includeDir "." = False - includeDir ".." = False - includeDir _ = True diff --git a/Codec/Archive/Tar/Entry.hs b/Codec/Archive/Tar/Entry.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Entry.hs @@ -0,0 +1,80 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar.Entry +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +-- Types and functions to manipulate tar entries. +-- +-- While the "Codec.Archive.Tar" module provides only the simple high level +-- api, this module provides full access to the details of tar entries. This +-- lets you inspect all the meta-data, construct entries and handle error cases +-- more precisely. +-- +-- This module uses common names and so is designed to be imported qualified: +-- +-- > import qualified Codec.Archive.Tar as Tar +-- > import qualified Codec.Archive.Tar.Entry as Tar +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Entry ( + + -- * Tar entry and associated types + Entry(..), + --TODO: should be the following with the Entry constructor not exported, + -- but haddock cannot document that properly + -- see http://trac.haskell.org/haddock/ticket/3 + --Entry(filePath, fileMode, ownerId, groupId, fileSize, modTime, + -- fileType, linkTarget, headerExt, fileContent), + entryPath, + EntryContent(..), + Ownership(..), + + FileSize, + Permissions, + EpochTime, + DevMajor, + DevMinor, + TypeCode, + Format(..), + + -- * Constructing simple entry values + simpleEntry, + fileEntry, + directoryEntry, + + -- * Standard file permissions + -- | For maximum portability when constructing archives use only these file + -- permissions. + ordinaryFilePermissions, + executableFilePermissions, + directoryPermissions, + + -- * Constructing entries from disk files + packFileEntry, + packDirectoryEntry, + getDirectoryContentsRecursive, + + -- * TarPath type + TarPath, + toTarPath, + fromTarPath, + fromTarPathToPosixPath, + fromTarPathToWindowsPath, + + -- * LinkTarget type + LinkTarget, + toLinkTarget, + fromLinkTarget, + fromLinkTargetToPosixPath, + fromLinkTargetToWindowsPath, + + ) where + +import Codec.Archive.Tar.Types +import Codec.Archive.Tar.Pack diff --git a/Codec/Archive/Tar/Extract.hs b/Codec/Archive/Tar/Extract.hs deleted file mode 100644 --- a/Codec/Archive/Tar/Extract.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Codec.Archive.Tar.Extract where - -import Codec.Archive.Tar.Types -import Codec.Archive.Tar.Util - -import System.PosixCompat.Extensions -import System.PosixCompat.Files - -import Control.Monad -import qualified Data.ByteString.Lazy as BS -import System.Directory -import System.PosixCompat.Types - --- | Extracts the contents of a TAR archive into the current directory. --- --- If problems are encountered, warnings are printed to --- 'stderr', and the extraction continues. -extractTarArchive :: TarArchive -> IO () -extractTarArchive = mapM_ extractTarEntry . archiveEntries - --- | Extracts a TAR entry into the current directory. --- --- This function throws an exception if any problems are encountered. -extractTarEntry :: TarEntry -> IO () -extractTarEntry (TarEntry hdr cnt) = - do -- FIXME: more path checks? - path <- forceRelativePath $ tarFileName hdr - let dir = dirName path - mode = tarFileMode hdr - when (not (null dir)) $ createDirectoryIfMissing True dir - case tarFileType hdr of - TarHardLink -> - -- FIXME: sanitize link target - createLink (tarLinkTarget hdr) path - TarSymbolicLink -> - -- FIXME: sanitize link target - createSymbolicLink (tarLinkTarget hdr) path - TarCharacterDevice -> - createCharacterDevice path mode (tarDeviceID hdr) - TarBlockDevice -> - createBlockDevice path mode (tarDeviceID hdr) - TarDirectory -> createDirectoryIfMissing False path - TarFIFO -> createNamedPipe path mode - _ -> BS.writeFile path cnt - warnIOError $ setFileMode path mode - -- FIXME: use tarOwnerName / tarGroupName if available - -- FIXME: gives lots of warnings if run by non-root - --warnIOError $ setOwnerAndGroup path (tarOwnerID hdr) (tarGroupID hdr) - setFileTimes path (tarModTime hdr) (tarModTime hdr) - -createCharacterDevice :: FilePath -> FileMode -> DeviceID -> IO () -createCharacterDevice path mode dev = createDevice path m dev - where m = mode `unionFileModes` characterSpecialMode - -createBlockDevice :: FilePath -> FileMode -> DeviceID -> IO () -createBlockDevice path mode dev = createDevice path m dev - where m = mode `unionFileModes` blockSpecialMode - -characterSpecialMode :: FileMode -characterSpecialMode = 0o0020000 - -blockSpecialMode :: FileMode -blockSpecialMode = 0o0060000 - -tarDeviceID :: TarHeader -> DeviceID -tarDeviceID hdr = makeDeviceID (tarDeviceMajor hdr) (tarDeviceMajor hdr) diff --git a/Codec/Archive/Tar/Pack.hs b/Codec/Archive/Tar/Pack.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Pack.hs @@ -0,0 +1,171 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Pack ( + pack, + packFileEntry, + packDirectoryEntry, + + getDirectoryContentsRecursive, + ) where + +import Codec.Archive.Tar.Types + +import qualified Data.ByteString.Lazy as BS +import System.FilePath + ( () ) +import qualified System.FilePath as FilePath.Native + ( makeRelative, addTrailingPathSeparator, hasTrailingPathSeparator ) +import System.Directory + ( getDirectoryContents, doesDirectoryExist, getModificationTime + , Permissions(..), getPermissions ) +import System.Posix.Types + ( FileMode ) +import System.Time + ( ClockTime(..) ) +import System.IO + ( IOMode(ReadMode), openBinaryFile, hFileSize ) +import System.IO.Unsafe (unsafeInterleaveIO) + +-- | Creates a tar archive from a list of directory or files. Any directories +-- specified will have their contents included recursively. Paths in the +-- archive will be relative to the given base directory. +-- +-- This is a portable implementation of packing suitable for portable archives. +-- In particular it only constructs 'NormalFile' and 'Directory' entries. Hard +-- links and symbolic links are treated like ordinary files. It cannot be used +-- to pack directories containing recursive symbolic links. Special files like +-- FIFOs (named pipes), sockets or device files will also cause problems. +-- +-- An exception will be thrown for any file names that are too long to +-- represent as a 'TarPath'. +-- +-- * This function returns results lazily. Subdirectories are scanned +-- and files are read one by one as the list of entries is consumed. +-- +pack :: FilePath -- ^ Base directory + -> [FilePath] -- ^ Files and directories to pack, relative to the base dir + -> IO [Entry] +pack baseDir paths0 = preparePaths baseDir paths0 >>= packPaths baseDir + +preparePaths :: FilePath -> [FilePath] -> IO [FilePath] +preparePaths baseDir paths = + fmap concat $ interleave + [ do isDir <- doesDirectoryExist path + if isDir then getDirectoryContentsRecursive (baseDir path) + else return [path] + | path <- paths ] + +packPaths :: FilePath -> [FilePath] -> IO [Entry] +packPaths baseDir paths = + interleave + [ do tarpath <- either fail return (toTarPath isDir relPath) + if isDir then packDirectoryEntry filepath tarpath + else packFileEntry filepath tarpath + | filepath <- paths + , let isDir = FilePath.Native.hasTrailingPathSeparator filepath + relPath = FilePath.Native.makeRelative baseDir filepath ] + +interleave :: [IO a] -> IO [a] +interleave = unsafeInterleaveIO . go + where + go [] = return [] + go (x:xs) = do + x' <- x + xs' <- interleave xs + return (x':xs') + +-- | Construct a tar 'Entry' based on a local file. +-- +-- This sets the entry size, the data contained in the file and the file's +-- modification time. If the file is executable then that information is also +-- preserved. File ownership and detailed permissions are not preserved. +-- +-- * The file contents is read lazily. +-- +packFileEntry :: FilePath -- ^ Full path to find the file on the local disk + -> TarPath -- ^ Path to use for the tar Entry in the archive + -> IO Entry +packFileEntry filepath tarpath = do + mtime <- getModTime filepath + perms <- getPermissions filepath + file <- openBinaryFile filepath ReadMode + size <- hFileSize file + content <- BS.hGetContents file + return (simpleEntry tarpath (NormalFile content (fromIntegral size))) { + entryPermissions = if executable perms then executableFilePermissions + else ordinaryFilePermissions, + entryTime = mtime + } + +-- | Construct a tar 'Entry' based on a local directory (but not its contents). +-- +-- The only attribute of the directory that is used is its modification time. +-- Directory ownership and detailed permissions are not preserved. +-- +packDirectoryEntry :: FilePath -- ^ Full path to find the file on the local disk + -> TarPath -- ^ Path to use for the tar Entry in the archive + -> IO Entry +packDirectoryEntry filepath tarpath = do + mtime <- getModTime filepath + return (directoryEntry tarpath) { + entryTime = mtime + } + +-- | This is a utility function, much like 'getDirectoryContents'. The +-- difference is that it includes the contents of subdirectories. +-- +-- The paths returned are all relative to the top directory. Directory paths +-- are distinguishable by having a trailing path separator +-- (see 'FilePath.Native.hasTrailingPathSeparator'). +-- +-- All directories are listed before the files that they contain. Amongst the +-- contents of a directory, subdirectories are listed after normal files. The +-- overall result is that files within a directory will be together in a single +-- contiguous group. This tends to improve file layout an IO performance when +-- creating or extracting tar archives. +-- +-- * This function returns results lazily. Subdirectories are not scanned +-- until the files entries in the parent directory have been consumed. +-- +getDirectoryContentsRecursive :: FilePath -> IO [FilePath] +getDirectoryContentsRecursive dir0 = + recurseDirectories [FilePath.Native.addTrailingPathSeparator dir0] + +recurseDirectories :: [FilePath] -> IO [FilePath] +recurseDirectories [] = return [] +recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do + (files, dirs') <- collect [] [] =<< getDirectoryContents dir + + files' <- recurseDirectories (dirs' ++ dirs) + return (dir : files ++ files') + + where + collect files dirs' [] = return (reverse files, reverse dirs') + collect files dirs' (entry:entries) | ignore entry + = collect files dirs' entries + collect files dirs' (entry:entries) = do + let dirEntry = dir entry + dirEntry' = FilePath.Native.addTrailingPathSeparator dirEntry + isDirectory <- doesDirectoryExist dirEntry + if isDirectory + then collect files (dirEntry':dirs') entries + else collect (dirEntry:files) dirs' entries + + ignore ['.'] = True + ignore ['.', '.'] = True + ignore _ = False + +getModTime :: FilePath -> IO EpochTime +getModTime path = do + (TOD s _) <- getModificationTime path + return $! fromIntegral s diff --git a/Codec/Archive/Tar/Read.hs b/Codec/Archive/Tar/Read.hs --- a/Codec/Archive/Tar/Read.hs +++ b/Codec/Archive/Tar/Read.hs @@ -1,135 +1,163 @@ -module Codec.Archive.Tar.Read (readTarArchive) where +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar.Read +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Read (read) where import Codec.Archive.Tar.Types -import Codec.Archive.Tar.Util -import Data.Binary.Get +import Data.Char (ord) +import Data.Int (Int64) +import Numeric (readOct) +import Control.Monad (unless) -import Data.Char (chr,ord) -import Data.Int (Int64) -import Control.Monad (liftM) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as L -import Data.Int (Int8) -import Numeric (readOct) +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import Data.ByteString.Lazy (ByteString) --- | Reads a TAR archive from a lazy ByteString. -readTarArchive :: L.ByteString -> TarArchive -readTarArchive = runGet getTarArchive +import Prelude hiding (read) -getTarArchive :: Get TarArchive -getTarArchive = liftM TarArchive $ unfoldM getTarEntry +-- | Convert a data stream in the tar file format into an internal data +-- structure. Decoding errors are reported by the 'Fail' constructor of the +-- 'Entries' type. +-- +-- * The conversion is done lazily. +-- +read :: ByteString -> Entries +read = unfoldEntries getEntry --- | Returns 'Nothing' if the entry is an end block. -getTarEntry :: Get (Maybe TarEntry) -getTarEntry = - do mhdr <- getTarHeader - case mhdr of - Nothing -> return Nothing - Just hdr -> do let size = contentSize hdr - cnt <- if size == 0 - then return L.empty - else let padding = (512 - size) `mod` 512 - in liftM (L.take size) $ getLazyByteString $ size + padding - return $ Just $ TarEntry hdr cnt +getEntry :: ByteString -> Either String (Maybe (Entry, ByteString)) +getEntry bs + | BS.length header < 512 = Left "truncated tar archive" --- | Get the size of the content for the given header. This can sometimes --- be different from 'tarFileSize'. I have seen hints that some platforms --- may set the size to non-zero values for directories. -contentSize :: TarHeader -> Int64 -contentSize hdr = if hasContent hdr then tarFileSize hdr else 0 + -- Tar files end with at least two blocks of all '0'. Checking this serves + -- two purposes. It checks the format but also forces the tail of the data + -- which is necessary to close the file if it came from a lazily read file. + | BS.head bs == 0 = case BS.splitAt 1024 bs of + (end, trailing) + | BS.length end /= 1024 -> Left "short tar trailer" + | not (BS.all (== 0) end) -> Left "bad tar trailer" + | not (BS.all (== 0) trailing) -> Left "tar file has trailing junk" + | otherwise -> Right Nothing -hasContent :: TarHeader -> Bool -hasContent hdr = case tarFileType hdr of - TarNormalFile -> True - TarOther _ -> True - _ -> False + | otherwise = partial $ do -getTarHeader :: Get (Maybe TarHeader) -getTarHeader = - do -- FIXME: warn and return nothing on EOF - block <- liftM B.copy $ getBytes 512 - return $ - if B.head block == '\NUL' - then Nothing - else let (hdr,chkSum) = - runGet getHeaderAndChkSum $ L.fromChunks [block] - in if checkChkSum block chkSum - then Just hdr - else error $ "TAR header checksum failure." + case (chksum_, format_) of + (Ok chksum, _ ) | correctChecksum header chksum -> return () + (Ok _, Ok _) -> fail "tar checksum error" + _ -> fail "data is not in tar format" -checkChkSum :: B.ByteString -> Int -> Bool -checkChkSum block s = s == chkSum block' || s == signedChkSum block' - where - block' = B.concat [B.take 148 block, B.replicate 8 ' ', B.drop 156 block] - -- tar.info says that Sun tar is buggy and - -- calculates the checksum using signed chars - chkSum = B.foldl' (\x y -> x + ord y) 0 - signedChkSum = B.foldl' (\x y -> x + (ordSigned y)) 0 + -- These fields are partial, have to check them + format <- format_; mode <- mode_; + uid <- uid_; gid <- gid_; + size <- size_; mtime <- mtime_; + devmajor <- devmajor_; devminor <- devminor_; -ordSigned :: Char -> Int -ordSigned c = fromIntegral (fromIntegral (ord c) :: Int8) + let content = BS.take size (BS.drop 512 bs) + padding = (512 - size) `mod` 512 + bs' = BS.drop (512 + size + padding) bs -getHeaderAndChkSum :: Get (TarHeader, Int) -getHeaderAndChkSum = - do fileSuffix <- getString 100 - mode <- getOct 8 - uid <- getOct 8 - gid <- getOct 8 - size <- getOct 12 - time <- getOct 12 - chkSum <- getOct 8 - typ <- getTarFileType - target <- getString 100 - _ustar <- skip 6 - _version <- skip 2 - uname <- getString 32 - gname <- getString 32 - major <- getOct 8 - minor <- getOct 8 - filePrefix <- getString 155 - _ <- skip 12 - let hdr = TarHeader { - tarFileName = filePrefix ++ fileSuffix, - tarFileMode = mode, - tarOwnerID = uid, - tarGroupID = gid, - tarFileSize = size, - tarModTime = fromInteger time, - tarFileType = typ, - tarLinkTarget = target, - tarOwnerName = uname, - tarGroupName = gname, - tarDeviceMajor = major, - tarDeviceMinor = minor - } - return (hdr,chkSum) + entry = Entry { + entryTarPath = TarPath name prefix, + entryContent = case typecode of + '\0' -> NormalFile content size + '0' -> NormalFile content size + '1' -> HardLink (LinkTarget linkname) + '2' -> SymbolicLink (LinkTarget linkname) + '3' -> CharacterDevice devmajor devminor + '4' -> BlockDevice devmajor devminor + '5' -> Directory + '6' -> NamedPipe + '7' -> NormalFile content size + _ -> OtherEntryType typecode content size, + entryPermissions = mode, + entryOwnership = Ownership uname gname uid gid, + entryTime = mtime, + entryFormat = format + } -getTarFileType :: Get TarFileType -getTarFileType = - do c <- getChar8 - return $ case c of - '\0'-> TarNormalFile - '0' -> TarNormalFile - '1' -> TarHardLink - '2' -> TarSymbolicLink - '3' -> TarCharacterDevice - '4' -> TarBlockDevice - '5' -> TarDirectory - '6' -> TarFIFO - _ -> TarOther c + return (Just (entry, bs')) + where + header = BS.take 512 bs + + name = getString 0 100 header + mode_ = getOct 100 8 header + uid_ = getOct 108 8 header + gid_ = getOct 116 8 header + size_ = getOct 124 12 header + mtime_ = getOct 136 12 header + chksum_ = getOct 148 8 header + typecode = getByte 156 header + linkname = getString 157 100 header + magic = getChars 257 8 header + uname = getString 265 32 header + gname = getString 297 32 header + devmajor_ = getOct 329 8 header + devminor_ = getOct 337 8 header + prefix = getString 345 155 header +-- trailing = getBytes 500 12 header + + format_ = case magic of + "\0\0\0\0\0\0\0\0" -> return V7Format + "ustar\NUL00" -> return UstarFormat + "ustar \NUL" -> return GnuFormat + _ -> fail "tar entry not in a recognised format" + +correctChecksum :: ByteString -> Int -> Bool +correctChecksum header checksum = checksum == checksum' + where + -- sum of all 512 bytes in the header block, + -- treating each byte as an 8-bit unsigned value + checksum' = BS.Char8.foldl' (\x y -> x + ord y) 0 header' + -- treating the 8 bytes of chksum as blank characters. + header' = BS.concat [BS.take 148 header, + BS.Char8.replicate 8 ' ', + BS.drop 156 header] + -- * TAR format primitive input -getOct :: Integral a => Int -> Get a -getOct n = getBytes n >>= parseOct . takeWhile (/='\0') . B.unpack - where parseOct "" = return 0 - parseOct s = case readOct s of - [(x,_)] -> return x - _ -> fail $ "Number format error: " ++ show s +getOct :: Integral a => Int64 -> Int64 -> ByteString -> Partial a +getOct off len = parseOct + . BS.Char8.unpack + . BS.Char8.takeWhile (\c -> c /= '\NUL' && c /= ' ') + . BS.Char8.dropWhile (== ' ') + . getBytes off len + where + parseOct "" = return 0 + parseOct ('\128':_) = fail "tar header uses non-standard number encoding" + parseOct s = case readOct s of + [(x,[])] -> return x + _ -> fail "tar header is malformatted (bad numeric encoding)" -getString :: Int -> Get String -getString n = liftM (takeWhile (/='\NUL') . B.unpack) $ getBytes n +getBytes :: Int64 -> Int64 -> ByteString -> ByteString +getBytes off len = BS.take len . BS.drop off -getChar8 :: Get Char -getChar8 = fmap (chr . fromIntegral) getWord8 +getByte :: Int64 -> ByteString -> Char +getByte off bs = BS.Char8.index bs off + +getChars :: Int64 -> Int64 -> ByteString -> String +getChars off len = BS.Char8.unpack . getBytes off len + +getString :: Int64 -> Int64 -> ByteString -> String +getString off len = BS.Char8.unpack . BS.Char8.takeWhile (/='\0') . getBytes off len + +data Partial a = Error String | Ok a + +partial :: Partial a -> Either String a +partial (Error msg) = Left msg +partial (Ok x) = Right x + +instance Monad Partial where + return = Ok + Error m >>= _ = Error m + Ok x >>= k = k x + fail = Error diff --git a/Codec/Archive/Tar/Types.hs b/Codec/Archive/Tar/Types.hs --- a/Codec/Archive/Tar/Types.hs +++ b/Codec/Archive/Tar/Types.hs @@ -1,69 +1,456 @@ -module Codec.Archive.Tar.Types where +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar.Types +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +-- Types to represent the content of @.tar@ archives. +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Types ( + Entry(..), + entryPath, + EntryContent(..), + FileSize, + Permissions, + Ownership(..), + EpochTime, + TypeCode, + DevMajor, + DevMinor, + Format(..), + + simpleEntry, + fileEntry, + directoryEntry, + + ordinaryFilePermissions, + executableFilePermissions, + directoryPermissions, + + TarPath(..), + toTarPath, + fromTarPath, + fromTarPathToPosixPath, + fromTarPathToWindowsPath, + + LinkTarget(..), + toLinkTarget, + fromLinkTarget, + fromLinkTargetToPosixPath, + fromLinkTargetToWindowsPath, + + Entries(..), + mapEntries, + foldEntries, + unfoldEntries, + + ) where + +import Data.Int (Int64) +import Data.Monoid (Monoid(..)) +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import Data.ByteString.Lazy (ByteString) -import Data.Int (Int64) -import System.PosixCompat.Types (FileMode, UserID, GroupID, EpochTime) -import System.PosixCompat.Extensions (CMajor, CMinor) --- | A TAR archive. -newtype TarArchive = TarArchive { archiveEntries :: [TarEntry] } - deriving Show +import qualified System.FilePath as FilePath.Native + ( joinPath, splitDirectories, addTrailingPathSeparator ) +import qualified System.FilePath.Posix as FilePath.Posix + ( joinPath, splitPath, splitDirectories, hasTrailingPathSeparator + , addTrailingPathSeparator ) +import qualified System.FilePath.Windows as FilePath.Windows + ( joinPath, addTrailingPathSeparator ) +import System.Posix.Types + ( FileMode ) --- | A TAR archive entry for a file or directory. -data TarEntry = TarEntry { - -- | Entry meta-data. - entryHeader :: TarHeader, - -- | Entry contents. For entries other than normal - -- files, this should be an empty string. - entryData :: ByteString - } - deriving Show +type FileSize = Int64 +-- | The number of seconds since the UNIX epoch +type EpochTime = Int64 +type DevMajor = Int +type DevMinor = Int +type TypeCode = Char +type Permissions = FileMode --- | TAR archive entry meta-data. -data TarHeader = TarHeader - { - -- | Path of the file or directory. The path separator should be @/@ - -- for portable TAR archives. - tarFileName :: FilePath, - -- | UNIX file mode. - tarFileMode :: FileMode, - -- | Numeric owner user id. Should be set to @0@ if unknown. - tarOwnerID :: UserID, - -- | Numeric owner group id. Should be set to @0@ if unknown. - tarGroupID :: GroupID, - -- | File size in bytes. Should be 0 for entries other than normal files. - tarFileSize :: Int64, - -- | Last modification time, expressed as the number of seconds - -- since the UNIX epoch. - tarModTime :: EpochTime, - -- | Type of this entry. - tarFileType :: TarFileType, - -- | If the entry is a hard link or a symbolic link, this is the path of - -- the link target. For all other entry types this should be @\"\"@. - tarLinkTarget :: FilePath, - -- | The owner user name. Should be set to @\"\"@ if unknown. - tarOwnerName :: String, - -- | The owner group name. Should be set to @\"\"@ if unknown. - tarGroupName :: String, - -- | For character and block device entries, this is the - -- major number of the device. For all other entry types, it - -- should be set to @0@. - tarDeviceMajor :: CMajor, - -- | For character and block device entries, this is the - -- minor number of the device. For all other entry types, it - -- should be set to @0@. - tarDeviceMinor :: CMinor - } - deriving Show +-- | Tar archive entry. +-- +data Entry = Entry { --- | TAR archive entry types. -data TarFileType = - TarNormalFile - | TarHardLink - | TarSymbolicLink - | TarCharacterDevice - | TarBlockDevice - | TarDirectory - | TarFIFO - | TarOther Char - deriving (Eq,Show) + -- | The path of the file or directory within the archive. This is in a + -- tar-specific form. Use 'entryPath' to get a native 'FilePath'. + entryTarPath :: !TarPath, + + -- | The real content of the entry. For 'NormalFile' this includes the + -- file data. An entry usually contains a 'NormalFile' or a 'Directory'. + entryContent :: !EntryContent, + + -- | File permissions (Unix style file mode). + entryPermissions :: !Permissions, + + -- | The user and group to which this file belongs. + entryOwnership :: !Ownership, + + -- | The time the file was last modified. + entryTime :: !EpochTime, + + -- | The tar format the archive is using. + entryFormat :: !Format + } + +-- | Native 'FilePath' of the file or directory within the archive. +-- +entryPath :: Entry -> FilePath +entryPath = fromTarPath . entryTarPath + +-- | The content of a tar archive entry, which depends on the type of entry. +-- +-- Portable archives should contain only 'NormalFile' and 'Directory'. +-- +data EntryContent = NormalFile ByteString !FileSize + | Directory + | SymbolicLink !LinkTarget + | HardLink !LinkTarget + | CharacterDevice !DevMajor !DevMinor + | BlockDevice !DevMajor !DevMinor + | NamedPipe + | OtherEntryType !TypeCode ByteString !FileSize + +data Ownership = Ownership { + -- | The owner user name. Should be set to @\"\"@ if unknown. + ownerName :: String, + + -- | The owner group name. Should be set to @\"\"@ if unknown. + groupName :: String, + + -- | Numeric owner user id. Should be set to @0@ if unknown. + ownerId :: !Int, + + -- | Numeric owner group id. Should be set to @0@ if unknown. + groupId :: !Int + } + +-- | There have been a number of extensions to the tar file format over the +-- years. They all share the basic entry fields and put more meta-data in +-- different extended headers. +-- +data Format = + + -- | This is the classic Unix V7 tar format. It does not support owner and + -- group names, just numeric Ids. It also does not support device numbers. + V7Format + + -- | The \"USTAR\" format is an extension of the classic V7 format. It was + -- later standardised by POSIX. It has some restructions but is the most + -- portable format. + -- + | UstarFormat + + -- | The GNU tar implementation also extends the classic V7 format, though + -- in a slightly different way from the USTAR format. In general for new + -- archives the standard USTAR/POSIX should be used. + -- + | GnuFormat + deriving Eq + +-- | @rw-r--r--@ for normal files +ordinaryFilePermissions :: Permissions +ordinaryFilePermissions = 0o0644 + +-- | @rwxr-xr-x@ for executable files +executableFilePermissions :: Permissions +executableFilePermissions = 0o0755 + +-- | @rwxr-xr-x@ for directories +directoryPermissions :: Permissions +directoryPermissions = 0o0755 + +-- | An 'Entry' with all default values except for the file name and type. It +-- uses the portable USTAR/POSIX format (see 'UstarHeader'). +-- +-- You can use this as a basis and override specific fields, eg: +-- +-- > (emptyEntry name HardLink) { linkTarget = target } +-- +simpleEntry :: TarPath -> EntryContent -> Entry +simpleEntry tarpath content = Entry { + entryTarPath = tarpath, + entryContent = content, + entryPermissions = case content of + Directory -> directoryPermissions + _ -> ordinaryFilePermissions, + entryOwnership = Ownership "" "" 0 0, + entryTime = 0, + entryFormat = UstarFormat + } + +-- | A tar 'Entry' for a file. +-- +-- Entry fields such as file permissions and ownership have default values. +-- +-- You can use this as a basis and override specific fields. For example if you +-- need an executable file you could use: +-- +-- > (fileEntry name content) { fileMode = executableFileMode } +-- +fileEntry :: TarPath -> ByteString -> Entry +fileEntry name fileContent = + simpleEntry name (NormalFile fileContent (BS.length fileContent)) + +-- | A tar 'Entry' for a directory. +-- +-- Entry fields such as file permissions and ownership have default values. +-- +directoryEntry :: TarPath -> Entry +directoryEntry name = simpleEntry name Directory + +-- +-- * Tar paths +-- + +-- | The classic tar format allowed just 100 charcters for the file name. The +-- USTAR format extended this with an extra 155 characters, however it uses a +-- complex method of splitting the name between the two sections. +-- +-- Instead of just putting any overflow into the extended area, it uses the +-- extended area as a prefix. The agrevating insane bit however is that the +-- prefix (if any) must only contain a directory prefix. That is the split +-- between the two areas must be on a directory separator boundary. So there is +-- no simple calculation to work out if a file name is too long. Instead we +-- have to try to find a valid split that makes the name fit in the two areas. +-- +-- The rationale presumably was to make it a bit more compatible with old tar +-- programs that only understand the classic format. A classic tar would be +-- able to extract the file name and possibly some dir prefix, but not the +-- full dir prefix. So the files would end up in the wrong place, but that's +-- probably better than ending up with the wrong names too. +-- +-- So it's understandable but rather annoying. +-- +-- * Tar paths use posix format (ie @\'/\'@ directory separators), irrespective +-- of the local path conventions. +-- +-- * The directory separator between the prefix and name is /not/ stored. +-- +data TarPath = TarPath FilePath -- path name, 100 characters max. + FilePath -- path prefix, 155 characters max. + deriving (Eq, Ord) + +-- | Convert a 'TarPath' to a native 'FilePath'. +-- +-- The native 'FilePath' will use the native directory separator but it is not +-- otherwise checked for validity or sanity. In particular: +-- +-- * The tar path may be invalid as a native path, eg the filename @\"nul\"@ is +-- not valid on Windows. +-- +-- * The tar path may be an absolute path or may contain @\"..\"@ components. +-- For security reasons this should not usually be allowed, but it is your +-- responsibility to check for these conditions (eg using 'checkSecurity'). +-- +fromTarPath :: TarPath -> FilePath +fromTarPath (TarPath name prefix) = adjustDirectory $ + FilePath.Native.joinPath $ FilePath.Posix.splitDirectories prefix + ++ FilePath.Posix.splitDirectories name + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name + = FilePath.Native.addTrailingPathSeparator + | otherwise = id + +-- | Convert a 'TarPath' to a Unix/Posix 'FilePath'. +-- +-- The difference compared to 'fromTarPath' is that it always returns a Unix +-- style path irrespective of the current operating system. +-- +-- This is useful to check how a 'TarPath' would be interpreted on a specific +-- operating system, eg to perform portability checks. +-- +fromTarPathToPosixPath :: TarPath -> FilePath +fromTarPathToPosixPath (TarPath name prefix) = adjustDirectory $ + FilePath.Posix.joinPath $ FilePath.Posix.splitDirectories prefix + ++ FilePath.Posix.splitDirectories name + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name + = FilePath.Posix.addTrailingPathSeparator + | otherwise = id + +-- | Convert a 'TarPath' to a Windows 'FilePath'. +-- +-- The only difference compared to 'fromTarPath' is that it always returns a +-- Windows style path irrespective of the current operating system. +-- +-- This is useful to check how a 'TarPath' would be interpreted on a specific +-- operating system, eg to perform portability checks. +-- +fromTarPathToWindowsPath :: TarPath -> FilePath +fromTarPathToWindowsPath (TarPath name prefix) = adjustDirectory $ + FilePath.Windows.joinPath $ FilePath.Posix.splitDirectories prefix + ++ FilePath.Posix.splitDirectories name + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name + = FilePath.Windows.addTrailingPathSeparator + | otherwise = id + +-- | Convert a native 'FilePath' to a 'TarPath'. +-- +-- The conversion may fail if the 'FilePath' is too long. See 'TarPath' for a +-- description of the problem with splitting long 'FilePath's. +-- +toTarPath :: Bool -- ^ Is the path for a directory? This is needed because for + -- directories a 'TarPath' must always use a trailing @\/@. + -> FilePath -> Either String TarPath +toTarPath isDir = splitLongPath + . addTrailingSep + . FilePath.Posix.joinPath + . FilePath.Native.splitDirectories + where + addTrailingSep | isDir = FilePath.Posix.addTrailingPathSeparator + | otherwise = id + +-- | Take a sanitized path, split on directory separators and try to pack it +-- into the 155 + 100 tar file name format. +-- +-- The stragey is this: take the name-directory components in reverse order +-- and try to fit as many components into the 100 long name area as possible. +-- If all the remaining components fit in the 155 name area then we win. +-- +splitLongPath :: FilePath -> Either String TarPath +splitLongPath path = + case packName nameMax (reverse (FilePath.Posix.splitPath path)) of + Left err -> Left err + Right (name, []) -> Right (TarPath name "") + Right (name, first:rest) -> case packName prefixMax remainder of + Left err -> Left err + Right (_ , (_:_)) -> Left "File name too long (cannot split)" + Right (prefix, []) -> Right (TarPath name prefix) + where + -- drop the '/' between the name and prefix: + remainder = init first : rest + + where + nameMax, prefixMax :: Int + nameMax = 100 + prefixMax = 155 + + packName _ [] = Left "File name empty" + packName maxLen (c:cs) + | n > maxLen = Left "File name too long" + | otherwise = Right (packName' maxLen n [c] cs) + where n = length c + + packName' maxLen n ok (c:cs) + | n' <= maxLen = packName' maxLen n' (c:ok) cs + where n' = n + length c + packName' _ _ ok cs = (FilePath.Posix.joinPath ok, cs) + +-- | The tar format allows just 100 ASCII charcters for the 'SymbolicLink' and +-- 'HardLink' entry types. +-- +newtype LinkTarget = LinkTarget FilePath + deriving (Eq, Ord) + +-- | Convert a native 'FilePath' to a tar 'LinkTarget'. This may fail if the +-- string is longer than 100 characters or if it contains non-portable +-- characters. +-- +toLinkTarget :: FilePath -> Maybe LinkTarget +toLinkTarget path | length path <= 100 = Just (LinkTarget path) + | otherwise = Nothing + +-- | Convert a tar 'LinkTarget' to a native 'FilePath'. +-- +fromLinkTarget :: LinkTarget -> FilePath +fromLinkTarget (LinkTarget path) = adjustDirectory $ + FilePath.Native.joinPath $ FilePath.Posix.splitDirectories path + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator path + = FilePath.Native.addTrailingPathSeparator + | otherwise = id + +-- | Convert a tar 'LinkTarget' to a unix/posix 'FilePath'. +-- +fromLinkTargetToPosixPath :: LinkTarget -> FilePath +fromLinkTargetToPosixPath (LinkTarget path) = adjustDirectory $ + FilePath.Posix.joinPath $ FilePath.Posix.splitDirectories path + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator path + = FilePath.Native.addTrailingPathSeparator + | otherwise = id + +-- | Convert a tar 'LinkTarget' to a Windows 'FilePath'. +-- +fromLinkTargetToWindowsPath :: LinkTarget -> FilePath +fromLinkTargetToWindowsPath (LinkTarget path) = adjustDirectory $ + FilePath.Windows.joinPath $ FilePath.Posix.splitDirectories path + where + adjustDirectory | FilePath.Posix.hasTrailingPathSeparator path + = FilePath.Windows.addTrailingPathSeparator + | otherwise = id + +-- +-- * Entries type +-- + +-- | A tar archive is a sequence of entries. +-- +-- The point of this type as opposed to just using a list is that it makes the +-- failure case explicit. We need this because the sequence of entries we get +-- from reading a tarball can include errors. +-- +-- It is a concrete data type so you can manipulate it directly but it is often +-- clearer to use the provided functions for mapping, folding and unfolding. +-- +-- Converting from a list can be done with just @foldr Next Done@. Converting +-- back into a list can be done with 'foldEntries' however in that case you +-- must be prepared to handle the 'Fail' case inherent in the 'Entries' type. +-- +-- The 'Monoid' instance lets you concatenate archives or append entries to an +-- archive. +-- +data Entries = Next Entry Entries + | Done + | Fail String + +-- | This is like the standard 'unfoldr' function on lists, but for 'Entries'. +-- It includes failure as an extra posibility that the stepper function may +-- return. +-- +-- It can be used to generate 'Entries' from some other type. For example it is +-- used internally to lazily unfold entries from a 'ByteString'. +-- +unfoldEntries :: (a -> Either String (Maybe (Entry, a))) -> a -> Entries +unfoldEntries f = unfold + where + unfold x = case f x of + Left err -> Fail err + Right Nothing -> Done + Right (Just (e, x')) -> Next e (unfold x') + +-- | This is like the standard 'foldr' function on lists, but for 'Entries'. +-- Compared to 'foldr' it takes an extra function to account for the posibility +-- of failure. +-- +-- This is used to consume a sequence of entries. For example it could be used +-- to scan a tarball for problems or to collect an index of the contents. +-- +foldEntries :: (Entry -> a -> a) -> a -> (String -> a) -> Entries -> a +foldEntries next done fail' = fold + where + fold (Next e es) = next e (fold es) + fold Done = done + fold (Fail err) = fail' err + +-- | This is like the standard 'map' function on lists, but for 'Entries'. It +-- includes failure as a extra possible outcome of the mapping function. +-- +mapEntries :: (Entry -> Either String Entry) -> Entries -> Entries +mapEntries f = + foldEntries (\entry rest -> either Fail (flip Next rest) (f entry)) Done Fail + +instance Monoid Entries where + mempty = Done + mappend a b = foldEntries Next b Fail a diff --git a/Codec/Archive/Tar/Unpack.hs b/Codec/Archive/Tar/Unpack.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Unpack.hs @@ -0,0 +1,86 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Unpack ( + unpack, + ) where + +import Codec.Archive.Tar.Types +import Codec.Archive.Tar.Check + +import qualified Data.ByteString.Lazy as BS +import System.FilePath + ( () ) +import qualified System.FilePath as FilePath.Native + ( (), takeDirectory ) +import System.Directory + ( createDirectoryIfMissing, copyFile ) + +-- | Create local files and directories based on the entries of a tar archive. +-- +-- This is a portable implementation of unpacking suitable for portable +-- archives. It handles 'NormalFile' and 'Directory' entries and has simulated +-- support for 'SymbolicLink' and 'HardLink' entries. Links are implemented by +-- copying the target file. This therefore works on Windows as well as Unix. +-- All other entry types are ignored, that is they are not unpacked and no +-- exception is raised. +-- +-- If the 'Entries' ends in an error then it is raised an an IO error. Any +-- files or directories that have been upacked before the error was encountered +-- will not be deleted. For this reason you may want to unpack into an empty +-- directory so that you can easily clean up if unpacking fails part-way. +-- +-- On its own, this function only checks for security (using 'checkSecurity'). +-- You can do other checks by applying checking functions to the 'Entries' that +-- you pass to this function. For example: +-- +-- > unpack dir (checkTarbomb expectedDir entries) +-- +-- If you care about the priority of the reported errors then you may want to +-- use 'checkSecurity' before 'checkTarbomb' or other checks. +-- +unpack :: FilePath -> Entries -> IO () +unpack baseDir entries = unpackEntries [] (checkSecurity entries) + >>= emulateLinks + + where + unpackEntries _ (Fail err) = fail err + unpackEntries links Done = return links + unpackEntries links (Next entry es) = case entryContent entry of + NormalFile file _ -> extractFile path file + >> unpackEntries links es + Directory -> extractDir path + >> unpackEntries links es + HardLink link -> (unpackEntries $! saveLink path link links) es + SymbolicLink link -> (unpackEntries $! saveLink path link links) es + _ -> unpackEntries links es --ignore other file types + where + path = entryPath entry + + extractFile path content = do + createDirectoryIfMissing False absDir + BS.writeFile absPath content + where + absDir = baseDir FilePath.Native.takeDirectory path + absPath = baseDir path + + extractDir path = createDirectoryIfMissing False (baseDir path) + + saveLink path link links = seq (length path) + $ seq (length link') + $ (path, link'):links + where link' = fromLinkTarget link + + emulateLinks = mapM_ $ \(relPath, relLinkTarget) -> + let absPath = baseDir relPath + absTarget = FilePath.Native.takeDirectory absPath relLinkTarget + in copyFile absTarget absPath diff --git a/Codec/Archive/Tar/Util.hs b/Codec/Archive/Tar/Util.hs deleted file mode 100644 --- a/Codec/Archive/Tar/Util.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Codec.Archive.Tar.Util where - -import Control.Exception (Exception(..), catchJust, ioErrors) -import Control.Monad (liftM) -import Data.Bits (Bits, shiftL, (.|.)) -import System.IO (hPutStrLn, stderr) -import System.IO.Error (IOErrorType, ioeGetErrorType, mkIOError, - doesNotExistErrorType, illegalOperationErrorType) -import System.PosixCompat.Types (EpochTime) -import System.Time (ClockTime(..)) - --- * Functions - -fixEq :: Eq a => (a -> a) -> a -> a -fixEq f x = let x' = f x in if x' == x then x else fixEq f x' - --- * IO - -warn :: String -> IO () -warn = hPutStrLn stderr . ("tar: "++) - -warnIOError :: IO a -> IO () -warnIOError m = catchJust ioErrors (m >> return ()) (\e -> warn $ show e) - -doesNotExist :: String -> FilePath -> IO a -doesNotExist loc = ioError . mkIOError doesNotExistErrorType loc Nothing . Just - -illegalOperation :: String -> Maybe FilePath -> IO a -illegalOperation loc = ioError . mkIOError illegalOperationErrorType loc Nothing - -catchJustIOError :: (IOErrorType -> Bool) -> IO a -> (IOError -> IO a) -> IO a -catchJustIOError p = catchJust q - where q (IOException ioe) | p (ioeGetErrorType ioe) = Just ioe - q _ = Nothing - --- * Monads - -unfoldM :: Monad m => m (Maybe a) -> m [a] -unfoldM f = f >>= maybe (return []) (\x -> liftM (x:) (unfoldM f)) - --- * Bits - -boolsToBits :: Bits a => [Bool] -> a -boolsToBits = f 0 - where f x [] = x - f x (b:bs) = f (x `shiftL` 1 .|. if b then 1 else 0) bs - --- * File paths - -pathSep :: Char -pathSep = '/' -- FIXME: backslash on Windows - --- FIXME: not good enough. Use System.FilePath? -dirName :: FilePath -> FilePath -dirName p = if null d then "." else d - where d = reverse $ dropWhile (/=pathSep) $ reverse p - --- FIXME: make nicer, no IO -forceRelativePath :: FilePath -> IO FilePath -forceRelativePath p - | null d = return p - | otherwise = do warn $ "removing initial " ++ d ++" from path " ++ p - return p' - where p' = fixEq (removeDotDot . removeSep) p - d = take (length p - length p') p - removeDotDot ('.':'.':x) = x - removeDotDot x = x - removeSep (c:x) | c == pathSep = x - removeSep x = x - --- * Date and time - -epochTimeToSecs :: EpochTime -> Integer -epochTimeToSecs = round . toRational - -clockTimeToEpochTime :: ClockTime -> EpochTime -clockTimeToEpochTime (TOD s _) = fromInteger s diff --git a/Codec/Archive/Tar/Write.hs b/Codec/Archive/Tar/Write.hs --- a/Codec/Archive/Tar/Write.hs +++ b/Codec/Archive/Tar/Write.hs @@ -1,111 +1,133 @@ -module Codec.Archive.Tar.Write (writeTarArchive) where +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Archive.Tar.Write +-- Copyright : (c) 2007 Bjorn Bringert, +-- 2008 Andrea Vezzosi, +-- 2008-2009 Duncan Coutts +-- License : BSD3 +-- +-- Maintainer : duncan@haskell.org +-- Portability : portable +-- +----------------------------------------------------------------------------- +module Codec.Archive.Tar.Write (write) where import Codec.Archive.Tar.Types -import Codec.Archive.Tar.Util -import Data.Binary.Put +import Data.Char (ord) +import Data.List (foldl') +import Numeric (showOct) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as L -import Data.Char (ord) -import Numeric (showOct) +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import Data.ByteString.Lazy (ByteString) --- | Writes a TAR archive to a lazy ByteString. --- --- The archive is written in USTAR (POSIX.1-1988) format --- (tar with extended header information). -writeTarArchive :: TarArchive -> L.ByteString -writeTarArchive = runPut . putTarArchive -putTarArchive :: TarArchive -> Put -putTarArchive (TarArchive es) = - do mapM_ putTarEntry es - fill 512 '\0' - fill 512 '\0' - flush - -putTarEntry :: TarEntry -> Put -putTarEntry (TarEntry hdr cnt) = - do putTarHeader hdr - putContent cnt - flush +-- | Create the external representation of a tar archive by serialising a list +-- of tar entries. +-- +-- * The conversion is done lazily. +-- +write :: [Entry] -> ByteString +write es = BS.concat $ map putEntry es ++ [BS.replicate (512*2) 0] --- | Puts a lazy ByteString and nul-pads to a multiple of 512 bytes. -putContent :: L.ByteString -> Put -putContent = f 0 . L.toChunks - where f 0 [] = return () - f n [] = fill (512 - n) '\NUL' - f n (x:xs) = putByteString x >> f ((n+B.length x) `mod` 512) xs +putEntry :: Entry -> ByteString +putEntry entry = case entryContent entry of + NormalFile content size -> BS.concat [ header, content, padding size ] + OtherEntryType _ content size -> BS.concat [ header, content, padding size ] + _ -> header + where + header = putHeader entry + padding size = BS.replicate paddingSize 0 + where paddingSize = fromIntegral (negate size `mod` 512) -putTarHeader :: TarHeader -> Put -putTarHeader hdr = - do let block = B.concat $ L.toChunks $ runPut (putHeaderNoChkSum hdr) - chkSum = B.foldl' (\x y -> x + ord y) 0 block - putByteString $ B.take 148 block - putOct 8 chkSum - putByteString $ B.drop 156 block +putHeader :: Entry -> ByteString +putHeader entry = + BS.Char8.pack $ take 148 block + ++ putOct 7 checksum + ++ ' ' : drop 156 block +-- ++ putOct 8 checksum +-- ++ drop 156 block + where + block = putHeaderNoChkSum entry + checksum = foldl' (\x y -> x + ord y) 0 block -putHeaderNoChkSum :: TarHeader -> Put -putHeaderNoChkSum hdr = - do let (filePrefix, fileSuffix) = splitLongPath (tarFileName hdr) - putString 100 $ fileSuffix - putOct 8 $ tarFileMode hdr - putOct 8 $ tarOwnerID hdr - putOct 8 $ tarGroupID hdr - putOct 12 $ tarFileSize hdr - putOct 12 $ epochTimeToSecs $ tarModTime hdr - fill 8 $ ' ' -- dummy checksum - putTarFileType $ tarFileType hdr - putString 100 $ tarLinkTarget hdr -- FIXME: take suffix split at / if too long - putString 6 $ "ustar" - putString 2 $ "00" -- no nul byte - putString 32 $ tarOwnerName hdr - putString 32 $ tarGroupName hdr - putOct 8 $ tarDeviceMajor hdr - putOct 8 $ tarDeviceMinor hdr - putString 155 $ filePrefix - fill 12 $ '\NUL' +putHeaderNoChkSum :: Entry -> String +putHeaderNoChkSum Entry { + entryTarPath = TarPath name prefix, + entryContent = content, + entryPermissions = permissions, + entryOwnership = ownership, + entryTime = modTime, + entryFormat = format + } = -putTarFileType :: TarFileType -> Put -putTarFileType t = - putChar8 $ case t of - TarNormalFile -> '0' - TarHardLink -> '1' - TarSymbolicLink -> '2' - TarCharacterDevice -> '3' - TarBlockDevice -> '4' - TarDirectory -> '5' - TarFIFO -> '6' - TarOther c -> c + concat + [ putString 100 $ name + , putOct 8 $ permissions + , putOct 8 $ ownerId ownership + , putOct 8 $ groupId ownership + , putOct 12 $ contentSize + , putOct 12 $ modTime + , fill 8 $ ' ' -- dummy checksum + , putChar8 $ typeCode + , putString 100 $ linkTarget + ] ++ + case format of + V7Format -> + fill 255 '\NUL' + UstarFormat -> concat + [ putString 8 $ "ustar\NUL00" + , putString 32 $ ownerName ownership + , putString 32 $ groupName ownership + , putOct 8 $ deviceMajor + , putOct 8 $ deviceMinor + , putString 155 $ prefix + , fill 12 $ '\NUL' + ] + GnuFormat -> concat + [ putString 8 $ "ustar \NUL" + , putString 32 $ ownerName ownership + , putString 32 $ groupName ownership + , putGnuDev 8 $ deviceMajor + , putGnuDev 8 $ deviceMinor + , putString 155 $ prefix + , fill 12 $ '\NUL' + ] + where + (typeCode, contentSize, linkTarget, + deviceMajor, deviceMinor) = case content of + NormalFile _ size -> ('0' , size, [], 0, 0) + Directory -> ('5' , 0, [], 0, 0) + SymbolicLink (LinkTarget link) -> ('2' , 0, link, 0, 0) + HardLink (LinkTarget link) -> ('1' , 0, link, 0, 0) + CharacterDevice major minor -> ('3' , 0, [], major, minor) + BlockDevice major minor -> ('4' , 0, [], major, minor) + NamedPipe -> ('6' , 0, [], 0, 0) + OtherEntryType code _ size -> (code, size, [], 0, 0) -splitLongPath :: FilePath -> (String,String) -splitLongPath path = - let (x,y) = splitAt (length path - 101) path - -- 101 since we will always move a separator to the prefix - in if null x - then if null y then err "Empty path." else ("", y) - else case break (==pathSep) y of - (_,"") -> err "Can't split path." - (_,_:"") -> err "Can't split path." - (y1,s:y2) | length p > 155 || length y2 > 100 -> err "Can't split path." - | otherwise -> (p,y2) - where p = x ++ y1 ++ [s] - where err e = error $ show path ++ ": " ++ e + putGnuDev w n = case content of + CharacterDevice _ _ -> putOct w n + BlockDevice _ _ -> putOct w n + _ -> replicate w '\NUL' -- * TAR format primitive output -putString :: Int -> String -> Put -putString n s = do mapM_ putChar8 $ take n s - fill (n - length s) '\NUL' +type FieldWidth = Int -putOct :: Integral a => Int -> a -> Put -putOct n x = do let o = take (n-1) $ showOct x "" - fill (n - length o - 1) '0' - mapM_ putChar8 o - putChar8 '\NUL' +putString :: FieldWidth -> String -> String +putString n s = take n s ++ fill (n - length s) '\NUL' -putChar8 :: Char -> Put -putChar8 c = putWord8 $ fromIntegral $ ord c +--TODO: check integer widths, eg for large file sizes +putOct :: Integral a => FieldWidth -> a -> String +putOct n x = + let octStr = take (n-1) $ showOct x "" + in fill (n - length octStr - 1) '0' + ++ octStr + ++ putChar8 '\NUL' -fill :: Int -> Char -> Put -fill n c = putByteString $ B.replicate n c +putChar8 :: Char -> String +putChar8 c = [c] + +fill :: FieldWidth -> Char -> String +fill n c = replicate n c diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ Copyright (c) 2007, Björn Bringert + 2008-2009 Duncan Coutts All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/tar.cabal b/tar.cabal --- a/tar.cabal +++ b/tar.cabal @@ -1,41 +1,43 @@ -Name: tar -Version: 0.1.1.3 -License: BSD3 -License-File: LICENSE -Author: Bjorn Bringert -Maintainer: Bjorn Bringert -Copyright: 2007 Bjorn Bringert -Stability: Experimental -Synopsis: TAR (tape archive format) library. -Description: - This is a library for reading and writing TAR archives. -Build-type: Simple -Cabal-version: >=1.2 +name: tar +version: 0.3.0.0 +license: BSD3 +license-File: LICENSE +author: Bjorn Bringert + Duncan Coutts +maintainer: Duncan Coutts +copyright: 2007 Bjorn Bringert + 2008-2009 Duncan Coutts +category: Codec +synopsis: Reading, writing and manipulating ".tar" archive files. +description: This library is for working with \"@.tar@\" archive files. It + can read and write a range of common variations of archive + format including V7, USTAR, POSIX and GNU formats. It provides + support for packing and unpacking portable archives. This + makes it suitable for distribution but not backup because + details like file ownership and exact permissions are not + preserved. +build-type: Simple +cabal-version: >=1.2 -Flag bytestring-in-base -Flag split-base +flag base3 -Library - if flag(bytestring-in-base) - -- bytestring was in base-2.0 and 2.1.1 - Build-depends: base >= 2.0 && < 2.2 +library + build-depends: base >= 2 && < 5, filepath + if flag(base3) + build-depends: base >= 3, directory, old-time, bytestring else - -- in base 1.0 and 3.0 bytestring is a separate package - Build-depends: base < 2.0 || == 3.*, bytestring >= 0.9 + build-depends: base < 3 - if flag(split-base) - Build-depends: base == 3.*, directory, old-time - else - Build-depends: base < 3.0 + exposed-modules: + Codec.Archive.Tar + Codec.Archive.Tar.Entry + Codec.Archive.Tar.Check - Build-depends: binary >= 0.2, unix-compat >= 0.1.2 + other-modules: + Codec.Archive.Tar.Types + Codec.Archive.Tar.Read + Codec.Archive.Tar.Write + Codec.Archive.Tar.Pack + Codec.Archive.Tar.Unpack - Exposed-modules: Codec.Archive.Tar - Other-modules: - Codec.Archive.Tar.Create, - Codec.Archive.Tar.Extract, - Codec.Archive.Tar.Read, - Codec.Archive.Tar.Types, - Codec.Archive.Tar.Util, - Codec.Archive.Tar.Write - GHC-Options: -Wall + ghc-options: -Wall -fno-warn-unused-imports