Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-zip-archive for openSUSE:Factory
checked in at 2026-11-06 19:50:49
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-zip-archive (Old)
and /work/SRC/openSUSE:Factory/.ghc-zip-archive.new.3759290 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-zip-archive"
Fri Nov 6 19:50:49 2026 rev:26 rq:1395586 version:0.5
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-zip-archive/ghc-zip-archive.changes
2024-06-03 17:45:57.700519965 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-zip-archive.new.3759290/ghc-zip-archive.changes
2026-11-06 19:58:00.923278560 +0100
@@ -1,0 +2,9 @@
+Mon Sep 21 18:19:52 UTC 2026 - Peter Simons <[email protected]>
+
+- Update zip-archive to version 0.5.
+ Upstream has edited the change log file since the last release in
+ a non-trivial way, i.e. they did more than just add a new entry
+ at the top. You can review the file at:
+ http://hackage.haskell.org/package/zip-archive-0.5/src/changelog
+
+-------------------------------------------------------------------
Old:
----
zip-archive-0.4.3.2.tar.gz
zip-archive.cabal
New:
----
zip-archive-0.5.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-zip-archive.spec ++++++
--- /var/tmp/diff_new_pack.3hG4yE/_old 2026-11-06 19:58:02.072326660 +0100
+++ /var/tmp/diff_new_pack.3hG4yE/_new 2026-11-06 19:58:02.076326827 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-zip-archive
#
-# Copyright (c) 2024 SUSE LLC
+# Copyright (c) 2026 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,13 +20,12 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.4.3.2
+Version: 0.5
Release: 0
Summary: Library for creating and modifying zip archives
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-array-devel
BuildRequires: ghc-array-prof
@@ -44,10 +43,6 @@
BuildRequires: ghc-directory-prof
BuildRequires: ghc-filepath-devel
BuildRequires: ghc-filepath-prof
-BuildRequires: ghc-mtl-devel
-BuildRequires: ghc-mtl-prof
-BuildRequires: ghc-pretty-devel
-BuildRequires: ghc-pretty-prof
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-text-devel
BuildRequires: ghc-text-prof
@@ -87,7 +82,7 @@
manipulate zip archives in "pure" contexts.
As an example of the use of the library, a standalone zip archiver and
-extracter is provided in the source distribution.
+extractor is provided in the source distribution.
%package devel
Summary: Haskell %{pkg_name} library development files
@@ -117,7 +112,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ zip-archive-0.4.3.2.tar.gz -> zip-archive-0.5.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/zip-archive-0.4.3.2/README.markdown
new/zip-archive-0.5/README.markdown
--- old/zip-archive-0.4.3.2/README.markdown 2001-09-09 03:46:40.000000000
+0200
+++ new/zip-archive-0.5/README.markdown 2001-09-09 03:46:40.000000000 +0200
@@ -24,4 +24,4 @@
archives in "pure" contexts.
As an example of the use of the library, a standalone zip archiver
-and extracter is provided in the source distribution.
+and extractor is provided in the source distribution.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/zip-archive-0.4.3.2/changelog
new/zip-archive-0.5/changelog
--- old/zip-archive-0.4.3.2/changelog 2001-09-09 03:46:40.000000000 +0200
+++ new/zip-archive-0.5/changelog 2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,87 @@
+zip-archive 0.5
+
+ * Reject absolute and drive-qualified entry paths on extraction, even
+ when OptDestination is given. `checkPath` now throws UnsafePath for
+ absolute (and, on Windows, drive-qualified) paths regardless of options.
+
+ * Validate symbolic link entry paths on extraction.
+
+ * Decode file names per the UTF-8 flag, with CP437 fallback.
+ Previously file names were unconditionally decoded as UTF-8, so archives
+ with non-UTF-8 names raised an impure UnicodeException.
+ Now the general purpose bit flag is consulted: when bit 11 (language
+ encoding flag) is set, names are decoded as UTF-8 leniently (invalid
+ bytes become U+FFFD); otherwise they are decoded as code page 437 as
+ specified in APPNOTE.TXT appendix D.
+
+ * Return Nothing from `decryptData` on truncated encrypted data, instead
+ of raising an exception.
+
+ * Raise Zip64NotSupported instead of silently truncating on overflow.
+ The library does not support ZIP64, but nothing prevented writing
+ archives that would need it: toEntry truncated sizes of entries of 4GB
+ or more to Word32, and putArchive truncated entry counts (Word16) and
+ central directory offsets (Word32), silently producing corrupt output.
+ Add a Zip64NotSupported constructor to ZipException [API change]
+ and throw it (as a pure exception) from toEntry for oversized
+ entries and from putArchive for too many entries or too-large
+ archives. Local file offsets are now computed in Int64 so overflow
+ can actually be detected.
+
+ * Undo the local time zone shift when setting extracted file times.
+ `readEntry` stores `eLastModified` shifted by the local time
+ zone offset; ensure that this shift is reversed on extraction.
+
+ * Clamp DOS datetimes at the upper end of the representable range
+ (year 2108).
+
+ * Stop claiming maximum compression in the general purpose bit flag.
+ `compressData` uses zlib's default compression level, but the written
+ flag (0x802) had bit 1 set, which means the entry was deflated with
+ maximum compression. Write 0x800 (UTF-8 file names only) instead.
+
+ * Make `addFilesToArchive` near-linear in the number of files.
+ Large directory trees now dedupe via Data.Set on normalized paths,
+ preserving the previous semantics (first entry for a path wins,
+ new entries precede old ones).
+
+ * Avoid retaining the whole remaining archive in `getCompressedData`.
+ The raw deflate stream is fed to zlib's incremental `decompressST`
+ chunk by chunk, counting only the bytes actually consumed, so
+ memory use is proportional to the entry rather than to everything
+ after it.
+
+ * Use a CRC32 lookup table in the PKWARE key schedule.
+
+ * Stream extraction in `writeEntry` with an incremental CRC check.
+ writeEntry previously computed the CRC32 of the whole uncompressed
+ entry and then wrote it with B.writeFile; the reference to the
+ data across the CRC pass forced the entire entry to be retained in
+ memory. Now the entry is written chunk by chunk to a temporary
+ file in the target directory while the CRC is updated
+ incrementally, and the file is renamed into place only if the CRC
+ matches. As before, a pre-existing file at the target path is
+ left intact when the CRC check fails; the temporary file is
+ removed on mismatch or on any exception during writing.
+
+ * Encode each entry path once in `putLocalFile` and `putFileHeader`.
+ Previously both serializers normalized and UTF-8-encoded the entry
+ path twice: once for its length field and once for the path bytes.
+
+ * cabal: use extra-doc-files stanza.
+
+ * Add regression test for issue #55 (dotfile paths).
+
+ * Fix spelling errors (@kianmeng, #69).
+
+ * Remove stack.yaml.
+
+ * Change default-language to Haskell2010.
+
+ * Remove spurious dependencies (pretty, mtl).
+
+ * Depend on base >= 4.11.
+
zip-archive 0.4.3.2
* readEntry: Fix computation of modification time (#67).
@@ -19,7 +103,7 @@
zlib's Internal module to identify where the compressed data
ends. Fixes both #65 and #25.
- zip-archive 0.4.3
+zip-archive 0.4.3
* Improve code for retrieving compressed data of unknown length (#63).
Do not assume we'll have the signature 0x08074b50 that is
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/zip-archive-0.4.3.2/src/Codec/Archive/Zip.hs
new/zip-archive-0.5/src/Codec/Archive/Zip.hs
--- old/zip-archive-0.4.3.2/src/Codec/Archive/Zip.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/zip-archive-0.5/src/Codec/Archive/Zip.hs 2001-09-09
03:46:40.000000000 +0200
@@ -22,8 +22,17 @@
-- read the most common zip archives, and the archives it produces should
-- be readable by all standard unzip programs.
--
+-- One known limitation: when parsing an archive whose local file
+-- headers defer sizes to a data descriptor (general purpose bit 3)
+-- and whose entries are stored without compression, the end of the
+-- entry data can only be found by scanning for the optional data
+-- descriptor signature @0x08074b50@. Parsing such an archive can
+-- therefore fail (or truncate an entry) if that byte sequence occurs
+-- within the stored data itself. Archives of this kind are rare;
+-- deflated entries with data descriptors are not affected.
+--
-- As an example of the use of the library, a standalone zip archiver
--- and extracter, Zip.hs, is provided in the source distribution.
+-- and extractor, 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>
@@ -75,28 +84,33 @@
import Data.Time.LocalTime ( TimeZone(..), TimeOfDay(..), timeToTimeOfDay,
getTimeZone )
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
-import Data.Bits ( shiftL, shiftR, (.&.), (.|.), xor, testBit )
+import Data.Bits ( shiftL, shiftR, (.&.), (.|.), xor, testBit, complement )
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
-import Data.List (nub, find, intercalate)
+import Data.List (find, intercalate)
+import Data.Int (Int64)
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_ )
+ createDirectoryIfMissing, getModificationTime,
+ renameFile, removeFile)
+import Control.Monad ( when, unless, zipWithM_, foldM )
+import Control.Monad.ST.Lazy ( runST )
import qualified Control.Exception as E
-import System.IO ( stderr, hPutStrLn )
+import System.IO ( stderr, hPutStrLn, hClose, openBinaryTempFile )
import qualified Data.Digest.CRC32 as CRC32
+import Data.Array.Unboxed ( UArray, listArray, (!) )
import qualified Data.Map as M
+import qualified Data.Set as Set
import Control.Applicative
#ifdef _WINDOWS
import Data.Char (isLetter)
#else
-import System.Posix.Files ( setFileTimes, setFileMode, fileMode,
getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink,
unionFileModes, createSymbolicLink, removeLink )
+import System.Posix.Files ( setFileTimes, setFileMode, setFileCreationMask,
fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink,
isSymbolicLink, unionFileModes, createSymbolicLink, removeLink, FileStatus )
import System.Posix.Types ( CMode(..) )
import Data.List (partition)
import Data.Maybe (fromJust)
@@ -110,6 +124,7 @@
-- text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Encoding.Error as TE
-- from zlib
import qualified Codec.Compression.Zlib.Raw as Zlib
@@ -148,7 +163,7 @@
{ eRelativePath :: FilePath -- ^ Relative
path, using '/' as separator
, eCompressionMethod :: !CompressionMethod -- ^
Compression method
, eEncryptionMethod :: !EncryptionMethod -- ^
Encryption method
- , eLastModified :: !Integer -- ^
Modification time (seconds since unix epoch)
+ , eLastModified :: !Integer -- ^
Modification time (seconds since unix epoch, shifted by the local time zone
offset: MSDOS timestamps in zip archives are conventionally local time)
, eCRC32 :: !Word32 -- ^ CRC32
checksum
, eCompressedSize :: !Word32 -- ^
Compressed size in bytes
, eUncompressedSize :: !Word32 -- ^
Uncompressed size in bytes
@@ -179,13 +194,14 @@
| 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.
+ | OptPreserveSymbolicLinks -- ^ Preserve symbolic links as
such. This option is ignored on Windows. WARNING: symbolic link targets are not
validated on extraction, so they may be absolute or point outside of the
destination directory; do not use this option when extracting untrusted
archives.
deriving (Read, Show, Eq)
data ZipException =
CRC32Mismatch FilePath
| UnsafePath FilePath
| CannotWriteEncryptedEntry FilePath
+ | Zip64NotSupported String -- ^ Data too large for the original zip format
(which this library is limited to); the ZIP64 extension would be required
deriving (Show, Typeable, Data, Eq)
instance E.Exception ZipException
@@ -212,6 +228,9 @@
Right (_,_,x) -> Right x
-- | Writes an 'Archive' structure to a raw zip archive (in a lazy bytestring).
+-- Throws a pure 'Zip64NotSupported' exception if the archive has 65535
+-- or more entries or is 4GB or larger, since this would require the
+-- (unsupported) ZIP64 extension.
fromArchive :: Archive -> B.ByteString
fromArchive = encode
@@ -229,13 +248,16 @@
-- | Deletes an entry from a zip archive.
deleteEntryFromArchive :: FilePath -> Archive -> Archive
deleteEntryFromArchive path archive =
- archive { zEntries = [e | e <- zEntries archive
- , not (eRelativePath e `matches` path)] }
+ let path' = normalizePath path
+ in archive { zEntries = [e | e <- zEntries archive
+ , normalizePath (eRelativePath e) /= path'] }
-- | Returns Just the zip entry with the specified path, or Nothing.
findEntryByPath :: FilePath -> Archive -> Maybe Entry
findEntryByPath path archive =
- find (\e -> path `matches` eRelativePath e) (zEntries archive)
+ let path' = normalizePath path
+ in find (\e -> path' == normalizePath (eRelativePath e))
+ (zEntries archive)
-- | Returns uncompressed contents of zip entry.
fromEntry :: Entry -> B.ByteString
@@ -255,6 +277,8 @@
_ -> False
-- | Create an 'Entry' with specified file path, modification time, and
contents.
+-- Throws a pure 'Zip64NotSupported' exception if the contents are too
+-- large to be represented without the (unsupported) ZIP64 extension.
toEntry :: FilePath -- ^ File path for entry
-> Integer -- ^ Modification time for entry (seconds since
unix epoch)
-> B.ByteString -- ^ Contents of entry
@@ -269,7 +293,11 @@
then (NoCompression, contents, uncompressedSize)
else (Deflate, compressedData, compressedSize)
crc32 = CRC32.crc32 contents
- in Entry { eRelativePath = normalizePath path
+ in if uncompressedSize >= 0xFFFFFFFF
+ then E.throw $ Zip64NotSupported $
+ path ++ ": entry of 4GB or more requires ZIP64"
+ else
+ Entry { eRelativePath = normalizePath path
, eCompressionMethod = compressionMethod
, eEncryptionMethod = NoEncryption
, eLastModified = modtime
@@ -346,12 +374,15 @@
compmethod (100 - (100 * compressionRatio entryE))
return entryE
--- check path, resolving .. and . components, raising
--- UnsafePath exception if this takes you outside of the root.
+-- check path: reject absolute paths and drive-qualified paths, and
+-- resolve .. and . components, raising UnsafePath exception if this
+-- takes you outside of the root.
checkPath :: FilePath -> IO ()
-checkPath fp =
- maybe (E.throwIO (UnsafePath fp)) (\_ -> return ())
- (resolve . splitDirectories $ fp)
+checkPath fp
+ | isAbsolute' fp || hasDrive fp = E.throwIO (UnsafePath fp)
+ | otherwise =
+ maybe (E.throwIO (UnsafePath fp)) (\_ -> return ())
+ (resolve . splitDirectories $ fp)
where
resolve =
fmap reverse . foldl go (return [])
@@ -364,6 +395,9 @@
[] -> fail "outside of root path"
(_:ys) -> return ys
_ -> return (x:xs)
+ -- ensure that /foo is absolute even on Windows:
+ isAbsolute' ('/':_) = True
+ isAbsolute' f = isAbsolute f
-- | Writes contents of an 'Entry' to a file. Throws a
-- 'CRC32Mismatch' exception if the CRC32 checksum for the entry
@@ -375,9 +409,8 @@
let relpath = eRelativePath entry
checkPath relpath
path <- case [d | OptDestination d <- opts] of
- (x:_) -> return (x </> relpath)
- [] | isAbsolute relpath -> E.throwIO $ UnsafePath relpath
- | otherwise -> return relpath
+ (x:_) -> return (x </> relpath)
+ [] -> return relpath
-- create directories if needed
let dir = takeDirectory path
exists <- doesDirectoryExist dir
@@ -392,14 +425,35 @@
hPutStrLn stderr $ case eCompressionMethod entry of
Deflate -> " inflating: " ++ path
NoCompression -> "extracting: " ++ path
- let uncompressedData = fromEntry entry
- if eCRC32 entry == CRC32.crc32 uncompressedData
- then B.writeFile path uncompressedData
- else E.throwIO $ CRC32Mismatch path
+ -- Write the entry chunk by chunk while updating the CRC
+ -- incrementally, so the uncompressed data need not be held in
+ -- memory in full. Write to a temporary file first and rename
+ -- it into place only if the CRC matches, so a pre-existing
+ -- file at the target path is left intact on a CRC mismatch.
+ (tmpPath, tmpHandle) <- openBinaryTempFile dir
+ (takeFileName path ++ ".tmp")
+ crc <- foldM (\k chunk -> do
+ S.hPut tmpHandle chunk
+ return (CRC32.crc32Update k chunk))
+ 0 (B.toChunks (fromEntry entry))
+ `E.onException` (hClose tmpHandle >> removeFile tmpPath)
+ hClose tmpHandle
+ if crc == eCRC32 entry
+ then renameFile tmpPath path
+ else do
+ removeFile tmpPath
+ E.throwIO $ CRC32Mismatch path
#ifndef _WINDOWS
+ -- openBinaryTempFile creates the file with mode 0600; restore
+ -- the default permissions the file would have had if written
+ -- directly, unless the entry carries its own mode bits.
let modes = fromIntegral $ shiftR (eExternalFileAttributes entry) 16
- when (eVersionMadeBy entry .&. 0xFF00 == 0x0300 &&
- modes /= 0) $ setFileMode path modes
+ if eVersionMadeBy entry .&. 0xFF00 == 0x0300 && modes /= 0
+ then setFileMode path modes
+ else do
+ umask <- setFileCreationMask 0o022
+ _ <- setFileCreationMask umask
+ setFileMode path (0o666 .&. complement umask)
#endif
-- Note that last modified times are supported only for POSIX, not for
-- Windows.
@@ -410,6 +464,10 @@
-- If the 'Entry' does not represent a symbolic link or
-- the options do not contain 'OptPreserveSymbolicLinks`, this
-- function behaves like `writeEntry`.
+--
+-- Note that the symbolic link target is written as is; it may be
+-- absolute or point outside of the extraction directory. Do not
+-- extract untrusted archives with 'OptPreserveSymbolicLinks'.
writeSymbolicLinkEntry :: [ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry opts entry =
if OptPreserveSymbolicLinks `notElem` opts
@@ -417,16 +475,38 @@
else do
if isEntrySymbolicLink entry
then do
+ let relpath = eRelativePath entry
+ checkPath relpath
let prefixPath = case [d | OptDestination d <- opts] of
(x:_) -> x
_ -> ""
+ checkSymbolicLinkAncestry prefixPath relpath
let targetPath = fromJust . symbolicLinkEntryTarget $ entry
- let symlinkPath = prefixPath </> eRelativePath entry
+ let symlinkPath = prefixPath </> relpath
when (OptVerbose `elem` opts) $ do
hPutStrLn stderr $ "linking " ++ symlinkPath ++ " to " ++
targetPath
forceSymLink targetPath symlinkPath
else writeEntry opts entry
+-- Guard against symlink chaining on extraction: raise 'UnsafePath' if
+-- any directory component of relpath (relative to prefix) is itself a
+-- symbolic link. Otherwise a crafted archive containing a symbolic
+-- link entry @a -> /somewhere@ followed by an entry @a/b@ could create
+-- a symbolic link outside of the destination directory.
+checkSymbolicLinkAncestry :: FilePath -> FilePath -> IO ()
+checkSymbolicLinkAncestry prefix relpath =
+ mapM_ check $ scanl1 (</>) ancestors
+ where
+ ancestors = case splitDirectories relpath of
+ [] -> []
+ cs -> init cs
+ check dir = do
+ res <- E.try (getSymbolicLinkStatus (prefix </> dir))
+ :: IO (Either E.IOException FileStatus)
+ case res of
+ Right st | isSymbolicLink st -> E.throwIO (UnsafePath relpath)
+ _ -> return ()
+
-- | Writes a symbolic link, but removes any conflicting files and retries if
necessary.
forceSymLink :: FilePath -> FilePath -> IO ()
@@ -459,19 +539,41 @@
addFilesToArchive opts archive files = do
filesAndChildren <- if OptRecursive `elem` opts
#ifdef _WINDOWS
- then mapM getDirectoryContentsRecursive files >>=
return . nub . concat
+ then ordNub . concat <$> mapM
getDirectoryContentsRecursive files
#else
- then nub . concat <$> mapM
(getDirectoryContentsRecursive' opts) files
+ then ordNub . concat <$> mapM
(getDirectoryContentsRecursive' opts) files
#endif
else return files
entries <- mapM (readEntry opts) filesAndChildren
- return $ foldr addEntryToArchive archive entries
+ -- Equivalent to foldr addEntryToArchive archive entries (the first
+ -- entry for a given path wins, new entries precede old ones), but
+ -- without quadratic cost in the number of entries.
+ let newPaths = Set.fromList $ map (normalizePath . eRelativePath) entries
+ return archive
+ { zEntries = ordNubOn (normalizePath . eRelativePath) entries ++
+ [e | e <- zEntries archive
+ , normalizePath (eRelativePath e) `Set.notMember` newPaths] }
+
+-- Remove duplicates from a list, keeping the first occurrence of each
+-- element and preserving order.
+ordNub :: Ord a => [a] -> [a]
+ordNub = ordNubOn id
+
+ordNubOn :: Ord b => (a -> b) -> [a] -> [a]
+ordNubOn f = go Set.empty
+ where go _ [] = []
+ go seen (x:xs)
+ | fx `Set.member` seen = go seen xs
+ | otherwise = x : go (Set.insert fx seen) xs
+ where fx = f x
-- | 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
+-- This function fails if encrypted entries are present.
+-- See the warning on 'OptPreserveSymbolicLinks' before using it
+-- with untrusted archives.
extractFilesFromArchive :: [ZipOption] -> Archive -> IO ()
extractFilesFromArchive opts archive = do
let entries = zEntries archive
@@ -505,10 +607,6 @@
dirParts = filter (/=".") $ splitDirectories dir'
in intercalate "/" (dirParts ++ [fn])
--- Equality modulo normalization. So, "./foo" `matches` "foo".
-matches :: FilePath -> FilePath -> Bool
-matches fp1 fp2 = normalizePath fp1 == normalizePath fp2
-
-- | Uncompress a lazy bytestring.
compressData :: CompressionMethod -> B.ByteString -> B.ByteString
compressData Deflate = Zlib.compress
@@ -520,22 +618,25 @@
decompressData NoCompression = id
-- | Decrypt a lazy bytestring
--- Returns Nothing if password is incorrect
+-- Returns Nothing if password is incorrect or the data is too short
+-- to contain the 12-byte encryption header
decryptData :: String -> EncryptionMethod -> B.ByteString -> Maybe B.ByteString
decryptData _ NoEncryption s = Just s
-decryptData password (PKWAREEncryption controlByte) s =
- let headerlen = 12
- initKeys = (305419896, 591751049, 878082192)
- startKeys = B.foldl pkwareUpdateKeys initKeys (C.pack password)
- (header, content) = B.splitAt headerlen $ snd $ B.mapAccumL
pkwareDecryptByte startKeys s
- in if B.last header == controlByte
- then Just content
- else Nothing
+decryptData password (PKWAREEncryption controlByte) s
+ | B.length s < headerlen = Nothing
+ | otherwise =
+ let initKeys = (305419896, 591751049, 878082192)
+ startKeys = B.foldl pkwareUpdateKeys initKeys (C.pack password)
+ (header, content) = B.splitAt headerlen $ snd $ B.mapAccumL
pkwareDecryptByte startKeys s
+ in if B.last header == controlByte
+ then Just content
+ else Nothing
+ where headerlen = 12
-- | PKWARE decryption context
type DecryptionCtx = (Word32, Word32, Word32)
--- | An interation of the PKWARE decryption algorithm
+-- | An implementation of the PKWARE decryption algorithm
pkwareDecryptByte :: DecryptionCtx -> Word8 -> (DecryptionCtx, Word8)
pkwareDecryptByte keys@(_, _, key2) inB =
let tmp = key2 .|. 2
@@ -546,12 +647,28 @@
-- | Update decryption keys after a decrypted byte
pkwareUpdateKeys :: DecryptionCtx -> Word8 -> DecryptionCtx
pkwareUpdateKeys (key0, key1, key2) inB =
- let key0' = CRC32.crc32Update (key0 `xor` 0xffffffff) [inB] `xor` 0xffffffff
+ let key0' = pkwareCrc32Byte key0 inB
key1' = (key1 + (key0' .&. 0xff)) * 134775813 + 1
key1Byte = fromIntegral (key1' `shiftR` 24) :: Word8
- key2' = CRC32.crc32Update (key2 `xor` 0xffffffff) [key1Byte] `xor`
0xffffffff
+ key2' = pkwareCrc32Byte key2 key1Byte
in (key0', key1', key2')
+-- | One step of the raw (unconditioned) CRC32 used by the PKWARE
+-- key schedule, computed with a lookup table.
+pkwareCrc32Byte :: Word32 -> Word8 -> Word32
+pkwareCrc32Byte key b =
+ (key `shiftR` 8) `xor`
+ (pkwareCrcTable ! ((key `xor` fromIntegral b) .&. 0xff))
+
+-- | Standard CRC32 table (reflected, polynomial 0xedb88320).
+pkwareCrcTable :: UArray Word32 Word32
+pkwareCrcTable = listArray (0, 255) $ map crcEntry [0..255]
+ where
+ crcEntry n = iterate step n !! (8 :: Int)
+ step x = if odd x
+ then (x `shiftR` 1) `xor` 0xedb88320
+ else x `shiftR` 1
+
-- | Calculate compression ratio for an entry (for verbose output).
compressionRatio :: Entry -> Float
compressionRatio entry =
@@ -575,11 +692,24 @@
minMSDOSDateTime :: Integer
minMSDOSDateTime = 315532800
--- | Convert a clock time to a MSDOS datetime. The MSDOS time will be
relative to UTC.
+-- | Epoch time corresponding to the maximum DOS DateTime (Dec 31 2107
23:59:58).
+maxMSDOSDateTime :: Integer
+maxMSDOSDateTime = floor $ utcTimeToPOSIXSeconds $
+ UTCTime (fromGregorian 2107 12 31) (23 * 3600 + 59 * 60 + 58)
+
+-- | Convert an epoch time to a MSDOS datetime. Note that no time zone
+-- adjustment happens here: the epoch time is rendered as is, so callers
+-- are expected to pass times already shifted to the local time zone
+-- (see 'readEntry' and 'setFileTimeStamp').
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime epochtime | epochtime < minMSDOSDateTime =
epochTimeToMSDOSDateTime minMSDOSDateTime
-- if time is earlier than minimum DOS datetime, return minimum
+epochTimeToMSDOSDateTime epochtime | epochtime > maxMSDOSDateTime =
+ epochTimeToMSDOSDateTime maxMSDOSDateTime
+ -- if time is later than maximum DOS datetime, return maximum;
+ -- the year field of a DOS datetime cannot represent years past 2107,
+ -- and larger values would make toEnum fail below
epochTimeToMSDOSDateTime epochtime =
let
UTCTime
@@ -641,7 +771,13 @@
setFileTimeStamp _ _ = return () -- TODO: figure out how to set the timestamp
on Windows
#else
setFileTimeStamp file epochtime = do
- let epochtime' = fromInteger epochtime
+ -- eLastModified is relative to the LOCAL time zone (see readEntry
+ -- and #67), because MSDOS timestamps are conventionally local time.
+ -- Reverse that shift here, so that reading and extracting an entry
+ -- preserves the file's modification time.
+ tzone <- getTimeZone (posixSecondsToUTCTime (fromIntegral epochtime))
+ let epochtime' = fromInteger $
+ epochtime - fromIntegral (timeZoneMinutes tzone * 60)
setFileTimes file epochtime' epochtime'
#endif
@@ -716,11 +852,16 @@
putArchive :: Archive -> Put
putArchive archive = do
+ let numEntries = length $ zEntries archive
+ when (numEntries >= 0xFFFF) $
+ E.throw $ Zip64NotSupported "65535 or more entries require ZIP64"
mapM_ putLocalFile $ zEntries archive
let localFileSizes = map localFileSize $ zEntries archive
let offsets = scanl (+) 0 localFileSizes
let cdOffset = last offsets
- _ <- zipWithM_ putFileHeader offsets (zEntries archive)
+ when (cdOffset >= 0xFFFFFFFF) $
+ E.throw $ Zip64NotSupported "archive of 4GB or more requires ZIP64"
+ _ <- zipWithM_ putFileHeader (map fromIntegral offsets) (zEntries archive)
putDigitalSignature $ zSignature archive
putWord32le 0x06054b50
putWord16le 0 -- disk number
@@ -739,10 +880,12 @@
fromIntegral (B.length $ fromString $ normalizePath $ eRelativePath f) +
B.length (eExtraField f) + B.length (eFileComment f)
-localFileSize :: Entry -> Word32
+-- Note: computed as Int64 (not Word32) so that putArchive can detect
+-- offsets that would overflow the 32-bit fields of the zip format.
+localFileSize :: Entry -> Int64
localFileSize f =
- fromIntegral $ 4 + 2 + 2 + 2 + 2 + 2 + 4 + 4 + 4 + 2 + 2 +
- fromIntegral (B.length $ fromString $ normalizePath $ eRelativePath f) +
+ 4 + 2 + 2 + 2 + 2 + 2 + 4 + 4 + 4 + 2 + 2 +
+ B.length (fromString $ normalizePath $ eRelativePath f) +
B.length (eExtraField f) + B.length (eCompressedData f)
-- Local file header:
@@ -806,7 +949,7 @@
then return raw
else fail $ printf
("Content size mismatch in data descriptor record: "
- <> "expected %d, got %d bytes")
+ ++ "expected %d, got %d bytes")
cs (B.length raw)
return (fromIntegral offset, compressedData)
@@ -814,7 +957,7 @@
putLocalFile f = do
putWord32le 0x04034b50
putWord16le 20 -- version needed to extract (>=2.0)
- putWord16le 0x802 -- general purpose bit flag (bit 1 = max compression, bit
11 = UTF-8)
+ putWord16le 0x800 -- general purpose bit flag (bit 11 = UTF-8)
putWord16le $ case eCompressionMethod f of
NoCompression -> 0
Deflate -> 8
@@ -824,10 +967,10 @@
putWord32le $ eCRC32 f
putWord32le $ eCompressedSize f
putWord32le $ eUncompressedSize f
- putWord16le $ fromIntegral $ B.length $ fromString
- $ normalizePath $ eRelativePath f
+ let encodedPath = fromString $ normalizePath $ eRelativePath f
+ putWord16le $ fromIntegral $ B.length encodedPath
putWord16le $ fromIntegral $ B.length $ eExtraField f
- putLazyByteString $ fromString $ normalizePath $ eRelativePath f
+ putLazyByteString encodedPath
putLazyByteString $ eExtraField f
putLazyByteString $ eCompressedData f
@@ -896,7 +1039,7 @@
Nothing -> fail $ "Unable to find data at offset " ++
show relativeOffset
return Entry
- { eRelativePath = toString fileName
+ { eRelativePath = decodeFileName bitflag fileName
, eCompressionMethod = compressionMethod
, eEncryptionMethod = encryptionMethod
, eLastModified = msDOSDateTimeToEpochTime $
@@ -920,7 +1063,7 @@
putWord32le 0x02014b50
putWord16le $ eVersionMadeBy local
putWord16le 20 -- version needed to extract (>= 2.0)
- putWord16le 0x802 -- general purpose bit flag (bit 1 = max compression, bit
11 = UTF-8)
+ putWord16le 0x800 -- general purpose bit flag (bit 11 = UTF-8)
putWord16le $ case eCompressionMethod local of
NoCompression -> 0
Deflate -> 8
@@ -930,15 +1073,15 @@
putWord32le $ eCRC32 local
putWord32le $ eCompressedSize local
putWord32le $ eUncompressedSize local
- putWord16le $ fromIntegral $ B.length $ fromString
- $ normalizePath $ eRelativePath local
+ let encodedPath = fromString $ normalizePath $ eRelativePath local
+ putWord16le $ fromIntegral $ B.length encodedPath
putWord16le $ fromIntegral $ B.length $ eExtraField local
putWord16le $ fromIntegral $ B.length $ eFileComment local
putWord16le 0 -- disk number start
putWord16le $ eInternalFileAttributes local
putWord32le $ eExternalFileAttributes local
putWord32le offset
- putLazyByteString $ fromString $ normalizePath $ eRelativePath local
+ putLazyByteString encodedPath
putLazyByteString $ eExtraField local
putLazyByteString $ eFileComment local
@@ -967,18 +1110,37 @@
then return ()
else fail "ensure not satisfied"
-toString :: B.ByteString -> String
-toString = TL.unpack . TL.decodeUtf8
+-- | Decode a file name from a zip archive according to the general
+-- purpose bit flag: if bit 11 is set, the name is UTF-8 encoded;
+-- otherwise the zip spec says it is encoded in IBM code page 437.
+-- Invalid UTF-8 is decoded leniently (invalid bytes are replaced by
+-- U+FFFD) rather than raising an exception, so that 'toArchiveOrFail'
+-- remains total.
+decodeFileName :: Word16 -> B.ByteString -> String
+decodeFileName bitflag fn
+ | testBit bitflag 11 = TL.unpack $ TL.decodeUtf8With TE.lenientDecode fn
+ | otherwise = map cp437ToChar $ B.unpack fn
+
+cp437ToChar :: Word8 -> Char
+cp437ToChar w
+ | w < 128 = toEnum (fromIntegral w)
+ | otherwise = cp437table !! fromIntegral (w - 128)
+
+-- IBM code page 437, upper half (0x80 - 0xFF).
+cp437table :: String
+cp437table =
+ "\199\252\233\226\228\224\229\231\234\235\232\239\238\236\196\197\
+ \\201\230\198\244\246\242\251\249\255\214\220\162\163\165\8359\402\
+ \\225\237\243\250\241\209\170\186\191\8976\172\189\188\161\171\187\
+
\\9617\9618\9619\9474\9508\9569\9570\9558\9557\9571\9553\9559\9565\9564\9563\9488\
+
\\9492\9524\9516\9500\9472\9532\9566\9567\9562\9556\9577\9574\9568\9552\9580\9575\
+
\\9576\9572\9573\9561\9560\9554\9555\9579\9578\9496\9484\9608\9604\9612\9616\9600\
+ \\945\223\915\960\931\963\181\964\934\920\937\948\8734\966\949\8745\
+ \\8801\177\8805\8804\8992\8993\247\8776\176\8729\183\8730\8319\178\9632\160"
fromString :: String -> B.ByteString
fromString = TL.encodeUtf8 . TL.pack
-data DecompressResult =
- DecompressSuccess B.ByteString -- bytes remaining
- -- (we just discard decompressed chunks, because we only
- -- want to know where the compressed data ends)
- | DecompressFailure ZlibInt.DecompressError
-
getCompressedData :: CompressionMethod -> Get B.ByteString
getCompressedData NoCompression = do
-- we assume there will be a signature on the data descriptor,
@@ -1008,20 +1170,39 @@
getLazyByteString compressedBytes
getCompressedData Deflate = do
remainingBytes <- lookAhead getRemainingLazyByteString
- let result = ZlibInt.foldDecompressStreamWithInput
- (\_bs res -> res)
- DecompressSuccess
- DecompressFailure
- (ZlibInt.decompressST ZlibInt.rawFormat
- ZlibInt.defaultDecompressParams{
- ZlibInt.decompressAllMembers = False })
- remainingBytes
- case result of
- DecompressFailure err -> fail (show err)
- DecompressSuccess afterCompressedBytes ->
- -- Consume the compressed bytes; we don't do anything with
- -- the decompressed chunks. We are just decompressing as a
- -- way of finding where the compressed data ends.
- getLazyByteString
- (fromIntegral (B.length remainingBytes - B.length
afterCompressedBytes))
+ -- We decompress (discarding the output) only as a way of finding
+ -- where the compressed data ends.
+ case countCompressedBytes remainingBytes of
+ Left err -> fail (show err)
+ Right consumed -> getLazyByteString consumed
+
+-- Decompress the input chunk by chunk, discarding the decompressed
+-- output, and return the number of compressed bytes consumed (i.e.,
+-- where the deflate stream ends). Feeding the decompressor chunk by
+-- chunk means we only ever force the compressed data itself, rather
+-- than computing the length of everything that follows it (which
+-- would force the entire rest of the archive).
+countCompressedBytes :: B.ByteString -> Either ZlibInt.DecompressError Int64
+countCompressedBytes input =
+ runST (go (B.toChunks input) 0
+ (ZlibInt.decompressST ZlibInt.rawFormat
+ ZlibInt.defaultDecompressParams{
+ ZlibInt.decompressAllMembers = False }))
+ where
+ go chunks supplied stream =
+ case stream of
+ ZlibInt.DecompressInputRequired next ->
+ case chunks of
+ (c:cs) -> let supplied' = supplied + fromIntegral (S.length c)
+ in supplied' `seq` (next c >>= go cs supplied')
+ [] -> next S.empty >>= go [] supplied
+ -- S.empty signals end of input; the
+ -- decompressor then either ends cleanly or
+ -- reports a truncated stream
+ ZlibInt.DecompressOutputAvailable _out next ->
+ next >>= go chunks supplied
+ ZlibInt.DecompressStreamEnd leftover ->
+ return $ Right $ supplied - fromIntegral (S.length leftover)
+ ZlibInt.DecompressStreamError err ->
+ return $ Left err
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/zip-archive-0.4.3.2/tests/test-zip-archive.hs
new/zip-archive-0.5/tests/test-zip-archive.hs
--- old/zip-archive-0.4.3.2/tests/test-zip-archive.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/zip-archive-0.5/tests/test-zip-archive.hs 2001-09-09
03:46:40.000000000 +0200
@@ -6,7 +6,11 @@
import Codec.Archive.Zip
import Control.Monad (unless)
-import Control.Exception (try, catch, SomeException)
+import Data.Bits
+import Data.Word (Word8)
+import Control.Exception (try, catch, evaluate, SomeException)
+import Data.Int (Int64)
+import Data.Time.Clock (diffUTCTime)
import System.Directory hiding (isSymbolicLink)
import Test.HUnit.Base
import Test.HUnit.Text
@@ -26,6 +30,65 @@
-- define equality for Archives so timestamps aren't distinguished if they
-- correspond to the same MSDOS datetime.
+-- build a minimal raw zip archive containing a single stored entry
+-- with empty contents (CRC32 = 0), a given general purpose bit flag,
+-- and the given raw file name bytes
+mkRawZip :: Int -> [Word8] -> BL.ByteString
+mkRawZip flag name = BL.pack (local ++ central ++ eocd)
+ where
+ n = length name
+ le16, le32 :: Int -> [Word8]
+ le16 x = [fromIntegral (x .&. 0xff), fromIntegral ((x `shiftR` 8) .&. 0xff)]
+ le32 x = le16 (x .&. 0xffff) ++ le16 ((x `shiftR` 16) .&. 0xffff)
+ local = [0x50,0x4b,0x03,0x04] ++ le16 20 ++ le16 flag ++ le16 0 -- stored
+ ++ le16 0 ++ le16 0x21 -- mod time/date (1980-01-01)
+ ++ le32 0 ++ le32 0 ++ le32 0 -- crc, csize, usize
+ ++ le16 n ++ le16 0 ++ name
+ central = [0x50,0x4b,0x01,0x02] ++ le16 20 ++ le16 20 ++ le16 flag
+ ++ le16 0 ++ le16 0 ++ le16 0x21
+ ++ le32 0 ++ le32 0 ++ le32 0
+ ++ le16 n ++ le16 0 ++ le16 0 -- name/extra/comment len
+ ++ le16 0 ++ le16 0 ++ le32 0 -- disk, int attrs, ext attrs
+ ++ le32 0 -- local header offset
+ ++ name
+ eocd = [0x50,0x4b,0x05,0x06] ++ le16 0 ++ le16 0 ++ le16 1 ++ le16 1
+ ++ le32 (46 + n) ++ le32 (30 + n) ++ le16 0
+
+-- build a raw zip archive whose local file header uses a data
+-- descriptor (general purpose bit 3): sizes and CRC in the local
+-- header are zero and instead follow the file data
+mkDataDescriptorZip :: Entry -> BL.ByteString
+mkDataDescriptorZip e = BL.concat
+ [ BL.pack local, eCompressedData e, BL.pack descriptor
+ , BL.pack central, BL.pack eocd ]
+ where
+ name = map (fromIntegral . fromEnum) (eRelativePath e) :: [Word8]
+ n = length name
+ flag = 8 -- bit 3: data descriptor
+ method = case eCompressionMethod e of
+ NoCompression -> 0
+ Deflate -> 8
+ crc = fromIntegral $ eCRC32 e
+ csize = fromIntegral $ eCompressedSize e
+ usize = fromIntegral $ eUncompressedSize e
+ le16, le32 :: Int -> [Word8]
+ le16 x = [fromIntegral (x .&. 0xff), fromIntegral ((x `shiftR` 8) .&. 0xff)]
+ le32 x = le16 (x .&. 0xffff) ++ le16 ((x `shiftR` 16) .&. 0xffff)
+ local = [0x50,0x4b,0x03,0x04] ++ le16 20 ++ le16 flag ++ le16 method
+ ++ le16 0 ++ le16 0x21
+ ++ le32 0 ++ le32 0 ++ le32 0 -- deferred to data descriptor
+ ++ le16 n ++ le16 0 ++ name
+ descriptor = [0x50,0x4b,0x07,0x08] ++ le32 crc ++ le32 csize ++ le32 usize
+ central = [0x50,0x4b,0x01,0x02] ++ le16 20 ++ le16 20 ++ le16 flag
+ ++ le16 method ++ le16 0 ++ le16 0x21
+ ++ le32 crc ++ le32 csize ++ le32 usize
+ ++ le16 n ++ le16 0 ++ le16 0
+ ++ le16 0 ++ le16 0 ++ le32 0
+ ++ le32 0
+ ++ name
+ eocd = [0x50,0x4b,0x05,0x06] ++ le16 0 ++ le16 0 ++ le16 1 ++ le16 1
+ ++ le32 (46 + n) ++ le32 (30 + n + csize + 16) ++ le16 0
+
instance Eq Archive where
(==) a1 a2 = zSignature a1 == zSignature a2
&& zComment a1 == zComment a2
@@ -34,6 +97,17 @@
#ifndef _WINDOWS
+-- construct an Entry that represents a symbolic link, as found in
+-- archives produced by Info-ZIP and this library
+mkSymlinkEntry :: FilePath -> String -> Entry
+mkSymlinkEntry linkPath target =
+ (toEntry linkPath 0 (BLC.pack target))
+ { eRelativePath = linkPath
+ , eVersionMadeBy = 0x0300 -- UNIX
+ , eExternalFileAttributes =
+ fromIntegral (shiftL (fromIntegral symbolicLinkMode .|. (0o777 ::
Integer)) 16)
+ }
+
createTestDirectoryWithSymlinks :: FilePath -> FilePath -> IO FilePath
createTestDirectoryWithSymlinks prefixDir baseDir = do
let testDir = prefixDir </> baseDir
@@ -64,17 +138,30 @@
, testFromToArchive
, testReadWriteEntry
, testAddFilesOptions
+ , testAddFilesDedupe
, testDeleteEntries
, testExtractFiles
, testExtractFilesFailOnEncrypted
, testPasswordProtectedRead
, testIncorrectPasswordRead
+ , testTruncatedEncryptedRead
, testEvilPath
+ , testAbsolutePath
+ , testDotFilePaths
+ , testCRCMismatchLeavesFileIntact
+ , testFileNameEncodings
+ , testZip64Limits
+ , testExtremeTimestamps
+ , testGeneralPurposeBitFlag
+ , testDataDescriptor
#ifndef _WINDOWS
+ , testTimestampRoundTrip
, testExtractFilesWithPosixAttrs
, testArchiveExtractSymlinks
, testExtractExternalZipWithSymlinks
, testExtractOverwriteExternalZipWithSymlinks
+ , testEvilSymlinkPath
+ , testEvilSymlinkChain
#endif
]
#ifndef _WINDOWS
@@ -149,6 +236,17 @@
#endif
+testAddFilesDedupe :: FilePath -> Test
+testAddFilesDedupe _tmpDir = TestCase $ do
+ -- adding the same file twice results in a single entry
+ archive <- addFilesToArchive [] emptyArchive ["LICENSE", "LICENSE"]
+ assertEqual "duplicate files are added once"
+ ["LICENSE"] (filesInArchive archive)
+ -- re-adding a file replaces the existing entry rather than duplicating it
+ archive2 <- addFilesToArchive [] archive ["LICENSE", "Setup.hs"]
+ assertEqual "re-adding a file replaces the entry"
+ ["LICENSE", "Setup.hs"] (filesInArchive archive2)
+
testDeleteEntries :: FilePath -> Test
testDeleteEntries _tmpDir = TestCase $ do
archive1 <- addFilesToArchive [] emptyArchive ["LICENSE", "src"]
@@ -156,6 +254,142 @@
let archive3 = deleteEntryFromArchive "src" archive2
assertEqual "for deleteFilesFromArchive" emptyArchive archive3
+testZip64Limits :: FilePath -> Test
+testZip64Limits _tmpDir = TestCase $ do
+ -- an entry of 4GB or more cannot be represented without ZIP64
+ bigResult <- try $ evaluate $ toEntry "big" 0 (BL.replicate (2^(32 :: Int))
0)
+ :: IO (Either ZipException Entry)
+ case bigResult of
+ Left (Zip64NotSupported _) -> return ()
+ Left err -> assertFailure $ "wrong exception for 4GB entry: " ++ show err
+ Right _ -> assertFailure "toEntry should have failed on a 4GB entry"
+ -- an archive with 65535 or more entries cannot be represented without ZIP64
+ let e = toEntry "a" 0 BL.empty
+ manyEntries = Archive (replicate 65535 e) Nothing BL.empty
+ manyResult <- try $ evaluate $ BL.length $ fromArchive manyEntries
+ :: IO (Either ZipException Int64)
+ case manyResult of
+ Left (Zip64NotSupported _) -> return ()
+ Left err -> assertFailure $ "wrong exception for 65535 entries: " ++ show
err
+ Right _ -> assertFailure "fromArchive should have failed on 65535 entries"
+
+testDataDescriptor :: FilePath -> Test
+testDataDescriptor _tmpDir = TestCase $ do
+ -- deflated entry whose sizes are only in a trailing data descriptor
+ let content = BLC.pack $ concat $ replicate 50 "all work and no play"
+ entry = toEntry "dd.txt" 0 content
+ assertEqual "test entry is deflated" Deflate (eCompressionMethod entry)
+ case toArchiveOrFail (mkDataDescriptorZip entry) of
+ Left err -> assertFailure $ "could not parse: " ++ err
+ Right a -> case findEntryByPath "dd.txt" a of
+ Nothing -> assertFailure "dd.txt not found in archive"
+ Just e -> assertEqual "for contents of dd.txt"
+ content (fromEntry e)
+ -- the same, for a stored entry (identified by descriptor signature)
+ let content' = BLC.pack "stored data"
+ entry' = (toEntry "dd2.txt" 0 content')
+ assertEqual "test entry is stored" NoCompression (eCompressionMethod entry')
+ case toArchiveOrFail (mkDataDescriptorZip entry') of
+ Left err -> assertFailure $ "could not parse: " ++ err
+ Right a -> case findEntryByPath "dd2.txt" a of
+ Nothing -> assertFailure "dd2.txt not found in archive"
+ Just e -> assertEqual "for contents of dd2.txt"
+ content' (fromEntry e)
+
+testGeneralPurposeBitFlag :: FilePath -> Test
+testGeneralPurposeBitFlag _tmpDir = TestCase $ do
+ -- we compress with zlib's default level, so the flag must not claim
+ -- maximum compression (bit 1); only bit 11 (UTF-8 names) is set
+ let bytes = fromArchive $ Archive [toEntry "a.txt" 0 (BLC.pack "hi")]
+ Nothing BL.empty
+ -- general purpose bit flag of the local file header is at offset 6
+ assertEqual "for general purpose bit flag"
+ [0x00, 0x08] (BL.unpack (BL.take 2 (BL.drop 6 bytes)))
+
+testExtremeTimestamps :: FilePath -> Test
+testExtremeTimestamps _tmpDir = TestCase $ do
+ -- timestamps outside the representable MSDOS datetime range
+ -- (1980..2107) are clamped rather than crashing
+ let farFuture = toEntry "future.txt" 99999999999 (BLC.pack "later")
+ past = toEntry "past.txt" (-99999) (BLC.pack "earlier")
+ archive = Archive [farFuture, past] Nothing BL.empty
+ result <- try $ evaluate $ BL.length $ fromArchive archive
+ :: IO (Either SomeException Int64)
+ case result of
+ Left err -> assertFailure $ "fromArchive crashed: " ++ show err
+ Right _ -> return ()
+
+testFileNameEncodings :: FilePath -> Test
+testFileNameEncodings _tmpDir = TestCase $ do
+ -- bit 11 clear: name is in IBM code page 437 (0x82 = 'é')
+ case toArchiveOrFail (mkRawZip 0 [0x82]) of
+ Left err -> assertFailure $ "could not parse CP437 archive: " ++ err
+ Right a -> assertEqual "for CP437 file name" ["\233"] (filesInArchive a)
+ -- bit 11 set: name is UTF-8 ('é' = 0xC3 0xA9)
+ case toArchiveOrFail (mkRawZip 0x800 [0xc3, 0xa9]) of
+ Left err -> assertFailure $ "could not parse UTF-8 archive: " ++ err
+ Right a -> assertEqual "for UTF-8 file name" ["\233"] (filesInArchive a)
+ -- bit 11 set but name is invalid UTF-8: decode leniently, don't crash
+ result <- try $ case toArchiveOrFail (mkRawZip 0x800 [0x82]) of
+ Left err -> return [err]
+ Right a -> mapM (\f -> length f `seq` return f)
+ (filesInArchive a)
+ :: IO (Either SomeException [FilePath])
+ case result of
+ Left err -> assertFailure $ "invalid UTF-8 name raised: " ++ show err
+ Right fs -> assertEqual "for invalid UTF-8 file name" ["\65533"] fs
+
+testAbsolutePath :: FilePath -> Test
+testAbsolutePath tmpDir = TestCase $ do
+ -- an entry with an absolute path must not escape OptDestination
+ -- (note that dest </> "/absolute/evil" == "/absolute/evil")
+ let entry = (toEntry "placeholder" 0 (BLC.pack "boom"))
+ { eRelativePath = "/absolute/evil" }
+ result <- try $ writeEntry [OptDestination (tmpDir </> "absdest")] entry
+ :: IO (Either ZipException ())
+ case result of
+ Left err -> assertEqual "exception for absolute path"
+ (UnsafePath "/absolute/evil") err
+ Right _ -> assertFailure "writeEntry should have failed on absolute path"
+
+testDotFilePaths :: FilePath -> Test
+testDotFilePaths tmpDir = TestCase $ do
+ -- issue #55: dotfiles and names containing ".." as a substring are
+ -- legitimate and must not raise UnsafePath; only actual "." and
+ -- ".." path components are unsafe
+ let dest = tmpDir </> "dotdest"
+ let archive = foldr addEntryToArchive emptyArchive
+ [ toEntry ".bowerrc" 0 (BLC.pack "dot")
+ , toEntry "sub/Hello..ciao" 0 (BLC.pack "dots")
+ , toEntry "sub/.hidden/file.txt" 0 (BLC.pack "hidden")
+ ]
+ extractFilesFromArchive [OptDestination dest] archive
+ c1 <- readFile (dest </> ".bowerrc")
+ assertEqual "for contents of extracted dotfile" "dot" c1
+ c2 <- readFile (dest </> "sub/Hello..ciao")
+ assertEqual "for contents of file with dots in name" "dots" c2
+ c3 <- readFile (dest </> "sub/.hidden/file.txt")
+ assertEqual "for contents of file in hidden directory" "hidden" c3
+
+testCRCMismatchLeavesFileIntact :: FilePath -> Test
+testCRCMismatchLeavesFileIntact tmpDir = TestCase $ do
+ let dest = tmpDir </> "crcdest"
+ createDirectoryIfMissing True dest
+ writeFile (dest </> "file.txt") "original"
+ let entry = (toEntry "file.txt" 0 (BLC.pack "corrupted contents"))
+ { eCRC32 = 0xdeadbeef }
+ result <- try (writeEntry [OptDestination dest] entry)
+ :: IO (Either ZipException ())
+ case result of
+ Left err -> assertEqual "exception for corrupt entry"
+ (CRC32Mismatch (dest </> "file.txt")) err
+ Right _ -> assertFailure "writeEntry should have failed on a bad CRC"
+ original <- readFile (dest </> "file.txt")
+ assertEqual "pre-existing file left intact" "original" original
+ files <- getDirectoryContents dest
+ assertEqual "no leftover temporary files" ["file.txt"]
+ (filter (`notElem` [".", ".."]) files)
+
testEvilPath :: FilePath -> Test
testEvilPath _tmpDir = TestCase $ do
archive <- toArchive <$> BL.readFile "tests/zip_with_evil_path.zip"
@@ -206,6 +440,15 @@
assertEqual "for contents of test.txt in archive"
(Just $ BLC.pack "SUCCESS\n") (fromEncryptedEntry "s3cr3t" f)
+testTruncatedEncryptedRead :: FilePath -> Test
+testTruncatedEncryptedRead _tmpDir = TestCase $ do
+ -- encrypted data shorter than the 12-byte header must not crash
+ let entry = (toEntry "trunc.txt" 0 BL.empty)
+ { eEncryptionMethod = PKWAREEncryption 0
+ , eCompressedData = BLC.pack "short" }
+ assertEqual "for truncated encrypted entry"
+ Nothing (fromEncryptedEntry "password" entry)
+
testIncorrectPasswordRead :: FilePath -> Test
testIncorrectPasswordRead _tmpDir = TestCase $ do
archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip"
@@ -217,6 +460,19 @@
#ifndef _WINDOWS
+testTimestampRoundTrip :: FilePath -> Test
+testTimestampRoundTrip tmpDir = TestCase $ do
+ let src = tmpDir </> "ts-src.txt"
+ writeFile src "timestamp"
+ srcTime <- getModificationTime src
+ entry <- readEntry [] src
+ let dest = tmpDir </> "ts-dest"
+ writeEntry [OptDestination dest] entry
+ destTime <- getModificationTime (dest </> src)
+ let diff = abs (realToFrac (diffUTCTime destTime srcTime)) :: Double
+ assertBool ("extracted mtime differs from original by " ++ show diff ++ "s")
+ (diff < 3) -- MSDOS timestamps have 2-second resolution
+
testExtractFilesWithPosixAttrs :: FilePath -> Test
testExtractFilesWithPosixAttrs tmpDir = TestCase $ do
createDirectory (tmpDir </> "dir3")
@@ -284,6 +540,45 @@
assertBool "Symbolic link to file is preserved" isFileSymlink
assertBool "Target file exists" targetFileExists
+testEvilSymlinkPath :: FilePath -> Test
+testEvilSymlinkPath tmpDir = TestCase $ do
+ let dest = tmpDir </> "symlink-dest1"
+ createDirectoryIfMissing True dest
+ let entry = mkSymlinkEntry "../evil-link" "/tmp"
+ result <- try $ writeSymbolicLinkEntry
+ [OptPreserveSymbolicLinks, OptDestination dest] entry
+ :: IO (Either ZipException ())
+ case result of
+ Left err -> assertEqual "exception for evil symlink path"
+ (UnsafePath "../evil-link") err
+ Right _ -> assertFailure "writeSymbolicLinkEntry should have failed"
+ evilExists <- pathIsSymbolicLink (tmpDir </> "evil-link")
+ `catch` (\(_ :: SomeException) -> return False)
+ assertBool "no symlink was created outside the destination" (not evilExists)
+
+testEvilSymlinkChain :: FilePath -> Test
+testEvilSymlinkChain tmpDir = TestCase $ do
+ let dest = tmpDir </> "symlink-dest2"
+ let outside = tmpDir </> "outside"
+ createDirectoryIfMissing True dest
+ createDirectoryIfMissing True outside
+ cwd <- getCurrentDirectory
+ -- first entry creates a symlink pointing outside the destination;
+ -- second entry tries to create a symlink through it
+ let archive = Archive [ mkSymlinkEntry "sub" (cwd </> outside)
+ , mkSymlinkEntry "sub/inner" "anywhere"
+ ] Nothing BL.empty
+ result <- try $ extractFilesFromArchive
+ [OptPreserveSymbolicLinks, OptDestination dest] archive
+ :: IO (Either ZipException ())
+ case result of
+ Left err -> assertEqual "exception for chained symlink"
+ (UnsafePath "sub/inner") err
+ Right _ -> assertFailure "extractFilesFromArchive should have failed"
+ innerExists <- pathIsSymbolicLink (outside </> "inner")
+ `catch` (\(_ :: SomeException) -> return False)
+ assertBool "no symlink was created through another symlink" (not innerExists)
+
testArchiveAndUnzip :: FilePath -> Test
testArchiveAndUnzip tmpDir = TestCase $ do
let dir = "test_dir_with_symlinks4"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/zip-archive-0.4.3.2/zip-archive.cabal
new/zip-archive-0.5/zip-archive.cabal
--- old/zip-archive-0.4.3.2/zip-archive.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/zip-archive-0.5/zip-archive.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,5 @@
Name: zip-archive
-Version: 0.4.3.2
+Version: 0.5
Cabal-Version: 2.0
Build-type: Simple
Synopsis: Library for creating and modifying zip archives.
@@ -24,49 +24,45 @@
choice if you want to manipulate zip archives in "pure" contexts.
.
As an example of the use of the library, a standalone zip archiver and
- extracter is provided in the source distribution.
+ extractor is provided in the source distribution.
Category: Codec
-Tested-with: GHC == 8.6.5, GHC == 8.8.1, GHC == 8.10.4, GHC == 9.0.1,
- GHC == 8.8.3, GHC == 9.2.1
License: BSD3
License-file: LICENSE
Homepage: http://github.com/jgm/zip-archive
Author: John MacFarlane
Maintainer: [email protected]
-Extra-Source-Files: changelog
- README.markdown
- tests/test4.zip
+Extra-Source-Files: tests/test4.zip
tests/test4/a.txt
tests/test4/b.bin
"tests/test4/c/with spaces.txt"
tests/zip_with_symlinks.zip
tests/zip_with_password.zip
tests/zip_with_evil_path.zip
+Extra-Doc-Files: changelog
+ README.markdown
Source-repository head
type: git
- location: git://github.com/jgm/zip-archive.git
+ location: https://github.com/jgm/zip-archive.git
flag executable
Description: Build the Zip executable.
Default: False
Library
- Build-depends: base >= 4.5 && < 5,
- pretty,
+ Build-depends: base >= 4.11 && < 5,
containers,
binary >= 0.7.2,
zlib,
filepath,
- bytestring >= 0.10.0,
array,
- mtl,
+ bytestring >= 0.10.0,
text >= 0.11,
digest >= 0.0.0.1,
directory >= 1.2.0,
time
Exposed-modules: Codec.Archive.Zip
- Default-Language: Haskell98
+ Default-Language: Haskell2010
Hs-Source-Dirs: src
Ghc-Options: -Wall
if os(windows)
@@ -81,23 +77,29 @@
Buildable: False
Main-is: Main.hs
Hs-Source-Dirs: .
- Build-Depends: base >= 4.5 && < 5,
+ Build-Depends: base >= 4.11 && < 5,
directory >= 1.1,
bytestring >= 0.9.0,
zip-archive
Other-Modules: Paths_zip_archive
Autogen-Modules: Paths_zip_archive
Ghc-Options: -Wall
- Default-Language: Haskell98
+ Default-Language: Haskell2010
Test-Suite test-zip-archive
Type: exitcode-stdio-1.0
Main-Is: test-zip-archive.hs
Hs-Source-Dirs: tests
Build-Depends: base >= 4.5 && < 5,
- directory >= 1.3, bytestring >= 0.9.0, process, time,
- HUnit, zip-archive, temporary, filepath
- Default-Language: Haskell98
+ zip-archive,
+ directory >= 1.3,
+ bytestring >= 0.9.0,
+ process,
+ time,
+ HUnit,
+ temporary,
+ filepath
+ Default-Language: Haskell2010
Ghc-Options: -Wall
if os(windows)
cpp-options: -D_WINDOWS
