99 lines
3.6 KiB
Diff
99 lines
3.6 KiB
Diff
Patch is in experimental state.
|
|
Hasn't sent upstream. Maybe binary package is
|
|
a better place to get lookAhead{,M} back
|
|
to lessen code uglification.
|
|
|
|
diff --git a/Codec/Archive/Zip.hs b/Codec/Archive/Zip.hs
|
|
index 4ad717b..e471786 100644
|
|
--- a/Codec/Archive/Zip.hs
|
|
+++ b/Codec/Archive/Zip.hs
|
|
@@ -61,7 +61,9 @@ import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds )
|
|
#endif
|
|
import Data.Bits ( shiftL, shiftR, (.&.) )
|
|
import Data.Binary
|
|
+import Control.Applicative ((<|>))
|
|
import Data.Binary.Get
|
|
+import Data.Maybe
|
|
import Data.Binary.Put
|
|
import Data.List ( nub, find )
|
|
import Text.Printf
|
|
@@ -88,6 +90,22 @@ import qualified Codec.Compression.Zlib.Raw as Zlib
|
|
|
|
------------------------------------------------------------------------
|
|
|
|
+lookAheadM :: Get (Maybe a) -> Get (Maybe a)
|
|
+lookAheadM gma =
|
|
+ (do ma <- gma
|
|
+ case ma of
|
|
+ Nothing -> fail "lookAheadM: input not met"
|
|
+ _ -> return ma
|
|
+ ) <|> return Nothing
|
|
+
|
|
+lookAndCheck :: (a -> Bool) -> Get a -> Get (Maybe a)
|
|
+lookAndCheck p gma =
|
|
+ (do ma <- gma
|
|
+ if p ma
|
|
+ then return (Just ma)
|
|
+ else fail "lookAndCheck: input not met"
|
|
+ ) <|> return Nothing
|
|
+
|
|
-- | Structured representation of a zip archive, including directory
|
|
-- information and contents (in lazy bytestrings).
|
|
data Archive = Archive
|
|
@@ -492,12 +510,11 @@ localFileSize f =
|
|
|
|
getLocalFile :: Get (Maybe (Word32, B.ByteString))
|
|
getLocalFile = do
|
|
- sig <- lookAhead getWord32le
|
|
- if sig /= 0x04034b50
|
|
+ offset <- bytesRead
|
|
+ sig <- lookAndCheck (== 0x04034b50) getWord32le
|
|
+ if isNothing sig
|
|
then return Nothing
|
|
else do
|
|
- offset <- bytesRead
|
|
- skip 4 -- signature
|
|
skip 2 -- version
|
|
bitflag <- getWord16le
|
|
skip 2 -- compressionMethod
|
|
@@ -520,11 +537,10 @@ getLocalFile = do
|
|
-- record has signature 0x08074b50; this is not required
|
|
-- by the specification but is common.
|
|
do raw <- many $ do
|
|
- s <- lookAhead getWord32le
|
|
- if s == 0x08074b50
|
|
+ s <- lookAndCheck (== 0x08074b50) getWord32le
|
|
+ if isJust s
|
|
then return Nothing
|
|
else liftM Just getWord8
|
|
- skip 4 -- signature
|
|
skip 4 -- crc32
|
|
cs <- getWord32le -- compressed size
|
|
skip 4 -- uncompressed size
|
|
@@ -581,11 +597,10 @@ putLocalFile f = do
|
|
getFileHeader :: M.Map Word32 B.ByteString -- ^ map of (offset, content) pairs returned by getLocalFile
|
|
-> Get (Maybe Entry)
|
|
getFileHeader locals = do
|
|
- sig <- lookAhead getWord32le
|
|
- if sig /= 0x02014b50
|
|
+ sig <- lookAndCheck (== 0x02014b50) getWord32le
|
|
+ if isNothing sig
|
|
then return Nothing
|
|
else do
|
|
- skip 4 -- skip past signature
|
|
skip 2 -- version made by
|
|
versionNeededToExtract <- getWord8
|
|
skip 1 -- upper byte indicates OS part of "version needed to extract"
|
|
diff --git a/zip-archive.cabal b/zip-archive.cabal
|
|
index 435514c..cbc8da8 100644
|
|
--- a/zip-archive.cabal
|
|
+++ b/zip-archive.cabal
|
|
@@ -29,7 +29,7 @@ Library
|
|
Build-depends: base >= 3 && < 5, pretty, containers
|
|
else
|
|
Build-depends: base < 3
|
|
- Build-depends: binary < 0.6, zlib, filepath, bytestring >= 0.9.0, array, mtl, utf8-string >= 0.3.1, old-time, digest >= 0.0.0.1, directory, time
|
|
+ Build-depends: binary >= 0.6, zlib, filepath, bytestring >= 0.9.0, array, mtl, utf8-string >= 0.3.1, old-time, digest >= 0.0.0.1, directory, time
|
|
Exposed-modules: Codec.Archive.Zip
|
|
Default-Language: Haskell98
|
|
Hs-Source-Dirs: .
|