packages feed

tar 0.1.1.3 → 0.3.0.0

raw patch · 13 files changed

+1407/−656 lines, 13 filesdep +filepathdep −binarydep −unix-compatdep ~basedep ~bytestringdep ~directory

Dependencies added: filepath

Dependencies removed: binary, unix-compat

Dependency ranges changed: base, bytestring, directory

Files

Codec/Archive/Tar.hs view
@@ -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
+ Codec/Archive/Tar/Check.hs view
@@ -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))
− Codec/Archive/Tar/Create.hs
@@ -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
+ Codec/Archive/Tar/Entry.hs view
@@ -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
− Codec/Archive/Tar/Extract.hs
@@ -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)
+ Codec/Archive/Tar/Pack.hs view
@@ -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
Codec/Archive/Tar/Read.hs view
@@ -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
Codec/Archive/Tar/Types.hs view
@@ -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
+ Codec/Archive/Tar/Unpack.hs view
@@ -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
− Codec/Archive/Tar/Util.hs
@@ -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
Codec/Archive/Tar/Write.hs view
@@ -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
LICENSE view
@@ -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 
tar.cabal view
@@ -1,41 +1,43 @@-Name: tar-Version: 0.1.1.3-License: BSD3-License-File: LICENSE-Author: Bjorn Bringert <bjorn@bringert.net>-Maintainer: Bjorn Bringert <bjorn@bringert.net>-Copyright: 2007 Bjorn Bringert <bjorn@bringert.net>-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 <bjorn@bringert.net>+                 Duncan Coutts <duncan@haskell.org>+maintainer:      Duncan Coutts <duncan@haskell.org>+copyright:       2007 Bjorn Bringert <bjorn@bringert.net>+                 2008-2009 Duncan Coutts <duncan@haskell.org>+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