zip-archive-0.1.3.4/0000755000000000000000000000000012115416204012260 5ustar0000000000000000zip-archive-0.1.3.4/LICENSE0000644000000000000000000000274212115416204013272 0ustar0000000000000000zip-archive - Haskell library Copyright (c) 2008-2012, John MacFarlane (jgm@berkeley.edu) All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. zip-archive-0.1.3.4/Setup.lhs0000644000000000000000000000011412115416204014064 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain zip-archive-0.1.3.4/zip-archive.cabal0000644000000000000000000000400012115416204015457 0ustar0000000000000000Name: zip-archive Version: 0.1.3.4 Cabal-Version: >= 1.10 Build-type: Simple Synopsis: Library for creating and modifying zip archives. Description: The zip-archive library provides functions for creating, modifying, and extracting files from zip archives. Category: Codec License: BSD3 License-file: LICENSE Homepage: http://github.com/jgm/zip-archive Author: John MacFarlane Maintainer: jgm@berkeley.edu Build-Depends: base Source-repository head type: git location: git://github.com/jgm/zip-archive.git flag splitBase Description: Choose the new, smaller, split-up base package. Default: True flag executable Description: Build the Zip executable. Default: False Library if flag(splitBase) Build-depends: base >= 3 && < 5, pretty, containers else Build-depends: base < 3 Build-depends: binary >= 0.5, 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: src Ghc-Options: -Wall Default-Extensions: CPP if os(windows) cpp-options: -D_WINDOWS else Build-depends: unix Executable Zip if flag(executable) Buildable: True else Buildable: False Main-is: Zip.hs Hs-Source-Dirs: . Build-Depends: base >= 4.2 && < 5, directory >= 1.1, bytestring >= 0.9.0, zip-archive Ghc-Options: -Wall Default-Language: Haskell98 Test-Suite test-zip-archive Type: exitcode-stdio-1.0 Main-Is: test-zip-archive.hs Hs-Source-Dirs: tests Build-Depends: base >= 4.2 && < 5, directory, bytestring >= 0.9.0, process, time, old-time, HUnit, zip-archive Default-Language: Haskell98 Ghc-Options: -Wall zip-archive-0.1.3.4/Zip.hs0000644000000000000000000000647112115416204013366 0ustar0000000000000000------------------------------------------------------------------------ -- Zip.hs -- Copyright (c) 2008 John MacFarlane -- License : BSD3 (see LICENSE) -- -- This is a demonstration of the use of the 'Codec.Archive.Zip' library. -- It duplicates some of the functionality of the 'zip' command-line -- program. ------------------------------------------------------------------------ import Codec.Archive.Zip import System.IO import qualified Data.ByteString.Lazy as B import System.Exit import System.Environment import System.Directory import System.Console.GetOpt import Control.Monad ( when ) import Control.Applicative ( (<$>) ) data Flag = Quiet | Version | Decompress | Recursive | Remove | List | Help deriving (Eq, Show, Read) options :: [OptDescr Flag] options = [ Option ['d'] ["decompress"] (NoArg Decompress) "decompress (unzip)" , Option ['r'] ["recursive"] (NoArg Recursive) "recursive" , Option ['R'] ["remove"] (NoArg Remove) "remove" , Option ['l'] ["list"] (NoArg List) "list" , Option ['v'] ["version"] (NoArg Version) "version" , Option ['q'] ["quiet"] (NoArg Quiet) "quiet" , Option ['h'] ["help"] (NoArg Help) "help" ] main :: IO () main = do argv <- getArgs progname <- getProgName let header = "Usage: " ++ progname ++ " [OPTION...] archive files..." (opts, args) <- case getOpt Permute options argv of (o, _, _) | Version `elem` o -> putStrLn "version 0.1.1.4" >> exitWith ExitSuccess (o, _, _) | Help `elem` o -> error $ usageInfo header options (o, (a:as), []) -> return (o, a:as) (_, _, errs) -> error $ concat errs ++ "\n" ++ usageInfo header options let verbosity = if Quiet `elem` opts then [] else [OptVerbose] let cmd = take 1 $ filter (`notElem` [Quiet, Help, Version]) opts let cmd' = if null cmd then Recursive else head cmd let (archivePath : files) = args exists <- doesFileExist archivePath archive <- if exists then toArchive <$> B.readFile archivePath else return emptyArchive case cmd' of Decompress -> extractFilesFromArchive verbosity archive Remove -> do tempDir <- getTemporaryDirectory (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" B.hPut tempArchive $ fromArchive $ foldr deleteEntryFromArchive archive files hClose tempArchive copyFile tempArchivePath archivePath removeFile tempArchivePath List -> mapM_ putStrLn $ filesInArchive archive Recursive -> do when (null files) $ error "No files specified." tempDir <- getTemporaryDirectory (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" addFilesToArchive (verbosity ++ [OptRecursive]) archive files >>= B.hPut tempArchive . fromArchive hClose tempArchive copyFile tempArchivePath archivePath removeFile tempArchivePath _ -> error "Unknown command" zip-archive-0.1.3.4/src/0000755000000000000000000000000012115416204013047 5ustar0000000000000000zip-archive-0.1.3.4/src/Codec/0000755000000000000000000000000012115416204014064 5ustar0000000000000000zip-archive-0.1.3.4/src/Codec/Archive/0000755000000000000000000000000012115416204015445 5ustar0000000000000000zip-archive-0.1.3.4/src/Codec/Archive/Zip.hs0000644000000000000000000007005012115416204016545 0ustar0000000000000000{-# LANGUAGE CPP #-} ------------------------------------------------------------------------ -- | -- Module : Codec.Archive.Zip -- Copyright : John MacFarlane -- License : BSD3 -- -- Maintainer : John MacFarlane < jgm at berkeley dot edu > -- Stability : unstable -- Portability : so far only tested on GHC -- -- The zip-archive library provides functions for creating, modifying, -- and extracting files from zip archives. -- -- Certain simplifying assumptions are made about the zip archives: in -- particular, there is no support for encryption, zip files that span -- multiple disks, ZIP64, OS-specific file attributes, or compression -- methods other than Deflate. However, the library should be able to -- read the most common zip archives, and the archives it produces should -- be readable by all standard unzip programs. -- -- As an example of the use of the library, a standalone zip archiver -- and extracter, Zip.hs, is provided in the source distribution. -- -- For more information on the format of zip archives, consult -- ------------------------------------------------------------------------ module Codec.Archive.Zip ( -- * Data structures Archive (..) , Entry (..) , CompressionMethod (..) , ZipOption (..) , emptyArchive -- * Pure functions for working with zip archives , toArchive , fromArchive , filesInArchive , addEntryToArchive , deleteEntryFromArchive , findEntryByPath , fromEntry , toEntry -- * IO functions for working with zip archives , readEntry , writeEntry , addFilesToArchive , extractFilesFromArchive ) where import System.Time ( toUTCTime, addToClockTime, CalendarTime (..), ClockTime (..), TimeDiff (..) ) #if MIN_VERSION_directory(1,2,0) import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds ) #else #endif import Data.Bits ( shiftL, shiftR, (.&.) ) import Data.Binary import Data.Binary.Get import Data.Binary.Put import Data.List ( nub, find ) import Text.Printf import System.FilePath import System.Directory ( doesDirectoryExist, getDirectoryContents, createDirectoryIfMissing ) import Control.Monad ( when, unless, zipWithM ) #if MIN_VERSION_directory(1,2,0) import Control.Monad ( liftM ) #endif import System.Directory ( getModificationTime ) import System.IO ( stderr, hPutStrLn ) import qualified Data.Digest.CRC32 as CRC32 import qualified Data.Map as M #if MIN_VERSION_binary(0, 6, 0) import Control.Applicative #endif #ifndef _WINDOWS import System.Posix.Files ( setFileTimes ) #endif -- from bytestring import qualified Data.ByteString.Lazy as B -- from utf8-string import Data.ByteString.Lazy.UTF8 ( toString, fromString ) -- from zlib import qualified Codec.Compression.Zlib.Raw as Zlib #if !MIN_VERSION_binary(0, 6, 0) manySig :: Word32 -> Get a -> Get [a] manySig sig p = do sig' <- lookAhead getWord32le if sig == sig' then do r <- p rs <- manySig sig p return $ r : rs else return [] #endif ------------------------------------------------------------------------ -- | Structured representation of a zip archive, including directory -- information and contents (in lazy bytestrings). data Archive = Archive { zEntries :: [Entry] -- ^ Files in zip archive , zSignature :: Maybe B.ByteString -- ^ Digital signature , zComment :: B.ByteString -- ^ Comment for whole zip archive } deriving (Read, Show) -- | Representation of an archived file, including content and metadata. data Entry = Entry { eRelativePath :: FilePath -- ^ Relative path, using '/' as separator , eCompressionMethod :: CompressionMethod -- ^ Compression method , eLastModified :: Integer -- ^ Modification time (seconds since unix epoch) , eCRC32 :: Word32 -- ^ CRC32 checksum , eCompressedSize :: Word32 -- ^ Compressed size in bytes , eUncompressedSize :: Word32 -- ^ Uncompressed size in bytes , eExtraField :: B.ByteString -- ^ Extra field - unused by this library , eFileComment :: B.ByteString -- ^ File comment - unused by this library , eInternalFileAttributes :: Word16 -- ^ Internal file attributes - unused by this library , eExternalFileAttributes :: Word32 -- ^ External file attributes (system-dependent) , eCompressedData :: B.ByteString -- ^ Compressed contents of file } deriving (Read, Show, Eq) -- | Compression methods. data CompressionMethod = Deflate | NoCompression deriving (Read, Show, Eq) -- | Options for 'addFilesToArchive' and 'extractFilesFromArchive'. data ZipOption = OptRecursive -- ^ Recurse into directories when adding files | OptVerbose -- ^ Print information to stderr deriving (Read, Show, Eq) -- | A zip archive with no contents. emptyArchive :: Archive emptyArchive = Archive { zEntries = [] , zSignature = Nothing , zComment = B.empty } -- | Reads an 'Archive' structure from a raw zip archive (in a lazy bytestring). toArchive :: B.ByteString -> Archive toArchive = runGet getArchive -- | Writes an 'Archive' structure to a raw zip archive (in a lazy bytestring). fromArchive :: Archive -> B.ByteString fromArchive = runPut . putArchive -- | Returns a list of files in a zip archive. filesInArchive :: Archive -> [FilePath] filesInArchive = (map eRelativePath) . zEntries -- | Adds an entry to a zip archive, or updates an existing entry. addEntryToArchive :: Entry -> Archive -> Archive addEntryToArchive entry archive = let archive' = deleteEntryFromArchive (eRelativePath entry) archive oldEntries = zEntries archive' in archive' { zEntries = entry : oldEntries } -- | Deletes an entry from a zip archive. deleteEntryFromArchive :: FilePath -> Archive -> Archive deleteEntryFromArchive path archive = let path' = zipifyFilePath path newEntries = filter (\e -> eRelativePath e /= path') $ zEntries archive in archive { zEntries = newEntries } -- | Returns Just the zip entry with the specified path, or Nothing. findEntryByPath :: FilePath -> Archive -> Maybe Entry findEntryByPath path archive = find (\e -> path == eRelativePath e) (zEntries archive) -- | 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" -- | Create an 'Entry' with specified file path, modification time, and contents. toEntry :: FilePath -- ^ File path for entry -> Integer -- ^ Modification time for entry (seconds since unix epoch) -> B.ByteString -- ^ Contents of entry -> Entry toEntry path modtime contents = let uncompressedSize = B.length contents compressedData = compressData Deflate contents compressedSize = B.length compressedData -- only use compression if it helps! (compressionMethod, finalData, finalSize) = if uncompressedSize <= compressedSize then (NoCompression, contents, uncompressedSize) else (Deflate, compressedData, compressedSize) crc32 = CRC32.crc32 contents in Entry { eRelativePath = path , eCompressionMethod = compressionMethod , eLastModified = modtime , eCRC32 = crc32 , eCompressedSize = fromIntegral finalSize , eUncompressedSize = fromIntegral uncompressedSize , eExtraField = B.empty , eFileComment = B.empty , eInternalFileAttributes = 0 -- potentially non-text , eExternalFileAttributes = 0 -- appropriate if from stdin , eCompressedData = finalData } -- | Generates a 'Entry' from a file or directory. readEntry :: [ZipOption] -> FilePath -> IO Entry readEntry opts path = do isDir <- doesDirectoryExist path let path' = zipifyFilePath $ normalise $ path ++ if isDir then "/" else "" -- make sure directories end with / contents <- if isDir then return B.empty else B.readFile path #if MIN_VERSION_directory(1,2,0) modEpochTime <- liftM (floor . utcTimeToPOSIXSeconds) $ getModificationTime path #else (TOD modEpochTime _) <- getModificationTime path #endif let entry = toEntry path' modEpochTime contents when (OptVerbose `elem` opts) $ do let compmethod = case eCompressionMethod entry of Deflate -> "deflated" NoCompression -> "stored" hPutStrLn stderr $ printf " adding: %s (%s %.f%%)" (eRelativePath entry) compmethod (100 - (100 * compressionRatio entry)) return entry -- | Writes contents of an 'Entry' to a file. writeEntry :: [ZipOption] -> Entry -> IO () writeEntry opts entry = do let path = eRelativePath entry -- create directories if needed let dir = takeDirectory path exists <- doesDirectoryExist dir unless exists $ do createDirectoryIfMissing True dir when (OptVerbose `elem` opts) $ hPutStrLn stderr $ " creating: " ++ dir if length path > 0 && last path == '/' -- path is a directory then return () else do when (OptVerbose `elem` opts) $ do hPutStrLn stderr $ case eCompressionMethod entry of Deflate -> " inflating: " ++ path NoCompression -> "extracting: " ++ path B.writeFile path (fromEntry entry) -- Note that last modified times are supported only for POSIX, not for -- Windows. setFileTimeStamp path (eLastModified entry) -- | Add the specified files to an 'Archive'. If 'OptRecursive' is specified, -- recursively add files contained in directories. If 'OptVerbose' is specified, -- print messages to stderr. addFilesToArchive :: [ZipOption] -> Archive -> [FilePath] -> IO Archive addFilesToArchive opts archive files = do filesAndChildren <- if OptRecursive `elem` opts then mapM getDirectoryContentsRecursive files >>= return . nub . concat else return files entries <- mapM (readEntry opts) filesAndChildren return $ foldr addEntryToArchive archive entries -- | Extract all files from an 'Archive', creating directories -- as needed. If 'OptVerbose' is specified, print messages to stderr. -- Note that the last-modified time is set correctly only in POSIX, -- not in Windows. extractFilesFromArchive :: [ZipOption] -> Archive -> IO () extractFilesFromArchive opts archive = mapM_ (writeEntry opts) $ zEntries archive -------------------------------------------------------------------------------- -- Internal functions for reading and writing zip binary format. -- Note that even on Windows, zip files use "/" internally as path separator. zipifyFilePath :: FilePath -> String zipifyFilePath path = let dir = takeDirectory path fn = takeFileName path (_drive, dir') = splitDrive dir -- note: some versions of filepath return ["."] if no dir dirParts = dropWhile (==".") $ splitDirectories dir' in (concat (map (++ "/") dirParts)) ++ fn -- | Uncompress a lazy bytestring. compressData :: CompressionMethod -> B.ByteString -> B.ByteString compressData Deflate = Zlib.compress compressData NoCompression = id -- | Compress a lazy bytestring. decompressData :: CompressionMethod -> B.ByteString -> B.ByteString decompressData Deflate = Zlib.decompress decompressData NoCompression = id -- | Calculate compression ratio for an entry (for verbose output). compressionRatio :: Entry -> Float compressionRatio entry = if eUncompressedSize entry == 0 then 1 else fromIntegral (eCompressedSize entry) / fromIntegral (eUncompressedSize entry) -- | MSDOS datetime: a pair of Word16s (date, time) with the following structure: -- -- > DATE bit 0 - 4 5 - 8 9 - 15 -- > value day (1 - 31) month (1 - 12) years from 1980 -- > TIME bit 0 - 4 5 - 10 11 - 15 -- > value seconds* minute hour -- > *stored in two-second increments -- data MSDOSDateTime = MSDOSDateTime { msDOSDate :: Word16 , msDOSTime :: Word16 } deriving (Read, Show, Eq) -- | Epoch time corresponding to the minimum DOS DateTime (Jan 1 1980 00:00:00). minMSDOSDateTime :: Integer minMSDOSDateTime = 315532800 -- | Convert a clock time to a MSDOS datetime. The MSDOS time will be relative to UTC. epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime epochTimeToMSDOSDateTime epochtime | epochtime < minMSDOSDateTime = epochTimeToMSDOSDateTime minMSDOSDateTime -- if time is earlier than minimum DOS datetime, return minimum epochTimeToMSDOSDateTime epochtime = let ut = toUTCTime (TOD epochtime 0) dosTime = toEnum $ (ctSec ut `div` 2) + shiftL (ctMin ut) 5 + shiftL (ctHour ut) 11 dosDate = toEnum $ ctDay ut + shiftL (fromEnum (ctMonth ut) + 1) 5 + shiftL (ctYear ut - 1980) 9 in MSDOSDateTime { msDOSDate = dosDate, msDOSTime = dosTime } -- | Convert a MSDOS datetime to a 'ClockTime'. msDOSDateTimeToEpochTime :: MSDOSDateTime -> Integer msDOSDateTimeToEpochTime (MSDOSDateTime {msDOSDate = dosDate, msDOSTime = dosTime}) = let seconds = fromIntegral $ 2 * (dosTime .&. 0O37) minutes = fromIntegral $ (shiftR dosTime 5) .&. 0O77 hour = fromIntegral $ shiftR dosTime 11 day = fromIntegral $ dosDate .&. 0O37 month = fromIntegral $ ((shiftR dosDate 5) .&. 0O17) - 1 year = fromIntegral $ shiftR dosDate 9 timeSinceEpoch = TimeDiff { tdYear = year + 10, -- dos times since 1980, unix epoch starts 1970 tdMonth = month, tdDay = day - 1, -- dos days start from 1 tdHour = hour, tdMin = minutes, tdSec = seconds, tdPicosec = 0 } (TOD epochsecs _) = addToClockTime timeSinceEpoch (TOD 0 0) in epochsecs getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive path = do isDir <- doesDirectoryExist path if isDir then do contents <- getDirectoryContents path let contents' = map (path ) $ filter (`notElem` ["..","."]) contents children <- mapM getDirectoryContentsRecursive contents' if path == "." then return (concat children) else return (path : concat children) else return [path] setFileTimeStamp :: FilePath -> Integer -> IO () setFileTimeStamp file epochtime = do #ifdef _WINDOWS return () -- TODO - figure out how to set the timestamp on Windows #else let epochtime' = fromInteger epochtime setFileTimes file epochtime' epochtime' #endif -- A zip file has the following format (*'d items are not supported in this implementation): -- -- > [local file header 1] -- > [file data 1] -- > [data descriptor 1*] -- > . -- > . -- > . -- > [local file header n] -- > [file data n] -- > [data descriptor n*] -- > [archive decryption header*] -- > [archive extra data record*] -- > [central directory] -- > [zip64 end of central directory record*] -- > [zip64 end of central directory locator*] -- > [end of central directory record] -- -- Files stored in arbitrary order. All values are stored in -- little-endian byte order unless otherwise specified. -- -- Central directory structure: -- -- > [file header 1] -- > . -- > . -- > . -- > [file header n] -- > [digital signature] -- -- End of central directory record: -- -- > end of central dir signature 4 bytes (0x06054b50) -- > number of this disk 2 bytes -- > number of the disk with the -- > start of the central directory 2 bytes -- > total number of entries in the -- > central directory on this disk 2 bytes -- > total number of entries in -- > the central directory 2 bytes -- > size of the central directory 4 bytes -- > offset of start of central -- > directory with respect to -- > the starting disk number 4 bytes -- > .ZIP file comment length 2 bytes -- > .ZIP file comment (variable size) getArchive :: Get Archive getArchive = do #if MIN_VERSION_binary(0, 6, 0) locals <- many getLocalFile files <- many (getFileHeader (M.fromList locals)) digSig <- Just `fmap` getDigitalSignature <|> return Nothing #else locals <- manySig 0x04034b50 getLocalFile files <- manySig 0x02014b50 (getFileHeader (M.fromList locals)) digSig <- lookAheadM getDigitalSignature #endif endSig <- getWord32le unless (endSig == 0x06054b50) $ fail "Did not find end of central directory signature" skip 2 -- disk number skip 2 -- disk number of central directory skip 2 -- num entries on this disk skip 2 -- num entries in central directory skip 4 -- central directory size skip 4 -- offset of central directory commentLength <- getWord16le zipComment <- getLazyByteString (toEnum $ fromEnum commentLength) return $ Archive { zEntries = files , zSignature = digSig , zComment = zipComment } putArchive :: Archive -> Put putArchive archive = do mapM_ putLocalFile $ zEntries archive let localFileSizes = map localFileSize $ zEntries archive let offsets = scanl (+) 0 localFileSizes let cdOffset = last offsets _ <- zipWithM putFileHeader offsets (zEntries archive) putDigitalSignature $ zSignature archive putWord32le 0x06054b50 putWord16le 0 -- disk number putWord16le 0 -- disk number of central directory putWord16le $ fromIntegral $ length $ zEntries archive -- number of entries this disk putWord16le $ fromIntegral $ length $ zEntries archive -- number of entries putWord32le $ sum $ map fileHeaderSize $ zEntries archive -- size of central directory putWord32le $ fromIntegral cdOffset -- offset of central dir putWord16le $ fromIntegral $ B.length $ zComment archive putLazyByteString $ zComment archive fileHeaderSize :: Entry -> Word32 fileHeaderSize f = fromIntegral $ 4 + 2 + 2 + 2 + 2 + 2 + 2 + 4 + 4 + 4 + 2 + 2 + 2 + 2 + 2 + 4 + 4 + fromIntegral (B.length $ fromString $ zipifyFilePath $ eRelativePath f) + B.length (eExtraField f) + B.length (eFileComment f) localFileSize :: Entry -> Word32 localFileSize f = fromIntegral $ 4 + 2 + 2 + 2 + 2 + 2 + 4 + 4 + 4 + 2 + 2 + fromIntegral (B.length $ fromString $ zipifyFilePath $ eRelativePath f) + B.length (eExtraField f) + B.length (eCompressedData f) -- Local file header: -- -- > local file header signature 4 bytes (0x04034b50) -- > version needed to extract 2 bytes -- > general purpose bit flag 2 bytes -- > compression method 2 bytes -- > last mod file time 2 bytes -- > last mod file date 2 bytes -- > crc-32 4 bytes -- > compressed size 4 bytes -- > uncompressed size 4 bytes -- > file name length 2 bytes -- > extra field length 2 bytes -- -- > file name (variable size) -- > extra field (variable size) -- -- Note that if bit 3 of the general purpose bit flag is set, then the -- compressed size will be 0 and the size will be stored instead in a -- data descriptor record AFTER the file contents. The record normally -- begins with the signature 0x08074b50, then 4 bytes crc-32, 4 bytes -- compressed size, 4 bytes uncompressed size. getLocalFile :: Get (Word32, B.ByteString) getLocalFile = do offset <- bytesRead getWord32le >>= ensure (== 0x04034b50) skip 2 -- version bitflag <- getWord16le skip 2 -- compressionMethod skip 2 -- last mod file time skip 2 -- last mod file date skip 4 -- crc32 compressedSize <- getWord32le when (compressedSize == 0xFFFFFFFF) $ fail "Can't read ZIP64 archive." skip 4 -- uncompressedsize fileNameLength <- getWord16le extraFieldLength <- getWord16le skip (fromIntegral fileNameLength) -- filename skip (fromIntegral extraFieldLength) -- extra field compressedData <- if bitflag .&. 0O10 == 0 then getLazyByteString (fromIntegral compressedSize) else -- If bit 3 of general purpose bit flag is set, -- then we need to read until we get to the -- data descriptor record. We assume that the -- record has signature 0x08074b50; this is not required -- by the specification but is common. do raw <- getWordsTilSig 0x08074b50 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" return (fromIntegral offset, compressedData) getWordsTilSig :: Word32 -> Get [Word8] getWordsTilSig sig = do #if MIN_VERSION_binary(0, 6, 0) (getWord32le >>= ensure (== sig) >> return []) <|> do w <- getWord8 ws <- getWordsTilSig sig return (w:ws) #else sig' <- lookAhead getWord32le if sig == sig' then skip 4 >> return [] else do w <- getWord8 ws <- getWordsTilSig sig return (w:ws) #endif putLocalFile :: Entry -> Put putLocalFile f = do putWord32le 0x04034b50 putWord16le 20 -- version needed to extract (>=2.0) putWord16le 2 -- general purpose bit flag (max compression) putWord16le $ case eCompressionMethod f of NoCompression -> 0 Deflate -> 8 let modTime = epochTimeToMSDOSDateTime $ eLastModified f putWord16le $ msDOSTime modTime putWord16le $ msDOSDate modTime putWord32le $ eCRC32 f putWord32le $ eCompressedSize f putWord32le $ eUncompressedSize f putWord16le $ fromIntegral $ B.length $ fromString $ zipifyFilePath $ eRelativePath f putWord16le $ fromIntegral $ B.length $ eExtraField f putLazyByteString $ fromString $ zipifyFilePath $ eRelativePath f putLazyByteString $ eExtraField f putLazyByteString $ eCompressedData f -- File header structure: -- -- > central file header signature 4 bytes (0x02014b50) -- > version made by 2 bytes -- > version needed to extract 2 bytes -- > general purpose bit flag 2 bytes -- > compression method 2 bytes -- > last mod file time 2 bytes -- > last mod file date 2 bytes -- > crc-32 4 bytes -- > compressed size 4 bytes -- > uncompressed size 4 bytes -- > file name length 2 bytes -- > extra field length 2 bytes -- > file comment length 2 bytes -- > disk number start 2 bytes -- > internal file attributes 2 bytes -- > external file attributes 4 bytes -- > relative offset of local header 4 bytes -- -- > file name (variable size) -- > extra field (variable size) -- > file comment (variable size) getFileHeader :: M.Map Word32 B.ByteString -- ^ map of (offset, content) pairs returned by getLocalFile -> Get Entry getFileHeader locals = do getWord32le >>= ensure (== 0x02014b50) skip 2 -- version made by versionNeededToExtract <- getWord8 skip 1 -- upper byte indicates OS part of "version needed to extract" unless (versionNeededToExtract <= 20) $ fail "This archive requires zip >= 2.0 to extract." skip 2 -- general purpose bit flag rawCompressionMethod <- getWord16le compressionMethod <- case rawCompressionMethod of 0 -> return NoCompression 8 -> return Deflate _ -> fail $ "Unknown compression method " ++ show rawCompressionMethod lastModFileTime <- getWord16le lastModFileDate <- getWord16le crc32 <- getWord32le compressedSize <- getWord32le uncompressedSize <- getWord32le fileNameLength <- getWord16le extraFieldLength <- getWord16le fileCommentLength <- getWord16le skip 2 -- disk number start internalFileAttributes <- getWord16le externalFileAttributes <- getWord32le relativeOffset <- getWord32le fileName <- getLazyByteString (toEnum $ fromEnum fileNameLength) extraField <- getLazyByteString (toEnum $ fromEnum extraFieldLength) fileComment <- getLazyByteString (toEnum $ fromEnum fileCommentLength) compressedData <- case (M.lookup relativeOffset locals) of Just x -> return x Nothing -> fail $ "Unable to find data at offset " ++ show relativeOffset return $ Entry { eRelativePath = toString fileName , eCompressionMethod = compressionMethod , eLastModified = msDOSDateTimeToEpochTime $ MSDOSDateTime { msDOSDate = lastModFileDate, msDOSTime = lastModFileTime } , eCRC32 = crc32 , eCompressedSize = compressedSize , eUncompressedSize = uncompressedSize , eExtraField = extraField , eFileComment = fileComment , eInternalFileAttributes = internalFileAttributes , eExternalFileAttributes = externalFileAttributes , eCompressedData = compressedData } putFileHeader :: Word32 -- ^ offset -> Entry -> Put putFileHeader offset local = do putWord32le 0x02014b50 putWord16le 0 -- version made by putWord16le 20 -- version needed to extract (>= 2.0) putWord16le 2 -- general purpose bit flag (max compression) putWord16le $ case eCompressionMethod local of NoCompression -> 0 Deflate -> 8 let modTime = epochTimeToMSDOSDateTime $ eLastModified local putWord16le $ msDOSTime modTime putWord16le $ msDOSDate modTime putWord32le $ eCRC32 local putWord32le $ eCompressedSize local putWord32le $ eUncompressedSize local putWord16le $ fromIntegral $ B.length $ fromString $ zipifyFilePath $ eRelativePath local putWord16le $ fromIntegral $ B.length $ eExtraField local putWord16le $ fromIntegral $ B.length $ eFileComment local putWord16le 0 -- disk number start putWord16le $ eInternalFileAttributes local putWord32le $ eExternalFileAttributes local putWord32le offset putLazyByteString $ fromString $ zipifyFilePath $ eRelativePath local putLazyByteString $ eExtraField local putLazyByteString $ eFileComment local -- Digital signature: -- -- > header signature 4 bytes (0x05054b50) -- > size of data 2 bytes -- > signature data (variable size) #if MIN_VERSION_binary(0, 6, 0) getDigitalSignature :: Get B.ByteString getDigitalSignature = do getWord32le >>= ensure (== 0x05054b50) sigSize <- getWord16le getLazyByteString (toEnum $ fromEnum sigSize) #else getDigitalSignature :: Get (Maybe B.ByteString) getDigitalSignature = do hdrSig <- getWord32le if hdrSig /= 0x05054b50 then return Nothing else do sigSize <- getWord16le getLazyByteString (toEnum $ fromEnum sigSize) >>= return . Just #endif putDigitalSignature :: Maybe B.ByteString -> Put putDigitalSignature Nothing = return () putDigitalSignature (Just sig) = do putWord32le 0x05054b50 putWord16le $ fromIntegral $ B.length sig putLazyByteString sig ensure :: (a -> Bool) -> a -> Get () ensure p val = if p val then return () else fail "ensure not satisfied" zip-archive-0.1.3.4/tests/0000755000000000000000000000000012115416204013422 5ustar0000000000000000zip-archive-0.1.3.4/tests/test-zip-archive.hs0000644000000000000000000001051312115416204017154 0ustar0000000000000000-- Test suite for Codec.Archive.Zip -- runghc Test.hs import Codec.Archive.Zip import System.Directory import Test.HUnit.Base import Test.HUnit.Text import System.Process import qualified Data.ByteString.Lazy as B import Control.Applicative import System.Exit -- define equality for Archives so timestamps aren't distinguished if they -- correspond to the same MSDOS datetime. instance Eq Archive where (==) a1 a2 = zSignature a1 == zSignature a2 && zComment a1 == zComment a2 && (all id $ zipWith (\x y -> x { eLastModified = eLastModified x `div` 2 } == y { eLastModified = eLastModified y `div` 2 }) (zEntries a1) (zEntries a2)) main :: IO Counts main = do createDirectory "test-temp" res <- runTestTT $ TestList [ testReadWriteArchive , testReadExternalZip , testFromToArchive , testReadWriteEntry , testAddFilesOptions , testDeleteEntries , testExtractFiles ] removeDirectoryRecursive "test-temp" exitWith $ case errors res of 0 -> ExitSuccess n -> ExitFailure n testReadWriteArchive :: Test testReadWriteArchive = TestCase $ do archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] B.writeFile "test-temp/test1.zip" $ fromArchive archive archive' <- toArchive <$> B.readFile "test-temp/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 "/usr/bin/zip -q -9 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 cabalContents <- B.readFile "zip-archive.cabal" case findEntryByPath "zip-archive.cabal" archive of 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 archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] assertEqual "for (toArchive $ fromArchive archive)" archive (toArchive $ fromArchive archive) testReadWriteEntry :: Test testReadWriteEntry = TestCase $ do entry <- readEntry [] "zip-archive.cabal" setCurrentDirectory "test-temp" writeEntry [] entry setCurrentDirectory ".." entry' <- readEntry [] "test-temp/zip-archive.cabal" let entry'' = entry' { eRelativePath = eRelativePath entry, eLastModified = eLastModified entry } assertEqual "for readEntry -> writeEntry -> readEntry" entry entry'' testAddFilesOptions :: Test testAddFilesOptions = 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 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" 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" 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