zip-stream 0.1.1 → 0.2.0.1
raw patch · 7 files changed
+38/−21 lines, 7 filesdep +text
Dependencies added: text
Files
- Codec/Archive/Zip/Conduit/Internal.hs +3/−2
- Codec/Archive/Zip/Conduit/Types.hs +4/−2
- Codec/Archive/Zip/Conduit/UnZip.hs +6/−3
- Codec/Archive/Zip/Conduit/Zip.hs +11/−8
- cmd/unzip.hs +5/−3
- cmd/zip.hs +5/−2
- zip-stream.cabal +4/−1
Codec/Archive/Zip/Conduit/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} module Codec.Archive.Zip.Conduit.Internal ( osVersion, zipVersion , zipError@@ -42,14 +43,14 @@ idConduit = C.awaitForever C.yield passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a-passthroughFold f z = C.await >>= maybe+passthroughFold f !z = C.await >>= maybe (return z) (\x -> do C.yield x passthroughFold f (f z x)) sizeCRC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m (Word64, Word32)-sizeCRC = passthroughFold (\(l, c) b -> (l + fromIntegral (BS.length b), crc32Update c b)) (0, 0)+sizeCRC = passthroughFold (\(!l, !c) b -> (l + fromIntegral (BS.length b), crc32Update c b)) (0, 0) sizeC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m Word64 sizeC = passthroughFold (\l b -> l + fromIntegral (BS.length b)) 0 -- fst <$> sizeCRC
Codec/Archive/Zip/Conduit/Types.hs view
@@ -7,9 +7,10 @@ import Data.Conduit.Binary (sourceLbs) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..))+import qualified Data.Text as T import Data.Time.LocalTime (LocalTime) import Data.Typeable (Typeable)-import Data.Word (Word64)+import Data.Word (Word32, Word64) -- |Errors thrown during zip file processing newtype ZipError = ZipError String@@ -29,9 +30,10 @@ -- |(The beginning of) a single entry in a zip stream, which may be any file or directory. -- As per zip file conventions, directory names should end with a slash and have no data, but this library does not ensure that. data ZipEntry = ZipEntry- { zipEntryName :: ByteString -- ^File name (in posix format, no leading slashes), usually utf-8 encoded, with a trailing slash for directories+ { zipEntryName :: Either T.Text ByteString -- ^File name (in posix format, no leading slashes), either UTF-8 encoded text or raw bytes (CP437), with a trailing slash for directories , zipEntryTime :: LocalTime -- ^Modification time , zipEntrySize :: Maybe Word64 -- ^Size of file data (if known); checked on zipping and also used as hint to enable zip64+ , zipEntryExternalAttributes :: Maybe Word32 -- ^Host-dependent attributes, often MS-DOS directory attribute byte (only supported when zipping) } deriving (Eq, Show) -- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'.
Codec/Archive/Zip/Conduit/UnZip.hs view
@@ -23,6 +23,8 @@ import qualified Data.Conduit.List as CL import Data.Conduit.Serialization.Binary (sinkGet) import qualified Data.Conduit.Zlib as CZ+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import Data.Time (LocalTime(..), TimeOfDay(..), fromGregorian) import Data.Word (Word16, Word32, Word64) @@ -136,7 +138,7 @@ -- optional data description (possibly ambiguous!) sinkGet $ (guard =<< dataDesc h) <|> return () return (size == usize && crc == fileCRC)- unless r $ zipError $ BSC.unpack (zipEntryName fileEntry) ++ ": data integrity check failed"+ unless r $ zipError $ either T.unpack BSC.unpack (zipEntryName fileEntry) ++ ": data integrity check failed" next EndOfCentralDirectory{..} -> do return endInfo@@ -166,7 +168,7 @@ when (ver > zipVersion) $ fail $ "Unsupported version: " ++ show ver gpf <- G.getWord16le -- when (gpf .&. complement (bit 1 .|. bit 2 .|. bit 3) /= 0) $ fail $ "Unsupported flags: " ++ show gpf- when (gpf `clearBit` 1 `clearBit` 2 `clearBit` 3 /= 0) $ fail $ "Unsupported flags: " ++ show gpf+ when (gpf `clearBit` 1 `clearBit` 2 `clearBit` 3 `clearBit` 11 /= 0) $ fail $ "Unsupported flags: " ++ show gpf comp <- G.getWord16le dcomp <- case comp of 0 | testBit gpf 3 -> fail "Unsupported uncompressed streaming file data"@@ -216,9 +218,10 @@ } return FileHeader { fileEntry = ZipEntry- { zipEntryName = name+ { zipEntryName = if testBit gpf 11 then Left (TE.decodeUtf8 name) else Right name , zipEntryTime = time , zipEntrySize = if testBit gpf 3 then Nothing else Just extZip64USize+ , zipEntryExternalAttributes = Nothing } , fileDecompress = dcomp , fileCSize = extZip64CSize
Codec/Archive/Zip/Conduit/Zip.hs view
@@ -35,6 +35,8 @@ import Data.Digest.CRC32 (crc32) import Data.Either (isLeft) import Data.Maybe (fromMaybe, fromJust)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import Data.Time (LocalTime(..), TimeOfDay(..), toGregorian) import Data.Word (Word16, Word64) @@ -127,12 +129,13 @@ | otherwise = (left (fmap (id &&& fst)) sdat, usiz) z64 = maybe (zipOpt64 || any (maxBound32 <) zipEntrySize) (maxBound32 <) (max <$> usiz <*> csiz)- namelen = BS.length zipEntryName+ name = either TE.encodeUtf8 id zipEntryName+ namelen = BS.length name (time, date) = toDOSTime zipEntryTime mcrc = either (const Nothing) (Just . crc32) dat- when (namelen > maxBound16) $ zipError $ BSC.unpack zipEntryName ++ ": entry name too long"+ when (namelen > maxBound16) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": entry name too long" let common = do- P.putWord16le $ isLeft dat ?* bit 3+ P.putWord16le $ isLeft dat ?* bit 3 .|. isLeft zipEntryName ?* bit 11 P.putWord16le $ comp ?* 8 P.putWord16le $ time P.putWord16le $ date@@ -147,7 +150,7 @@ P.putWord32le $ if z64 then maxBound32 else maybe 0 fromIntegral usiz P.putWord16le $ fromIntegral namelen P.putWord16le $ z64 ?* 20- P.putByteString zipEntryName+ P.putByteString name when z64 $ do P.putWord16le 0x0001 P.putWord16le 16@@ -157,7 +160,7 @@ ((usz, crc), csz) <- either (\cd -> do r@((usz, crc), csz) <- outsz cd -- write compressed data- when (not z64 && (usz > maxBound32 || csz > maxBound32)) $ zipError $ BSC.unpack zipEntryName ++ ": file too large and zipOpt64 disabled"+ when (not z64 && (usz > maxBound32 || csz > maxBound32)) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": file too large and zipOpt64 disabled" output $ do P.putWord32le 0x08074b50 P.putWord32le crc@@ -169,7 +172,7 @@ return r) (\b -> outsz $ ((fromJust usiz, fromJust mcrc), fromJust csiz) <$ CB.sourceLbs b) cdat- when (any (usz /=) zipEntrySize) $ zipError $ BSC.unpack zipEntryName ++ ": incorrect zipEntrySize"+ when (any (usz /=) zipEntrySize) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": incorrect zipEntrySize" return $ do -- central directory let o64 = off >= maxBound32@@ -189,9 +192,9 @@ P.putWord16le 0 -- comment length P.putWord16le 0 -- disk number P.putWord16le 0 -- internal file attributes- P.putWord32le 0 -- external file attributes+ P.putWord32le $ fromMaybe 0 zipEntryExternalAttributes P.putWord32le $ if o64 then maxBound32 else fromIntegral off- P.putByteString zipEntryName+ P.putByteString name when a64 $ do P.putWord16le 0x0001 P.putWord16le l64
cmd/unzip.hs view
@@ -6,6 +6,8 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB+import qualified Data.Text as T+import qualified Data.Text.IO as TIO import Data.Time.LocalTime (localTimeToUTC, utc) import Data.Void (Void) import System.Directory (createDirectoryIfMissing@@ -23,9 +25,9 @@ extract :: C.ConduitM (Either ZipEntry BS.ByteString) Void IO () extract = C.awaitForever start where start (Left ZipEntry{..}) = do- liftIO $ BSC.putStrLn zipEntryName+ liftIO $ either TIO.putStrLn BSC.putStrLn zipEntryName liftIO $ createDirectoryIfMissing True (takeDirectory name)- if BSC.last zipEntryName == '/'+ if either T.last BSC.last zipEntryName == '/' then when ((0 /=) `any` zipEntrySize) $ fail $ name ++ ": non-empty directory" else do -- C.bracketP h <- liftIO $ openFile name WriteMode@@ -35,7 +37,7 @@ #if MIN_VERSION_directory(1,2,3) liftIO $ setModificationTime name $ localTimeToUTC utc zipEntryTime -- FIXME: timezone #endif- where name = BSC.unpack $ BSC.dropWhile ('/' ==) zipEntryName -- should we utf8 decode?+ where name = either (T.unpack . T.dropWhile ('/' ==)) (BSC.unpack . BSC.dropWhile ('/' ==)) zipEntryName start (Right _) = fail "Unexpected leading or directory data contents" write = C.await >>= maybe (return ())
cmd/zip.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+import Control.Arrow ((+++)) import Control.Monad (filterM, void) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Resource (MonadResource, runResourceT)@@ -6,6 +7,7 @@ import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import Data.List (foldl')+import qualified Data.Text as T import Data.Time.LocalTime (utcToLocalTime, utc) import qualified System.Console.GetOpt as Opt import System.Directory (doesDirectoryExist, getModificationTime@@ -43,9 +45,10 @@ generate (p:paths) = do t <- liftIO $ getModificationTime p let e = ZipEntry- { zipEntryName = BSC.pack $ dropWhile ('/' ==) p+ { zipEntryName = Right $ BSC.pack $ dropWhile ('/' ==) p , zipEntryTime = utcToLocalTime utc t -- FIXME: timezone , zipEntrySize = Nothing+ , zipEntryExternalAttributes = Nothing } isd <- liftIO $ doesDirectoryExist p if isd@@ -62,7 +65,7 @@ #else filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p #endif- C.yield (e{ zipEntryName = zipEntryName e `BSC.snoc` '/', zipEntrySize = Just 0 }, mempty)+ C.yield (e{ zipEntryName = (`T.snoc` '/') +++ (`BSC.snoc` '/') $ zipEntryName e, zipEntrySize = Just 0 }, mempty) generate $ dl ++ paths else do C.yield (e, zipFileData p)
zip-stream.cabal view
@@ -1,5 +1,5 @@ name: zip-stream-version: 0.1.1+version: 0.2.0.1 synopsis: ZIP archive streaming using conduits description: Process (extract and create) zip files as streams (e.g., over the network), accessing contained files without having to write the zip file to disk (unlike zip-conduit). license: BSD3@@ -36,6 +36,7 @@ mtl, primitive, resourcet,+ text, time, transformers-base, zlib@@ -52,6 +53,7 @@ conduit-extra, directory, filepath,+ text, time, transformers, zip-stream@@ -69,6 +71,7 @@ directory, filepath, resourcet,+ text, time, transformers, zip-stream