tar 0.3.2.0 → 0.4.0.0
raw patch · 7 files changed
+262/−78 lines, 7 files
Files
- Codec/Archive/Tar.hs +30/−14
- Codec/Archive/Tar/Check.hs +138/−31
- Codec/Archive/Tar/Read.hs +63/−18
- Codec/Archive/Tar/Types.hs +18/−8
- Codec/Archive/Tar/Unpack.hs +5/−3
- LICENSE +3/−2
- tar.cabal +5/−2
Codec/Archive/Tar.hs view
@@ -3,7 +3,7 @@ -- Module : Codec.Archive.Tar -- Copyright : (c) 2007 Bjorn Bringert, -- 2008 Andrea Vezzosi,--- 2008-2009 Duncan Coutts+-- 2008-2012 Duncan Coutts -- License : BSD3 -- -- Maintainer : duncan@community.haskell.org@@ -54,7 +54,8 @@ -- \"@.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".+ -- @Codec.Compression.GZip@ or @Codec.Compression.BZip@+ -- (see @zlib@ or @bzlib@ packages). -- -- Creating a compressed \"@.tar.gz@\" file is just a minor variation on the -- 'create' function, but where throw compression into the pipeline:@@ -67,17 +68,6 @@ -- > Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar -- - -- ** 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@.- -- ** Security -- | This is pretty important. A maliciously constructed tar archives could -- contain entries that specify bad file names. It could specify absolute@@ -90,6 +80,17 @@ -- 'checkSecurity' function for more details. If you need to do any custom -- unpacking then you should use this. + -- ** 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@.+ -- * 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.@@ -119,9 +120,23 @@ -- ** Sequences of tar entries Entries(..), mapEntries,+ mapEntriesNoFail, foldEntries, unfoldEntries, + -- * Error handling+ -- | Reading tar files can fail if the data does not match the tar file+ -- format correctly.+ --+ -- The style of error handling by returning structured errors. The pure+ -- functions in the library do not throw exceptions, they return the errors+ -- as data. The IO actions in the library can throw exceptions, in particular+ -- the 'unpack' action does this. All the error types used are an instance of+ -- the standard 'Exception' class so it is possible to 'throw' and 'catch'+ -- them.++ -- ** Errors from reading tar files+ FormatError(..), ) where import Codec.Archive.Tar.Types@@ -132,8 +147,9 @@ import Codec.Archive.Tar.Pack import Codec.Archive.Tar.Unpack -import Codec.Archive.Tar.Check ()+import Codec.Archive.Tar.Check +import Control.Exception (Exception, throw, catch) import qualified Data.ByteString.Lazy as BS import Prelude hiding (read)
Codec/Archive/Tar/Check.hs view
@@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar--- Copyright : (c) 2008-2009 Duncan Coutts+-- Copyright : (c) 2008-2012 Duncan Coutts+-- 2011 Max Bolingbroke -- License : BSD3 -- -- Maintainer : duncan@community.haskell.org@@ -11,13 +12,25 @@ -- ----------------------------------------------------------------------------- module Codec.Archive.Tar.Check (++ -- * Security checkSecurity,+ FileNameError(..),++ -- * Tarbombs checkTarbomb,+ TarBombError(..),++ -- * Portability checkPortability,+ PortabilityError(..),+ PortabilityPlatform, ) where import Codec.Archive.Tar.Types +import Data.Typeable (Typeable)+import Control.Exception (Exception) import Control.Monad (MonadPlus(mplus)) import qualified System.FilePath as FilePath.Native ( splitDirectories, isAbsolute, isValid )@@ -25,6 +38,11 @@ import qualified System.FilePath.Windows as FilePath.Windows import qualified System.FilePath.Posix as FilePath.Posix ++--------------------------+-- Security+--+ -- | This function checks a sequence of tar entries for file name security -- problems. It checks that: --@@ -40,17 +58,10 @@ -- link target. A failure in any entry terminates the sequence of entries with -- an error. ---checkSecurity :: Entries -> Entries+checkSecurity :: Entries e -> Entries (Either e FileNameError) checkSecurity = checkEntries checkEntrySecurity -checkTarbomb :: FilePath -> Entries -> Entries-checkTarbomb expectedTopDir = checkEntries (checkEntryTarbomb expectedTopDir)--checkPortability :: Entries -> Entries-checkPortability = checkEntries checkEntryPortability---checkEntrySecurity :: Entry -> Maybe String+checkEntrySecurity :: Entry -> Maybe FileNameError checkEntrySecurity entry = case entryContent entry of HardLink link -> check (entryPath entry) `mplus` check (fromLinkTarget link)@@ -61,51 +72,119 @@ where check name | FilePath.Native.isAbsolute name- = Just $ "Absolute file name in tar archive: " ++ show name+ = Just $ AbsoluteFileName name | not (FilePath.Native.isValid name)- = Just $ "Invalid file name in tar archive: " ++ show name+ = Just $ InvalidFileName name | any (=="..") (FilePath.Native.splitDirectories name)- = Just $ "Invalid file name in tar archive: " ++ show name+ = Just $ InvalidFileName name | otherwise = Nothing -checkEntryTarbomb :: FilePath -> Entry -> Maybe String+-- | Errors arising from tar file names being in some way invalid or dangerous+data FileNameError+ = InvalidFileName FilePath+ | AbsoluteFileName FilePath+ deriving (Typeable)++instance Show FileNameError where+ show = showFileNameError Nothing++instance Exception FileNameError++showFileNameError :: Maybe PortabilityPlatform -> FileNameError -> String+showFileNameError mb_plat err = case err of+ InvalidFileName path -> "Invalid" ++ plat ++ " file name in tar archive: " ++ show path+ AbsoluteFileName path -> "Absolute" ++ plat ++ " file name in tar archive: " ++ show path+ where plat = maybe "" (' ':) mb_plat+++--------------------------+-- Tarbombs+--++-- | This function checks a sequence of tar entries for being a \"tar bomb\".+-- This means that the tar file does not follow the standard convention that+-- all entries are within a single subdirectory, e.g. a file \"foo.tar\" would+-- usually have all entries within the \"foo/\" subdirectory.+--+-- Given the expected subdirectory, this function checks all entries are within+-- that subdirectroy.+--+-- Note: This check must be used in conjunction with 'checkSecurity'.+--+checkTarbomb :: FilePath -> Entries e -> Entries (Either e TarBombError)+checkTarbomb expectedTopDir = checkEntries (checkEntryTarbomb expectedTopDir)++checkEntryTarbomb :: FilePath -> Entry -> Maybe TarBombError 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+ _ -> Just $ TarBombError expectedTopDir -checkEntryPortability :: Entry -> Maybe String-checkEntryPortability entry- | entryFormat entry == V7Format- = Just "Archive is in the old Unix V7 tar format"+-- | An error that occurs if a tar file is a \"tar bomb\" that would extract+-- files outside of the intended directory.+data TarBombError = TarBombError FilePath+ deriving (Typeable) - | entryFormat entry == GnuFormat- = Just "Archive is in the GNU tar format"+instance Exception TarBombError +instance Show TarBombError where+ show (TarBombError expectedTopDir)+ = "File in tar archive is not in the expected directory " ++ show expectedTopDir+++--------------------------+-- Portability+--++-- | This function checks a sequence of tar entries for a number of portability+-- issues. It will complain if:+--+-- * The old \"Unix V7\" or \"gnu\" formats are used. For maximum portability+-- only the POSIX standard \"ustar\" format should be used.+--+-- * A non-portable entry type is used. Only ordinary files, hard links,+-- symlinks and directories are portable. Device files, pipes and others are+-- not portable between all common operating systems.+--+-- * Non-ASCII characters are used in file names. There is no agreed portable+-- convention for Unicode or other extended character sets in file names in+-- tar archives.+--+-- * File names that would not be portable to both Unix and Windows. This check+-- includes characters that are valid in both systems and the \'/\' vs \'\\\'+-- directory separator conventions.+--+checkPortability :: Entries e -> Entries (Either e PortabilityError)+checkPortability = checkEntries checkEntryPortability++checkEntryPortability :: Entry -> Maybe PortabilityError+checkEntryPortability entry+ | entryFormat entry `elem` [V7Format, GnuFormat]+ = Just $ NonPortableFormat (entryFormat entry)+ | not (portableFileType (entryContent entry))- = Just "Non-portable file type in archive"+ = Just NonPortableFileType | not (all portableChar posixPath)- = Just $ "Non-portable character in archive entry name: " ++ show posixPath+ = Just $ NonPortableEntryNameChar posixPath | not (FilePath.Posix.isValid posixPath)- = Just $ "Invalid unix file name in tar archive: " ++ show posixPath+ = Just $ NonPortableFileName "unix" (InvalidFileName posixPath) | not (FilePath.Windows.isValid windowsPath)- = Just $ "Invalid windows file name in tar archive: " ++ show windowsPath+ = Just $ NonPortableFileName "windows" (InvalidFileName windowsPath) | FilePath.Posix.isAbsolute posixPath- = Just $ "Absolute unix file name in tar archive: " ++ show posixPath+ = Just $ NonPortableFileName "unix" (AbsoluteFileName posixPath) | FilePath.Windows.isAbsolute windowsPath- = Just $ "Absolute windows file name in tar archive: " ++ show windowsPath+ = Just $ NonPortableFileName "windows" (AbsoluteFileName windowsPath) | any (=="..") (FilePath.Posix.splitDirectories posixPath)- = Just $ "Invalid unix file name in tar archive: " ++ show posixPath+ = Just $ NonPortableFileName "unix" (InvalidFileName posixPath) | any (=="..") (FilePath.Windows.splitDirectories windowsPath)- = Just $ "Invalid windows file name in tar archive: " ++ show windowsPath+ = Just $ NonPortableFileName "windows" (InvalidFileName windowsPath) | otherwise = Nothing @@ -122,7 +201,35 @@ portableChar c = c <= '\127' +-- | Potential portability issues in a tar archive+data PortabilityError+ = NonPortableFormat Format+ | NonPortableFileType+ | NonPortableEntryNameChar FilePath+ | NonPortableFileName PortabilityPlatform FileNameError+ deriving (Typeable) -checkEntries :: (Entry -> Maybe String) -> Entries -> Entries+-- | The name of a platform that portability issues arise from+type PortabilityPlatform = String++instance Exception PortabilityError++instance Show PortabilityError where+ show (NonPortableFormat format) = "Archive is in the " ++ fmt ++ " format"+ where fmt = case format of V7Format -> "old Unix V7 tar"+ UstarFormat -> "ustar" -- I never generate this but a user might+ GnuFormat -> "GNU tar"+ show NonPortableFileType = "Non-portable file type in archive"+ show (NonPortableEntryNameChar posixPath)+ = "Non-portable character in archive entry name: " ++ show posixPath+ show (NonPortableFileName platform err)+ = showFileNameError (Just platform) err+++--------------------------+-- Utils+--++checkEntries :: (Entry -> Maybe e') -> Entries e -> Entries (Either e e') checkEntries checkEntry = mapEntries (\entry -> maybe (Right entry) Left (checkEntry entry))
Codec/Archive/Tar/Read.hs view
@@ -3,20 +3,23 @@ -- Module : Codec.Archive.Tar.Read -- Copyright : (c) 2007 Bjorn Bringert, -- 2008 Andrea Vezzosi,--- 2008-2009 Duncan Coutts+-- 2008-2009 Duncan Coutts,+-- 2011 Max Bolingbroke -- License : BSD3 -- -- Maintainer : duncan@community.haskell.org -- Portability : portable -- ------------------------------------------------------------------------------module Codec.Archive.Tar.Read (read) where+module Codec.Archive.Tar.Read (read, FormatError(..)) where import Codec.Archive.Tar.Types import Data.Char (ord) import Data.Int (Int64) import Numeric (readOct)+import Control.Exception (Exception)+import Data.Typeable (Typeable) import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8@@ -24,35 +27,61 @@ import Prelude hiding (read) ++-- | Errors that can be encountered when parsing a Tar archive.+data FormatError+ = TruncatedArchive+ | ShortTrailer+ | BadTrailer+ | TrailingJunk+ | ChecksumIncorrect+ | NotTarFormat+ | UnrecognisedTarFormat+ | HeaderBadNumericEncoding+ deriving (Typeable)++instance Show FormatError where+ show TruncatedArchive = "truncated tar archive"+ show ShortTrailer = "short tar trailer"+ show BadTrailer = "bad tar trailer"+ show TrailingJunk = "tar file has trailing junk"+ show ChecksumIncorrect = "tar checksum error"+ show NotTarFormat = "data is not in tar format"+ show UnrecognisedTarFormat = "tar entry not in a recognised format"+ show HeaderBadNumericEncoding = "tar header is malformed (bad numeric encoding)"++instance Exception FormatError++ -- | 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 :: ByteString -> Entries FormatError read = unfoldEntries getEntry -getEntry :: ByteString -> Either String (Maybe (Entry, ByteString))+getEntry :: ByteString -> Either FormatError (Maybe (Entry, ByteString)) getEntry bs- | BS.length header < 512 = Left "truncated tar archive"+ | BS.length header < 512 = Left TruncatedArchive -- 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"+ | BS.length end /= 1024 -> Left ShortTrailer+ | not (BS.all (== 0) end) -> Left BadTrailer+ | not (BS.all (== 0) trailing) -> Left TrailingJunk | otherwise -> Right Nothing | otherwise = partial $ do case (chksum_, format_) of (Ok chksum, _ ) | correctChecksum header chksum -> return ()- (Ok _, Ok _) -> fail "tar checksum error"- _ -> fail "data is not in tar format"+ (Ok _, Ok _) -> Error ChecksumIncorrect+ _ -> Error NotTarFormat -- These fields are partial, have to check them format <- format_; mode <- mode_;@@ -109,7 +138,7 @@ "\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"+ _ -> Error UnrecognisedTarFormat correctChecksum :: ByteString -> Int -> Bool correctChecksum header checksum = checksum == checksum'@@ -124,7 +153,7 @@ -- * TAR format primitive input -getOct :: Integral a => Int64 -> Int64 -> ByteString -> Partial a+getOct :: Integral a => Int64 -> Int64 -> ByteString -> Partial FormatError a getOct off len = parseOct . BS.Char8.unpack . BS.Char8.takeWhile (\c -> c /= '\NUL' && c /= ' ')@@ -132,11 +161,27 @@ . getBytes off len where parseOct "" = return 0- parseOct ('\128':_) = fail "tar header uses non-standard number encoding"+ -- As a star extension, octal fields can hold a base-256 value if the high+ -- bit of the initial character is set. The initial character can be:+ -- 0x80 ==> trailing characters hold a positive base-256 value+ -- 0xFF ==> trailing characters hold a negative base-256 value+ --+ -- In both cases, there won't be a trailing NUL/space.+ --+ -- GNU tar seems to contain a half-implementation of code that deals with+ -- extra bits in the first character, but I don't think it works and the+ -- docs I can find on star seem to suggest that these will always be 0,+ -- which is what I will assume.+ parseOct ('\128':xs) = return (readBytes xs)+ parseOct ('\255':xs) = return (negate (readBytes xs)) parseOct s = case readOct s of [(x,[])] -> return x- _ -> fail "tar header is malformed (bad numeric encoding)"+ _ -> Error HeaderBadNumericEncoding + readBytes = go 0+ where go acc [] = acc+ go acc (x:xs) = go (acc * 256 + fromIntegral (ord x)) xs+ getBytes :: Int64 -> Int64 -> ByteString -> ByteString getBytes off len = BS.take len . BS.drop off @@ -149,14 +194,14 @@ 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+data Partial e a = Error e | Ok a -partial :: Partial a -> Either String a+partial :: Partial e a -> Either e a partial (Error msg) = Left msg partial (Ok x) = Right x -instance Monad Partial where+instance Monad (Partial e) where return = Ok Error m >>= _ = Error m Ok x >>= k = k x- fail = Error+ fail = error "fail @(Partial e)"
Codec/Archive/Tar/Types.hs view
@@ -4,6 +4,7 @@ -- Copyright : (c) 2007 Bjorn Bringert, -- 2008 Andrea Vezzosi, -- 2008-2009 Duncan Coutts+-- 2011 Max Bolingbroke -- License : BSD3 -- -- Maintainer : duncan@community.haskell.org@@ -48,6 +49,7 @@ Entries(..), mapEntries,+ mapEntriesNoFail, foldEntries, unfoldEntries, @@ -410,9 +412,9 @@ -- The 'Monoid' instance lets you concatenate archives or append entries to an -- archive. ---data Entries = Next Entry Entries- | Done- | Fail String+data Entries e = Next Entry (Entries e)+ | Done+ | Fail e -- | This is like the standard 'unfoldr' function on lists, but for 'Entries'. -- It includes failure as an extra possibility that the stepper function may@@ -421,7 +423,7 @@ -- 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 :: (a -> Either e (Maybe (Entry, a))) -> a -> Entries e unfoldEntries f = unfold where unfold x = case f x of@@ -436,7 +438,7 @@ -- 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 :: (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a foldEntries next done fail' = fold where fold (Next e es) = next e (fold es)@@ -446,10 +448,18 @@ -- | 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+-- If your mapping function cannot fail it may be more convenient to use+-- 'mapEntriesNoFail'+mapEntries :: (Entry -> Either e' Entry) -> Entries e -> Entries (Either e e') mapEntries f =- foldEntries (\entry rest -> either Fail (flip Next rest) (f entry)) Done Fail+ foldEntries (\entry rest -> either (Fail . Right) (flip Next rest) (f entry)) Done (Fail . Left) -instance Monoid Entries where+-- | Like 'mapEntries' but the mapping function itself cannot fail.+--+mapEntriesNoFail :: (Entry -> Entry) -> Entries e -> Entries e+mapEntriesNoFail f =+ foldEntries (\entry -> Next (f entry)) Done Fail++instance Monoid (Entries e) where mempty = Done mappend a b = foldEntries Next b Fail a
Codec/Archive/Tar/Unpack.hs view
@@ -24,6 +24,8 @@ ( takeDirectory ) import System.Directory ( createDirectoryIfMissing, copyFile )+import Control.Exception+ ( Exception, throwIO ) -- | Create local files and directories based on the entries of a tar archive. --@@ -34,7 +36,7 @@ -- 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+-- If the 'Entries' ends in an error then it is raised an an exception. Any -- files or directories that have been unpacked 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@@ -49,7 +51,7 @@ -- 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 :: Exception e => FilePath -> Entries e -> IO () unpack baseDir entries = unpackEntries [] (checkSecurity entries) >>= emulateLinks @@ -57,7 +59,7 @@ -- We're relying here on 'checkSecurity' to make sure we're not scribbling -- files all over the place. - unpackEntries _ (Fail err) = fail err+ unpackEntries _ (Fail err) = either throwIO throwIO err unpackEntries links Done = return links unpackEntries links (Next entry es) = case entryContent entry of NormalFile file _ -> extractFile path file
LICENSE view
@@ -1,5 +1,6 @@-Copyright (c) 2007, Björn Bringert- 2008-2009 Duncan Coutts+Copyright (c) 2007 Björn Bringert,+ 2008-2012 Duncan Coutts,+ 2011 Max Bolingbroke All rights reserved. Redistribution and use in source and binary forms, with or without
tar.cabal view
@@ -1,5 +1,5 @@ name: tar-version: 0.3.2.0+version: 0.4.0.0 license: BSD3 license-file: LICENSE author: Bjorn Bringert <bjorn@bringert.net>@@ -39,4 +39,7 @@ Codec.Archive.Tar.Pack Codec.Archive.Tar.Unpack - ghc-options: -Wall+ extensions:+ DeriveDataTypeable++ ghc-options: -Wall -fno-warn-unused-imports