diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +## Zip 0.1.2 + +* Relaxed dependency on `semigroups`. + +* Added explicit check of “version needed to extract”, so if archive uses + some advanced features that we do not support yet, parsing fails. + +* Value of “version needed to extract” field is now calculated dynamically + with respect to actually used features, e.g. if you just store or deflate + a not very big file, `2.0` version will be written (previously we wrote + `4.6` unconditionally). This is needed to avoid scaring tools that can + only handle basic Zip archives. + ## Zip 0.1.1 * Make decoding of CP437 faster. diff --git a/Codec/Archive/Zip/Internal.hs b/Codec/Archive/Zip/Internal.hs --- a/Codec/Archive/Zip/Internal.hs +++ b/Codec/Archive/Zip/Internal.hs @@ -151,7 +151,7 @@ ---------------------------------------------------------------------------- -- Constants --- | Version to specify when writing archive data. For now it's a constant. +-- | “Version created by” to specify when writing archive data. zipVersion :: Version zipVersion = Version [4,6] [] @@ -398,7 +398,7 @@ (GenericOrigin, _) -> Nothing (Borrowed ed, Nothing) -> edComment ed (Borrowed _, Just ()) -> Nothing - desc' = EntryDescription -- to write in local header + desc0 = EntryDescription -- to write in local header { edVersionMadeBy = zipVersion , edVersionNeeded = zipVersion , edCompression = compression @@ -409,7 +409,7 @@ , edOffset = fromIntegral offset , edComment = M.lookup s eaEntryComment <|> oldComment , edExtraField = extraField } - B.hPut h (runPut (putHeader LocalHeader s desc')) + B.hPut h (runPut (putHeader LocalHeader s desc0)) DataDescriptor {..} <- runResourceT $ if recompression then @@ -418,22 +418,25 @@ else src =$= decompressingPipe compressed $$ sinkData h compression else src $$ sinkData h Store afterStreaming <- hTell h - let desc = case o of - GenericOrigin -> desc' + let desc1 = case o of + GenericOrigin -> desc0 { edCRC32 = ddCRC32 , edCompressedSize = ddCompressedSize , edUncompressedSize = ddUncompressedSize } - Borrowed ed -> desc' + Borrowed ed -> desc0 { edCRC32 = bool (edCRC32 ed) ddCRC32 recompression , edCompressedSize = bool (edCompressedSize ed) ddCompressedSize recompression , edUncompressedSize = bool (edUncompressedSize ed) ddUncompressedSize recompression } + desc2 = desc1 + { edVersionNeeded = + getZipVersion (needsZip64 desc1) (Just compression) } hSeek h AbsoluteSeek offset - B.hPut h (runPut (putHeader LocalHeader s desc)) + B.hPut h (runPut (putHeader LocalHeader s desc2)) hSeek h AbsoluteSeek afterStreaming - return (s, desc) + return (s, desc2) -- | Create 'Sink' to stream data there. Once streaming is finished, return -- 'DataDescriptor' for the streamed data. The action /does not/ close given @@ -521,9 +524,13 @@ getSignature 0x02014b50 -- central file header signature versionMadeBy <- toVersion <$> getWord16le -- version made by versionNeeded <- toVersion <$> getWord16le -- version needed to extract + when (versionNeeded > zipVersion) . fail $ + "Version required to extract the archive is " + ++ showVersion versionNeeded ++ " (can do " + ++ showVersion zipVersion ++ ")" bitFlag <- getWord16le -- general purpose bit flag - when (any (testBit bitFlag) [0,6,13]) $ - fail "Encrypted archives are not supported" + when (any (testBit bitFlag) [0,6,13]) . fail $ + "Encrypted archives are not supported" let needUnicode = testBit bitFlag 11 mcompression <- toCompressionMethod <$> getWord16le -- compression method modTime <- getWord16le -- last mod file time @@ -688,7 +695,8 @@ putWord32le 0x06064b50 -- zip64 end of central dir signature putWord64le 44 -- size of zip64 end of central dir record putWord16le (fromVersion zipVersion) -- version made by - putWord16le (fromVersion zipVersion) -- version needed to extract + putWord16le (fromVersion $ getZipVersion True Nothing) + -- ↑ version needed to extract putWord32le 0 -- number of this disk putWord32le 0 -- number of the disk with the start of the central directory putWord64le (fromIntegral totalCount) -- total number of entries (this disk) @@ -879,7 +887,7 @@ -- | Decode 'ByteString'. The first argument indicates whether we should -- treat it as UTF-8 (in case bit 11 of general-purpose bit flag is set), -- otherwise the function assumes CP437. Note that since not every stream of --- bytes constitute valid UTF-8 text, this function can fail. In that case +-- bytes constitutes valid UTF-8 text, this function can fail. In that case -- 'Nothing' is returned. decodeText @@ -925,6 +933,24 @@ fromCompressionMethod Store = 0 fromCompressionMethod Deflate = 8 fromCompressionMethod BZip2 = 12 + +-- | Check if entry with these parameters needs Zip64 extension. + +needsZip64 :: EntryDescription -> Bool +needsZip64 EntryDescription {..} = any (>= 0xffffffff) + [edOffset, edCompressedSize, edUncompressedSize] + +-- | Determine “version needed to extract” that should be written headers +-- given need of Zip64 feature and compression method. + +getZipVersion :: Bool -> Maybe CompressionMethod -> Version +getZipVersion zip64 m = max zip64ver mver + where zip64ver = makeVersion (if zip64 then [4,5] else [2,0]) + mver = makeVersion $ case m of + Nothing -> [2,0] + Just Store -> [2,0] + Just Deflate -> [2,0] + Just BZip2 -> [4,6] -- | Return decompressing 'Conduit' corresponding to given compression -- method. diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -52,6 +52,7 @@ import Data.Monoid import Data.Text (Text) import Data.Time +import Data.Version import Path import Path.IO import System.IO @@ -84,6 +85,7 @@ describe "withArchive" withArchiveSpec describe "archive comment" archiveCommentSpec describe "getEntryDesc" getEntryDescSpec + describe "version needed" versionNeededSpec describe "addEntry" addEntrySpec describe "sinkEntry" sinkEntrySpec describe "loadEntry" loadEntrySpec @@ -99,7 +101,7 @@ describe "undoEntryChanges" undoEntryChangesSpec describe "undoArchiveChanges" undoArchiveChangesSpec describe "undoAll" undoAllSpec - describe "consistencySpec" consistencySpec + describe "consistency" consistencySpec describe "packDirRecur" packDirRecurSpec describe "unpackInto" unpackIntoSpec @@ -325,6 +327,19 @@ \path -> property $ \(EM s desc z) -> do desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s) desc' `shouldSatisfy` softEq desc + +versionNeededSpec :: SpecWith (Path Abs File) +versionNeededSpec = + it "writes correct version that is needed to extract archive" $ + -- NOTE for now we check only how version depends on compression method, + -- it should be mentioned that the version also depends on Zip64 feature + \path -> property $ \(EM s desc z) -> do + desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s) + edVersionNeeded desc' `shouldBe` makeVersion + (case edCompression desc of + Store -> [2,0] + Deflate -> [2,0] + BZip2 -> [4,6]) addEntrySpec :: SpecWith (Path Abs File) addEntrySpec = diff --git a/zip.cabal b/zip.cabal --- a/zip.cabal +++ b/zip.cabal @@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE. name: zip -version: 0.1.1 +version: 0.1.2 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE.md @@ -72,7 +72,7 @@ , time >= 1.4 && < 1.7 , transformers >= 0.4 && < 0.6 if !impl(ghc >= 8.0) - build-depends: semigroups == 0.18.* + build-depends: semigroups >= 0.16 default-extensions: RecordWildCards , TupleSections exposed-modules: Codec.Archive.Zip @@ -106,7 +106,7 @@ , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.7 , transformers >= 0.4 && < 0.6 - , zip >= 0.1.1 + , zip >= 0.1.2 default-language: Haskell2010 benchmark bench @@ -119,7 +119,7 @@ ghc-options: -O2 -Wall build-depends: base >= 4.8 && < 5 , criterion >= 1.0 - , zip >= 0.1.1 + , zip >= 0.1.2 default-language: Haskell2010 source-repository head