{-# 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.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 :: forall a. Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p = do
    Word32
sig' <- Get Word32 -> Get Word32
forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
    if Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
sig'
        then do
            a
r <- Get a
p
            [a]
rs <- Word32 -> Get a -> Get [a]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p
            [a] -> Get [a]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$ a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs
        else [a] -> Get [a]
forall a. a -> Get a
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]
(Int -> ReadS Archive)
-> ReadS [Archive]
-> ReadPrec Archive
-> ReadPrec [Archive]
-> Read Archive
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Archive
readsPrec :: Int -> ReadS Archive
$creadList :: ReadS [Archive]
readList :: ReadS [Archive]
$creadPrec :: ReadPrec Archive
readPrec :: ReadPrec Archive
$creadListPrec :: ReadPrec [Archive]
readListPrec :: ReadPrec [Archive]
Read, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> [Char]
(Int -> Archive -> ShowS)
-> (Archive -> [Char]) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Archive -> ShowS
showsPrec :: Int -> Archive -> ShowS
$cshow :: Archive -> [Char]
show :: Archive -> [Char]
$cshowList :: [Archive] -> ShowS
showList :: [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 -> [Char]
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]
(Int -> ReadS Entry)
-> ReadS [Entry]
-> ReadPrec Entry
-> ReadPrec [Entry]
-> Read Entry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Entry
readsPrec :: Int -> ReadS Entry
$creadList :: ReadS [Entry]
readList :: ReadS [Entry]
$creadPrec :: ReadPrec Entry
readPrec :: ReadPrec Entry
$creadListPrec :: ReadPrec [Entry]
readListPrec :: ReadPrec [Entry]
Read, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> [Char]
(Int -> Entry -> ShowS)
-> (Entry -> [Char]) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> [Char]
show :: Entry -> [Char]
$cshowList :: [Entry] -> ShowS
showList :: [Entry] -> ShowS
Show, Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq)

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

data ZipException =
    CRC32Mismatch FilePath
  | UnsafePath FilePath
  | CannotWriteEncryptedEntry FilePath
  deriving (Int -> ZipException -> ShowS
[ZipException] -> ShowS
ZipException -> [Char]
(Int -> ZipException -> ShowS)
-> (ZipException -> [Char])
-> ([ZipException] -> ShowS)
-> Show ZipException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ZipException -> ShowS
showsPrec :: Int -> ZipException -> ShowS
$cshow :: ZipException -> [Char]
show :: ZipException -> [Char]
$cshowList :: [ZipException] -> ShowS
showList :: [ZipException] -> ShowS
Show, Typeable, Typeable ZipException
Typeable ZipException =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ZipException -> c ZipException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ZipException)
-> (ZipException -> Constr)
-> (ZipException -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> ZipException -> ZipException)
-> (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 u. (forall d. Data d => d -> u) -> ZipException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ZipException -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ZipException -> m ZipException)
-> Data ZipException
ZipException -> Constr
ZipException -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
$ctoConstr :: ZipException -> Constr
toConstr :: ZipException -> Constr
$cdataTypeOf :: ZipException -> DataType
dataTypeOf :: ZipException -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
$cgmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
gmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
Data, ZipException -> ZipException -> Bool
(ZipException -> ZipException -> Bool)
-> (ZipException -> ZipException -> Bool) -> Eq ZipException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZipException -> ZipException -> Bool
== :: ZipException -> ZipException -> Bool
$c/= :: ZipException -> ZipException -> Bool
/= :: 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              = Maybe ByteString
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 = ByteString -> Archive
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 [Char] Archive
toArchiveOrFail ByteString
bs = case ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, Archive)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, a)
decodeOrFail ByteString
bs of
                           Left (ByteString
_,Int64
_,[Char]
e)  -> [Char] -> Either [Char] Archive
forall a b. a -> Either a b
Left [Char]
e
                           Right (ByteString
_,Int64
_,Archive
x) -> Archive -> Either [Char] Archive
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 = Archive -> ByteString
forall a. Binary a => a -> ByteString
encode

-- | Returns a list of files in a zip archive.
filesInArchive :: Archive -> [FilePath]
filesInArchive :: Archive -> [[Char]]
filesInArchive = (Entry -> [Char]) -> [Entry] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> [Char]
eRelativePath ([Entry] -> [[Char]])
-> (Archive -> [Entry]) -> Archive -> [[Char]]
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'   = [Char] -> Archive -> Archive
deleteEntryFromArchive (Entry -> [Char]
eRelativePath Entry
entry) Archive
archive
      oldEntries :: [Entry]
oldEntries = Archive -> [Entry]
zEntries Archive
archive'
  in  Archive
archive' { zEntries = entry : oldEntries }

-- | Deletes an entry from a zip archive.
deleteEntryFromArchive :: FilePath -> Archive -> Archive
deleteEntryFromArchive :: [Char] -> Archive -> Archive
deleteEntryFromArchive [Char]
path Archive
archive =
  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 :: [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
path Archive
archive =
  (Entry -> Bool) -> [Entry] -> Maybe Entry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Entry
e -> [Char]
path [Char] -> [Char] -> Bool
`matches` Entry -> [Char]
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 :: [Char] -> Entry -> Maybe ByteString
fromEncryptedEntry [Char]
password Entry
entry =
  CompressionMethod -> ByteString -> ByteString
decompressData (Entry -> CompressionMethod
eCompressionMethod Entry
entry) (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData [Char]
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 :: [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
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 Int64 -> Int64 -> Bool
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 = ByteString -> Word32
forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
contents
  in  Entry { eRelativePath :: [Char]
eRelativePath            = ShowS
normalizePath [Char]
path
            , eCompressionMethod :: CompressionMethod
eCompressionMethod       = CompressionMethod
compressionMethod
            , eEncryptionMethod :: EncryptionMethod
eEncryptionMethod        = EncryptionMethod
NoEncryption
            , eLastModified :: Integer
eLastModified            = Integer
modtime
            , eCRC32 :: Word32
eCRC32                   = Word32
crc32
            , eCompressedSize :: Word32
eCompressedSize          = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
finalSize
            , eUncompressedSize :: Word32
eUncompressedSize        = Int64 -> Word32
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] -> [Char] -> IO Entry
readEntry [ZipOption]
opts [Char]
path = do
  Bool
isDir <- [Char] -> IO Bool
doesDirectoryExist [Char]
path
#ifdef _WINDOWS
  let isSymLink = False
#else
  FileStatus
fs <- [Char] -> IO FileStatus
getSymbolicLinkStatus [Char]
path
  let isSymLink :: Bool
isSymLink = FileStatus -> Bool
isSymbolicLink FileStatus
fs
#endif
 -- make sure directories end in / and deal with the OptLocation option
  let path' :: [Char]
path' = let p :: [Char]
p = [Char]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (case ShowS
forall a. [a] -> [a]
reverse [Char]
path of
                                    (Char
'/':[Char]
_) -> [Char]
""
                                    [Char]
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isSymLink -> [Char]
"/"
                                    [Char]
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool
isSymLink -> [Char]
""
                                      | Bool
otherwise -> [Char]
"") in
              (case [([Char]
l,Bool
a) | OptLocation [Char]
l Bool
a <- [ZipOption]
opts] of
                    (([Char]
l,Bool
a):[([Char], Bool)]
_) -> if Bool
a then [Char]
l [Char] -> ShowS
</> [Char]
p else [Char]
l [Char] -> ShowS
</> ShowS
takeFileName [Char]
p
                    [([Char], Bool)]
_         -> [Char]
p)
  ByteString
contents <-
#ifndef _WINDOWS
              if Bool
isSymLink
                 then do
                   [Char]
linkTarget <- [Char] -> IO [Char]
readSymbolicLink [Char]
path
                   ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
C.pack [Char]
linkTarget
                 else
#endif
                   if Bool
isDir
                      then
                        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                      else
                        ByteString -> ByteString
B.fromStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
S.readFile [Char]
path
  UTCTime
modTime <- [Char] -> IO UTCTime
getModificationTime [Char]
path
  TimeZone
tzone <- UTCTime -> IO TimeZone
getTimeZone UTCTime
modTime
  let modEpochTime :: Integer
modEpochTime = -- UNIX time computed relative to LOCAL time zone! (#67)
        POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
modTime) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
          Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeZone -> Int
timeZoneMinutes TimeZone
tzone Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)
  let entry :: Entry
entry = [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
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 = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL (CMode -> Integer
forall a. Integral a => a -> Integer
toInteger CMode
fm) Int
16
           Entry -> IO Entry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> IO Entry) -> Entry -> IO Entry
forall a b. (a -> b) -> a -> b
$ Entry
entry { eExternalFileAttributes = modes,
                            eVersionMadeBy = 0x0300 } -- UNIX file attributes
#endif

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let compmethod :: [Char]
compmethod = case Entry -> CompressionMethod
eCompressionMethod Entry
entryE of
                     CompressionMethod
Deflate       -> ([Char]
"deflated" :: String)
                     CompressionMethod
NoCompression -> [Char]
"stored"
    Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [Char] -> [Char] -> Float -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"  adding: %s (%s %.f%%)" (Entry -> [Char]
eRelativePath Entry
entryE)
      [Char]
compmethod (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Entry -> Float
compressionRatio Entry
entryE))
  Entry -> IO Entry
forall a. a -> IO a
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 :: [Char] -> IO ()
checkPath [Char]
fp =
  IO () -> ([[Char]] -> IO ()) -> Maybe [[Char]] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ([Char] -> ZipException
UnsafePath [Char]
fp)) (\[[Char]]
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([[Char]] -> Maybe [[Char]]
resolve ([[Char]] -> Maybe [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories ([Char] -> Maybe [[Char]]) -> [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
fp)
  where
    resolve :: [[Char]] -> Maybe [[Char]]
resolve =
      ([[Char]] -> [[Char]]) -> Maybe [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse (Maybe [[Char]] -> Maybe [[Char]])
-> ([[Char]] -> Maybe [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [[Char]] -> [Char] -> Maybe [[Char]])
-> Maybe [[Char]] -> [[Char]] -> Maybe [[Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe [[Char]] -> [Char] -> Maybe [[Char]]
forall {m :: * -> *} {a}.
(Eq a, IsString a, MonadFail m) =>
m [a] -> a -> m [a]
go ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
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
"."  -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
          a
".." -> case [a]
xs of
                    []     -> [Char] -> m [a]
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"outside of root path"
                    (a
_:[a]
ys) -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ys
          a
_    -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall 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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Bool
isEncryptedEntry Entry
entry) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO ()) -> ZipException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ZipException
CannotWriteEncryptedEntry (Entry -> [Char]
eRelativePath Entry
entry)
  let relpath :: [Char]
relpath = Entry -> [Char]
eRelativePath Entry
entry
  [Char] -> IO ()
checkPath [Char]
relpath
  [Char]
path <- case [[Char]
d | OptDestination [Char]
d <- [ZipOption]
opts] of
             ([Char]
x:[[Char]]
_)                   -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
x [Char] -> ShowS
</> [Char]
relpath)
             [] | [Char] -> Bool
isAbsolute [Char]
relpath -> ZipException -> IO [Char]
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO [Char]) -> ZipException -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ZipException
UnsafePath [Char]
relpath
                | Bool
otherwise          -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
relpath
  -- create directories if needed
  let dir :: [Char]
dir = ShowS
takeDirectory [Char]
path
  Bool
exists <- [Char] -> IO Bool
doesDirectoryExist [Char]
dir
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"  creating: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dir
  if Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
path) Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' -- path is a directory
     then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else do
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
entry of
                                 CompressionMethod
Deflate       -> [Char]
" inflating: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path
                                 CompressionMethod
NoCompression -> [Char]
"extracting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path
       let uncompressedData :: ByteString
uncompressedData = Entry -> ByteString
fromEntry Entry
entry
       if Entry -> Word32
eCRC32 Entry
entry Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Word32
forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
uncompressedData
          then [Char] -> ByteString -> IO ()
B.writeFile [Char]
path ByteString
uncompressedData
          else ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO ()) -> ZipException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ZipException
CRC32Mismatch [Char]
path
#ifndef _WINDOWS
       let modes :: CMode
modes = Word32 -> CMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> CMode) -> Word32 -> CMode
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR (Entry -> Word32
eExternalFileAttributes Entry
entry) Int
16
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Word16
eVersionMadeBy Entry
entry Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xFF00 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0x0300 Bool -> Bool -> Bool
&&
         CMode
modes CMode -> CMode -> Bool
forall a. Eq a => a -> a -> Bool
/= CMode
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> CMode -> IO ()
setFileMode [Char]
path CMode
modes
#endif
  -- Note that last modified times are supported only for POSIX, not for
  -- Windows.
  [Char] -> Integer -> IO ()
setFileTimeStamp [Char]
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 ZipOption -> [ZipOption] -> Bool
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 :: [Char]
prefixPath = case [[Char]
d | OptDestination [Char]
d <- [ZipOption]
opts] of
                                   ([Char]
x:[[Char]]
_) -> [Char]
x
                                   [[Char]]
_     -> [Char]
""
             let targetPath :: [Char]
targetPath = Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char])
-> (Entry -> Maybe [Char]) -> Entry -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> Maybe [Char]
symbolicLinkEntryTarget (Entry -> [Char]) -> Entry -> [Char]
forall a b. (a -> b) -> a -> b
$ Entry
entry
             let symlinkPath :: [Char]
symlinkPath = [Char]
prefixPath [Char] -> ShowS
</> Entry -> [Char]
eRelativePath Entry
entry
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
               Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"linking " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
symlinkPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
targetPath
             [Char] -> [Char] -> IO ()
forceSymLink [Char]
targetPath [Char]
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 :: [Char] -> [Char] -> IO ()
forceSymLink [Char]
target [Char]
linkName =
    [Char] -> [Char] -> IO ()
createSymbolicLink [Char]
target [Char]
linkName IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
      (\IOError
e -> if IOError -> Bool
isAlreadyExistsError IOError
e
             then [Char] -> IO ()
removeLink [Char]
linkName IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [Char] -> IO ()
createSymbolicLink [Char]
target [Char]
linkName
             else IOError -> IO ()
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 [Char]
symbolicLinkEntryTarget Entry
entry | Entry -> Bool
isEntrySymbolicLink Entry
entry = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (ByteString -> [Char]) -> ByteString -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack (ByteString -> Maybe [Char]) -> ByteString -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
fromEntry Entry
entry
                              | Bool
otherwise = Maybe [Char]
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 CMode -> CMode -> CMode
forall a. Bits a => a -> a -> a
.&. CMode
symbolicLinkMode CMode -> CMode -> Bool
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 (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
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 -> [[Char]] -> IO Archive
addFilesToArchive [ZipOption]
opts Archive
archive [[Char]]
files = do
  [[Char]]
filesAndChildren <- if ZipOption
OptRecursive ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]]) -> IO [[[Char]]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([ZipOption] -> [Char] -> IO [[Char]]
getDirectoryContentsRecursive' [ZipOption]
opts) [[Char]]
files
#endif
                         else [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
files
  [Entry]
entries <- ([Char] -> IO Entry) -> [[Char]] -> IO [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([ZipOption] -> [Char] -> IO Entry
readEntry [ZipOption]
opts) [[Char]]
filesAndChildren
  Archive -> IO Archive
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Archive -> IO Archive) -> Archive -> IO Archive
forall a b. (a -> b) -> a -> b
$ (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> 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 ZipOption -> [ZipOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
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) = (Entry -> Bool) -> [Entry] -> ([Entry], [Entry])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Entry -> Bool
isEntrySymbolicLink [Entry]
entries
      (Entry -> IO ()) -> [Entry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts) [Entry]
nonSymbolicLinkEntries
      (Entry -> IO ()) -> [Entry] -> IO ()
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 (Entry -> IO ()) -> [Entry] -> IO ()
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 [Char]
path =
  let dir :: [Char]
dir   = ShowS
takeDirectory [Char]
path
      fn :: [Char]
fn    = ShowS
takeFileName [Char]
path
      dir' :: [Char]
dir' = case [Char]
dir of
#ifdef _WINDOWS
               (c:':':d:xs) | isLetter c
                            , d == '/' || d == '\\'
                            -> xs  -- remove drive
#endif
               [Char]
_ -> [Char]
dir
      -- note: some versions of filepath return ["."] if no dir
      dirParts :: [[Char]]
dirParts = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Char]
".") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitDirectories [Char]
dir'
  in  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" ([[Char]]
dirParts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
fn])

-- Equality modulo normalization.  So, "./foo" `matches` "foo".
matches :: FilePath -> FilePath -> Bool
matches :: [Char] -> [Char] -> Bool
matches [Char]
fp1 [Char]
fp2 = ShowS
normalizePath [Char]
fp1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
normalizePath [Char]
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 = ByteString -> ByteString
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 = ByteString -> ByteString
forall a. a -> a
id

-- | Decrypt a lazy bytestring
-- Returns Nothing if password is incorrect
decryptData :: String -> EncryptionMethod -> B.ByteString -> Maybe B.ByteString
decryptData :: [Char] -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData [Char]
_ EncryptionMethod
NoEncryption ByteString
s = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
decryptData [Char]
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 = ((Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32))
-> (Word32, Word32, Word32)
-> ByteString
-> (Word32, Word32, Word32)
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32, Word32, Word32)
initKeys ([Char] -> ByteString
C.pack [Char]
password)
      (ByteString
header, ByteString
content) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
headerlen (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ((Word32, Word32, Word32), ByteString) -> ByteString
forall a b. (a, b) -> b
snd (((Word32, Word32, Word32), ByteString) -> ByteString)
-> ((Word32, Word32, Word32), ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Word32, Word32, Word32)
 -> Word8 -> ((Word32, Word32, Word32), Word8))
-> (Word32, Word32, Word32)
-> ByteString
-> ((Word32, Word32, Word32), ByteString)
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
ByteString -> Word8
B.last ByteString
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
controlByte
        then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
content
        else Maybe ByteString
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 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
2
      tmp' :: Word8
tmp' = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
tmp Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* (Word32
tmp Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
1)) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) :: Word8
      outB :: Word8
outB = Word8
inB Word8 -> Word8 -> Word8
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' = Word32 -> [Word8] -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
inB] Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff
      key1' :: Word32
key1' = (Word32
key1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
key0' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
134775813 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
      key1Byte :: Word8
key1Byte = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
key1' Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) :: Word8
      key2' :: Word32
key2' = Word32 -> [Word8] -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
key1Byte] Word32 -> Word32 -> Word32
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 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
     then Float
1
     else Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Entry -> Word32
eCompressedSize Entry
entry) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Word32 -> Float
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]
(Int -> ReadS MSDOSDateTime)
-> ReadS [MSDOSDateTime]
-> ReadPrec MSDOSDateTime
-> ReadPrec [MSDOSDateTime]
-> Read MSDOSDateTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MSDOSDateTime
readsPrec :: Int -> ReadS MSDOSDateTime
$creadList :: ReadS [MSDOSDateTime]
readList :: ReadS [MSDOSDateTime]
$creadPrec :: ReadPrec MSDOSDateTime
readPrec :: ReadPrec MSDOSDateTime
$creadListPrec :: ReadPrec [MSDOSDateTime]
readListPrec :: ReadPrec [MSDOSDateTime]
Read, Int -> MSDOSDateTime -> ShowS
[MSDOSDateTime] -> ShowS
MSDOSDateTime -> [Char]
(Int -> MSDOSDateTime -> ShowS)
-> (MSDOSDateTime -> [Char])
-> ([MSDOSDateTime] -> ShowS)
-> Show MSDOSDateTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSDOSDateTime -> ShowS
showsPrec :: Int -> MSDOSDateTime -> ShowS
$cshow :: MSDOSDateTime -> [Char]
show :: MSDOSDateTime -> [Char]
$cshowList :: [MSDOSDateTime] -> ShowS
showList :: [MSDOSDateTime] -> ShowS
Show, MSDOSDateTime -> MSDOSDateTime -> Bool
(MSDOSDateTime -> MSDOSDateTime -> Bool)
-> (MSDOSDateTime -> MSDOSDateTime -> Bool) -> Eq MSDOSDateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MSDOSDateTime -> MSDOSDateTime -> Bool
== :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
/= :: 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 Integer -> Integer -> Bool
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 -> (Integer -> Int
forall a. Num a => Integer -> a
fromInteger -> Int
year, Int
month, Int
day))
      (DiffTime -> TimeOfDay
timeToTimeOfDay -> (TimeOfDay Int
hour Int
minutes (Pico -> Int
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor -> Int
sec)))
      = POSIXTime -> UTCTime
posixSecondsToUTCTime (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
epochtime)

    dosTime :: Word16
dosTime = Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Int
sec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
minutes Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
hour Int
11
    dosDate :: Word16
dosDate = Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
month Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Int
year Int -> Int -> Int
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 = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16
2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* (Word16
dosTime Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O37)
      minutes :: DiffTime
minutes = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O77
      hour :: DiffTime
hour    = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
11
      day :: Int
day     = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
dosDate Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O37
      month :: Int
month   = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
5) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O17)
      year :: Integer
year    = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
year) Int
month Int
day) (DiffTime
3600 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
hour DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
minutes DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
seconds)
  in POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc)

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

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

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


setFileTimeStamp :: FilePath -> Integer -> IO ()
#ifdef _WINDOWS
setFileTimeStamp _ _ = return () -- TODO: figure out how to set the timestamp on Windows
#else
setFileTimeStamp :: [Char] -> Integer -> IO ()
setFileTimeStamp [Char]
file Integer
epochtime = do
  let epochtime' :: EpochTime
epochtime' = Integer -> EpochTime
forall a. Num a => Integer -> a
fromInteger Integer
epochtime
  [Char] -> EpochTime -> EpochTime -> IO ()
setFileTimes [Char]
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 <- Word32 -> Get (Word32, ByteString) -> Get [(Word32, ByteString)]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x04034b50 Get (Word32, ByteString)
getLocalFile
  [Entry]
files <- Word32 -> Get Entry -> Get [Entry]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x02014b50 (Map Word32 ByteString -> Get Entry
getFileHeader ([(Word32, ByteString)] -> Map Word32 ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Word32, ByteString)]
locals))
  Maybe ByteString
digSig <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Get ByteString -> Get (Maybe ByteString)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get ByteString
getDigitalSignature Get (Maybe ByteString)
-> Get (Maybe ByteString) -> Get (Maybe ByteString)
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ByteString -> Get (Maybe ByteString)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
  Word32
endSig <- Get Word32
getWord32le
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
endSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x06054b50)
    (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 (Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
commentLength)
  Archive -> Get Archive
forall a. a -> Get a
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
  (Entry -> Put) -> [Entry] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> Put
putLocalFile ([Entry] -> Put) -> [Entry] -> Put
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
  let localFileSizes :: [Word32]
localFileSizes = (Entry -> Word32) -> [Entry] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
localFileSize ([Entry] -> [Word32]) -> [Entry] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
  let offsets :: [Word32]
offsets = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> [Word32]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+) Word32
0 [Word32]
localFileSizes
  let cdOffset :: Word32
cdOffset = [Word32] -> Word32
forall a. HasCallStack => [a] -> a
last [Word32]
offsets
  ()
_ <- (Word32 -> Entry -> Put) -> [Word32] -> [Entry] -> Put
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 (Maybe ByteString -> Put) -> Maybe ByteString -> Put
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 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Entry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Entry] -> Int) -> [Entry] -> Int
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive -- number of entries this disk
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Entry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Entry] -> Int) -> [Entry] -> Int
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive -- number of entries
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ [Word32] -> Word32
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word32] -> Word32) -> [Word32] -> Word32
forall a b. (a -> b) -> a -> b
$ (Entry -> Word32) -> [Entry] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
fileHeaderSize ([Entry] -> [Word32]) -> [Entry] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive  -- size of central directory
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cdOffset                    -- offset of central dir
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive


fileHeaderSize :: Entry -> Word32
fileHeaderSize :: Entry -> Word32
fileHeaderSize Entry
f =
  Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
f) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    ByteString -> Int64
B.length (Entry -> ByteString
eExtraField Entry
f) Int64 -> Int64 -> Int64
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 =
  Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
f) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    ByteString -> Int64
B.length (Entry -> ByteString
eExtraField Entry
f) Int64 -> Int64 -> Int64
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 Get Word32 -> (Word32 -> Get ()) -> Get ()
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x04034b50)
  Int -> Get ()
skip Int
2  -- version
  Word16
bitflag <- Get Word16
getWord16le
  Word16
rawCompressionMethod <- Get Word16
getWord16le
  CompressionMethod
compressionMethod <- case Word16
rawCompressionMethod of
                        Word16
0 -> CompressionMethod -> Get CompressionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
                        Word16
8 -> CompressionMethod -> Get CompressionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
                        Word16
_ -> [Char] -> Get CompressionMethod
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get CompressionMethod)
-> [Char] -> Get CompressionMethod
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown compression method " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
rawCompressionMethod
  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
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
compressedSize Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xFFFFFFFF) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Can't read ZIP64 archive."
  Int -> Get ()
skip Int
4  -- uncompressedsize
  Word16
fileNameLength <- Get Word16
getWord16le
  Word16
extraFieldLength <- Get Word16
getWord16le
  Int -> Get ()
skip (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fileNameLength)  -- filename
  Int -> Get ()
skip (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraFieldLength) -- extra field
  ByteString
compressedData <-
    if Word16
bitflag Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O10 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
      then Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
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 <- CompressionMethod -> Get ByteString
getCompressedData CompressionMethod
compressionMethod
              Word32
sig <- Get Word32 -> Get Word32
forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
              Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x08074b50) (Get () -> Get ()) -> Get () -> Get ()
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 Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
B.length ByteString
raw
                 then ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw
                 else [Char] -> Get ByteString
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get ByteString) -> [Char] -> Get ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Word32 -> Int64 -> [Char]
forall r. PrintfType r => [Char] -> r
printf
                       ([Char]
"Content size mismatch in data descriptor record: "
                         [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"expected %d, got %d bytes")
                       Word32
cs (ByteString -> Int64
B.length ByteString
raw)
  (Word32, ByteString) -> Get (Word32, ByteString)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset, ByteString
compressedData)

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 (Word16 -> Put) -> Word16 -> Put
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 (Integer -> MSDOSDateTime) -> Integer -> MSDOSDateTime
forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
f
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
f
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
f
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
f
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString
              ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
f
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
f
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
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 Get Word32 -> (Word32 -> Get ()) -> Get ()
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
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"
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
versionNeededToExtract Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
20) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 -> CompressionMethod -> Get CompressionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
                        Word16
8 -> CompressionMethod -> Get CompressionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
                        Word16
_ -> [Char] -> Get CompressionMethod
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get CompressionMethod)
-> [Char] -> Get CompressionMethod
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown compression method " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
rawCompressionMethod
  Word16
lastModFileTime <- Get Word16
getWord16le
  Word16
lastModFileDate <- Get Word16
getWord16le
  Word32
crc32 <- Get Word32
getWord32le
  EncryptionMethod
encryptionMethod <- case (Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
0, Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
3, Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
6) of
                        (Bool
False, Bool
_, Bool
_) -> EncryptionMethod -> Get EncryptionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionMethod
NoEncryption
                        (Bool
True, Bool
False, Bool
False) -> EncryptionMethod -> Get EncryptionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptionMethod -> Get EncryptionMethod)
-> EncryptionMethod -> Get EncryptionMethod
forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
crc32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
                        (Bool
True, Bool
True, Bool
False) -> EncryptionMethod -> Get EncryptionMethod
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptionMethod -> Get EncryptionMethod)
-> EncryptionMethod -> Get EncryptionMethod
forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
lastModFileTime Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
                        (Bool
True, Bool
_, Bool
True) -> [Char] -> Get EncryptionMethod
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 (Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fileNameLength)
  ByteString
extraField <- Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
extraFieldLength)
  ByteString
fileComment <- Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fileCommentLength)
  ByteString
compressedData <- case Word32 -> Map Word32 ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word32
relativeOffset Map Word32 ByteString
locals of
                    Just ByteString
x  -> ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
                    Maybe ByteString
Nothing -> [Char] -> Get ByteString
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get ByteString) -> [Char] -> Get ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to find data at offset " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
relativeOffset
  Entry -> Get Entry
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
            { eRelativePath :: [Char]
eRelativePath            = ByteString -> [Char]
toString ByteString
fileName
            , eCompressionMethod :: CompressionMethod
eCompressionMethod       = CompressionMethod
compressionMethod
            , eEncryptionMethod :: EncryptionMethod
eEncryptionMethod        = EncryptionMethod
encryptionMethod
            , eLastModified :: Integer
eLastModified            = MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime (MSDOSDateTime -> Integer) -> MSDOSDateTime -> Integer
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 (Word16 -> Put) -> Word16 -> Put
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 (Word16 -> Put) -> Word16 -> Put
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 (Integer -> MSDOSDateTime) -> Integer -> MSDOSDateTime
forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
local
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
local
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
local
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
local
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString
              ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
local
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eFileComment Entry
local
  Word16 -> Put
putWord16le Word16
0  -- disk number start
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word16
eInternalFileAttributes Entry
local
  Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eExternalFileAttributes Entry
local
  Word32 -> Put
putWord32le Word32
offset
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> [Char]
eRelativePath Entry
local
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
  ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
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 Get Word32 -> (Word32 -> Get ()) -> Get ()
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x05054b50)
  Word16
sigSize <- Get Word16
getWord16le
  Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
sigSize)

putDigitalSignature :: Maybe B.ByteString -> Put
putDigitalSignature :: Maybe ByteString -> Put
putDigitalSignature Maybe ByteString
Nothing = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putDigitalSignature (Just ByteString
sig) = do
  Word32 -> Put
putWord32le Word32
0x05054b50
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
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 () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"ensure not satisfied"

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

fromString :: String -> B.ByteString
fromString :: [Char] -> ByteString
fromString = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
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 :: CompressionMethod -> Get ByteString
getCompressedData CompressionMethod
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 :: Get Int64
findSigPos = do
        Word8
w1 <- Get Word8
getWord8
        if Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x50
           then do
             Word8
w2 <- Get Word8
getWord8
             if Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x4b
                then do
                  Word8
w3 <- Get Word8
getWord8
                  if Word8
w3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x07
                     then do
                       Word8
w4 <- Get Word8
getWord8
                       if Word8
w4 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x08
                          then (\Int64
x -> Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
4) (Int64 -> Int64) -> Get Int64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
bytesRead
                          else Get Int64
findSigPos
                     else Get Int64
findSigPos
                else Get Int64
findSigPos
           else Get Int64
findSigPos
  Int64
pos <- Get Int64
bytesRead
  Int64
sigpos <- Get Int64 -> Get Int64
forall a. Get a -> Get a
lookAhead Get Int64
findSigPos Get Int64 -> Get Int64 -> Get Int64
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              [Char] -> Get Int64
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"getCompressedData can't find data descriptor signature"
  let compressedBytes :: Int64
compressedBytes = Int64
sigpos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
pos
  Int64 -> Get ByteString
getLazyByteString Int64
compressedBytes
getCompressedData CompressionMethod
Deflate = do
  ByteString
remainingBytes <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead Get ByteString
getRemainingLazyByteString
  let result :: DecompressResult
result = (ByteString -> DecompressResult -> DecompressResult)
-> (ByteString -> DecompressResult)
-> (DecompressError -> DecompressResult)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> DecompressResult
forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
ZlibInt.foldDecompressStreamWithInput
                (\ByteString
_bs DecompressResult
res -> DecompressResult
res)
                ByteString -> DecompressResult
DecompressSuccess
                DecompressError -> DecompressResult
DecompressFailure
                (Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
ZlibInt.decompressST Format
ZlibInt.rawFormat
                 DecompressParams
ZlibInt.defaultDecompressParams{
                     ZlibInt.decompressAllMembers = False })
                ByteString
remainingBytes
  case DecompressResult
result of
    DecompressFailure DecompressError
err -> [Char] -> Get ByteString
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (DecompressError -> [Char]
forall a. Show a => a -> [Char]
show DecompressError
err)
    DecompressSuccess ByteString
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.
      Int64 -> Get ByteString
getLazyByteString
        (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length ByteString
remainingBytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
B.length ByteString
afterCompressedBytes))