{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns #-}
------------------------------------------------------------------------
-- |
-- Module      : Codec.Archive.Zip
-- Copyright   : John MacFarlane
-- License     : BSD3
--
-- Maintainer  : John MacFarlane < jgm at berkeley dot edu >
-- Stability   : unstable
-- Portability : so far only tested on GHC
--
-- The zip-archive library provides functions for creating, modifying,
-- and extracting files from zip archives.
--
-- Certain simplifying assumptions are made about the zip archives: in
-- particular, there is no support for strong encryption, zip files that span
-- multiple disks, ZIP64, OS-specific file attributes, or compression
-- methods other than Deflate.  However, the library should be able to
-- read the most common zip archives, and the archives it produces should
-- be readable by all standard unzip programs.
--
-- As an example of the use of the library, a standalone zip archiver
-- and extracter, Zip.hs, is provided in the source distribution.
--
-- For more information on the format of zip archives, consult
-- <http://www.pkware.com/documents/casestudies/APPNOTE.TXT>
------------------------------------------------------------------------

module Codec.Archive.Zip
       (

       -- * Data structures
         Archive (..)
       , Entry (..)
       , CompressionMethod (..)
       , EncryptionMethod (..)
       , ZipOption (..)
       , ZipException (..)
       , emptyArchive

       -- * Pure functions for working with zip archives
       , toArchive
       , toArchiveOrFail
       , fromArchive
       , filesInArchive
       , addEntryToArchive
       , deleteEntryFromArchive
       , findEntryByPath
       , fromEntry
       , fromEncryptedEntry
       , isEncryptedEntry
       , toEntry
#ifndef _WINDOWS
       , isEntrySymbolicLink
       , symbolicLinkEntryTarget
       , entryCMode
#endif

       -- * IO functions for working with zip archives
       , readEntry
       , writeEntry
#ifndef _WINDOWS
       , writeSymbolicLinkEntry
#endif
       , addFilesToArchive
       , extractFilesFromArchive

       ) where

import Data.Time.Calendar ( toGregorian, fromGregorian )
import Data.Time.Clock ( UTCTime(..) )
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.LocalTime ( TimeOfDay(..), timeToTimeOfDay )
import Data.Bits ( shiftL, shiftR, (.&.), (.|.), xor, testBit )
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.List (nub, find, intercalate)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Text.Printf
import System.FilePath
import System.Directory
       (doesDirectoryExist, getDirectoryContents,
        createDirectoryIfMissing, getModificationTime)
import Control.Monad ( when, unless, zipWithM_ )
import qualified Control.Exception as E
import System.IO ( stderr, hPutStrLn )
import qualified Data.Digest.CRC32 as CRC32
import qualified Data.Map as M
import Control.Applicative
#ifndef _WINDOWS
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 System.IO.Error (isAlreadyExistsError)

manySig :: Word32 -> Get a -> Get [a]
manySig :: 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 (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 (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
readListPrec :: ReadPrec [Archive]
$creadListPrec :: ReadPrec [Archive]
readPrec :: ReadPrec Archive
$creadPrec :: ReadPrec Archive
readList :: ReadS [Archive]
$creadList :: ReadS [Archive]
readsPrec :: Int -> ReadS Archive
$creadsPrec :: Int -> ReadS Archive
Read, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> String
(Int -> Archive -> ShowS)
-> (Archive -> String) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> String
$cshow :: Archive -> String
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show)

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

-- | Representation of an archived file, including content and metadata.
data Entry = Entry
               { Entry -> String
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
readListPrec :: ReadPrec [Entry]
$creadListPrec :: ReadPrec [Entry]
readPrec :: ReadPrec Entry
$creadPrec :: ReadPrec Entry
readList :: ReadS [Entry]
$creadList :: ReadS [Entry]
readsPrec :: Int -> ReadS Entry
$creadsPrec :: Int -> ReadS Entry
Read, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show, Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq)

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

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

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

-- | Options for 'addFilesToArchive' and 'extractFilesFromArchive'.
data ZipOption = OptRecursive               -- ^ Recurse into directories when adding files
               | OptVerbose                 -- ^ Print information to stderr
               | OptDestination FilePath    -- ^ Directory in which to extract
               | OptLocation FilePath Bool  -- ^ Where to place file when adding files and whether to append current path
               | OptPreserveSymbolicLinks   -- ^ Preserve symbolic links as such. This option is ignored on Windows.
               deriving (ReadPrec [ZipOption]
ReadPrec ZipOption
Int -> ReadS ZipOption
ReadS [ZipOption]
(Int -> ReadS ZipOption)
-> ReadS [ZipOption]
-> ReadPrec ZipOption
-> ReadPrec [ZipOption]
-> Read ZipOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ZipOption]
$creadListPrec :: ReadPrec [ZipOption]
readPrec :: ReadPrec ZipOption
$creadPrec :: ReadPrec ZipOption
readList :: ReadS [ZipOption]
$creadList :: ReadS [ZipOption]
readsPrec :: Int -> ReadS ZipOption
$creadsPrec :: Int -> ReadS ZipOption
Read, Int -> ZipOption -> ShowS
[ZipOption] -> ShowS
ZipOption -> String
(Int -> ZipOption -> ShowS)
-> (ZipOption -> String)
-> ([ZipOption] -> ShowS)
-> Show ZipOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipOption] -> ShowS
$cshowList :: [ZipOption] -> ShowS
show :: ZipOption -> String
$cshow :: ZipOption -> String
showsPrec :: Int -> ZipOption -> ShowS
$cshowsPrec :: Int -> ZipOption -> ShowS
Show, ZipOption -> ZipOption -> Bool
(ZipOption -> ZipOption -> Bool)
-> (ZipOption -> ZipOption -> Bool) -> Eq ZipOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipOption -> ZipOption -> Bool
$c/= :: ZipOption -> ZipOption -> Bool
== :: ZipOption -> ZipOption -> Bool
$c== :: ZipOption -> ZipOption -> Bool
Eq)

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

instance E.Exception ZipException

-- | A zip archive with no contents.
emptyArchive :: Archive
emptyArchive :: Archive
emptyArchive = Archive :: [Entry] -> Maybe ByteString -> ByteString -> Archive
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
#if MIN_VERSION_binary(0,7,0)
toArchiveOrFail :: ByteString -> Either String Archive
toArchiveOrFail ByteString
bs = case ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Archive)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bs of
                           Left (ByteString
_,ByteOffset
_,String
e)  -> String -> Either String Archive
forall a b. a -> Either a b
Left String
e
                           Right (ByteString
_,ByteOffset
_,Archive
x) -> Archive -> Either String Archive
forall a b. b -> Either a b
Right Archive
x
#else
toArchiveOrFail bs = Right $ toArchive bs
#endif

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

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

-- | Returns Just the zip entry with the specified path, or Nothing.
findEntryByPath :: FilePath -> Archive -> Maybe Entry
findEntryByPath :: String -> Archive -> Maybe Entry
findEntryByPath String
path Archive
archive =
  (Entry -> Bool) -> [Entry] -> Maybe Entry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Entry
e -> String
path String -> String -> Bool
`matches` Entry -> String
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 :: String -> Entry -> Maybe ByteString
fromEncryptedEntry String
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
<$> String -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData String
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 :: String -> Integer -> ByteString -> Entry
toEntry String
path Integer
modtime ByteString
contents =
  let uncompressedSize :: ByteOffset
uncompressedSize = ByteString -> ByteOffset
B.length ByteString
contents
      compressedData :: ByteString
compressedData = CompressionMethod -> ByteString -> ByteString
compressData CompressionMethod
Deflate ByteString
contents
      compressedSize :: ByteOffset
compressedSize = ByteString -> ByteOffset
B.length ByteString
compressedData
      -- only use compression if it helps!
      (CompressionMethod
compressionMethod, ByteString
finalData, ByteOffset
finalSize) =
        if ByteOffset
uncompressedSize ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
compressedSize
           then (CompressionMethod
NoCompression, ByteString
contents, ByteOffset
uncompressedSize)
           else (CompressionMethod
Deflate, ByteString
compressedData, ByteOffset
compressedSize)
      crc32 :: Word32
crc32 = ByteString -> Word32
forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
contents
  in  Entry :: String
-> CompressionMethod
-> EncryptionMethod
-> Integer
-> Word32
-> Word32
-> Word32
-> ByteString
-> ByteString
-> Word16
-> Word16
-> Word32
-> ByteString
-> Entry
Entry { eRelativePath :: String
eRelativePath            = ShowS
normalizePath String
path
            , eCompressionMethod :: CompressionMethod
eCompressionMethod       = CompressionMethod
compressionMethod
            , eEncryptionMethod :: EncryptionMethod
eEncryptionMethod        = EncryptionMethod
NoEncryption
            , eLastModified :: Integer
eLastModified            = Integer
modtime
            , eCRC32 :: Word32
eCRC32                   = Word32
crc32
            , eCompressedSize :: Word32
eCompressedSize          = ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
finalSize
            , eUncompressedSize :: Word32
eUncompressedSize        = ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
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] -> String -> IO Entry
readEntry [ZipOption]
opts String
path = do
  Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
#ifdef _WINDOWS
  let isSymLink = False
#else
  FileStatus
fs <- String -> IO FileStatus
getSymbolicLinkStatus String
path
  let isSymLink :: Bool
isSymLink = FileStatus -> Bool
isSymbolicLink FileStatus
fs
#endif
 -- make sure directories end in / and deal with the OptLocation option
  let path' :: String
path' = let p :: String
p = String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ (case ShowS
forall a. [a] -> [a]
reverse String
path of
                                    (Char
'/':String
_) -> String
""
                                    String
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isSymLink -> String
"/"
                                    String
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool
isSymLink -> String
""
                                      | Bool
otherwise -> String
"") in
              (case [(String
l,Bool
a) | OptLocation String
l Bool
a <- [ZipOption]
opts] of
                    ((String
l,Bool
a):[(String, Bool)]
_) -> if Bool
a then String
l String -> ShowS
</> String
p else String
l String -> ShowS
</> ShowS
takeFileName String
p
                    [(String, Bool)]
_         -> String
p)
  ByteString
contents <-
#ifndef _WINDOWS
              if Bool
isSymLink
                 then do
                   String
linkTarget <- String -> IO String
readSymbolicLink String
path
                   ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack String
linkTarget
                 else
#endif
                   if Bool
isDir
                      then
                        ByteString -> IO ByteString
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
<$> String -> IO ByteString
S.readFile String
path
  Integer
modEpochTime <- (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds) (UTCTime -> Integer) -> IO UTCTime -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
path
  let entry :: Entry
entry = String -> Integer -> ByteString -> Entry
toEntry String
path' Integer
modEpochTime ByteString
contents

  Entry
entryE <-
#ifdef _WINDOWS
        return $ entry { eVersionMadeBy = 0x0000 } -- FAT/VFAT/VFAT32 file attributes
#else
        do
           let fm :: FileMode
fm = if Bool
isSymLink
                      then FileMode -> FileMode -> FileMode
unionFileModes FileMode
symbolicLinkMode (FileStatus -> FileMode
fileMode FileStatus
fs)
                      else FileStatus -> FileMode
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 (FileMode -> Integer
forall a. Integral a => a -> Integer
toInteger FileMode
fm) Int
16
           Entry -> IO Entry
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 :: Word32
eExternalFileAttributes = Word32
modes,
                            eVersionMadeBy :: Word16
eVersionMadeBy = Word16
0x0300 } -- UNIX file attributes
#endif

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> 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 :: String
compmethod = case Entry -> CompressionMethod
eCompressionMethod Entry
entryE of
                     CompressionMethod
Deflate       -> (String
"deflated" :: String)
                     CompressionMethod
NoCompression -> String
"stored"
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> String -> String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"  adding: %s (%s %.f%%)" (Entry -> String
eRelativePath Entry
entryE)
      String
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 (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 :: String -> IO ()
checkPath String
fp =
  IO () -> ([String] -> IO ()) -> Maybe [String] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (String -> ZipException
UnsafePath String
fp)) (\[String]
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([String] -> Maybe [String]
resolve ([String] -> Maybe [String])
-> (String -> [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String
fp)
  where
    resolve :: [String] -> Maybe [String]
resolve =
      ([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
forall a. [a] -> [a]
reverse (Maybe [String] -> Maybe [String])
-> ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [String] -> String -> Maybe [String])
-> Maybe [String] -> [String] -> Maybe [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe [String] -> String -> Maybe [String]
forall (m :: * -> *).
MonadFail m =>
m [String] -> String -> m [String]
go ([String] -> Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      where
      go :: m [String] -> String -> m [String]
go m [String]
acc String
x = do
        [String]
xs <- m [String]
acc
        case String
x of
          String
"."  -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
xs
          String
".." -> case [String]
xs of
                    []     -> String -> m [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"outside of root path"
                    (String
_:[String]
ys) -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
ys
          String
_    -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
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
$ String -> ZipException
CannotWriteEncryptedEntry (Entry -> String
eRelativePath Entry
entry)
  let relpath :: String
relpath = Entry -> String
eRelativePath Entry
entry
  String -> IO ()
checkPath String
relpath
  String
path <- case [String
d | OptDestination String
d <- [ZipOption]
opts] of
             (String
x:[String]
_)                   -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x String -> ShowS
</> String
relpath)
             [] | String -> Bool
isAbsolute String
relpath -> ZipException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO String) -> ZipException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> ZipException
UnsafePath String
relpath
                | Bool
otherwise          -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
relpath
  -- create directories if needed
  let dir :: String
dir = ShowS
takeDirectory String
path
  Bool
exists <- String -> IO Bool
doesDirectoryExist String
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 -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> 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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  creating: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir
  if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path) Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' -- path is a directory
     then () -> IO ()
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 (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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
entry of
                                 CompressionMethod
Deflate       -> String
" inflating: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
                                 CompressionMethod
NoCompression -> String
"extracting: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
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 String -> ByteString -> IO ()
B.writeFile String
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
$ String -> ZipException
CRC32Mismatch String
path
#ifndef _WINDOWS
       let modes :: FileMode
modes = Word32 -> FileMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> FileMode) -> Word32 -> FileMode
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
&&
         FileMode
modes FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
path FileMode
modes
#endif
  -- Note that last modified times are supported only for POSIX, not for
  -- Windows.
  String -> Integer -> IO ()
setFileTimeStamp String
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 :: String
prefixPath = case [String
d | OptDestination String
d <- [ZipOption]
opts] of
                                   (String
x:[String]
_) -> String
x
                                   [String]
_     -> String
""
             let targetPath :: String
targetPath = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (Entry -> Maybe String) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> Maybe String
symbolicLinkEntryTarget (Entry -> String) -> Entry -> String
forall a b. (a -> b) -> a -> b
$ Entry
entry
             let symlinkPath :: String
symlinkPath = String
prefixPath String -> ShowS
</> Entry -> String
eRelativePath Entry
entry
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> 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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"linking " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
symlinkPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
targetPath
             String -> String -> IO ()
forceSymLink String
targetPath String
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 :: String -> String -> IO ()
forceSymLink String
target String
linkName =
    String -> String -> IO ()
createSymbolicLink String
target String
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 String -> IO ()
removeLink String
linkName IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
createSymbolicLink String
target String
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 String
symbolicLinkEntryTarget Entry
entry | Entry -> Bool
isEntrySymbolicLink Entry
entry = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack (ByteString -> Maybe String) -> ByteString -> Maybe String
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
fromEntry Entry
entry
                              | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

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

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

-- Equality modulo normalization.  So, "./foo" `matches` "foo".
matches :: FilePath -> FilePath -> Bool
matches :: String -> String -> Bool
matches String
fp1 String
fp2 = ShowS
normalizePath String
fp1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
normalizePath String
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 :: String -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData String
_ EncryptionMethod
NoEncryption ByteString
s = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
decryptData String
password (PKWAREEncryption Word8
controlByte) ByteString
s =
  let headerlen :: ByteOffset
headerlen = ByteOffset
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 (String -> ByteString
C.pack String
password)
      (ByteString
header, ByteString
content) = ByteOffset -> ByteString -> (ByteString, ByteString)
B.splitAt ByteOffset
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 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
readListPrec :: ReadPrec [MSDOSDateTime]
$creadListPrec :: ReadPrec [MSDOSDateTime]
readPrec :: ReadPrec MSDOSDateTime
$creadPrec :: ReadPrec MSDOSDateTime
readList :: ReadS [MSDOSDateTime]
$creadList :: ReadS [MSDOSDateTime]
readsPrec :: Int -> ReadS MSDOSDateTime
$creadsPrec :: Int -> ReadS MSDOSDateTime
Read, Int -> MSDOSDateTime -> ShowS
[MSDOSDateTime] -> ShowS
MSDOSDateTime -> String
(Int -> MSDOSDateTime -> ShowS)
-> (MSDOSDateTime -> String)
-> ([MSDOSDateTime] -> ShowS)
-> Show MSDOSDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSDOSDateTime] -> ShowS
$cshowList :: [MSDOSDateTime] -> ShowS
show :: MSDOSDateTime -> String
$cshow :: MSDOSDateTime -> String
showsPrec :: Int -> MSDOSDateTime -> ShowS
$cshowsPrec :: Int -> MSDOSDateTime -> ShowS
Show, MSDOSDateTime -> MSDOSDateTime -> Bool
(MSDOSDateTime -> MSDOSDateTime -> Bool)
-> (MSDOSDateTime -> MSDOSDateTime -> Bool) -> Eq MSDOSDateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
== :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c== :: MSDOSDateTime -> MSDOSDateTime -> Bool
Eq)

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

-- | Convert a clock time to a MSDOS datetime.  The MSDOS time will be relative to UTC.
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime Integer
epochtime | Integer
epochtime 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 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 :: Word16 -> Word16 -> MSDOSDateTime
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 a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc)

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

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

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


setFileTimeStamp :: FilePath -> Integer -> IO ()
#ifdef _WINDOWS
setFileTimeStamp _ _ = return () -- TODO: figure out how to set the timestamp on Windows
#else
setFileTimeStamp :: String -> Integer -> IO ()
setFileTimeStamp String
file Integer
epochtime = do
  let epochtime' :: EpochTime
epochtime' = Integer -> EpochTime
forall a. Num a => Integer -> a
fromInteger Integer
epochtime
  String -> EpochTime -> EpochTime -> IO ()
setFileTimes String
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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ByteString -> Get (Maybe ByteString)
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
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
commentLength)
  Archive -> Get Archive
forall (m :: * -> *) a. Monad m => a -> m a
return Archive :: [Entry] -> Maybe ByteString -> ByteString -> Archive
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. [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 (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 (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 (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
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
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 =
  ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word32) -> ByteOffset -> Word32
forall a b. (a -> b) -> a -> b
$ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
    ByteOffset -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
    ByteString -> ByteOffset
B.length (Entry -> ByteString
eExtraField Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteString -> ByteOffset
B.length (Entry -> ByteString
eFileComment Entry
f)

localFileSize :: Entry -> Word32
localFileSize :: Entry -> Word32
localFileSize Entry
f =
  ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word32) -> ByteOffset -> Word32
forall a b. (a -> b) -> a -> b
$ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
    ByteOffset -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
    ByteString -> ByteOffset
B.length (Entry -> ByteString
eExtraField Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteString -> ByteOffset
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
  ByteOffset
offset <- Get ByteOffset
bytesRead
  Get Word32
getWord32le Get Word32 -> (Word32 -> Get ()) -> Get ()
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
  Int -> Get ()
skip Int
2  -- compressionMethod
  Int -> Get ()
skip Int
2  -- last mod file time
  Int -> Get ()
skip Int
2  -- last mod file date
  Int -> Get ()
skip Int
4  -- crc32
  Word32
compressedSize <- Get Word32
getWord32le
  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
$
    String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 ByteOffset -> Get ByteString
getLazyByteString (Word32 -> ByteOffset
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.  We assume that the
           -- record has signature 0x08074b50; this is not required
           -- by the specification but is common.
           do ByteString
raw <- Word32 -> Get ByteString
getWordsTilSig Word32
0x08074b50
              Int -> Get ()
skip Int
4 -- crc32
              Word32
cs <- Get Word32
getWord32le  -- compressed size
              Int -> Get ()
skip Int
4 -- uncompressed size
              if Word32 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cs ByteOffset -> ByteOffset -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteOffset
B.length ByteString
raw
                 then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw
                 else String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Content size mismatch in data descriptor record"
  (Word32, ByteString) -> Get (Word32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
offset, ByteString
compressedData)

getWordsTilSig :: Word32 -> Get B.ByteString
getWordsTilSig :: Word32 -> Get ByteString
getWordsTilSig Word32
sig = ([ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse) ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
forall a. Maybe a
Nothing []
  where
    sig' :: ByteString
sig' = [Word8] -> ByteString
S.pack [Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
                   Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR`  Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
                   Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
                   Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF]
    chunkSize :: Int
chunkSize = Int
16384
    --chunkSize = 4 -- for testing prefix match
    checkChunk :: ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk = do -- find in content
          let (ByteString
prefix, ByteString
start) = ByteString -> ByteString -> (ByteString, ByteString)
S.breakSubstring ByteString
sig' ByteString
chunk
          if ByteString -> Bool
S.null ByteString
start
            then Either Int ByteString -> m (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> m (Either Int ByteString))
-> Either Int ByteString -> m (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Int ByteString
forall a b. b -> Either a b
Right ByteString
chunk
            else Either Int ByteString -> m (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> m (Either Int ByteString))
-> Either Int ByteString -> m (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
prefix
    go :: Maybe (Word8, Word8, Word8) -> [S.ByteString] -> Get [S.ByteString]
    go :: Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
prefixes [ByteString]
acc = do
      -- note: lookAheadE will rewind if the result is Left
      Either Int ByteString
eitherChunkOrIndex <- Get (Either Int ByteString) -> Get (Either Int ByteString)
forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE (Get (Either Int ByteString) -> Get (Either Int ByteString))
-> Get (Either Int ByteString) -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ do
          ByteString
chunk <- Int -> Get ByteString
getByteString Int
chunkSize Get ByteString -> Get ByteString -> Get ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> ByteString
B.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get ByteString
getRemainingLazyByteString
          case Maybe (Word8, Word8, Word8)
prefixes of
            Just (Word8
byte3,Word8
byte2,Word8
byte1) ->
              let len :: Int
len = ByteString -> Int
S.length ByteString
chunk in
                if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&&
                   [Word8] -> ByteString
S.pack [Word8
byte3,Word8
byte2,Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
                then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
3
                else if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
                   [Word8] -> ByteString
S.pack [Word8
byte2,Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0,ByteString -> Int -> Word8
S.index ByteString
chunk Int
1] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
                then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
2
                else if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&&
                   [Word8] -> ByteString
S.pack [Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0,ByteString -> Int -> Word8
S.index ByteString
chunk Int
1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
2] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
                then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
1
                else ByteString -> Get (Either Int ByteString)
forall (m :: * -> *).
Monad m =>
ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk
            Maybe (Word8, Word8, Word8)
Nothing -> ByteString -> Get (Either Int ByteString)
forall (m :: * -> *).
Monad m =>
ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk
      case Either Int ByteString
eitherChunkOrIndex of
        Left Int
index -> if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
            then do -- prefix match
                Int -> Get ()
skip (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) -- skip over partial match in next chunk
                [ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Get [ByteString])
-> [ByteString] -> Get [ByteString]
forall a b. (a -> b) -> a -> b
$ (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
acc) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
acc)) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
acc)
            else do -- match inside this chunk
                ByteString
lastchunk <- Int -> Get ByteString
getByteString Int
index -- must read again
                Int -> Get ()
skip Int
4
                [ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
lastchunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
        Right ByteString
chunk -> if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chunkSize
            then Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
prefixes' (ByteString
chunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
            else String -> Get [ByteString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get [ByteString]) -> String -> Get [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"getWordsTilSig: signature not found before EOF"
          where
            len :: Int
len = ByteString -> Int
S.length ByteString
chunk
            prefixes' :: Maybe (Word8, Word8, Word8)
prefixes' = (Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8)
forall a. a -> Maybe a
Just ((Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8))
-> (Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3), ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2), ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

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
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString
              (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
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
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
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 (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
$
    String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
                        Word16
8 -> CompressionMethod -> Get CompressionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
                        Word16
_ -> String -> Get CompressionMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get CompressionMethod)
-> String -> Get CompressionMethod
forall a b. (a -> b) -> a -> b
$ String
"Unknown compression method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
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 (m :: * -> *) a. Monad m => a -> m a
return EncryptionMethod
NoEncryption
                        (Bool
True, Bool
False, Bool
False) -> EncryptionMethod -> Get EncryptionMethod
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 (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) -> String -> Get EncryptionMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fileNameLength)
  ByteString
extraField <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
extraFieldLength)
  ByteString
fileComment <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
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 (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
                    Maybe ByteString
Nothing -> String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ByteString) -> String -> Get ByteString
forall a b. (a -> b) -> a -> b
$ String
"Unable to find data at offset " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        Word32 -> String
forall a. Show a => a -> String
show Word32
relativeOffset
  Entry -> Get Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry :: String
-> CompressionMethod
-> EncryptionMethod
-> Integer
-> Word32
-> Word32
-> Word32
-> ByteString
-> ByteString
-> Word16
-> Word16
-> Word32
-> ByteString
-> Entry
Entry
            { eRelativePath :: String
eRelativePath            = ByteString -> String
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 :: Word16 -> Word16 -> MSDOSDateTime
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
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString
              (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
local
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
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
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
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
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
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 (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
  ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
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 (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
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length ByteString
sig
  ByteString -> Put
putLazyByteString ByteString
sig

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

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

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