{-# 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
-- <http://www.pkware.com/documents/casestudies/APPNOTE.TXT>
------------------------------------------------------------------------

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.Clock.POSIX ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.LocalTime ( TimeOfDay(..), timeToTimeOfDay )
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

import GHC.Int (Int64)

-- 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 System.IO.Error (isAlreadyExistsError)

manySig :: Word32 -> Get a -> Get [a]
manySig :: forall a. Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p = do
    Word32
sig' <- forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
    if Word32
sig forall a. Eq a => a -> a -> Bool
== Word32
sig'
        then do
            a
r <- Get a
p
            [a]
rs <- forall a. Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
r forall a. a -> [a] -> [a]
: [a]
rs
        else forall (m :: * -> *) a. Monad m => a -> m a
return []


------------------------------------------------------------------------

-- | Structured representation of a zip archive, including directory
-- information and contents (in lazy bytestrings).
data Archive = Archive
                { Archive -> [Entry]
zEntries                :: [Entry]              -- ^ Files in zip archive
                , Archive -> Maybe ByteString
zSignature              :: Maybe B.ByteString   -- ^ Digital signature
                , Archive -> ByteString
zComment                :: !B.ByteString        -- ^ Comment for whole zip archive
                } deriving (ReadPrec [Archive]
ReadPrec Archive
Int -> ReadS Archive
ReadS [Archive]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Archive]
$creadListPrec :: ReadPrec [Archive]
readPrec :: ReadPrec Archive
$creadPrec :: ReadPrec Archive
readList :: ReadS [Archive]
$creadList :: ReadS [Archive]
readsPrec :: Int -> ReadS Archive
$creadsPrec :: Int -> ReadS Archive
Read, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> FilePath
$cshow :: Archive -> FilePath
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show)

instance Binary Archive where
  put :: Archive -> Put
put = Archive -> Put
putArchive
  get :: Get Archive
get = Get Archive
getArchive

-- | Representation of an archived file, including content and metadata.
data Entry = Entry
               { Entry -> FilePath
eRelativePath            :: FilePath            -- ^ Relative path, using '/' as separator
               , Entry -> CompressionMethod
eCompressionMethod       :: !CompressionMethod   -- ^ Compression method
               , Entry -> EncryptionMethod
eEncryptionMethod        :: !EncryptionMethod    -- ^ Encryption method
               , Entry -> Integer
eLastModified            :: !Integer             -- ^ Modification time (seconds since unix epoch)
               , Entry -> Word32
eCRC32                   :: !Word32              -- ^ CRC32 checksum
               , Entry -> Word32
eCompressedSize          :: !Word32              -- ^ Compressed size in bytes
               , Entry -> Word32
eUncompressedSize        :: !Word32              -- ^ Uncompressed size in bytes
               , Entry -> ByteString
eExtraField              :: !B.ByteString        -- ^ Extra field - unused by this library
               , Entry -> ByteString
eFileComment             :: !B.ByteString        -- ^ File comment - unused by this library
               , Entry -> Word16
eVersionMadeBy           :: !Word16              -- ^ Version made by field
               , Entry -> Word16
eInternalFileAttributes  :: !Word16              -- ^ Internal file attributes - unused by this library
               , Entry -> Word32
eExternalFileAttributes  :: !Word32              -- ^ External file attributes (system-dependent)
               , Entry -> ByteString
eCompressedData          :: !B.ByteString        -- ^ Compressed contents of file
               } deriving (ReadPrec [Entry]
ReadPrec Entry
Int -> ReadS Entry
ReadS [Entry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Entry]
$creadListPrec :: ReadPrec [Entry]
readPrec :: ReadPrec Entry
$creadPrec :: ReadPrec Entry
readList :: ReadS [Entry]
$creadList :: ReadS [Entry]
readsPrec :: Int -> ReadS Entry
$creadsPrec :: Int -> ReadS Entry
Read, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> FilePath
$cshow :: Entry -> FilePath
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show, Entry -> Entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq)

-- | Compression methods.
data CompressionMethod = Deflate
                       | NoCompression
                       deriving (ReadPrec [CompressionMethod]
ReadPrec CompressionMethod
Int -> ReadS CompressionMethod
ReadS [CompressionMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompressionMethod]
$creadListPrec :: ReadPrec [CompressionMethod]
readPrec :: ReadPrec CompressionMethod
$creadPrec :: ReadPrec CompressionMethod
readList :: ReadS [CompressionMethod]
$creadList :: ReadS [CompressionMethod]
readsPrec :: Int -> ReadS CompressionMethod
$creadsPrec :: Int -> ReadS CompressionMethod
Read, Int -> CompressionMethod -> ShowS
[CompressionMethod] -> ShowS
CompressionMethod -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompressionMethod] -> ShowS
$cshowList :: [CompressionMethod] -> ShowS
show :: CompressionMethod -> FilePath
$cshow :: CompressionMethod -> FilePath
showsPrec :: Int -> CompressionMethod -> ShowS
$cshowsPrec :: Int -> CompressionMethod -> ShowS
Show, CompressionMethod -> CompressionMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionMethod -> CompressionMethod -> Bool
$c/= :: CompressionMethod -> CompressionMethod -> Bool
== :: CompressionMethod -> CompressionMethod -> Bool
$c== :: CompressionMethod -> CompressionMethod -> Bool
Eq)

data EncryptionMethod = NoEncryption             -- ^ Entry is not encrypted
                      | PKWAREEncryption !Word8  -- ^ Entry is encrypted with the traditional PKWARE encryption
                      deriving (ReadPrec [EncryptionMethod]
ReadPrec EncryptionMethod
Int -> ReadS EncryptionMethod
ReadS [EncryptionMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncryptionMethod]
$creadListPrec :: ReadPrec [EncryptionMethod]
readPrec :: ReadPrec EncryptionMethod
$creadPrec :: ReadPrec EncryptionMethod
readList :: ReadS [EncryptionMethod]
$creadList :: ReadS [EncryptionMethod]
readsPrec :: Int -> ReadS EncryptionMethod
$creadsPrec :: Int -> ReadS EncryptionMethod
Read, Int -> EncryptionMethod -> ShowS
[EncryptionMethod] -> ShowS
EncryptionMethod -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionMethod] -> ShowS
$cshowList :: [EncryptionMethod] -> ShowS
show :: EncryptionMethod -> FilePath
$cshow :: EncryptionMethod -> FilePath
showsPrec :: Int -> EncryptionMethod -> ShowS
$cshowsPrec :: Int -> EncryptionMethod -> ShowS
Show, EncryptionMethod -> EncryptionMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionMethod -> EncryptionMethod -> Bool
$c/= :: EncryptionMethod -> EncryptionMethod -> Bool
== :: EncryptionMethod -> EncryptionMethod -> Bool
$c== :: EncryptionMethod -> EncryptionMethod -> Bool
Eq)

-- | The way the password should be verified during entry decryption
data PKWAREVerificationType = CheckTimeByte
                            | CheckCRCByte
                            deriving (ReadPrec [PKWAREVerificationType]
ReadPrec PKWAREVerificationType
Int -> ReadS PKWAREVerificationType
ReadS [PKWAREVerificationType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PKWAREVerificationType]
$creadListPrec :: ReadPrec [PKWAREVerificationType]
readPrec :: ReadPrec PKWAREVerificationType
$creadPrec :: ReadPrec PKWAREVerificationType
readList :: ReadS [PKWAREVerificationType]
$creadList :: ReadS [PKWAREVerificationType]
readsPrec :: Int -> ReadS PKWAREVerificationType
$creadsPrec :: Int -> ReadS PKWAREVerificationType
Read, Int -> PKWAREVerificationType -> ShowS
[PKWAREVerificationType] -> ShowS
PKWAREVerificationType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PKWAREVerificationType] -> ShowS
$cshowList :: [PKWAREVerificationType] -> ShowS
show :: PKWAREVerificationType -> FilePath
$cshow :: PKWAREVerificationType -> FilePath
showsPrec :: Int -> PKWAREVerificationType -> ShowS
$cshowsPrec :: Int -> PKWAREVerificationType -> ShowS
Show, PKWAREVerificationType -> PKWAREVerificationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
$c/= :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
== :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
$c== :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
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 (ReadPrec [ZipOption]
ReadPrec ZipOption
Int -> ReadS ZipOption
ReadS [ZipOption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ZipOption]
$creadListPrec :: ReadPrec [ZipOption]
readPrec :: ReadPrec ZipOption
$creadPrec :: ReadPrec ZipOption
readList :: ReadS [ZipOption]
$creadList :: ReadS [ZipOption]
readsPrec :: Int -> ReadS ZipOption
$creadsPrec :: Int -> ReadS ZipOption
Read, Int -> ZipOption -> ShowS
[ZipOption] -> ShowS
ZipOption -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ZipOption] -> ShowS
$cshowList :: [ZipOption] -> ShowS
show :: ZipOption -> FilePath
$cshow :: ZipOption -> FilePath
showsPrec :: Int -> ZipOption -> ShowS
$cshowsPrec :: Int -> ZipOption -> ShowS
Show, ZipOption -> ZipOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipOption -> ZipOption -> Bool
$c/= :: ZipOption -> ZipOption -> Bool
== :: ZipOption -> ZipOption -> Bool
$c== :: ZipOption -> ZipOption -> Bool
Eq)

data ZipException =
    CRC32Mismatch FilePath
  | UnsafePath FilePath
  | CannotWriteEncryptedEntry FilePath
  deriving (Int -> ZipException -> ShowS
[ZipException] -> ShowS
ZipException -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ZipException] -> ShowS
$cshowList :: [ZipException] -> ShowS
show :: ZipException -> FilePath
$cshow :: ZipException -> FilePath
showsPrec :: Int -> ZipException -> ShowS
$cshowsPrec :: Int -> ZipException -> ShowS
Show, Typeable, Typeable ZipException
ZipException -> DataType
ZipException -> Constr
(forall b. Data b => b -> b) -> ZipException -> ZipException
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
gmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
$cgmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
dataTypeOf :: ZipException -> DataType
$cdataTypeOf :: ZipException -> DataType
toConstr :: ZipException -> Constr
$ctoConstr :: ZipException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
Data, ZipException -> ZipException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipException -> ZipException -> Bool
$c/= :: ZipException -> ZipException -> Bool
== :: ZipException -> ZipException -> Bool
$c== :: ZipException -> ZipException -> Bool
Eq)

instance E.Exception ZipException

-- | A zip archive with no contents.
emptyArchive :: Archive
emptyArchive :: Archive
emptyArchive = Archive
                { zEntries :: [Entry]
zEntries                  = []
                , zSignature :: Maybe ByteString
zSignature              = forall a. Maybe a
Nothing
                , zComment :: ByteString
zComment                = ByteString
B.empty }

-- | Reads an 'Archive' structure from a raw zip archive (in a lazy bytestring).
toArchive :: B.ByteString -> Archive
toArchive :: ByteString -> Archive
toArchive = forall a. Binary a => ByteString -> a
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 :: ByteString -> Either FilePath Archive
toArchiveOrFail ByteString
bs = case forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, FilePath) (ByteString, Int64, a)
decodeOrFail ByteString
bs of
                           Left (ByteString
_,Int64
_,FilePath
e)  -> forall a b. a -> Either a b
Left FilePath
e
                           Right (ByteString
_,Int64
_,Archive
x) -> forall a b. b -> Either a b
Right Archive
x

-- | Writes an 'Archive' structure to a raw zip archive (in a lazy bytestring).
fromArchive :: Archive -> B.ByteString
fromArchive :: Archive -> ByteString
fromArchive = forall a. Binary a => a -> ByteString
encode

-- | Returns a list of files in a zip archive.
filesInArchive :: Archive -> [FilePath]
filesInArchive :: Archive -> [FilePath]
filesInArchive = forall a b. (a -> b) -> [a] -> [b]
map Entry -> FilePath
eRelativePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> [Entry]
zEntries

-- | Adds an entry to a zip archive, or updates an existing entry.
addEntryToArchive :: Entry -> Archive -> Archive
addEntryToArchive :: Entry -> Archive -> Archive
addEntryToArchive Entry
entry Archive
archive =
  let archive' :: Archive
archive'   = FilePath -> Archive -> Archive
deleteEntryFromArchive (Entry -> FilePath
eRelativePath Entry
entry) Archive
archive
      oldEntries :: [Entry]
oldEntries = Archive -> [Entry]
zEntries Archive
archive'
  in  Archive
archive' { zEntries :: [Entry]
zEntries = Entry
entry forall a. a -> [a] -> [a]
: [Entry]
oldEntries }

-- | Deletes an entry from a zip archive.
deleteEntryFromArchive :: FilePath -> Archive -> Archive
deleteEntryFromArchive :: FilePath -> Archive -> Archive
deleteEntryFromArchive FilePath
path Archive
archive =
  Archive
archive { zEntries :: [Entry]
zEntries = [Entry
e | Entry
e <- Archive -> [Entry]
zEntries Archive
archive
                       , Bool -> Bool
not (Entry -> FilePath
eRelativePath Entry
e FilePath -> FilePath -> Bool
`matches` FilePath
path)] }

-- | Returns Just the zip entry with the specified path, or Nothing.
findEntryByPath :: FilePath -> Archive -> Maybe Entry
findEntryByPath :: FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
path Archive
archive =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Entry
e -> FilePath
path FilePath -> FilePath -> Bool
`matches` Entry -> FilePath
eRelativePath Entry
e) (Archive -> [Entry]
zEntries Archive
archive)

-- | Returns uncompressed contents of zip entry.
fromEntry :: Entry -> B.ByteString
fromEntry :: Entry -> ByteString
fromEntry Entry
entry =
  CompressionMethod -> ByteString -> ByteString
decompressData (Entry -> CompressionMethod
eCompressionMethod Entry
entry) (Entry -> ByteString
eCompressedData Entry
entry)

-- | Returns decrypted and uncompressed contents of zip entry.
fromEncryptedEntry :: String -> Entry -> Maybe B.ByteString
fromEncryptedEntry :: FilePath -> Entry -> Maybe ByteString
fromEncryptedEntry FilePath
password Entry
entry =
  CompressionMethod -> ByteString -> ByteString
decompressData (Entry -> CompressionMethod
eCompressionMethod Entry
entry) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData FilePath
password (Entry -> EncryptionMethod
eEncryptionMethod Entry
entry) (Entry -> ByteString
eCompressedData Entry
entry)

-- | Check if an 'Entry' is encrypted
isEncryptedEntry :: Entry -> Bool
isEncryptedEntry :: Entry -> Bool
isEncryptedEntry Entry
entry =
  case Entry -> EncryptionMethod
eEncryptionMethod Entry
entry of
    (PKWAREEncryption Word8
_) -> Bool
True
    EncryptionMethod
_ -> Bool
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 :: FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
path Integer
modtime ByteString
contents =
  let uncompressedSize :: Int64
uncompressedSize = ByteString -> Int64
B.length ByteString
contents
      compressedData :: ByteString
compressedData = CompressionMethod -> ByteString -> ByteString
compressData CompressionMethod
Deflate ByteString
contents
      compressedSize :: Int64
compressedSize = ByteString -> Int64
B.length ByteString
compressedData
      -- only use compression if it helps!
      (CompressionMethod
compressionMethod, ByteString
finalData, Int64
finalSize) =
        if Int64
uncompressedSize forall a. Ord a => a -> a -> Bool
<= Int64
compressedSize
           then (CompressionMethod
NoCompression, ByteString
contents, Int64
uncompressedSize)
           else (CompressionMethod
Deflate, ByteString
compressedData, Int64
compressedSize)
      crc32 :: Word32
crc32 = forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
contents
  in  Entry { eRelativePath :: FilePath
eRelativePath            = ShowS
normalizePath FilePath
path
            , eCompressionMethod :: CompressionMethod
eCompressionMethod       = CompressionMethod
compressionMethod
            , eEncryptionMethod :: EncryptionMethod
eEncryptionMethod        = EncryptionMethod
NoEncryption
            , eLastModified :: Integer
eLastModified            = Integer
modtime
            , eCRC32 :: Word32
eCRC32                   = Word32
crc32
            , eCompressedSize :: Word32
eCompressedSize          = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
finalSize
            , eUncompressedSize :: Word32
eUncompressedSize        = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
uncompressedSize
            , eExtraField :: ByteString
eExtraField              = ByteString
B.empty
            , eFileComment :: ByteString
eFileComment             = ByteString
B.empty
            , eVersionMadeBy :: Word16
eVersionMadeBy           = Word16
0  -- FAT
            , eInternalFileAttributes :: Word16
eInternalFileAttributes  = Word16
0  -- potentially non-text
            , eExternalFileAttributes :: Word32
eExternalFileAttributes  = Word32
0  -- appropriate if from stdin
            , eCompressedData :: ByteString
eCompressedData          = ByteString
finalData
            }

-- | Generates a 'Entry' from a file or directory.
readEntry :: [ZipOption] -> FilePath -> IO Entry
readEntry :: [ZipOption] -> FilePath -> IO Entry
readEntry [ZipOption]
opts FilePath
path = do
  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
#ifdef _WINDOWS
  let isSymLink = False
#else
  FileStatus
fs <- FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
path
  let isSymLink :: Bool
isSymLink = FileStatus -> Bool
isSymbolicLink FileStatus
fs
#endif
 -- make sure directories end in / and deal with the OptLocation option
  let path' :: FilePath
path' = let p :: FilePath
p = FilePath
path forall a. [a] -> [a] -> [a]
++ (case forall a. [a] -> [a]
reverse FilePath
path of
                                    (Char
'/':FilePath
_) -> FilePath
""
                                    FilePath
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isSymLink -> FilePath
"/"
                                    FilePath
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool
isSymLink -> FilePath
""
                                      | Bool
otherwise -> FilePath
"") in
              (case [(FilePath
l,Bool
a) | OptLocation FilePath
l Bool
a <- [ZipOption]
opts] of
                    ((FilePath
l,Bool
a):[(FilePath, Bool)]
_) -> if Bool
a then FilePath
l FilePath -> ShowS
</> FilePath
p else FilePath
l FilePath -> ShowS
</> ShowS
takeFileName FilePath
p
                    [(FilePath, Bool)]
_         -> FilePath
p)
  ByteString
contents <-
#ifndef _WINDOWS
              if Bool
isSymLink
                 then do
                   FilePath
linkTarget <- FilePath -> IO FilePath
readSymbolicLink FilePath
path
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
C.pack FilePath
linkTarget
                 else
#endif
                   if Bool
isDir
                      then
                        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                      else
                        ByteString -> ByteString
B.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
S.readFile FilePath
path
  Integer
modEpochTime <- (forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime FilePath
path
  let entry :: Entry
entry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
path' Integer
modEpochTime ByteString
contents

  Entry
entryE <-
#ifdef _WINDOWS
        return $ entry { eVersionMadeBy = 0x0000 } -- FAT/VFAT/VFAT32 file attributes
#else
        do
           let fm :: CMode
fm = if Bool
isSymLink
                      then CMode -> CMode -> CMode
unionFileModes CMode
symbolicLinkMode (FileStatus -> CMode
fileMode FileStatus
fs)
                      else FileStatus -> CMode
fileMode FileStatus
fs

           let modes :: Word32
modes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftL (forall a. Integral a => a -> Integer
toInteger CMode
fm) Int
16
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Entry
entry { eExternalFileAttributes :: Word32
eExternalFileAttributes = Word32
modes,
                            eVersionMadeBy :: Word16
eVersionMadeBy = Word16
0x0300 } -- UNIX file attributes
#endif

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) forall a b. (a -> b) -> a -> b
$ do
    let compmethod :: FilePath
compmethod = case Entry -> CompressionMethod
eCompressionMethod Entry
entryE of
                     CompressionMethod
Deflate       -> (FilePath
"deflated" :: String)
                     CompressionMethod
NoCompression -> FilePath
"stored"
    Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
      forall r. PrintfType r => FilePath -> r
printf FilePath
"  adding: %s (%s %.f%%)" (Entry -> FilePath
eRelativePath Entry
entryE)
      FilePath
compmethod (Float
100 forall a. Num a => a -> a -> a
- (Float
100 forall a. Num a => a -> a -> a
* Entry -> Float
compressionRatio Entry
entryE))
  forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entryE

-- check path, resolving .. and . components, raising
-- UnsafePath exception if this takes you outside of the root.
checkPath :: FilePath -> IO ()
checkPath :: FilePath -> IO ()
checkPath FilePath
fp =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
E.throwIO (FilePath -> ZipException
UnsafePath FilePath
fp)) (\[FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([FilePath] -> Maybe [FilePath]
resolve forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories forall a b. (a -> b) -> a -> b
$ FilePath
fp)
  where
    resolve :: [FilePath] -> Maybe [FilePath]
resolve =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {m :: * -> *} {a}.
(Eq a, IsString a, MonadFail m) =>
m [a] -> a -> m [a]
go (forall (m :: * -> *) a. Monad m => a -> m a
return [])
      where
      go :: m [a] -> a -> m [a]
go m [a]
acc a
x = do
        [a]
xs <- m [a]
acc
        case a
x of
          a
"."  -> forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
          a
".." -> case [a]
xs of
                    []     -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"outside of root path"
                    (a
_:[a]
ys) -> forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ys
          a
_    -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
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 :: [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Bool
isEncryptedEntry Entry
entry) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> ZipException
CannotWriteEncryptedEntry (Entry -> FilePath
eRelativePath Entry
entry)
  let relpath :: FilePath
relpath = Entry -> FilePath
eRelativePath Entry
entry
  FilePath -> IO ()
checkPath FilePath
relpath
  FilePath
path <- case [FilePath
d | OptDestination FilePath
d <- [ZipOption]
opts] of
             (FilePath
x:[FilePath]
_)                   -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
x FilePath -> ShowS
</> FilePath
relpath)
             [] | FilePath -> Bool
isAbsolute FilePath
relpath -> forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> ZipException
UnsafePath FilePath
relpath
                | Bool
otherwise          -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
relpath
  -- create directories if needed
  let dir :: FilePath
dir = ShowS
takeDirectory FilePath
path
  Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) forall a b. (a -> b) -> a -> b
$
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"  creating: " forall a. [a] -> [a] -> [a]
++ FilePath
dir
  if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
path) Bool -> Bool -> Bool
&& forall a. [a] -> a
last FilePath
path forall a. Eq a => a -> a -> Bool
== Char
'/' -- path is a directory
     then forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else do
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) forall a b. (a -> b) -> a -> b
$
         Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
entry of
                                 CompressionMethod
Deflate       -> FilePath
" inflating: " forall a. [a] -> [a] -> [a]
++ FilePath
path
                                 CompressionMethod
NoCompression -> FilePath
"extracting: " forall a. [a] -> [a] -> [a]
++ FilePath
path
       let uncompressedData :: ByteString
uncompressedData = Entry -> ByteString
fromEntry Entry
entry
       if Entry -> Word32
eCRC32 Entry
entry forall a. Eq a => a -> a -> Bool
== forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
uncompressedData
          then FilePath -> ByteString -> IO ()
B.writeFile FilePath
path ByteString
uncompressedData
          else forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> ZipException
CRC32Mismatch FilePath
path
#ifndef _WINDOWS
       let modes :: CMode
modes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR (Entry -> Word32
eExternalFileAttributes Entry
entry) Int
16
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Word16
eVersionMadeBy Entry
entry forall a. Bits a => a -> a -> a
.&. Word16
0xFF00 forall a. Eq a => a -> a -> Bool
== Word16
0x0300 Bool -> Bool -> Bool
&&
         CMode
modes forall a. Eq a => a -> a -> Bool
/= CMode
0) forall a b. (a -> b) -> a -> b
$ FilePath -> CMode -> IO ()
setFileMode FilePath
path CMode
modes
#endif
  -- Note that last modified times are supported only for POSIX, not for
  -- Windows.
  FilePath -> Integer -> IO ()
setFileTimeStamp FilePath
path (Entry -> Integer
eLastModified Entry
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 :: [ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry [ZipOption]
opts Entry
entry =
  if ZipOption
OptPreserveSymbolicLinks forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ZipOption]
opts
     then [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry
     else do
        if Entry -> Bool
isEntrySymbolicLink Entry
entry
           then do
             let prefixPath :: FilePath
prefixPath = case [FilePath
d | OptDestination FilePath
d <- [ZipOption]
opts] of
                                   (FilePath
x:[FilePath]
_) -> FilePath
x
                                   [FilePath]
_     -> FilePath
""
             let targetPath :: FilePath
targetPath = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> Maybe FilePath
symbolicLinkEntryTarget forall a b. (a -> b) -> a -> b
$ Entry
entry
             let symlinkPath :: FilePath
symlinkPath = FilePath
prefixPath FilePath -> ShowS
</> Entry -> FilePath
eRelativePath Entry
entry
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) forall a b. (a -> b) -> a -> b
$ do
               Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"linking " forall a. [a] -> [a] -> [a]
++ FilePath
symlinkPath forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
targetPath
             FilePath -> FilePath -> IO ()
forceSymLink FilePath
targetPath FilePath
symlinkPath
           else [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry


-- | Writes a symbolic link, but removes any conflicting files and retries if necessary.
forceSymLink :: FilePath -> FilePath -> IO ()
forceSymLink :: FilePath -> FilePath -> IO ()
forceSymLink FilePath
target FilePath
linkName =
    FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
target FilePath
linkName forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
      (\IOError
e -> if IOError -> Bool
isAlreadyExistsError IOError
e
             then FilePath -> IO ()
removeLink FilePath
linkName forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
target FilePath
linkName
             else forall a. IOError -> IO a
ioError 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 -> Maybe FilePath
symbolicLinkEntryTarget Entry
entry | Entry -> Bool
isEntrySymbolicLink Entry
entry = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
C.unpack forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
fromEntry Entry
entry
                              | Bool
otherwise = forall a. Maybe a
Nothing

-- | Check if an 'Entry' represents a symbolic link
isEntrySymbolicLink :: Entry -> Bool
isEntrySymbolicLink :: Entry -> Bool
isEntrySymbolicLink Entry
entry = Entry -> CMode
entryCMode Entry
entry forall a. Bits a => a -> a -> a
.&. CMode
symbolicLinkMode forall a. Eq a => a -> a -> Bool
== CMode
symbolicLinkMode

-- | Get the 'eExternalFileAttributes' of an 'Entry' as a 'CMode' a.k.a. 'FileMode'
entryCMode :: Entry -> CMode
entryCMode :: Entry -> CMode
entryCMode Entry
entry = Word32 -> CMode
CMode (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR (Entry -> Word32
eExternalFileAttributes Entry
entry) Int
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 :: [ZipOption] -> Archive -> [FilePath] -> IO Archive
addFilesToArchive [ZipOption]
opts Archive
archive [FilePath]
files = do
  [FilePath]
filesAndChildren <- if ZipOption
OptRecursive forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
#ifdef _WINDOWS
                         then mapM getDirectoryContentsRecursive files >>= return . nub . concat
#else
                         then forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ZipOption] -> FilePath -> IO [FilePath]
getDirectoryContentsRecursive' [ZipOption]
opts) [FilePath]
files
#endif
                         else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
files
  [Entry]
entries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ZipOption] -> FilePath -> IO Entry
readEntry [ZipOption]
opts) [FilePath]
filesAndChildren
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
archive [Entry]
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 :: [ZipOption] -> Archive -> IO ()
extractFilesFromArchive [ZipOption]
opts Archive
archive = do
  let entries :: [Entry]
entries = Archive -> [Entry]
zEntries Archive
archive
  if ZipOption
OptPreserveSymbolicLinks forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
    then do
#ifdef _WINDOWS
      mapM_ (writeEntry opts) entries
#else
      let ([Entry]
symbolicLinkEntries, [Entry]
nonSymbolicLinkEntries) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Entry -> Bool
isEntrySymbolicLink [Entry]
entries
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts) [Entry]
nonSymbolicLinkEntries
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry [ZipOption]
opts) [Entry]
symbolicLinkEntries
#endif
    else forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts) [Entry]
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 :: ShowS
normalizePath FilePath
path =
  let dir :: FilePath
dir   = ShowS
takeDirectory FilePath
path
      fn :: FilePath
fn    = ShowS
takeFileName FilePath
path
      dir' :: FilePath
dir' = case FilePath
dir of
#ifdef _WINDOWS
               (c:':':d:xs) | isLetter c
                            , d == '/' || d == '\\'
                            -> xs  -- remove drive
#endif
               FilePath
_ -> FilePath
dir
      -- note: some versions of filepath return ["."] if no dir
      dirParts :: [FilePath]
dirParts = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=FilePath
".") forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
dir'
  in  forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"/" ([FilePath]
dirParts forall a. [a] -> [a] -> [a]
++ [FilePath
fn])

-- Equality modulo normalization.  So, "./foo" `matches` "foo".
matches :: FilePath -> FilePath -> Bool
matches :: FilePath -> FilePath -> Bool
matches FilePath
fp1 FilePath
fp2 = ShowS
normalizePath FilePath
fp1 forall a. Eq a => a -> a -> Bool
== ShowS
normalizePath FilePath
fp2

-- | Uncompress a lazy bytestring.
compressData :: CompressionMethod -> B.ByteString -> B.ByteString
compressData :: CompressionMethod -> ByteString -> ByteString
compressData CompressionMethod
Deflate       = ByteString -> ByteString
Zlib.compress
compressData CompressionMethod
NoCompression = forall a. a -> a
id

-- | Compress a lazy bytestring.
decompressData :: CompressionMethod -> B.ByteString -> B.ByteString
decompressData :: CompressionMethod -> ByteString -> ByteString
decompressData CompressionMethod
Deflate       = ByteString -> ByteString
Zlib.decompress
decompressData CompressionMethod
NoCompression = forall a. a -> a
id

-- | Decrypt a lazy bytestring
-- Returns Nothing if password is incorrect
decryptData :: String -> EncryptionMethod -> B.ByteString -> Maybe B.ByteString
decryptData :: FilePath -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData FilePath
_ EncryptionMethod
NoEncryption ByteString
s = forall a. a -> Maybe a
Just ByteString
s
decryptData FilePath
password (PKWAREEncryption Word8
controlByte) ByteString
s =
  let headerlen :: Int64
headerlen = Int64
12
      initKeys :: (Word32, Word32, Word32)
initKeys = (Word32
305419896, Word32
591751049, Word32
878082192)
      startKeys :: (Word32, Word32, Word32)
startKeys = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32, Word32, Word32)
initKeys (FilePath -> ByteString
C.pack FilePath
password)
      (ByteString
header, ByteString
content) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
headerlen forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (Word32, Word32, Word32)
-> Word8 -> ((Word32, Word32, Word32), Word8)
pkwareDecryptByte (Word32, Word32, Word32)
startKeys ByteString
s
  in if HasCallStack => ByteString -> Word8
B.last ByteString
header forall a. Eq a => a -> a -> Bool
== Word8
controlByte
        then forall a. a -> Maybe a
Just ByteString
content
        else forall a. Maybe a
Nothing

-- | PKWARE decryption context
type DecryptionCtx = (Word32, Word32, Word32)

-- | An interation of the PKWARE decryption algorithm
pkwareDecryptByte :: DecryptionCtx -> Word8 -> (DecryptionCtx, Word8)
pkwareDecryptByte :: (Word32, Word32, Word32)
-> Word8 -> ((Word32, Word32, Word32), Word8)
pkwareDecryptByte keys :: (Word32, Word32, Word32)
keys@(Word32
_, Word32
_, Word32
key2) Word8
inB =
  let tmp :: Word32
tmp = Word32
key2 forall a. Bits a => a -> a -> a
.|. Word32
2
      tmp' :: Word8
tmp' = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
tmp forall a. Num a => a -> a -> a
* (Word32
tmp forall a. Bits a => a -> a -> a
`xor` Word32
1)) forall a. Bits a => a -> Int -> a
`shiftR` Int
8) :: Word8
      outB :: Word8
outB = Word8
inB forall a. Bits a => a -> a -> a
`xor` Word8
tmp'
  in ((Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32, Word32, Word32)
keys Word8
outB, Word8
outB)

-- | Update decryption keys after a decrypted byte
pkwareUpdateKeys :: DecryptionCtx -> Word8 -> DecryptionCtx
pkwareUpdateKeys :: (Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32
key0, Word32
key1, Word32
key2) Word8
inB =
  let key0' :: Word32
key0' = forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key0 forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
inB] forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff
      key1' :: Word32
key1' = (Word32
key1 forall a. Num a => a -> a -> a
+ (Word32
key0' forall a. Bits a => a -> a -> a
.&. Word32
0xff)) forall a. Num a => a -> a -> a
* Word32
134775813 forall a. Num a => a -> a -> a
+ Word32
1
      key1Byte :: Word8
key1Byte = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
key1' forall a. Bits a => a -> Int -> a
`shiftR` Int
24) :: Word8
      key2' :: Word32
key2' = forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key2 forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
key1Byte] forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff
  in (Word32
key0', Word32
key1', Word32
key2')

-- | Calculate compression ratio for an entry (for verbose output).
compressionRatio :: Entry -> Float
compressionRatio :: Entry -> Float
compressionRatio Entry
entry =
  if Entry -> Word32
eUncompressedSize Entry
entry forall a. Eq a => a -> a -> Bool
== Word32
0
     then Float
1
     else forall a b. (Integral a, Num b) => a -> b
fromIntegral (Entry -> Word32
eCompressedSize Entry
entry) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Entry -> Word32
eUncompressedSize Entry
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 { MSDOSDateTime -> Word16
msDOSDate :: Word16
                                   , MSDOSDateTime -> Word16
msDOSTime :: Word16
                                   } deriving (ReadPrec [MSDOSDateTime]
ReadPrec MSDOSDateTime
Int -> ReadS MSDOSDateTime
ReadS [MSDOSDateTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MSDOSDateTime]
$creadListPrec :: ReadPrec [MSDOSDateTime]
readPrec :: ReadPrec MSDOSDateTime
$creadPrec :: ReadPrec MSDOSDateTime
readList :: ReadS [MSDOSDateTime]
$creadList :: ReadS [MSDOSDateTime]
readsPrec :: Int -> ReadS MSDOSDateTime
$creadsPrec :: Int -> ReadS MSDOSDateTime
Read, Int -> MSDOSDateTime -> ShowS
[MSDOSDateTime] -> ShowS
MSDOSDateTime -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MSDOSDateTime] -> ShowS
$cshowList :: [MSDOSDateTime] -> ShowS
show :: MSDOSDateTime -> FilePath
$cshow :: MSDOSDateTime -> FilePath
showsPrec :: Int -> MSDOSDateTime -> ShowS
$cshowsPrec :: Int -> MSDOSDateTime -> ShowS
Show, MSDOSDateTime -> MSDOSDateTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
== :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c== :: MSDOSDateTime -> MSDOSDateTime -> Bool
Eq)

-- | Epoch time corresponding to the minimum DOS DateTime (Jan 1 1980 00:00:00).
minMSDOSDateTime :: Integer
minMSDOSDateTime :: Integer
minMSDOSDateTime = Integer
315532800

-- | Convert a clock time to a MSDOS datetime.  The MSDOS time will be relative to UTC.
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime Integer
epochtime | Integer
epochtime forall a. Ord a => a -> a -> Bool
< Integer
minMSDOSDateTime =
  Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime Integer
minMSDOSDateTime
  -- if time is earlier than minimum DOS datetime, return minimum
epochTimeToMSDOSDateTime Integer
epochtime =
  let
    UTCTime
      (Day -> (Integer, Int, Int)
toGregorian -> (forall a. Num a => Integer -> a
fromInteger -> Int
year, Int
month, Int
day))
      (DiffTime -> TimeOfDay
timeToTimeOfDay -> (TimeOfDay Int
hour Int
minutes (forall a b. (RealFrac a, Integral b) => a -> b
floor -> Int
sec)))
      = POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
epochtime)

    dosTime :: Word16
dosTime = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ (Int
sec forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
minutes Int
5 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
hour Int
11
    dosDate :: Word16
dosDate = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
day forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
month Int
5 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL (Int
year forall a. Num a => a -> a -> a
- Int
1980) Int
9
  in  MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
dosDate, msDOSTime :: Word16
msDOSTime = Word16
dosTime }

-- | Convert a MSDOS datetime to a 'ClockTime'.
msDOSDateTimeToEpochTime :: MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime :: MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime MSDOSDateTime {msDOSDate :: MSDOSDateTime -> Word16
msDOSDate = Word16
dosDate, msDOSTime :: MSDOSDateTime -> Word16
msDOSTime = Word16
dosTime} =
  let seconds :: DiffTime
seconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
2 forall a. Num a => a -> a -> a
* (Word16
dosTime forall a. Bits a => a -> a -> a
.&. Word16
0O37)
      minutes :: DiffTime
minutes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
5 forall a. Bits a => a -> a -> a
.&. Word16
0O77
      hour :: DiffTime
hour    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
11
      day :: Int
day     = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
dosDate forall a. Bits a => a -> a -> a
.&. Word16
0O37
      month :: Int
month   = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
5) forall a. Bits a => a -> a -> a
.&. Word16
0O17)
      year :: Integer
year    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
9
      utc :: UTCTime
utc = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian (Integer
1980 forall a. Num a => a -> a -> a
+ Integer
year) Int
month Int
day) (DiffTime
3600 forall a. Num a => a -> a -> a
* DiffTime
hour forall a. Num a => a -> a -> a
+ DiffTime
60 forall a. Num a => a -> a -> a
* DiffTime
minutes forall a. Num a => a -> a -> a
+ DiffTime
seconds)
  in forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc)

#ifndef _WINDOWS
getDirectoryContentsRecursive' :: [ZipOption] -> FilePath -> IO [FilePath]
getDirectoryContentsRecursive' :: [ZipOption] -> FilePath -> IO [FilePath]
getDirectoryContentsRecursive' [ZipOption]
opts FilePath
path =
  if ZipOption
OptPreserveSymbolicLinks forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
     then do
       Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
       if Bool
isDir
          then do
            Bool
isSymLink <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isSymbolicLink forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
path
            if Bool
isSymLink
               then forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
               else (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
getDirectoryContentsRecursivelyBy ([ZipOption] -> FilePath -> IO [FilePath]
getDirectoryContentsRecursive' [ZipOption]
opts) FilePath
path
          else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
     else FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
path
#endif

getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
path = do
  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
  if Bool
isDir
     then (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
getDirectoryContentsRecursivelyBy FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
path
     else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]

getDirectoryContentsRecursivelyBy :: (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
getDirectoryContentsRecursivelyBy :: (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
getDirectoryContentsRecursivelyBy FilePath -> IO [FilePath]
exploreMethod FilePath
path = do
       [FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
       let contents' :: [FilePath]
contents' = forall a b. (a -> b) -> [a] -> [b]
map (FilePath
path FilePath -> ShowS
</>) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
"..",FilePath
"."]) [FilePath]
contents
       [[FilePath]]
children <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
exploreMethod [FilePath]
contents'
       if FilePath
path forall a. Eq a => a -> a -> Bool
== FilePath
"."
          then forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
children)
          else forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
children)


setFileTimeStamp :: FilePath -> Integer -> IO ()
#ifdef _WINDOWS
setFileTimeStamp _ _ = return () -- TODO: figure out how to set the timestamp on Windows
#else
setFileTimeStamp :: FilePath -> Integer -> IO ()
setFileTimeStamp FilePath
file Integer
epochtime = do
  let epochtime' :: EpochTime
epochtime' = forall a. Num a => Integer -> a
fromInteger Integer
epochtime
  FilePath -> EpochTime -> EpochTime -> IO ()
setFileTimes FilePath
file EpochTime
epochtime' 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 :: Get Archive
getArchive = do
  [(Word32, ByteString)]
locals <- forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x04034b50 Get (Word32, ByteString)
getLocalFile
  [Entry]
files <- forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x02014b50 (Map Word32 ByteString -> Get Entry
getFileHeader (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Word32, ByteString)]
locals))
  Maybe ByteString
digSig <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get ByteString
getDigitalSignature forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  Word32
endSig <- Get Word32
getWord32le
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
endSig forall a. Eq a => a -> a -> Bool
== Word32
0x06054b50)
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Did not find end of central directory signature"
  Int -> Get ()
skip Int
2 -- disk number
  Int -> Get ()
skip Int
2 -- disk number of central directory
  Int -> Get ()
skip Int
2 -- num entries on this disk
  Int -> Get ()
skip Int
2 -- num entries in central directory
  Int -> Get ()
skip Int
4 -- central directory size
  Int -> Get ()
skip Int
4 -- offset of central directory
  Word16
commentLength <- Get Word16
getWord16le
  ByteString
zipComment <- Int64 -> Get ByteString
getLazyByteString (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Word16
commentLength)
  forall (m :: * -> *) a. Monad m => a -> m a
return Archive
           { zEntries :: [Entry]
zEntries                = [Entry]
files
           , zSignature :: Maybe ByteString
zSignature              = Maybe ByteString
digSig
           , zComment :: ByteString
zComment                = ByteString
zipComment
           }

putArchive :: Archive -> Put
putArchive :: Archive -> Put
putArchive Archive
archive = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> Put
putLocalFile forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
  let localFileSizes :: [Word32]
localFileSizes = forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
localFileSize forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
  let offsets :: [Word32]
offsets = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Word32
0 [Word32]
localFileSizes
  let cdOffset :: Word32
cdOffset = forall a. [a] -> a
last [Word32]
offsets
  ()
_ <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Word32 -> Entry -> Put
putFileHeader [Word32]
offsets (Archive -> [Entry]
zEntries Archive
archive)
  Maybe ByteString -> Put
putDigitalSignature forall a b. (a -> b) -> a -> b
$ Archive -> Maybe ByteString
zSignature Archive
archive
  Word32 -> Put
putWord32le Word32
0x06054b50
  Word16 -> Put
putWord16le Word16
0 -- disk number
  Word16 -> Put
putWord16le Word16
0 -- disk number of central directory
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive -- number of entries this disk
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive -- number of entries
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
fileHeaderSize forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive  -- size of central directory
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cdOffset                    -- offset of central dir
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive


fileHeaderSize :: Entry -> Word32
fileHeaderSize :: Entry -> Word32
fileHeaderSize Entry
f =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int64
4 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+
    forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
f) forall a. Num a => a -> a -> a
+
    ByteString -> Int64
B.length (Entry -> ByteString
eExtraField Entry
f) forall a. Num a => a -> a -> a
+ ByteString -> Int64
B.length (Entry -> ByteString
eFileComment Entry
f)

localFileSize :: Entry -> Word32
localFileSize :: Entry -> Word32
localFileSize Entry
f =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int64
4 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
4 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+ Int64
2 forall a. Num a => a -> a -> a
+
    forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
f) forall a. Num a => a -> a -> a
+
    ByteString -> Int64
B.length (Entry -> ByteString
eExtraField Entry
f) forall a. Num a => a -> a -> a
+ ByteString -> Int64
B.length (Entry -> ByteString
eCompressedData Entry
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 :: Get (Word32, ByteString)
getLocalFile = do
  Int64
offset <- Get Int64
bytesRead
  Get Word32
getWord32le forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> Get ()
ensure (forall a. Eq a => a -> a -> Bool
== Word32
0x04034b50)
  Int -> Get ()
skip Int
2  -- version
  Word16
bitflag <- Get Word16
getWord16le
  Int -> Get ()
skip Int
2  -- compressionMethod
  Int -> Get ()
skip Int
2  -- last mod file time
  Int -> Get ()
skip Int
2  -- last mod file date
  Int -> Get ()
skip Int
4  -- crc32
  Word32
compressedSize <- Get Word32
getWord32le
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
compressedSize forall a. Eq a => a -> a -> Bool
== Word32
0xFFFFFFFF) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Can't read ZIP64 archive."
  Int -> Get ()
skip Int
4  -- uncompressedsize
  Word16
fileNameLength <- Get Word16
getWord16le
  Word16
extraFieldLength <- Get Word16
getWord16le
  Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fileNameLength)  -- filename
  Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraFieldLength) -- extra field
  ByteString
compressedData <- if Word16
bitflag forall a. Bits a => a -> a -> a
.&. Word16
0O10 forall a. Eq a => a -> a -> Bool
== Word16
0
      then Int64 -> Get ByteString
getLazyByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
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 ByteString
raw <- Get ByteString
getCompressedData
              Word32
sig <- forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
sig forall a. Eq a => a -> a -> Bool
== Word32
0x08074b50) forall a b. (a -> b) -> a -> b
$ Int -> Get ()
skip Int
4
              Int -> Get ()
skip Int
4 -- crc32
              Word32
cs <- Get Word32
getWord32le  -- compressed size
              Int -> Get ()
skip Int
4 -- uncompressed size
              if forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cs forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
B.length ByteString
raw
                 then forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw
                 else forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Content size mismatch in data descriptor record"
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset, ByteString
compressedData)

-- Move forward over data (not consuming it) until:
-- - start of the next local file header
-- - start of archive decryption header
-- Then back up 12 bytes (the data description record)
-- and possibly 4 more bytes
-- (conventional but not required sig 0x08074b50 for data description record).
getCompressedData :: Get B.ByteString
getCompressedData :: Get ByteString
getCompressedData = do
  Int64
numbytes <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ Int64 -> Get Int64
findEnd Int64
0
  Int64 -> Get ByteString
getLazyByteString Int64
numbytes
 where
   chunkSize :: Int64
   chunkSize :: Int64
chunkSize = Int64
16384
   findEnd :: Int64 -> Get Int64
   findEnd :: Int64 -> Get Int64
findEnd Int64
n = do
     Word32
sig <- forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
     case Word32
sig of
       Word32
0x08074b50 -> Int -> Get ()
skip Int
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int64
n
       Word32
0x04034b50 -> -- sig for local file header
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
n forall a. Num a => a -> a -> a
- Int64
12) -- rewind past data description
       Word32
0x02014b50 -> -- sig for file header
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
n forall a. Num a => a -> a -> a
- Int64
12) -- rewind past data description
       Word32
0x06054b50 -> -- sig for end of central directory header
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
n forall a. Num a => a -> a -> a
- Int64
12) -- rewind past data description
       Word32
x | Word32
x forall a. Bits a => a -> a -> a
.&. Word32
0xFF forall a. Eq a => a -> a -> Bool
== Word32
0x50 -> Int -> Get ()
skip Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get Int64
findEnd (Int64
n forall a. Num a => a -> a -> a
+ Int64
1)
       Word32
_ -> do ByteString
bs <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ Int64 -> Get ByteString
getLazyByteString Int64
chunkSize
                             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Get ByteString
getRemainingLazyByteString
               let bsLen :: Int64
bsLen = ByteString -> Int64
B.length ByteString
bs
               let mbIdx :: Maybe Int64
mbIdx = Word8 -> ByteString -> Maybe Int64
B.elemIndex Word8
0x50 ByteString
bs
               case Maybe Int64
mbIdx of
                 Maybe Int64
Nothing -> Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bsLen) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get Int64
findEnd (Int64
n forall a. Num a => a -> a -> a
+ Int64
bsLen)
                 Just Int64
0  -> Int -> Get ()
skip Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get Int64
findEnd (Int64
n forall a. Num a => a -> a -> a
+ Int64
1)
                 Just Int64
idx -> Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
idx) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get Int64
findEnd (Int64
n forall a. Num a => a -> a -> a
+ Int64
idx)

putLocalFile :: Entry -> Put
putLocalFile :: Entry -> Put
putLocalFile Entry
f = do
  Word32 -> Put
putWord32le Word32
0x04034b50
  Word16 -> Put
putWord16le Word16
20 -- version needed to extract (>=2.0)
  Word16 -> Put
putWord16le Word16
0x802  -- general purpose bit flag (bit 1 = max compression, bit 11 = UTF-8)
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
f of
                     CompressionMethod
NoCompression -> Word16
0
                     CompressionMethod
Deflate       -> Word16
8
  let modTime :: MSDOSDateTime
modTime = Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
f
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
f
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
f
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
f
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString
              forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
f
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
f
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eCompressedData Entry
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 :: Map Word32 ByteString -> Get Entry
getFileHeader Map Word32 ByteString
locals = do
  Get Word32
getWord32le forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> Get ()
ensure (forall a. Eq a => a -> a -> Bool
== Word32
0x02014b50)
  Word16
vmb <- Get Word16
getWord16le  -- version made by
  Word8
versionNeededToExtract <- Get Word8
getWord8
  Int -> Get ()
skip Int
1 -- upper byte indicates OS part of "version needed to extract"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
versionNeededToExtract forall a. Ord a => a -> a -> Bool
<= Word8
20) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"This archive requires zip >= 2.0 to extract."
  Word16
bitflag <- Get Word16
getWord16le
  Word16
rawCompressionMethod <- Get Word16
getWord16le
  CompressionMethod
compressionMethod <- case Word16
rawCompressionMethod of
                        Word16
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
                        Word16
8 -> forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
                        Word16
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown compression method " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Word16
rawCompressionMethod
  Word16
lastModFileTime <- Get Word16
getWord16le
  Word16
lastModFileDate <- Get Word16
getWord16le
  Word32
crc32 <- Get Word32
getWord32le
  EncryptionMethod
encryptionMethod <- case (forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
0, forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
3, forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
6) of
                        (Bool
False, Bool
_, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionMethod
NoEncryption
                        (Bool
True, Bool
False, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
crc32 forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
                        (Bool
True, Bool
True, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
lastModFileTime forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
                        (Bool
True, Bool
_, Bool
True) -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Strong encryption is not supported"

  Word32
compressedSize <- Get Word32
getWord32le
  Word32
uncompressedSize <- Get Word32
getWord32le
  Word16
fileNameLength <- Get Word16
getWord16le
  Word16
extraFieldLength <- Get Word16
getWord16le
  Word16
fileCommentLength <- Get Word16
getWord16le
  Int -> Get ()
skip Int
2 -- disk number start
  Word16
internalFileAttributes <- Get Word16
getWord16le
  Word32
externalFileAttributes <- Get Word32
getWord32le
  Word32
relativeOffset <- Get Word32
getWord32le
  ByteString
fileName <- Int64 -> Get ByteString
getLazyByteString (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Word16
fileNameLength)
  ByteString
extraField <- Int64 -> Get ByteString
getLazyByteString (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Word16
extraFieldLength)
  ByteString
fileComment <- Int64 -> Get ByteString
getLazyByteString (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Word16
fileCommentLength)
  ByteString
compressedData <- case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word32
relativeOffset Map Word32 ByteString
locals of
                    Just ByteString
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
                    Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Unable to find data at offset " forall a. [a] -> [a] -> [a]
++
                                        forall a. Show a => a -> FilePath
show Word32
relativeOffset
  forall (m :: * -> *) a. Monad m => a -> m a
return Entry
            { eRelativePath :: FilePath
eRelativePath            = ByteString -> FilePath
toString ByteString
fileName
            , eCompressionMethod :: CompressionMethod
eCompressionMethod       = CompressionMethod
compressionMethod
            , eEncryptionMethod :: EncryptionMethod
eEncryptionMethod        = EncryptionMethod
encryptionMethod
            , eLastModified :: Integer
eLastModified            = MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime forall a b. (a -> b) -> a -> b
$
                                         MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
lastModFileDate,
                                                         msDOSTime :: Word16
msDOSTime = Word16
lastModFileTime }
            , eCRC32 :: Word32
eCRC32                   = Word32
crc32
            , eCompressedSize :: Word32
eCompressedSize          = Word32
compressedSize
            , eUncompressedSize :: Word32
eUncompressedSize        = Word32
uncompressedSize
            , eExtraField :: ByteString
eExtraField              = ByteString
extraField
            , eFileComment :: ByteString
eFileComment             = ByteString
fileComment
            , eVersionMadeBy :: Word16
eVersionMadeBy           = Word16
vmb
            , eInternalFileAttributes :: Word16
eInternalFileAttributes  = Word16
internalFileAttributes
            , eExternalFileAttributes :: Word32
eExternalFileAttributes  = Word32
externalFileAttributes
            , eCompressedData :: ByteString
eCompressedData          = ByteString
compressedData
            }

putFileHeader :: Word32        -- ^ offset
              -> Entry
              -> Put
putFileHeader :: Word32 -> Entry -> Put
putFileHeader Word32
offset Entry
local = do
  Word32 -> Put
putWord32le Word32
0x02014b50
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ Entry -> Word16
eVersionMadeBy Entry
local
  Word16 -> Put
putWord16le Word16
20 -- version needed to extract (>= 2.0)
  Word16 -> Put
putWord16le Word16
0x802  -- general purpose bit flag (bit 1 = max compression, bit 11 = UTF-8)
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
local of
                     CompressionMethod
NoCompression -> Word16
0
                     CompressionMethod
Deflate       -> Word16
8
  let modTime :: MSDOSDateTime
modTime = Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
local
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
local
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
local
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
local
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString
              forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
local
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eFileComment Entry
local
  Word16 -> Put
putWord16le Word16
0  -- disk number start
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ Entry -> Word16
eInternalFileAttributes Entry
local
  Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eExternalFileAttributes Entry
local
  Word32 -> Put
putWord32le Word32
offset
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
eRelativePath Entry
local
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
  ByteString -> Put
putLazyByteString forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eFileComment Entry
local

--  Digital signature:
--
-- >     header signature                4 bytes  (0x05054b50)
-- >     size of data                    2 bytes
-- >     signature data (variable size)

getDigitalSignature :: Get B.ByteString
getDigitalSignature :: Get ByteString
getDigitalSignature = do
  Get Word32
getWord32le forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> Get ()
ensure (forall a. Eq a => a -> a -> Bool
== Word32
0x05054b50)
  Word16
sigSize <- Get Word16
getWord16le
  Int64 -> Get ByteString
getLazyByteString (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Word16
sigSize)

putDigitalSignature :: Maybe B.ByteString -> Put
putDigitalSignature :: Maybe ByteString -> Put
putDigitalSignature Maybe ByteString
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
putDigitalSignature (Just ByteString
sig) = do
  Word32 -> Put
putWord32le Word32
0x05054b50
  Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
sig
  ByteString -> Put
putLazyByteString ByteString
sig

ensure :: (a -> Bool) -> a -> Get ()
ensure :: forall a. (a -> Bool) -> a -> Get ()
ensure a -> Bool
p a
val =
  if a -> Bool
p a
val
     then forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"ensure not satisfied"

toString :: B.ByteString -> String
toString :: ByteString -> FilePath
toString = Text -> FilePath
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8

fromString :: String -> B.ByteString
fromString :: FilePath -> ByteString
fromString = Text -> ByteString
TL.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
TL.pack