zip-archive 0.3.0.2 → 0.3.0.4
raw patch · 4 files changed
+120/−56 lines, 4 filesdep +temporarydep ~bytestring
Dependencies added: temporary
Dependency ranges changed: bytestring
Files
- changelog +17/−0
- src/Codec/Archive/Zip.hs +55/−10
- tests/test-zip-archive.hs +46/−44
- zip-archive.cabal +2/−2
changelog view
@@ -1,3 +1,20 @@+zip-archive 0.3.0.4++ * Fix `toArchive` so it doesn't use too much memory when a data+ data descriptor holds the size (Michael Stahl, #29).+ The size fields in the local file headers may not contain valid values,+ in which case the sizes are stored in a "data descriptor" that follows+ the file data. Previously handling this case required reading the+ entire archive is a `[Word8]` list. With this change, `getWordsTilSig`+ iteratively reads chunks as strict ByteStrings and converts them to+ a lazy ByteString at the end.++zip-archive 0.3.0.3++ * Test suite: use withTempDir to create temporary directory.+ This should help fix problems some have encountered with the+ test suite leaving a temporary directory behind.+ zip-archive 0.3.0.2 * Fix test suite so it runs on Windows.
src/Codec/Archive/Zip.hs view
@@ -85,6 +85,7 @@ #endif -- from bytestring+import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as B -- text@@ -605,20 +606,64 @@ skip 4 -- crc32 cs <- getWord32le -- compressed size skip 4 -- uncompressed size- if fromIntegral cs == length raw- then return $ B.pack raw- else fail "Content size mismatch in data descriptor record" + if fromIntegral cs == B.length raw+ then return $ raw+ else fail "Content size mismatch in data descriptor record" return (fromIntegral offset, compressedData) -getWordsTilSig :: Word32 -> Get [Word8]-getWordsTilSig sig = go []- where- go acc = do+getWordsTilSig :: Word32 -> Get B.ByteString #if MIN_VERSION_binary(0, 6, 0)- (getWord32le >>= ensure (== sig) >> return (reverse acc)) <|>- do w <- getWord8- go (w:acc)+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)) #else+getWordsTilSig sig = B.pack `fmap` go []+ where+ go acc = do sig' <- lookAhead getWord32le if sig == sig' then skip 4 >> return (reverse acc)
tests/test-zip-archive.hs view
@@ -11,6 +11,7 @@ import qualified Data.ByteString.Lazy as B import Control.Applicative import System.Exit+import System.IO.Temp (withTempDirectory) #ifndef _WINDOWS import System.Posix.Files@@ -25,9 +26,9 @@ y { eLastModified = eLastModified y `div` 2 }) (zEntries a1) (zEntries a2)) main :: IO Counts-main = do- createDirectory "test-temp"- res <- runTestTT $ TestList [ testReadWriteArchive+main = withTempDirectory "." "test-zip-archive." $ \tmpDir -> do+ res <- runTestTT $ TestList $ map (\f -> f tmpDir)+ [ testReadWriteArchive , testReadExternalZip , testFromToArchive , testReadWriteEntry@@ -38,23 +39,24 @@ , testExtractFilesWithPosixAttrs #endif ]- removeDirectoryRecursive "test-temp" exitWith $ case (failures res + errors res) of 0 -> ExitSuccess n -> ExitFailure n -testReadWriteArchive :: Test-testReadWriteArchive = TestCase $ do+testReadWriteArchive :: FilePath -> Test+testReadWriteArchive tmpDir = TestCase $ do archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"]- B.writeFile "test-temp/test1.zip" $ fromArchive archive- archive' <- toArchive <$> B.readFile "test-temp/test1.zip"+ B.writeFile (tmpDir ++ "/test1.zip") $ fromArchive archive+ archive' <- toArchive <$> B.readFile (tmpDir ++ "/test1.zip") assertEqual "for writing and reading test1.zip" archive archive' assertEqual "for writing and reading test1.zip" archive archive' -testReadExternalZip :: Test-testReadExternalZip = TestCase $ do- _ <- runCommand "zip -q test-temp/test4.zip zip-archive.cabal src/Codec/Archive/Zip.hs" >>= waitForProcess- archive <- toArchive <$> B.readFile "test-temp/test4.zip"+testReadExternalZip :: FilePath -> Test+testReadExternalZip tmpDir = TestCase $ do+ _ <- runCommand ("zip -q " ++ tmpDir +++ "/test4.zip zip-archive.cabal src/Codec/Archive/Zip.hs") >>=+ waitForProcess+ archive <- toArchive <$> B.readFile (tmpDir ++ "/test4.zip") let files = filesInArchive archive assertEqual "for results of filesInArchive" ["zip-archive.cabal", "src/Codec/Archive/Zip.hs"] files cabalContents <- B.readFile "zip-archive.cabal"@@ -62,64 +64,64 @@ Nothing -> assertFailure "zip-archive.cabal not found in archive" Just f -> assertEqual "for contents of zip-archive.cabal in archive" cabalContents (fromEntry f) -testFromToArchive :: Test-testFromToArchive = TestCase $ do+testFromToArchive :: FilePath -> Test+testFromToArchive _tmpDir = TestCase $ do archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] assertEqual "for (toArchive $ fromArchive archive)" archive (toArchive $ fromArchive archive) -testReadWriteEntry :: Test-testReadWriteEntry = TestCase $ do+testReadWriteEntry :: FilePath -> Test+testReadWriteEntry tmpDir = TestCase $ do entry <- readEntry [] "zip-archive.cabal"- setCurrentDirectory "test-temp"+ setCurrentDirectory tmpDir writeEntry [] entry setCurrentDirectory ".."- entry' <- readEntry [] "test-temp/zip-archive.cabal"+ entry' <- readEntry [] (tmpDir ++ "/zip-archive.cabal") let entry'' = entry' { eRelativePath = eRelativePath entry, eLastModified = eLastModified entry } assertEqual "for readEntry -> writeEntry -> readEntry" entry entry'' -testAddFilesOptions :: Test-testAddFilesOptions = TestCase $ do+testAddFilesOptions :: FilePath -> Test+testAddFilesOptions _tmpDir = TestCase $ do archive1 <- addFilesToArchive [OptVerbose] emptyArchive ["LICENSE", "src"] archive2 <- addFilesToArchive [OptRecursive, OptVerbose] archive1 ["LICENSE", "src"] assertBool "for recursive and nonrecursive addFilesToArchive" (length (filesInArchive archive1) < length (filesInArchive archive2)) -testDeleteEntries :: Test-testDeleteEntries = TestCase $ do+testDeleteEntries :: FilePath -> Test+testDeleteEntries _tmpDir = TestCase $ do archive1 <- addFilesToArchive [] emptyArchive ["LICENSE", "src"] let archive2 = deleteEntryFromArchive "LICENSE" archive1 let archive3 = deleteEntryFromArchive "src" archive2 assertEqual "for deleteFilesFromArchive" emptyArchive archive3 -testExtractFiles :: Test-testExtractFiles = TestCase $ do- createDirectory "test-temp/dir1"- createDirectory "test-temp/dir1/dir2"+testExtractFiles :: FilePath -> Test+testExtractFiles tmpDir = TestCase $ do+ createDirectory (tmpDir ++ "/dir1")+ createDirectory (tmpDir ++ "/dir1/dir2") let hiMsg = "hello there" let helloMsg = "Hello there. This file is very long. Longer than 31 characters."- writeFile "test-temp/dir1/hi" hiMsg- writeFile "test-temp/dir1/dir2/hello" helloMsg- archive <- addFilesToArchive [OptRecursive] emptyArchive ["test-temp/dir1"]- removeDirectoryRecursive "test-temp/dir1"+ writeFile (tmpDir ++ "/dir1/hi") hiMsg+ writeFile (tmpDir ++ "/dir1/dir2/hello") helloMsg+ archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir ++ "/dir1")]+ removeDirectoryRecursive (tmpDir ++ "/dir1") extractFilesFromArchive [OptVerbose] archive- hi <- readFile "test-temp/dir1/hi"- hello <- readFile "test-temp/dir1/dir2/hello"- assertEqual "contents of test-temp/dir1/hi" hiMsg hi- assertEqual "contents of test-temp/dir1/dir2/hello" helloMsg hello+ hi <- readFile (tmpDir ++ "/dir1/hi")+ hello <- readFile (tmpDir ++ "/dir1/dir2/hello")+ assertEqual ("contents of " ++ tmpDir ++ "/dir1/hi") hiMsg hi+ assertEqual ("contents of " ++ tmpDir ++ "/dir1/dir2/hello") helloMsg hello #ifndef _WINDOWS-testExtractFilesWithPosixAttrs :: Test-testExtractFilesWithPosixAttrs = TestCase $ do- createDirectory "test-temp/dir3"+testExtractFilesWithPosixAttrs :: FilePath -> Test+testExtractFilesWithPosixAttrs tmpDir = TestCase $ do+ createDirectory (tmpDir ++ "/dir3") let hiMsg = "hello there"- writeFile "test-temp/dir3/hi" hiMsg+ writeFile (tmpDir ++ "/dir3/hi") hiMsg let perms = unionFileModes ownerReadMode $ unionFileModes ownerWriteMode ownerExecuteMode- setFileMode "test-temp/dir3/hi" perms- archive <- addFilesToArchive [OptRecursive] emptyArchive ["test-temp/dir3"]- removeDirectoryRecursive "test-temp/dir3"+ setFileMode (tmpDir ++ "/dir3/hi") perms+ archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir ++ "/dir3")]+ removeDirectoryRecursive (tmpDir ++ "/dir3") extractFilesFromArchive [OptVerbose] archive- hi <- readFile "test-temp/dir3/hi"- fm <- fmap fileMode $ getFileStatus "test-temp/dir3/hi"+ hi <- readFile (tmpDir ++ "/dir3/hi")+ fm <- fmap fileMode $ getFileStatus (tmpDir ++ "/dir3/hi") assertEqual "file modes" perms (intersectFileModes perms fm)- assertEqual "contents of test-temp/dir3/hi" hiMsg hi+ assertEqual ("contents of " ++ tmpDir ++ "/dir3/hi") hiMsg hi #endif
zip-archive.cabal view
@@ -1,5 +1,5 @@ Name: zip-archive-Version: 0.3.0.2+Version: 0.3.0.4 Cabal-Version: >= 1.10 Build-type: Custom Synopsis: Library for creating and modifying zip archives.@@ -61,7 +61,7 @@ Hs-Source-Dirs: tests Build-Depends: base >= 4.2 && < 5, directory, bytestring >= 0.9.0, process, time, old-time,- HUnit, zip-archive+ HUnit, zip-archive, temporary Default-Language: Haskell98 Ghc-Options: -Wall Build-Tools: zip