diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -16,7 +16,6 @@ import System.Directory import System.Console.GetOpt import Control.Monad ( when ) -import Control.Applicative ( (<$>) ) import Data.Version ( showVersion ) import Paths_zip_archive ( version ) import Debug.Trace ( traceShowId ) @@ -70,7 +69,9 @@ let cmd = case filter (`notElem` [Quiet, Help, Version, Debug]) opts of [] -> Recursive (x:_) -> x - let (archivePath : files) = args + (archivePath : files) <- case args of + [] -> quit True "No archive path given" + _ -> return args exists <- doesFileExist archivePath archive <- if exists then toArchive <$> B.readFile archivePath diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,12 @@ +zip-archive 0.4.3 + + * Improve code for retrieving compressed data of unknown length (#63). + Do not assume we'll have the signature 0x08074b50 that is + sometimes used for the data description, because it is not + in the spec and is not always used. + * Make some record fields strict. + * Require binary >= 0.7.2, remove some CPP + zip-archive 0.4.2.2 * Use `command -v` before trying `which` in the test suite (#62). diff --git a/src/Codec/Archive/Zip.hs b/src/Codec/Archive/Zip.hs --- a/src/Codec/Archive/Zip.hs +++ b/src/Codec/Archive/Zip.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} ------------------------------------------------------------------------ @@ -100,6 +101,8 @@ import Data.Maybe (fromJust) #endif +import GHC.Int (Int64) + -- from bytestring import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as B @@ -131,7 +134,7 @@ data Archive = Archive { zEntries :: [Entry] -- ^ Files in zip archive , zSignature :: Maybe B.ByteString -- ^ Digital signature - , zComment :: B.ByteString -- ^ Comment for whole zip archive + , zComment :: !B.ByteString -- ^ Comment for whole zip archive } deriving (Read, Show) instance Binary Archive where @@ -141,18 +144,18 @@ -- | Representation of an archived file, including content and metadata. data Entry = Entry { eRelativePath :: FilePath -- ^ Relative path, using '/' as separator - , eCompressionMethod :: CompressionMethod -- ^ Compression method - , eEncryptionMethod :: EncryptionMethod -- ^ Encryption method - , eLastModified :: Integer -- ^ Modification time (seconds since unix epoch) - , eCRC32 :: Word32 -- ^ CRC32 checksum - , eCompressedSize :: Word32 -- ^ Compressed size in bytes - , eUncompressedSize :: Word32 -- ^ Uncompressed size in bytes - , eExtraField :: B.ByteString -- ^ Extra field - unused by this library - , eFileComment :: B.ByteString -- ^ File comment - unused by this library - , eVersionMadeBy :: Word16 -- ^ Version made by field - , eInternalFileAttributes :: Word16 -- ^ Internal file attributes - unused by this library - , eExternalFileAttributes :: Word32 -- ^ External file attributes (system-dependent) - , eCompressedData :: B.ByteString -- ^ Compressed contents of file + , eCompressionMethod :: !CompressionMethod -- ^ Compression method + , eEncryptionMethod :: !EncryptionMethod -- ^ Encryption method + , eLastModified :: !Integer -- ^ Modification time (seconds since unix epoch) + , eCRC32 :: !Word32 -- ^ CRC32 checksum + , eCompressedSize :: !Word32 -- ^ Compressed size in bytes + , eUncompressedSize :: !Word32 -- ^ Uncompressed size in bytes + , eExtraField :: !B.ByteString -- ^ Extra field - unused by this library + , eFileComment :: !B.ByteString -- ^ File comment - unused by this library + , eVersionMadeBy :: !Word16 -- ^ Version made by field + , eInternalFileAttributes :: !Word16 -- ^ Internal file attributes - unused by this library + , eExternalFileAttributes :: !Word32 -- ^ External file attributes (system-dependent) + , eCompressedData :: !B.ByteString -- ^ Compressed contents of file } deriving (Read, Show, Eq) -- | Compression methods. @@ -160,8 +163,8 @@ | NoCompression deriving (Read, Show, Eq) -data EncryptionMethod = NoEncryption -- ^ Entry is not encrypted - | PKWAREEncryption Word8 -- ^ Entry is encrypted with the traditional PKWARE encryption +data EncryptionMethod = NoEncryption -- ^ Entry is not encrypted + | PKWAREEncryption !Word8 -- ^ Entry is encrypted with the traditional PKWARE encryption deriving (Read, Show, Eq) -- | The way the password should be verified during entry decryption @@ -173,7 +176,7 @@ data ZipOption = OptRecursive -- ^ Recurse into directories when adding files | OptVerbose -- ^ Print information to stderr | OptDestination FilePath -- ^ Directory in which to extract - | OptLocation FilePath Bool -- ^ Where to place file when adding files and whether to append current path + | OptLocation FilePath !Bool -- ^ Where to place file when adding files and whether to append current path | OptPreserveSymbolicLinks -- ^ Preserve symbolic links as such. This option is ignored on Windows. deriving (Read, Show, Eq) @@ -202,13 +205,9 @@ -- With earlier versions, it will always return a Right value, -- raising an error if parsing fails. toArchiveOrFail :: B.ByteString -> Either String Archive -#if MIN_VERSION_binary(0,7,0) toArchiveOrFail bs = case decodeOrFail bs of Left (_,_,e) -> Left e Right (_,_,x) -> Right x -#else -toArchiveOrFail bs = Right $ toArchive bs -#endif -- | Writes an 'Archive' structure to a raw zip archive (in a lazy bytestring). fromArchive :: Archive -> B.ByteString @@ -785,10 +784,10 @@ then getLazyByteString (fromIntegral compressedSize) else -- If bit 3 of general purpose bit flag is set, -- then we need to read until we get to the - -- data descriptor record. We assume that the - -- record has signature 0x08074b50; this is not required - -- by the specification but is common. - do raw <- getWordsTilSig 0x08074b50 + -- data descriptor record. + do raw <- getCompressedData + sig <- lookAhead getWord32le + when (sig == 0x08074b50) $ skip 4 skip 4 -- crc32 cs <- getWord32le -- compressed size skip 4 -- uncompressed size @@ -797,54 +796,39 @@ else fail "Content size mismatch in data descriptor record" return (fromIntegral offset, compressedData) -getWordsTilSig :: Word32 -> Get B.ByteString -getWordsTilSig sig = (B.fromChunks . reverse) `fmap` go Nothing [] - where - sig' = S.pack [fromIntegral $ sig .&. 0xFF, - fromIntegral $ sig `shiftR` 8 .&. 0xFF, - fromIntegral $ sig `shiftR` 16 .&. 0xFF, - fromIntegral $ sig `shiftR` 24 .&. 0xFF] - chunkSize = 16384 - --chunkSize = 4 -- for testing prefix match - checkChunk chunk = do -- find in content - let (prefix, start) = S.breakSubstring sig' chunk - if S.null start - then return $ Right chunk - else return $ Left $ S.length prefix - go :: Maybe (Word8, Word8, Word8) -> [S.ByteString] -> Get [S.ByteString] - go prefixes acc = do - -- note: lookAheadE will rewind if the result is Left - eitherChunkOrIndex <- lookAheadE $ do - chunk <- getByteString chunkSize <|> B.toStrict `fmap` getRemainingLazyByteString - case prefixes of - Just (byte3,byte2,byte1) -> - let len = S.length chunk in - if len >= 1 && - S.pack [byte3,byte2,byte1,S.index chunk 0] == sig' - then return $ Left $ -3 - else if len >= 2 && - S.pack [byte2,byte1,S.index chunk 0,S.index chunk 1] == sig' - then return $ Left $ -2 - else if len >= 3 && - S.pack [byte1,S.index chunk 0,S.index chunk 1,S.index chunk 2] == sig' - then return $ Left $ -1 - else checkChunk chunk - Nothing -> checkChunk chunk - case eitherChunkOrIndex of - Left index -> if index < 0 - then do -- prefix match - skip (4 + index) -- skip over partial match in next chunk - return $ (S.take (S.length (head acc) + index) (head acc)) : (tail acc) - else do -- match inside this chunk - lastchunk <- getByteString index -- must read again - skip 4 - return (lastchunk:acc) - Right chunk -> if len == chunkSize - then go prefixes' (chunk:acc) - else fail $ "getWordsTilSig: signature not found before EOF" - where - len = S.length chunk - prefixes' = Just $ (S.index chunk (len - 3), S.index chunk (len - 2), S.index chunk (len - 1)) +-- Move forward over data (not consuming it) until: +-- - start of the next local file header +-- - start of archive decryption header +-- Then back up 12 bytes (the data description record) +-- and possibly 4 more bytes +-- (conventional but not required sig 0x08074b50 for data description record). +getCompressedData :: Get B.ByteString +getCompressedData = do + numbytes <- lookAhead $ findEnd 0 + getLazyByteString numbytes + where + chunkSize :: Int64 + chunkSize = 16384 + findEnd :: Int64 -> Get Int64 + findEnd n = do + sig <- lookAhead getWord32le + case sig of + 0x08074b50 -> skip 4 >> return n + 0x04034b50 -> -- sig for local file header + return (n - 12) -- rewind past data description + 0x02014b50 -> -- sig for file header + return (n - 12) -- rewind past data description + 0x06054b50 -> -- sig for end of central directory header + return (n - 12) -- rewind past data description + x | x .&. 0xFF == 0x50 -> skip 1 >> findEnd (n + 1) + _ -> do bs <- lookAhead $ getLazyByteString chunkSize + <|> getRemainingLazyByteString + let bsLen = B.length bs + let mbIdx = B.elemIndex 0x50 bs + case mbIdx of + Nothing -> skip (fromIntegral bsLen) >> findEnd (n + bsLen) + Just 0 -> skip 1 >> findEnd (n + 1) + Just idx -> skip (fromIntegral idx) >> findEnd (n + idx) putLocalFile :: Entry -> Put putLocalFile f = do diff --git a/zip-archive.cabal b/zip-archive.cabal --- a/zip-archive.cabal +++ b/zip-archive.cabal @@ -1,5 +1,5 @@ Name: zip-archive -Version: 0.4.2.2 +Version: 0.4.3 Cabal-Version: 2.0 Build-type: Simple Synopsis: Library for creating and modifying zip archives. @@ -55,7 +55,7 @@ Build-depends: base >= 4.5 && < 5, pretty, containers, - binary >= 0.6, + binary >= 0.7.2, zlib, filepath, bytestring >= 0.10.0,