zip-archive-0.4.3.2/0000755000000000000000000000000007346545000012270 5ustar0000000000000000zip-archive-0.4.3.2/LICENSE0000644000000000000000000000274207346545000013302 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.4.3.2/Main.hs0000644000000000000000000001011407346545000013505 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 Data.Version ( showVersion ) import Paths_zip_archive ( version ) import Debug.Trace ( traceShowId ) data Flag = Quiet | Version | Decompress | Recursive | Remove | List | Debug | 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 [] ["debug"] (NoArg Debug) "debug output" , Option ['h'] ["help"] (NoArg Help) "help" ] quit :: Bool -> String -> IO a quit failure msg = do hPutStr stderr msg _ <- exitWith $ if failure then ExitFailure 1 else ExitSuccess return undefined 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 -> do putStrLn ("version " ++ showVersion version) exitWith ExitSuccess (o, _, _) | Help `elem` o -> quit False $ usageInfo header options (o, (a:as), []) -> return (o, a:as) (_, [], []) -> quit True $ usageInfo header options (_, _, errs) -> quit True $ concat errs ++ "\n" ++ usageInfo header options let verbosity = if Quiet `elem` opts then [] else [OptVerbose] let debug = Debug `elem` opts let cmd = case filter (`notElem` [Quiet, Help, Version, Debug]) opts of [] -> Recursive (x:_) -> x (archivePath : files) <- case args of [] -> quit True "No archive path given" _ -> return args exists <- doesFileExist archivePath archive <- if exists then toArchive <$> B.readFile archivePath else return emptyArchive let showArchiveIfDebug x = if debug then traceShowId x else x case cmd of Decompress -> extractFilesFromArchive verbosity $ showArchiveIfDebug archive Remove -> do tempDir <- getTemporaryDirectory (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" B.hPut tempArchive $ fromArchive $ showArchiveIfDebug $ foldr deleteEntryFromArchive archive files hClose tempArchive copyFile tempArchivePath archivePath removeFile tempArchivePath List -> mapM_ putStrLn $ filesInArchive $ showArchiveIfDebug 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 . showArchiveIfDebug hClose tempArchive copyFile tempArchivePath archivePath removeFile tempArchivePath _ -> error $ "Unknown command " ++ show cmd zip-archive-0.4.3.2/README.markdown0000644000000000000000000000231307346545000014770 0ustar0000000000000000zip-archive =========== The zip-archive library provides functions for creating, modifying, and extracting files from zip archives. The zip archive format is documented in . Certain simplifying assumptions are made about the zip archives: in particular, there is no support for strong 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. Archives are built and extracted in memory, so manipulating large zip files will consume a lot of memory. If you work with large zip files or need features not supported by this library, a better choice may be [zip](http://hackage.haskell.org/package/zip), which uses a memory-efficient streaming approach. However, zip can only read and write archives inside instances of MonadIO, so zip-archive is a better choice if you want to manipulate zip archives in "pure" contexts. As an example of the use of the library, a standalone zip archiver and extracter is provided in the source distribution. zip-archive-0.4.3.2/Setup.hs0000644000000000000000000000005607346545000013725 0ustar0000000000000000import Distribution.Simple main = defaultMain zip-archive-0.4.3.2/changelog0000644000000000000000000002524607346545000014153 0ustar0000000000000000zip-archive 0.4.3.2 * readEntry: Fix computation of modification time (#67). It should be a UNIX time (seconds since UNIX epoch), but computed relative to the local time zone, not UTC. zip-archive 0.4.3.1 * Use streaming decompress to identify extent of compressed data (#66). This fixes a problem that arises for local files with bit 3 of the general purpose bit flag set. In this case, we don't get information up front about the size of the compressed data. So how do we know where the compressed data ends? Previously, we tried to determine this by looking for the signature of the data descriptor. But the data descriptor doesn't always HAVE a signature, and it is also possible for signatures to occur accidentally in the compressed data itself (#65). Instead, we now use the streaming decompression interface from zlib's Internal module to identify where the compressed data ends. Fixes both #65 and #25. zip-archive 0.4.3 * Improve code for retrieving compressed data of unknown length (#63). Do not assume we'll have the signature 0x08074b50 that is sometimes used for the data description, because it is not in the spec and is not always used. * Make some record fields strict. * Require binary >= 0.7.2, remove some CPP zip-archive 0.4.2.2 * Use `command -v` before trying `which` in the test suite (#62). `command` is a bash builtin, but for busybox we'll need `which`. zip-archive 0.4.2.1 * Fix Windows build regression (#61). zip-archive 0.4.2 * Fix problem with files with colon (#89). * Remove build-tools. This was used to indicate that the 'unzip' executable was needed for testing, but it was never intended to be used this way and now the field is deprecated. The current test suite simply skips the test using the unzip executable (with a warning) if 'unzip' is not in the path. * Remove existing symlinks when extracting zip files with symlinks (#60, Vikrem). Previously, writeEntry would raise an error if it tried to create a symlink and a symlink already existed at that path. This behavior was inconsistent with its behavior for regular files, which it overwrote without comment. This commit causes symlinks to be replaced by writeEntry instead of an error being raised. * Remove binary < 0.6 CPP. It's no longer needed because we don't support binary < 0.6. Also use manySig instead of many, to get better error messages. * Add type annotation for printf. * Better checking for unsafe paths (#55). This method allows things like `foo/bar/../../baz`. * Require base >= 4.5 (#56) * Add GitHub CI. zip-archive 0.4.1 * writEntry behavior change: Improve raising of UnsafePath error (#55). Previously we raised this error spuriously when archives were unpacked outside the working directory. Now we raise it if eRelativePath contains ".." as a path component, or eRelativePath path is an absolute path and there is no separate destination directory. (Note that `/foo/bar` is fine as a path as long as a destination directory, e.g. `/usr/local`, is specified.) zip-archive 0.4 * Implement read-only support for PKWARE encryption (Sergii Rudchenko). The "traditional" PKWARE encryption is a symmetric encryption algorithm described in zip format specification in section 6.1. This change allows to extract basic "password-protected" entries from ZIP files. Note that the standard file extraction function extractFilesFromArchive does not decrypt entries (it will raise an exception if it encounters an encrypted entry). To handle archives with encrypted entries, use the new function fromEncryptedEntry. API changes: + Add eEncryptionMethod field to Entry. + Add EncryptionMethod type. + Add function isEncryptedEntry. + Add function fromEncryptedEntry. * Add CannotWriteEncryptedEntry constructor to ZipException. * Add UnsafePath to ZipException (#50). * writeEntry: raise UnsafePath exception for unsafe paths (#50). This prevents malicious zip files from overwriting paths above the working directory. * Add Paths_zip_archive to autogen-modules. * Clarify README and cabal description. * Specify cabal-version: 2.0. Otherwise we get an unknown build tool error using `build-depends` without a custom Setup.hs. * Change build-type to simple. Retain 'build-tools: unzip' in test stanza, though now it doesn't do anything except give a hint to external tools. If unzip is not found in the path, the test suite prints a message and counts the test that requires unzip as succeeding (see #51). zip-archive 0.3.3 * Remove dependency on old-time (typedrat). * Drop splitBase flag and support for base versions < 3. zip-archive 0.3.2.5 * Move 'build-tools: unzip' from library stanza to test stanza. unzip should only be required for testing, not for regular builds of the library. zip-archive 0.3.2.4 * Make build-tools stanza conditional on non-windows. Closes #44. zip-archive 0.3.2.3 * Use custom-setup stanza and specify build-tools. Closes #41. zip-archive 0.3.2.2 * Use createSymbolicLink instead of createFileLink in tests. This allows us to lower the directory lower bound (#40). zip-archive 0.3.2.1 * Fixes for handling of symbolic links (#39, Tommaso Piazza). * Fixes for symbolic link tests, and additional tests. zip-archive 0.3.2 * Add ZipOption to preserve symbolic links (#37, Tommaso Piazza). Add OptPreserveSymbolicLinks constructor to ZipOption. If this option is set, symbolic links will be preserved. Symbolic links are not supported on Windows. * Require binary >= 0.6 (#36). * Improve exit handling in zip-archive program. zip-archive 0.3.1.1 * readEntry: Read file as a strict ByteString. This avoids problems on Windows, where the file handle wasn't being closed. * Added appveyor.yml to do continuous testing on Windows. * Test suite: remove need for external zip program (#35). Instead of creating an archive with zip, we now store a small externally created zip archive to use for testing. zip-archive 0.3.1 * Don't use a custom build (#28). * Renamed executable Zip -> zip-archive, added --debug option. The --debug option prints the intermediate Haskell data structure. zip-archive 0.3.0.7 * Fix check for unix file attributes (#34). Previously attributes would not always be preserved for files in zip archives. zip-archive 0.3.0.6 * Bump bytestring lower bound so toStrict is guaranteed (Benjamin Landers). zip-archive 0.3.0.5 * Fix bug in `OptLocation` handling (EugeneN). When using `OptLocation folder False` (for adding files to an archive into a folder without preserving full path hierarchy), original files' names were ignored, resulting in all the files getting the same name. zip-archive 0.3.0.4 * Fix `toArchive` so it doesn't use too much memory when a data data descriptor holds the size (Michael Stahl, #29). The size fields in the local file headers may not contain valid values, in which case the sizes are stored in a "data descriptor" that follows the file data. Previously handling this case required reading the entire archive is a `[Word8]` list. With this change, `getWordsTilSig` iteratively reads chunks as strict ByteStrings and converts them to a lazy ByteString at the end. zip-archive 0.3.0.3 * Test suite: use withTempDir to create temporary directory. This should help fix problems some have encountered with the test suite leaving a temporary directory behind. zip-archive 0.3.0.2 * Fix test suite so it runs on Windows. * Zip executable: get version from cabal `Paths_zip_archive` (#27). zip-archive 0.3.0.1 * Set `eVersionMadeBy` to 0 (default) in `toEntry`, since we are setting external attributes to 0. See jgm/pandoc#2822. Only to `eVersionMadeBy` to UNIX if we actually read file attributes on a UNIX system. 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). zip-archive 0.2.3.6 * Removed hard-coded path to zip in test suite (#21). * Removed misplaced build-depends in cabal file. zip-archive 0.2.3.5 * Allow compilation with binary >= 0.5. Note that toArchiveOrFail is not safe when compiled against binary < 0.7; it will never return a Left value, and will raise an error if parsing fails, just like toArchive. This is documented in the haddocks. This is ugly, but justified by the need to have a version of zip-archive that compiles against older versions of binary. zip-archive 0.2.3.4 * Make sure all path comparisons compare normalized paths. So, findEntryByPath "foo" will find something stored as "./foo" in the zip container. zip-archive 0.2.3.3 * Better normalization of file paths: "./foo/bar" and "foo/./bar" are now treated the same, for example. Note that we do not yet treat "foo/../bar" and "bar" as the same. zip-archive 0.2.3.2 * Removed lower bound on directory (>= 1.2), which caused build failures with GHC 7.4 and 7.6. * Added travis script for automatic testing on 3 GHC versions. zip-archive 0.2.3.1 * Require binary >= 0.7 and directory >= 1.2. The newer binary is needed to provide toArchiveOrFail. The other change is mainly for convenience, to avoid lots of ugly conditional compilation. zip-archive 0.2.3 * Export new function `toArchiveOrFail`. Closes #17. * Set general purpose bit flag to use UTF8 in local file header. Otherwise we get a mismatch between the flag in the central directory and the flag in the local file header, which causes some programs not to be able to extract the files. Closes #19. zip-archive 0.2.2.1 * Fix a stack overflow in getWordsTillSig (Tristan Ravitch). zip-archive 0.2.2 * Set bit 11 in the file header to ensure other programs recognize UTF-8 encoded file names (Tobias Brandt). zip-archive 0.2.1 * Added OptLocation, to specify the path to which a file is to be added when readEntry is used (Stephen McIntosh). zip-archive-0.4.3.2/src/Codec/Archive/0000755000000000000000000000000007346545000015455 5ustar0000000000000000zip-archive-0.4.3.2/src/Codec/Archive/Zip.hs0000644000000000000000000012174407346545000016564 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} ------------------------------------------------------------------------ -- | -- 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 strong 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 (..) , EncryptionMethod (..) , ZipOption (..) , ZipException (..) , emptyArchive -- * Pure functions for working with zip archives , toArchive , toArchiveOrFail , fromArchive , filesInArchive , addEntryToArchive , deleteEntryFromArchive , findEntryByPath , fromEntry , fromEncryptedEntry , isEncryptedEntry , toEntry #ifndef _WINDOWS , isEntrySymbolicLink , symbolicLinkEntryTarget , entryCMode #endif -- * IO functions for working with zip archives , readEntry , writeEntry #ifndef _WINDOWS , writeSymbolicLinkEntry #endif , addFilesToArchive , extractFilesFromArchive ) where import Data.Time.Calendar ( toGregorian, fromGregorian ) import Data.Time.Clock ( UTCTime(..) ) import Data.Time.LocalTime ( TimeZone(..), TimeOfDay(..), timeToTimeOfDay, getTimeZone ) import Data.Time.Clock.POSIX ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds ) import Data.Bits ( shiftL, shiftR, (.&.), (.|.), xor, testBit ) import Data.Binary 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, getModificationTime,) import Control.Monad ( when, unless, zipWithM_ ) import qualified Control.Exception as E import System.IO ( stderr, hPutStrLn ) import qualified Data.Digest.CRC32 as CRC32 import qualified Data.Map as M import Control.Applicative #ifdef _WINDOWS import Data.Char (isLetter) #else import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink, unionFileModes, createSymbolicLink, removeLink ) import System.Posix.Types ( CMode(..) ) import Data.List (partition) import Data.Maybe (fromJust) #endif -- from bytestring import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as C -- text import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -- from zlib import qualified Codec.Compression.Zlib.Raw as Zlib import qualified Codec.Compression.Zlib.Internal as ZlibInt import System.IO.Error (isAlreadyExistsError) -- import Debug.Trace 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 [] ------------------------------------------------------------------------ -- | 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) instance Binary Archive where put = putArchive get = getArchive -- | Representation of an archived file, including content and metadata. data Entry = Entry { eRelativePath :: FilePath -- ^ Relative path, using '/' as separator , eCompressionMethod :: !CompressionMethod -- ^ Compression method , eEncryptionMethod :: !EncryptionMethod -- ^ Encryption 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 , 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 } deriving (Read, Show, Eq) -- | Compression methods. data CompressionMethod = Deflate | NoCompression deriving (Read, Show, Eq) data EncryptionMethod = NoEncryption -- ^ Entry is not encrypted | PKWAREEncryption !Word8 -- ^ Entry is encrypted with the traditional PKWARE encryption deriving (Read, Show, Eq) -- | The way the password should be verified during entry decryption data PKWAREVerificationType = CheckTimeByte | CheckCRCByte deriving (Read, Show, Eq) -- | Options for 'addFilesToArchive' and 'extractFilesFromArchive'. data ZipOption = OptRecursive -- ^ Recurse into directories when adding files | OptVerbose -- ^ Print information to stderr | OptDestination FilePath -- ^ Directory in which to extract | OptLocation FilePath !Bool -- ^ Where to place file when adding files and whether to append current path | OptPreserveSymbolicLinks -- ^ Preserve symbolic links as such. This option is ignored on Windows. deriving (Read, Show, Eq) data ZipException = CRC32Mismatch FilePath | UnsafePath FilePath | CannotWriteEncryptedEntry FilePath deriving (Show, Typeable, Data, Eq) instance E.Exception ZipException -- | 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 = decode -- | Like 'toArchive', but returns an 'Either' value instead of raising an -- error if the archive cannot be decoded. NOTE: This function only -- works properly when the library is compiled against binary >= 0.7. -- With earlier versions, it will always return a Right value, -- raising an error if parsing fails. toArchiveOrFail :: B.ByteString -> Either String Archive toArchiveOrFail bs = case decodeOrFail bs of Left (_,_,e) -> Left e Right (_,_,x) -> Right x -- | Writes an 'Archive' structure to a raw zip archive (in a lazy bytestring). fromArchive :: Archive -> B.ByteString fromArchive = encode -- | 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 = archive { zEntries = [e | e <- zEntries archive , not (eRelativePath e `matches` path)] } -- | Returns Just the zip entry with the specified path, or Nothing. findEntryByPath :: FilePath -> Archive -> Maybe Entry findEntryByPath path archive = find (\e -> path `matches` eRelativePath e) (zEntries archive) -- | Returns uncompressed contents of zip entry. fromEntry :: Entry -> B.ByteString fromEntry entry = decompressData (eCompressionMethod entry) (eCompressedData entry) -- | Returns decrypted and uncompressed contents of zip entry. fromEncryptedEntry :: String -> Entry -> Maybe B.ByteString fromEncryptedEntry password entry = decompressData (eCompressionMethod entry) <$> decryptData password (eEncryptionMethod entry) (eCompressedData entry) -- | Check if an 'Entry' is encrypted isEncryptedEntry :: Entry -> Bool isEncryptedEntry entry = case eEncryptionMethod entry of (PKWAREEncryption _) -> True _ -> False -- | 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 = normalizePath path , eCompressionMethod = compressionMethod , eEncryptionMethod = NoEncryption , eLastModified = modtime , eCRC32 = crc32 , eCompressedSize = fromIntegral finalSize , eUncompressedSize = fromIntegral uncompressedSize , eExtraField = B.empty , eFileComment = B.empty , eVersionMadeBy = 0 -- FAT , 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 #ifdef _WINDOWS let isSymLink = False #else fs <- getSymbolicLinkStatus path let isSymLink = isSymbolicLink fs #endif -- make sure directories end in / and deal with the OptLocation option let path' = let p = path ++ (case reverse path of ('/':_) -> "" _ | isDir && not isSymLink -> "/" _ | isDir && isSymLink -> "" | otherwise -> "") in (case [(l,a) | OptLocation l a <- opts] of ((l,a):_) -> if a then l p else l takeFileName p _ -> p) contents <- #ifndef _WINDOWS if isSymLink then do linkTarget <- readSymbolicLink path return $ C.pack linkTarget else #endif if isDir then return B.empty else B.fromStrict <$> S.readFile path modTime <- getModificationTime path tzone <- getTimeZone modTime let modEpochTime = -- UNIX time computed relative to LOCAL time zone! (#67) floor (utcTimeToPOSIXSeconds modTime) + fromIntegral (timeZoneMinutes tzone * 60) let entry = toEntry path' modEpochTime contents entryE <- #ifdef _WINDOWS return $ entry { eVersionMadeBy = 0x0000 } -- FAT/VFAT/VFAT32 file attributes #else do let fm = if isSymLink then unionFileModes symbolicLinkMode (fileMode fs) else fileMode fs let modes = fromIntegral $ shiftL (toInteger fm) 16 return $ entry { eExternalFileAttributes = modes, eVersionMadeBy = 0x0300 } -- UNIX file attributes #endif when (OptVerbose `elem` opts) $ do let compmethod = case eCompressionMethod entryE of Deflate -> ("deflated" :: String) NoCompression -> "stored" hPutStrLn stderr $ printf " adding: %s (%s %.f%%)" (eRelativePath entryE) compmethod (100 - (100 * compressionRatio entryE)) return entryE -- check path, resolving .. and . components, raising -- UnsafePath exception if this takes you outside of the root. checkPath :: FilePath -> IO () checkPath fp = maybe (E.throwIO (UnsafePath fp)) (\_ -> return ()) (resolve . splitDirectories $ fp) where resolve = fmap reverse . foldl go (return []) where go acc x = do xs <- acc case x of "." -> return xs ".." -> case xs of [] -> fail "outside of root path" (_:ys) -> return ys _ -> return (x:xs) -- | 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 when (isEncryptedEntry entry) $ E.throwIO $ CannotWriteEncryptedEntry (eRelativePath entry) let relpath = eRelativePath entry checkPath relpath path <- case [d | OptDestination d <- opts] of (x:_) -> return (x relpath) [] | isAbsolute relpath -> E.throwIO $ UnsafePath relpath | otherwise -> return relpath -- 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 not (null path) && last path == '/' -- path is a directory then return () else do when (OptVerbose `elem` opts) $ hPutStrLn stderr $ case eCompressionMethod entry of Deflate -> " inflating: " ++ path NoCompression -> "extracting: " ++ path 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 .&. 0xFF00 == 0x0300 && modes /= 0) $ setFileMode path modes #endif -- Note that last modified times are supported only for POSIX, not for -- Windows. setFileTimeStamp path (eLastModified entry) #ifndef _WINDOWS -- | Write an 'Entry' representing a symbolic link to a file. -- If the 'Entry' does not represent a symbolic link or -- the options do not contain 'OptPreserveSymbolicLinks`, this -- function behaves like `writeEntry`. writeSymbolicLinkEntry :: [ZipOption] -> Entry -> IO () writeSymbolicLinkEntry opts entry = if OptPreserveSymbolicLinks `notElem` opts then writeEntry opts entry else do if isEntrySymbolicLink entry then do let prefixPath = case [d | OptDestination d <- opts] of (x:_) -> x _ -> "" let targetPath = fromJust . symbolicLinkEntryTarget $ entry let symlinkPath = prefixPath eRelativePath entry when (OptVerbose `elem` opts) $ do hPutStrLn stderr $ "linking " ++ symlinkPath ++ " to " ++ targetPath forceSymLink targetPath symlinkPath else writeEntry opts entry -- | Writes a symbolic link, but removes any conflicting files and retries if necessary. forceSymLink :: FilePath -> FilePath -> IO () forceSymLink target linkName = createSymbolicLink target linkName `E.catch` (\e -> if isAlreadyExistsError e then removeLink linkName >> createSymbolicLink target linkName else ioError e) -- | Get the target of a 'Entry' representing a symbolic link. This might fail -- if the 'Entry' does not represent a symbolic link symbolicLinkEntryTarget :: Entry -> Maybe FilePath symbolicLinkEntryTarget entry | isEntrySymbolicLink entry = Just . C.unpack $ fromEntry entry | otherwise = Nothing -- | Check if an 'Entry' represents a symbolic link isEntrySymbolicLink :: Entry -> Bool isEntrySymbolicLink entry = entryCMode entry .&. symbolicLinkMode == symbolicLinkMode -- | Get the 'eExternalFileAttributes' of an 'Entry' as a 'CMode' a.k.a. 'FileMode' entryCMode :: Entry -> CMode entryCMode entry = CMode (fromIntegral $ shiftR (eExternalFileAttributes entry) 16) #endif -- | Add the specified files to an 'Archive'. If 'OptRecursive' is specified, -- recursively add files contained in directories. if 'OptPreserveSymbolicLinks' -- is specified, don't recurse into it. If 'OptVerbose' is specified, -- print messages to stderr. addFilesToArchive :: [ZipOption] -> Archive -> [FilePath] -> IO Archive addFilesToArchive opts archive files = do filesAndChildren <- if OptRecursive `elem` opts #ifdef _WINDOWS then mapM getDirectoryContentsRecursive files >>= return . nub . concat #else then nub . concat <$> mapM (getDirectoryContentsRecursive' opts) files #endif 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. -- This function fails if encrypted entries are present extractFilesFromArchive :: [ZipOption] -> Archive -> IO () extractFilesFromArchive opts archive = do let entries = zEntries archive if OptPreserveSymbolicLinks `elem` opts then do #ifdef _WINDOWS mapM_ (writeEntry opts) entries #else let (symbolicLinkEntries, nonSymbolicLinkEntries) = partition isEntrySymbolicLink entries mapM_ (writeEntry opts) nonSymbolicLinkEntries mapM_ (writeSymbolicLinkEntry opts) symbolicLinkEntries #endif else mapM_ (writeEntry opts) entries -------------------------------------------------------------------------------- -- Internal functions for reading and writing zip binary format. -- Note that even on Windows, zip files use "/" internally as path separator. normalizePath :: FilePath -> String normalizePath path = let dir = takeDirectory path fn = takeFileName path dir' = case dir of #ifdef _WINDOWS (c:':':d:xs) | isLetter c , d == '/' || d == '\\' -> xs -- remove drive #endif _ -> dir -- note: some versions of filepath return ["."] if no dir dirParts = filter (/=".") $ splitDirectories dir' in intercalate "/" (dirParts ++ [fn]) -- Equality modulo normalization. So, "./foo" `matches` "foo". matches :: FilePath -> FilePath -> Bool matches fp1 fp2 = normalizePath fp1 == normalizePath fp2 -- | 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 -- | Decrypt a lazy bytestring -- Returns Nothing if password is incorrect decryptData :: String -> EncryptionMethod -> B.ByteString -> Maybe B.ByteString decryptData _ NoEncryption s = Just s decryptData password (PKWAREEncryption controlByte) s = let headerlen = 12 initKeys = (305419896, 591751049, 878082192) startKeys = B.foldl pkwareUpdateKeys initKeys (C.pack password) (header, content) = B.splitAt headerlen $ snd $ B.mapAccumL pkwareDecryptByte startKeys s in if B.last header == controlByte then Just content else Nothing -- | PKWARE decryption context type DecryptionCtx = (Word32, Word32, Word32) -- | An interation of the PKWARE decryption algorithm pkwareDecryptByte :: DecryptionCtx -> Word8 -> (DecryptionCtx, Word8) pkwareDecryptByte keys@(_, _, key2) inB = let tmp = key2 .|. 2 tmp' = fromIntegral ((tmp * (tmp `xor` 1)) `shiftR` 8) :: Word8 outB = inB `xor` tmp' in (pkwareUpdateKeys keys outB, outB) -- | Update decryption keys after a decrypted byte pkwareUpdateKeys :: DecryptionCtx -> Word8 -> DecryptionCtx pkwareUpdateKeys (key0, key1, key2) inB = let key0' = CRC32.crc32Update (key0 `xor` 0xffffffff) [inB] `xor` 0xffffffff key1' = (key1 + (key0' .&. 0xff)) * 134775813 + 1 key1Byte = fromIntegral (key1' `shiftR` 24) :: Word8 key2' = CRC32.crc32Update (key2 `xor` 0xffffffff) [key1Byte] `xor` 0xffffffff in (key0', key1', key2') -- | 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 UTCTime (toGregorian -> (fromInteger -> year, month, day)) (timeToTimeOfDay -> (TimeOfDay hour minutes (floor -> sec))) = posixSecondsToUTCTime (fromIntegral epochtime) dosTime = toEnum $ (sec `div` 2) + shiftL minutes 5 + shiftL hour 11 dosDate = toEnum $ day + shiftL month 5 + shiftL (year - 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) year = fromIntegral $ shiftR dosDate 9 utc = UTCTime (fromGregorian (1980 + year) month day) (3600 * hour + 60 * minutes + seconds) in floor (utcTimeToPOSIXSeconds utc) #ifndef _WINDOWS getDirectoryContentsRecursive' :: [ZipOption] -> FilePath -> IO [FilePath] getDirectoryContentsRecursive' opts path = if OptPreserveSymbolicLinks `elem` opts then do isDir <- doesDirectoryExist path if isDir then do isSymLink <- fmap isSymbolicLink $ getSymbolicLinkStatus path if isSymLink then return [path] else getDirectoryContentsRecursivelyBy (getDirectoryContentsRecursive' opts) path else return [path] else getDirectoryContentsRecursive path #endif getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive path = do isDir <- doesDirectoryExist path if isDir then getDirectoryContentsRecursivelyBy getDirectoryContentsRecursive path else return [path] getDirectoryContentsRecursivelyBy :: (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath] getDirectoryContentsRecursivelyBy exploreMethod path = do contents <- getDirectoryContents path let contents' = map (path ) $ filter (`notElem` ["..","."]) contents children <- mapM exploreMethod contents' if path == "." then return (concat children) else return (path : concat children) setFileTimeStamp :: FilePath -> Integer -> IO () #ifdef _WINDOWS setFileTimeStamp _ _ = return () -- TODO: figure out how to set the timestamp on Windows #else setFileTimeStamp file epochtime = do 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 locals <- manySig 0x04034b50 getLocalFile files <- manySig 0x02014b50 (getFileHeader (M.fromList locals)) digSig <- Just `fmap` getDigitalSignature <|> return Nothing 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 $ normalizePath $ 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 $ normalizePath $ 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 rawCompressionMethod <- getWord16le compressionMethod <- case rawCompressionMethod of 0 -> return NoCompression 8 -> return Deflate _ -> fail $ "Unknown compression method " ++ show rawCompressionMethod 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. do raw <- getCompressedData compressionMethod sig <- lookAhead getWord32le when (sig == 0x08074b50) $ skip 4 skip 4 -- crc32 cs <- getWord32le -- compressed size skip 4 -- uncompressed size if fromIntegral cs == B.length raw then return raw else fail $ printf ("Content size mismatch in data descriptor record: " <> "expected %d, got %d bytes") cs (B.length raw) return (fromIntegral offset, compressedData) putLocalFile :: Entry -> Put putLocalFile f = do putWord32le 0x04034b50 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 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 $ normalizePath $ eRelativePath f putWord16le $ fromIntegral $ B.length $ eExtraField f putLazyByteString $ fromString $ normalizePath $ 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) vmb <- getWord16le -- 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." bitflag <- getWord16le rawCompressionMethod <- getWord16le compressionMethod <- case rawCompressionMethod of 0 -> return NoCompression 8 -> return Deflate _ -> fail $ "Unknown compression method " ++ show rawCompressionMethod lastModFileTime <- getWord16le lastModFileDate <- getWord16le crc32 <- getWord32le encryptionMethod <- case (testBit bitflag 0, testBit bitflag 3, testBit bitflag 6) of (False, _, _) -> return NoEncryption (True, False, False) -> return $ PKWAREEncryption (fromIntegral (crc32 `shiftR` 24)) (True, True, False) -> return $ PKWAREEncryption (fromIntegral (lastModFileTime `shiftR` 8)) (True, _, True) -> fail "Strong encryption is not supported" 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 , eEncryptionMethod = encryptionMethod , eLastModified = msDOSDateTimeToEpochTime $ MSDOSDateTime { msDOSDate = lastModFileDate, msDOSTime = lastModFileTime } , eCRC32 = crc32 , eCompressedSize = compressedSize , eUncompressedSize = uncompressedSize , eExtraField = extraField , eFileComment = fileComment , eVersionMadeBy = vmb , eInternalFileAttributes = internalFileAttributes , eExternalFileAttributes = externalFileAttributes , eCompressedData = compressedData } putFileHeader :: Word32 -- ^ offset -> Entry -> Put putFileHeader offset local = do putWord32le 0x02014b50 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 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 $ normalizePath $ 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 $ normalizePath $ eRelativePath local putLazyByteString $ eExtraField local putLazyByteString $ eFileComment local -- Digital signature: -- -- > header signature 4 bytes (0x05054b50) -- > size of data 2 bytes -- > signature data (variable size) getDigitalSignature :: Get B.ByteString getDigitalSignature = do getWord32le >>= ensure (== 0x05054b50) sigSize <- getWord16le getLazyByteString (toEnum $ fromEnum sigSize) 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" toString :: B.ByteString -> String toString = TL.unpack . TL.decodeUtf8 fromString :: String -> B.ByteString fromString = TL.encodeUtf8 . TL.pack data DecompressResult = DecompressSuccess B.ByteString -- bytes remaining -- (we just discard decompressed chunks, because we only -- want to know where the compressed data ends) | DecompressFailure ZlibInt.DecompressError getCompressedData :: CompressionMethod -> Get B.ByteString getCompressedData NoCompression = do -- we assume there will be a signature on the data descriptor, -- otherwise we have no way of identifying where the data ends! -- The signature 0x08074b50 is commonly used but not required by spec. let findSigPos = do w1 <- getWord8 if w1 == 0x50 then do w2 <- getWord8 if w2 == 0x4b then do w3 <- getWord8 if w3 == 0x07 then do w4 <- getWord8 if w4 == 0x08 then (\x -> x - 4) <$> bytesRead else findSigPos else findSigPos else findSigPos else findSigPos pos <- bytesRead sigpos <- lookAhead findSigPos <|> fail "getCompressedData can't find data descriptor signature" let compressedBytes = sigpos - pos getLazyByteString compressedBytes getCompressedData Deflate = do remainingBytes <- lookAhead getRemainingLazyByteString let result = ZlibInt.foldDecompressStreamWithInput (\_bs res -> res) DecompressSuccess DecompressFailure (ZlibInt.decompressST ZlibInt.rawFormat ZlibInt.defaultDecompressParams{ ZlibInt.decompressAllMembers = False }) remainingBytes case result of DecompressFailure err -> fail (show err) DecompressSuccess afterCompressedBytes -> -- Consume the compressed bytes; we don't do anything with -- the decompressed chunks. We are just decompressing as a -- way of finding where the compressed data ends. getLazyByteString (fromIntegral (B.length remainingBytes - B.length afterCompressedBytes)) zip-archive-0.4.3.2/tests/0000755000000000000000000000000007346545000013432 5ustar0000000000000000zip-archive-0.4.3.2/tests/test-zip-archive.hs0000644000000000000000000003376507346545000017202 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- Test suite for Codec.Archive.Zip -- runghc Test.hs import Codec.Archive.Zip import Control.Monad (unless) import Control.Exception (try, catch, SomeException) import System.Directory hiding (isSymbolicLink) import Test.HUnit.Base import Test.HUnit.Text import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import System.Exit import System.IO.Temp (withTempDirectory) #ifndef _WINDOWS import System.FilePath.Posix import System.Posix.Files import System.Process (rawSystem) #else import System.FilePath.Windows #endif -- 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)) #ifndef _WINDOWS createTestDirectoryWithSymlinks :: FilePath -> FilePath -> IO FilePath createTestDirectoryWithSymlinks prefixDir baseDir = do let testDir = prefixDir baseDir createDirectoryIfMissing True testDir createDirectoryIfMissing True (testDir "1") writeFile (testDir "1/file.txt") "hello" cwd <- getCurrentDirectory createSymbolicLink (cwd testDir "1/file.txt") (testDir "link_to_file") createSymbolicLink (cwd testDir "1") (testDir "link_to_directory") return testDir #endif main :: IO Counts main = withTempDirectory "." "test-zip-archive." $ \tmpDir -> do #ifndef _WINDOWS ec <- catch (rawSystem "command" ["-v", "unzip"]) (\(_ :: SomeException) -> rawSystem "which" ["unzip"]) let unzipInPath = ec == ExitSuccess unless unzipInPath $ putStrLn "\n\nunzip is not in path; skipping testArchiveAndUnzip\n" #endif res <- runTestTT $ TestList $ map (\f -> f tmpDir) $ [ testReadWriteArchive , testReadExternalZip , testFromToArchive , testReadWriteEntry , testAddFilesOptions , testDeleteEntries , testExtractFiles , testExtractFilesFailOnEncrypted , testPasswordProtectedRead , testIncorrectPasswordRead , testEvilPath #ifndef _WINDOWS , testExtractFilesWithPosixAttrs , testArchiveExtractSymlinks , testExtractExternalZipWithSymlinks , testExtractOverwriteExternalZipWithSymlinks #endif ] #ifndef _WINDOWS ++ [testArchiveAndUnzip | unzipInPath] #endif exitWith $ case (failures res + errors res) of 0 -> ExitSuccess n -> ExitFailure n testReadWriteArchive :: FilePath -> Test testReadWriteArchive tmpDir = TestCase $ do archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] BL.writeFile (tmpDir "test1.zip") $ fromArchive archive archive' <- toArchive <$> BL.readFile (tmpDir "test1.zip") assertEqual "for writing and reading test1.zip" archive archive' assertEqual "for writing and reading test1.zip" archive archive' testReadExternalZip :: FilePath -> Test testReadExternalZip _tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/test4.zip" let files = filesInArchive archive assertEqual "for results of filesInArchive" ["test4/","test4/a.txt","test4/b.bin","test4/c/", "test4/c/with spaces.txt"] files bContents <- BL.readFile "tests/test4/b.bin" case findEntryByPath "test4/b.bin" archive of Nothing -> assertFailure "test4/b.bin not found in archive" Just f -> do assertEqual "for text4/b.bin file entry" NoEncryption (eEncryptionMethod f) assertEqual "for contents of test4/b.bin in archive" bContents (fromEntry f) case findEntryByPath "test4/" archive of Nothing -> assertFailure "test4/ not found in archive" Just f -> assertEqual "for contents of test4/ in archive" BL.empty (fromEntry f) testFromToArchive :: FilePath -> Test testFromToArchive tmpDir = TestCase $ do archive1 <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] assertEqual "for (toArchive $ fromArchive archive)" archive1 (toArchive $ fromArchive archive1) #ifndef _WINDOWS testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks" archive2 <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir] assertEqual "for (toArchive $ fromArchive archive)" archive2 (toArchive $ fromArchive archive2) #endif testReadWriteEntry :: FilePath -> Test testReadWriteEntry tmpDir = TestCase $ do entry <- readEntry [] "zip-archive.cabal" setCurrentDirectory tmpDir writeEntry [] entry setCurrentDirectory ".." entry' <- readEntry [] (tmpDir "zip-archive.cabal") let entry'' = entry' { eRelativePath = eRelativePath entry, eLastModified = eLastModified entry } assertEqual "for readEntry -> writeEntry -> readEntry" entry entry'' testAddFilesOptions :: FilePath -> Test testAddFilesOptions tmpDir = 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)) #ifndef _WINDOWS testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks2" archive3 <- addFilesToArchive [OptVerbose, OptRecursive] emptyArchive [testDir] archive4 <- addFilesToArchive [OptVerbose, OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir] mapM_ putStrLn $ filesInArchive archive3 mapM_ putStrLn $ filesInArchive archive4 assertBool "for recursive and recursive by preserving symlinks addFilesToArchive" (length (filesInArchive archive4) < length (filesInArchive archive3)) #endif testDeleteEntries :: FilePath -> Test testDeleteEntries _tmpDir = TestCase $ do archive1 <- addFilesToArchive [] emptyArchive ["LICENSE", "src"] let archive2 = deleteEntryFromArchive "LICENSE" archive1 let archive3 = deleteEntryFromArchive "src" archive2 assertEqual "for deleteFilesFromArchive" emptyArchive archive3 testEvilPath :: FilePath -> Test testEvilPath _tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/zip_with_evil_path.zip" result <- try $ extractFilesFromArchive [] archive :: IO (Either ZipException ()) case result of Left err -> assertBool "Wrong exception" $ err == UnsafePath "../evil" Right _ -> assertFailure "extractFilesFromArchive should have failed" testExtractFiles :: FilePath -> Test testExtractFiles tmpDir = TestCase $ do createDirectory (tmpDir "dir1") createDirectory (tmpDir "dir1/dir2") let hiMsg = BS.pack "hello there" let helloMsg = BS.pack "Hello there. This file is very long. Longer than 31 characters." BS.writeFile (tmpDir "dir1/hi") hiMsg BS.writeFile (tmpDir "dir1/dir2/hello") helloMsg archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir "dir1")] removeDirectoryRecursive (tmpDir "dir1") extractFilesFromArchive [OptVerbose] archive hi <- BS.readFile (tmpDir "dir1/hi") hello <- BS.readFile (tmpDir "dir1/dir2/hello") assertEqual ("contents of " tmpDir "dir1/hi") hiMsg hi assertEqual ("contents of " tmpDir "dir1/dir2/hello") helloMsg hello testExtractFilesFailOnEncrypted :: FilePath -> Test testExtractFilesFailOnEncrypted tmpDir = TestCase $ do let dir = tmpDir "fail-encrypted" createDirectory dir archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip" result <- try $ extractFilesFromArchive [OptDestination dir] archive :: IO (Either ZipException ()) removeDirectoryRecursive dir case result of Left err -> assertBool "Wrong exception" $ err == CannotWriteEncryptedEntry "test.txt" Right _ -> assertFailure "extractFilesFromArchive should have failed" testPasswordProtectedRead :: FilePath -> Test testPasswordProtectedRead _tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip" assertEqual "for results of filesInArchive" ["test.txt"] (filesInArchive archive) case findEntryByPath "test.txt" archive of Nothing -> assertFailure "test.txt not found in archive" Just f -> do assertBool "for encrypted test.txt file entry" (isEncryptedEntry f) assertEqual "for contents of test.txt in archive" (Just $ BLC.pack "SUCCESS\n") (fromEncryptedEntry "s3cr3t" f) testIncorrectPasswordRead :: FilePath -> Test testIncorrectPasswordRead _tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip" case findEntryByPath "test.txt" archive of Nothing -> assertFailure "test.txt not found in archive" Just f -> do assertEqual "for contents of test.txt in archive" Nothing (fromEncryptedEntry "INCORRECT" f) #ifndef _WINDOWS testExtractFilesWithPosixAttrs :: FilePath -> Test testExtractFilesWithPosixAttrs tmpDir = TestCase $ do createDirectory (tmpDir "dir3") let hiMsg = "hello there" writeFile (tmpDir "dir3/hi") hiMsg let perms = unionFileModes ownerReadMode $ unionFileModes ownerWriteMode ownerExecuteMode setFileMode (tmpDir "dir3/hi") perms archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir "dir3")] removeDirectoryRecursive (tmpDir "dir3") extractFilesFromArchive [OptVerbose] archive hi <- readFile (tmpDir "dir3/hi") fm <- fmap fileMode $ getFileStatus (tmpDir "dir3/hi") assertEqual "file modes" perms (intersectFileModes perms fm) assertEqual ("contents of " tmpDir "dir3/hi") hiMsg hi testArchiveExtractSymlinks :: FilePath -> Test testArchiveExtractSymlinks tmpDir = TestCase $ do testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks3" let locationDir = "location_dir" archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks, OptLocation locationDir True] emptyArchive [testDir] removeDirectoryRecursive testDir let destination = "test_dest" extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination destination] archive isDirSymlink <- pathIsSymbolicLink (destination locationDir testDir "link_to_directory") isFileSymlink <- pathIsSymbolicLink (destination locationDir testDir "link_to_file") assertBool "Symbolic link to directory is preserved" isDirSymlink assertBool "Symbolic link to file is preserved" isFileSymlink removeDirectoryRecursive destination testExtractExternalZipWithSymlinks :: FilePath -> Test testExtractExternalZipWithSymlinks tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/zip_with_symlinks.zip" extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive let zipRootDir = "zip_test_dir_with_symlinks" symlinkDir = tmpDir zipRootDir "symlink_to_dir_1" symlinkFile = tmpDir zipRootDir "symlink_to_file_1" isDirSymlink <- pathIsSymbolicLink symlinkDir targetDirExists <- doesDirectoryExist symlinkDir isFileSymlink <- pathIsSymbolicLink symlinkFile targetFileExists <- doesFileExist symlinkFile assertBool "Symbolic link to directory is preserved" isDirSymlink assertBool "Target directory exists" targetDirExists assertBool "Symbolic link to file is preserved" isFileSymlink assertBool "Target file exists" targetFileExists removeDirectoryRecursive tmpDir testExtractOverwriteExternalZipWithSymlinks :: FilePath -> Test testExtractOverwriteExternalZipWithSymlinks tmpDir = TestCase $ do archive <- toArchive <$> BL.readFile "tests/zip_with_symlinks.zip" extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive asserts extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive asserts where zipRootDir = "zip_test_dir_with_symlinks" symlinkDir = tmpDir zipRootDir "symlink_to_dir_1" symlinkFile = tmpDir zipRootDir "symlink_to_file_1" asserts = do isDirSymlink <- pathIsSymbolicLink symlinkDir targetDirExists <- doesDirectoryExist symlinkDir isFileSymlink <- pathIsSymbolicLink symlinkFile targetFileExists <- doesFileExist symlinkFile assertBool "Symbolic link to directory is preserved" isDirSymlink assertBool "Target directory exists" targetDirExists assertBool "Symbolic link to file is preserved" isFileSymlink assertBool "Target file exists" targetFileExists testArchiveAndUnzip :: FilePath -> Test testArchiveAndUnzip tmpDir = TestCase $ do let dir = "test_dir_with_symlinks4" testDir <- createTestDirectoryWithSymlinks tmpDir dir archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir] removeDirectoryRecursive testDir let zipFile = tmpDir "testUnzip.zip" BL.writeFile zipFile $ fromArchive archive ec <- rawSystem "unzip" [zipFile] assertBool "unzip succeeds" $ ec == ExitSuccess let symlinkDir = testDir "link_to_directory" symlinkFile = testDir "link_to_file" isDirSymlink <- pathIsSymbolicLink symlinkDir targetDirExists <- doesDirectoryExist symlinkDir isFileSymlink <- pathIsSymbolicLink symlinkFile targetFileExists <- doesFileExist symlinkFile assertBool "Symbolic link to directory is preserved" isDirSymlink assertBool "Target directory exists" targetDirExists assertBool "Symbolic link to file is preserved" isFileSymlink assertBool "Target file exists" targetFileExists removeDirectoryRecursive tmpDir #endif zip-archive-0.4.3.2/tests/test4.zip0000644000000000000000000000151207346545000015220 0ustar0000000000000000PK IJtest4/UT yGYyGYux PK IJBC test4/a.txtUT yGYyGYux Hello, this is a test! PK IJ[ test4/b.binUT yGYyGYux lѫ>0^ڪ@ PK IJtest4/c/UT yGYyGYux PK IJtest4/c/with spaces.txtUT yGYyGYux Another file. PK IJAtest4/UTyGYux PK IJBC @test4/a.txtUTyGYux PK IJ[ test4/b.binUTyGYux PK IJAtest4/c/UTyGYux PK IJ<test4/c/with spaces.txtUTyGYux PKzip-archive-0.4.3.2/tests/test4/0000755000000000000000000000000007346545000014475 5ustar0000000000000000zip-archive-0.4.3.2/tests/test4/a.txt0000644000000000000000000000002707346545000015455 0ustar0000000000000000Hello, this is a test! zip-archive-0.4.3.2/tests/test4/b.bin0000644000000000000000000000003107346545000015402 0ustar0000000000000000lѫ>0^ڪ@ zip-archive-0.4.3.2/tests/test4/c/0000755000000000000000000000000007346545000014717 5ustar0000000000000000zip-archive-0.4.3.2/tests/test4/c/with spaces.txt0000644000000000000000000000001607346545000017667 0ustar0000000000000000Another file. zip-archive-0.4.3.2/tests/zip_with_evil_path.zip0000644000000000000000000000016007346545000020043 0ustar0000000000000000PK!../evilPK!../evilPK5%zip-archive-0.4.3.2/tests/zip_with_password.zip0000644000000000000000000000031207346545000017731 0ustar0000000000000000PK 'sMhhtest.txtUT \\ux Ng߼?iVnPKhhPK 'sMhhtest.txtUT\ux PKNfzip-archive-0.4.3.2/tests/zip_with_symlinks.zip0000644000000000000000000000202207346545000017740 0ustar0000000000000000PK `c3Lzip_test_dir_with_symlinks/UT aZeZux PK `c3Lzip_test_dir_with_symlinks/1/UT aZeZux PK `c3L)&zip_test_dir_with_symlinks/1/file1.txtUT aZaZux file1 PK `c3L܃+zip_test_dir_with_symlinks/symlink_to_dir_1UT aZaZux 1PK `c3LI ,zip_test_dir_with_symlinks/symlink_to_file_1UT aZaZux 1/file1.txtPK `c3LAzip_test_dir_with_symlinks/UTaZux PK `c3LAUzip_test_dir_with_symlinks/1/UTaZux PK `c3L)&zip_test_dir_with_symlinks/1/file1.txtUTaZux PK `c3L܃+zip_test_dir_with_symlinks/symlink_to_dir_1UTaZux PK `c3LI ,xzip_test_dir_with_symlinks/symlink_to_file_1UTaZux PKzip-archive-0.4.3.2/zip-archive.cabal0000644000000000000000000000751507346545000015505 0ustar0000000000000000Name: zip-archive Version: 0.4.3.2 Cabal-Version: 2.0 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. The zip archive format is documented in . . Certain simplifying assumptions are made about the zip archives: in particular, there is no support for strong 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. . Archives are built and extracted in memory, so manipulating large zip files will consume a lot of memory. If you work with large zip files or need features not supported by this library, a better choice may be , which uses a memory-efficient streaming approach. However, zip can only read and write archives inside instances of MonadIO, so zip-archive is a better choice if you want to manipulate zip archives in "pure" contexts. . As an example of the use of the library, a standalone zip archiver and extracter is provided in the source distribution. Category: Codec Tested-with: GHC == 8.6.5, GHC == 8.8.1, GHC == 8.10.4, GHC == 9.0.1, GHC == 8.8.3, GHC == 9.2.1 License: BSD3 License-file: LICENSE Homepage: http://github.com/jgm/zip-archive Author: John MacFarlane Maintainer: jgm@berkeley.edu Extra-Source-Files: changelog README.markdown tests/test4.zip tests/test4/a.txt tests/test4/b.bin "tests/test4/c/with spaces.txt" tests/zip_with_symlinks.zip tests/zip_with_password.zip tests/zip_with_evil_path.zip Source-repository head type: git location: git://github.com/jgm/zip-archive.git flag executable Description: Build the Zip executable. Default: False Library Build-depends: base >= 4.5 && < 5, pretty, containers, binary >= 0.7.2, zlib, filepath, bytestring >= 0.10.0, array, mtl, text >= 0.11, digest >= 0.0.0.1, directory >= 1.2.0, time Exposed-modules: Codec.Archive.Zip Default-Language: Haskell98 Hs-Source-Dirs: src Ghc-Options: -Wall if os(windows) cpp-options: -D_WINDOWS else Build-depends: unix Executable zip-archive if flag(executable) Buildable: True else Buildable: False Main-is: Main.hs Hs-Source-Dirs: . Build-Depends: base >= 4.5 && < 5, directory >= 1.1, bytestring >= 0.9.0, zip-archive Other-Modules: Paths_zip_archive Autogen-Modules: Paths_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.5 && < 5, directory >= 1.3, bytestring >= 0.9.0, process, time, HUnit, zip-archive, temporary, filepath Default-Language: Haskell98 Ghc-Options: -Wall if os(windows) cpp-options: -D_WINDOWS else Build-depends: unix