diff --git a/Codec/Archive/Tar.hs b/Codec/Archive/Tar.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar.hs @@ -0,0 +1,89 @@ +-- | This is a library for reading and writing TAR archives. +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 + +import Control.Monad (liftM) +import qualified Data.ByteString.Lazy.Char8 as L +import Data.ByteString.Lazy (ByteString) +import System.IO + + +-- | 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 + +-- | 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 + +-- | 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 + + +-- | 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 + + +-- | 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 + +-- | 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 + + diff --git a/Codec/Archive/Tar/Create.hs b/Codec/Archive/Tar/Create.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Create.hs @@ -0,0 +1,131 @@ +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 System.PosixCompat.User + +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/Extract.hs b/Codec/Archive/Tar/Extract.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Extract.hs @@ -0,0 +1,66 @@ +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.Posix.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/Read.hs b/Codec/Archive/Tar/Read.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Read.hs @@ -0,0 +1,135 @@ +module Codec.Archive.Tar.Read (readTarArchive) where + +import Codec.Archive.Tar.Types +import Codec.Archive.Tar.Util + +import Data.Binary.Get + +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) + +-- | Reads a TAR archive from a lazy ByteString. +readTarArchive :: L.ByteString -> TarArchive +readTarArchive = runGet getTarArchive + +getTarArchive :: Get TarArchive +getTarArchive = liftM TarArchive $ unfoldM getTarEntry + +-- | 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 + +-- | 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 + +hasContent :: TarHeader -> Bool +hasContent hdr = case tarFileType hdr of + TarNormalFile -> True + TarOther _ -> True + _ -> False + +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." + +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 + +ordSigned :: Char -> Int +ordSigned c = fromIntegral (fromIntegral (ord c) :: Int8) + +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) + +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 + +-- * 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 + +getString :: Int -> Get String +getString n = liftM (takeWhile (/='\NUL') . B.unpack) $ getBytes n + +getChar8 :: Get Char +getChar8 = fmap (chr . fromIntegral) getWord8 diff --git a/Codec/Archive/Tar/Types.hs b/Codec/Archive/Tar/Types.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Types.hs @@ -0,0 +1,69 @@ +module Codec.Archive.Tar.Types where + +import Data.ByteString.Lazy (ByteString) +import Data.Int (Int64) +import System.Posix.Types (FileMode, UserID, GroupID, EpochTime) +import System.PosixCompat.Extensions (CMajor, CMinor) + +-- | A TAR archive. +newtype TarArchive = TarArchive { archiveEntries :: [TarEntry] } + deriving Show + +-- | 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 + +-- | 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 types. +data TarFileType = + TarNormalFile + | TarHardLink + | TarSymbolicLink + | TarCharacterDevice + | TarBlockDevice + | TarDirectory + | TarFIFO + | TarOther Char + deriving (Eq,Show) diff --git a/Codec/Archive/Tar/Util.hs b/Codec/Archive/Tar/Util.hs new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Util.hs @@ -0,0 +1,77 @@ +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.Posix.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 new file mode 100644 --- /dev/null +++ b/Codec/Archive/Tar/Write.hs @@ -0,0 +1,111 @@ +module Codec.Archive.Tar.Write (writeTarArchive) where + +import Codec.Archive.Tar.Types +import Codec.Archive.Tar.Util + +import Data.Binary.Put + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as L +import Data.Char (ord) +import Numeric (showOct) + +-- | 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 + +-- | 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 + +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 + +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' + +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 + +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 + +-- * TAR format primitive output + +putString :: Int -> String -> Put +putString n s = do mapM_ putChar8 $ take n s + fill (n - length s) '\NUL' + +putOct :: Integral a => Int -> a -> Put +putOct n x = do let o = take n $ showOct x "" + fill (n - length o - 1) '0' + mapM_ putChar8 o + putChar8 '\NUL' + +putChar8 :: Char -> Put +putChar8 c = putWord8 $ fromIntegral $ ord c + +fill :: Int -> Char -> Put +fill n c = putByteString $ B.replicate n c diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2007, Björn Bringert +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +- Neither the names of the copyright owners nor the names of the + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,26 @@ +> import Distribution.PackageDescription (PackageDescription(buildDepends)) +> import Distribution.Setup (ConfigFlags) +> import Distribution.Simple (UserHooks(confHook), +> defaultMainWithHooks, defaultUserHooks, +> Dependency(..), VersionRange(..)) +> import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) +> import qualified System.Info (os) + +> main :: IO () +> main = defaultMainWithHooks myHooks + +> myHooks :: UserHooks +> myHooks = addOptionalUnixDependencyHook defaultUserHooks + +> addOptionalUnixDependencyHook :: UserHooks -> UserHooks +> addOptionalUnixDependencyHook hooks = +> hooks { confHook = confHook hooks . addOptionalUnixDependency } + +> addOptionalUnixDependency :: PackageDescription -> PackageDescription +> addOptionalUnixDependency desc = +> case System.Info.os of +> "mingw32" -> desc +> _ -> addDependency (Dependency "unix" AnyVersion) desc + +> addDependency :: Dependency -> PackageDescription -> PackageDescription +> addDependency dep desc = desc { buildDepends = dep : buildDepends desc} diff --git a/tar.cabal b/tar.cabal new file mode 100644 --- /dev/null +++ b/tar.cabal @@ -0,0 +1,21 @@ +Name: tar +Version: 0.1 +License: BSD4 +License-File: LICENSE +Author: Bjorn Bringert +Maintainer: Bjorn Bringert +Copyright: 2007 Bjorn Bringert +Stability: Experimental +Build-depends: base >= 2.0, binary >= 0.2, unix-compat >= 0.1 +Synopsis: TAR (tape archive format) library. +Description: + This is a library for reading and writing TAR archives. +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: -O -Wall