zip-archive 0.2.3.7 → 0.3
raw patch · 4 files changed
+94/−16 lines, 4 files
Files
- changelog +13/−0
- src/Codec/Archive/Zip.hs +52/−13
- tests/test-zip-archive.hs +24/−2
- zip-archive.cabal +5/−1
changelog view
@@ -1,3 +1,16 @@+zip-archive 0.3++ * Support preservation of file modes on Posix (Dan Aloni, #26).+ * Add `eVersionMadeBy` field to `Entry` (API change).+ * Export `ZipException` (API change).+ * `fromEntry` no longer checks for CRC32 match. Previously, it issued+ `error` if the match failed. CRC32 match is now checked in `writeEntry`+ instead, and a `CRC32Exception` is raised if the checksum doesn't match.+ * Test suite: return nonzero status if there are test failures.+ Previously we mistakenly did this only on 'errors', not failures.+ * Test suite: don't use -9 with zip as it isn't always available.+ * Use .travis.yml that builds on both stack and cabal.+ zip-archive 0.2.3.7 * Declared test suite's dependency on 'zip' using custom Setup.lhs (#21,#22).
src/Codec/Archive/Zip.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} ------------------------------------------------------------------------ -- | -- Module : Codec.Archive.Zip@@ -34,6 +35,7 @@ , Entry (..) , CompressionMethod (..) , ZipOption (..)+ , ZipException (..) , emptyArchive -- * Pure functions for working with zip archives@@ -64,10 +66,13 @@ import Data.Binary.Get import Data.Binary.Put import Data.List ( nub, find, intercalate )+import Data.Data (Data)+import Data.Typeable (Typeable) import Text.Printf import System.FilePath import System.Directory ( doesDirectoryExist, getDirectoryContents, createDirectoryIfMissing ) import Control.Monad ( when, unless, zipWithM )+import qualified Control.Exception as E import System.Directory ( getModificationTime ) import System.IO ( stderr, hPutStrLn ) import qualified Data.Digest.CRC32 as CRC32@@ -76,7 +81,7 @@ import Control.Applicative #endif #ifndef _WINDOWS-import System.Posix.Files ( setFileTimes )+import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getFileStatus ) #endif -- from bytestring@@ -89,6 +94,13 @@ -- from zlib import qualified Codec.Compression.Zlib.Raw as Zlib +versionMadeBy :: Word16+#ifdef _WINDOWS+versionMadeBy = 0x0000 -- FAT/VFAT/VFAT32 file attributes+#else+versionMadeBy = 0x0300 -- UNIX file attributes+#endif+ #if !MIN_VERSION_binary(0, 6, 0) manySig :: Word32 -> Get a -> Get [a] manySig sig p = do@@ -126,6 +138,7 @@ , 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@@ -143,6 +156,12 @@ | OptLocation FilePath Bool -- ^ Where to place file when adding files and whether to append current path deriving (Read, Show, Eq) +data ZipException =+ CRC32Mismatch FilePath+ deriving (Show, Typeable, Data)++instance E.Exception ZipException+ -- | A zip archive with no contents. emptyArchive :: Archive emptyArchive = Archive@@ -197,10 +216,7 @@ -- | Returns uncompressed contents of zip entry. fromEntry :: Entry -> B.ByteString fromEntry entry =- let uncompressedData = decompressData (eCompressionMethod entry) (eCompressedData entry)- in if eCRC32 entry == CRC32.crc32 uncompressedData- then uncompressedData- else error "CRC32 mismatch"+ decompressData (eCompressionMethod entry) (eCompressedData entry) -- | Create an 'Entry' with specified file path, modification time, and contents. toEntry :: FilePath -- ^ File path for entry@@ -225,6 +241,7 @@ , eUncompressedSize = fromIntegral uncompressedSize , eExtraField = B.empty , eFileComment = B.empty+ , eVersionMadeBy = versionMadeBy , eInternalFileAttributes = 0 -- potentially non-text , eExternalFileAttributes = 0 -- appropriate if from stdin , eCompressedData = finalData@@ -252,16 +269,28 @@ (TOD modEpochTime _) <- getModificationTime path #endif let entry = toEntry path' modEpochTime contents++ entryE <-+#ifdef _WINDOWS+ return $ entry+#else+ do fm <- fmap fileMode $ getFileStatus path'+ let modes = fromIntegral $ shiftL (toInteger fm) 16+ return $ entry { eExternalFileAttributes = modes }+#endif+ when (OptVerbose `elem` opts) $ do- let compmethod = case eCompressionMethod entry of+ let compmethod = case eCompressionMethod entryE of Deflate -> "deflated" NoCompression -> "stored" hPutStrLn stderr $- printf " adding: %s (%s %.f%%)" (eRelativePath entry)- compmethod (100 - (100 * compressionRatio entry))- return entry+ printf " adding: %s (%s %.f%%)" (eRelativePath entryE)+ compmethod (100 - (100 * compressionRatio entryE))+ return entryE --- | Writes contents of an 'Entry' to a file.+-- | Writes contents of an 'Entry' to a file. Throws a+-- 'CRC32Mismatch' exception if the CRC32 checksum for the entry+-- does not match the uncompressed data. writeEntry :: [ZipOption] -> Entry -> IO () writeEntry opts entry = do let path = case [d | OptDestination d <- opts] of@@ -281,7 +310,16 @@ hPutStrLn stderr $ case eCompressionMethod entry of Deflate -> " inflating: " ++ path NoCompression -> "extracting: " ++ path- B.writeFile path (fromEntry entry)+ let uncompressedData = fromEntry entry+ if eCRC32 entry == CRC32.crc32 uncompressedData+ then B.writeFile path uncompressedData+ else E.throwIO $ CRC32Mismatch path+#ifndef _WINDOWS+ let modes = fromIntegral $ shiftR (eExternalFileAttributes entry) 16+ when (eVersionMadeBy entry == 0x0300 &&+ modes /= 0) $ setFileMode path modes+#endif+ -- Note that last modified times are supported only for POSIX, not for -- Windows. setFileTimeStamp path (eLastModified entry)@@ -637,7 +675,7 @@ -> Get Entry getFileHeader locals = do getWord32le >>= ensure (== 0x02014b50)- skip 2 -- version made by+ vmb <- getWord16le -- version made by versionNeededToExtract <- getWord8 skip 1 -- upper byte indicates OS part of "version needed to extract" unless (versionNeededToExtract <= 20) $@@ -678,6 +716,7 @@ , eUncompressedSize = uncompressedSize , eExtraField = extraField , eFileComment = fileComment+ , eVersionMadeBy = vmb , eInternalFileAttributes = internalFileAttributes , eExternalFileAttributes = externalFileAttributes , eCompressedData = compressedData@@ -688,7 +727,7 @@ -> Put putFileHeader offset local = do putWord32le 0x02014b50- putWord16le 0 -- version made by+ putWord16le $ eVersionMadeBy local putWord16le 20 -- version needed to extract (>= 2.0) putWord16le 0x802 -- general purpose bit flag (bit 1 = max compression, bit 11 = UTF-8) putWord16le $ case eCompressionMethod local of
tests/test-zip-archive.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-} -- Test suite for Codec.Archive.Zip -- runghc Test.hs @@ -11,6 +12,10 @@ import Control.Applicative import System.Exit +#ifndef _WINDOWS+import System.Posix.Files+#endif+ -- define equality for Archives so timestamps aren't distinguished if they -- correspond to the same MSDOS datetime. instance Eq Archive where@@ -29,9 +34,12 @@ , testAddFilesOptions , testDeleteEntries , testExtractFiles+#ifndef _WINDOWS+ , testExtractFilesWithPosixAttrs+#endif ] removeDirectoryRecursive "test-temp"- exitWith $ case errors res of+ exitWith $ case (failures res + errors res) of 0 -> ExitSuccess n -> ExitFailure n @@ -45,7 +53,7 @@ testReadExternalZip :: Test testReadExternalZip = TestCase $ do- _ <- runCommand "zip -q -9 test-temp/test4.zip zip-archive.cabal src/Codec/Archive/Zip.hs" >>= waitForProcess+ _ <- runCommand "zip -q test-temp/test4.zip zip-archive.cabal src/Codec/Archive/Zip.hs" >>= waitForProcess archive <- toArchive <$> B.readFile "test-temp/test4.zip" let files = filesInArchive archive assertEqual "for results of filesInArchive" ["zip-archive.cabal", "src/Codec/Archive/Zip.hs"] files@@ -99,3 +107,17 @@ assertEqual "contents of test-temp/dir1/hi" hiMsg hi assertEqual "contents of test-temp/dir1/dir2/hello" helloMsg hello +testExtractFilesWithPosixAttrs :: Test+testExtractFilesWithPosixAttrs = TestCase $ do+ createDirectory "test-temp/dir3"+ let hiMsg = "hello there"+ writeFile "test-temp/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"+ extractFilesFromArchive [OptVerbose] archive+ hi <- readFile "test-temp/dir3/hi"+ fm <- fmap fileMode $ getFileStatus "test-temp/dir3/hi"+ assertEqual "file modes" perms (intersectFileModes perms fm)+ assertEqual "contents of test-temp/dir3/hi" hiMsg hi
zip-archive.cabal view
@@ -1,5 +1,5 @@ Name: zip-archive-Version: 0.2.3.7+Version: 0.3 Cabal-Version: >= 1.10 Build-type: Custom Synopsis: Library for creating and modifying zip archives.@@ -64,3 +64,7 @@ Default-Language: Haskell98 Ghc-Options: -Wall Build-Tools: zip+ if os(windows)+ cpp-options: -D_WINDOWS+ else+ Build-depends: unix