zip-archive 0.4.1 → 0.4.2
raw patch · 4 files changed
+94/−54 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- changelog +23/−0
- src/Codec/Archive/Zip.hs +43/−46
- tests/test-zip-archive.hs +22/−1
- zip-archive.cabal +6/−7
changelog view
@@ -1,3 +1,26 @@+zip-archive 0.4.2++ * Fix problem with files with colon (#89).+ * Remove build-tools. This was used to indicate that the 'unzip'+ executable was needed for testing, but it was never intended to be used+ this way and now the field is deprecated. The current test suite+ simply skips the test using the unzip executable (with a warning) if+ 'unzip' is not in the path.+ * Remove existing symlinks when extracting zip files with symlinks (#60,+ Vikrem). Previously, writeEntry would raise an error if it tried to+ create a symlink and a symlink already existed at that path. This+ behavior was inconsistent with its behavior for regular files, which+ it overwrote without comment. This commit causes symlinks to be replaced+ by writeEntry instead of an error being raised.+ * Remove binary < 0.6 CPP. It's no longer needed because we don't support+ binary < 0.6. Also use manySig instead of many, to get better error+ messages.+ * Add type annotation for printf.+ * Better checking for unsafe paths (#55). This method allows things like+ `foo/bar/../../baz`.+ * Require base >= 4.5 (#56)+ * Add GitHub CI.+ zip-archive 0.4.1 * writEntry behavior change: Improve raising of UnsafePath error (#55).
src/Codec/Archive/Zip.hs view
@@ -90,11 +90,9 @@ import System.IO ( stderr, hPutStrLn ) import qualified Data.Digest.CRC32 as CRC32 import qualified Data.Map as M-#if MIN_VERSION_binary(0,6,0) import Control.Applicative-#endif #ifndef _WINDOWS-import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink, unionFileModes, createSymbolicLink )+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)@@ -111,8 +109,8 @@ -- from zlib import qualified Codec.Compression.Zlib.Raw as Zlib+import System.IO.Error (isAlreadyExistsError) -#if !MIN_VERSION_binary(0, 6, 0) manySig :: Word32 -> Get a -> Get [a] manySig sig p = do sig' <- lookAhead getWord32le@@ -122,7 +120,6 @@ rs <- manySig sig p return $ r : rs else return []-#endif ------------------------------------------------------------------------@@ -335,13 +332,32 @@ when (OptVerbose `elem` opts) $ do let compmethod = case eCompressionMethod entryE of- Deflate -> "deflated"+ Deflate -> ("deflated" :: String) NoCompression -> "stored" hPutStrLn stderr $ printf " adding: %s (%s %.f%%)" (eRelativePath entryE) compmethod (100 - (100 * compressionRatio entryE)) return entryE +-- check path, resolving .. and . components, raising+-- UnsafePath exception if this takes you outside of the root.+checkPath :: FilePath -> IO ()+checkPath fp =+ maybe (E.throwIO (UnsafePath fp)) (\_ -> return ())+ (resolve . splitDirectories $ fp)+ where+ resolve =+ fmap reverse . foldl go (return [])+ where+ go acc x = do+ xs <- acc+ case x of+ "." -> return xs+ ".." -> case xs of+ [] -> fail "outside of root path"+ (_:ys) -> return ys+ _ -> return (x:xs)+ -- | Writes contents of an 'Entry' to a file. Throws a -- 'CRC32Mismatch' exception if the CRC32 checksum for the entry -- does not match the uncompressed data.@@ -350,15 +366,11 @@ when (isEncryptedEntry entry) $ E.throwIO $ CannotWriteEncryptedEntry (eRelativePath entry) let relpath = eRelativePath entry- let isUnsafePath = ".." `elem` splitDirectories relpath- when isUnsafePath $- E.throwIO $ UnsafePath relpath+ 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)+ [] | isAbsolute relpath -> E.throwIO $ UnsafePath relpath+ | otherwise -> return relpath -- create directories if needed let dir = takeDirectory path exists <- doesDirectoryExist dir@@ -405,10 +417,18 @@ let symlinkPath = prefixPath </> eRelativePath entry when (OptVerbose `elem` opts) $ do hPutStrLn stderr $ "linking " ++ symlinkPath ++ " to " ++ targetPath- createSymbolicLink targetPath symlinkPath+ forceSymLink targetPath symlinkPath else writeEntry opts entry +-- | Writes a symbolic link, but removes any conflicting files and retries if necessary.+forceSymLink :: FilePath -> FilePath -> IO ()+forceSymLink target linkName =+ createSymbolicLink target linkName `E.catch`+ (\e -> if isAlreadyExistsError e+ then removeLink linkName >> createSymbolicLink target linkName+ else ioError e)+ -- | Get the target of a 'Entry' representing a symbolic link. This might fail -- if the 'Entry' does not represent a symbolic link symbolicLinkEntryTarget :: Entry -> Maybe FilePath@@ -467,7 +487,13 @@ normalizePath path = let dir = takeDirectory path fn = takeFileName path- (_drive, dir') = splitDrive dir+ dir' = case dir of+#ifdef _WINDOWS+ (c:':':d:xs) | isLetter c+ , d == '/' || d == '\\'+ -> xs -- remove drive+#endif+ _ -> dir -- note: some versions of filepath return ["."] if no dir dirParts = filter (/=".") $ splitDirectories dir' in intercalate "/" (dirParts ++ [fn])@@ -661,15 +687,9 @@ getArchive :: Get Archive getArchive = do-#if MIN_VERSION_binary(0,6,0)- locals <- many getLocalFile- files <- many (getFileHeader (M.fromList locals))- digSig <- Just `fmap` getDigitalSignature <|> return Nothing-#else locals <- manySig 0x04034b50 getLocalFile files <- manySig 0x02014b50 (getFileHeader (M.fromList locals))- digSig <- lookAheadM getDigitalSignature-#endif+ digSig <- Just `fmap` getDigitalSignature <|> return Nothing endSig <- getWord32le unless (endSig == 0x06054b50) $ fail "Did not find end of central directory signature"@@ -776,7 +796,6 @@ return (fromIntegral offset, compressedData) getWordsTilSig :: Word32 -> Get B.ByteString-#if MIN_VERSION_binary(0, 6, 0) getWordsTilSig sig = (B.fromChunks . reverse) `fmap` go Nothing [] where sig' = S.pack [fromIntegral $ sig .&. 0xFF,@@ -824,17 +843,6 @@ where len = S.length chunk prefixes' = Just $ (S.index chunk (len - 3), S.index chunk (len - 2), S.index chunk (len - 1))-#else-getWordsTilSig sig = B.pack `fmap` go []- where- go acc = do- sig' <- lookAhead getWord32le- if sig == sig'- then skip 4 >> return (reverse acc)- else do- w <- getWord8- go (w:acc)-#endif putLocalFile :: Entry -> Put putLocalFile f = do@@ -974,22 +982,11 @@ -- > size of data 2 bytes -- > signature data (variable size) -#if MIN_VERSION_binary(0,6,0) getDigitalSignature :: Get B.ByteString getDigitalSignature = do getWord32le >>= ensure (== 0x05054b50) sigSize <- getWord16le getLazyByteString (toEnum $ fromEnum sigSize)-#else-getDigitalSignature :: Get (Maybe B.ByteString)-getDigitalSignature = do- hdrSig <- getWord32le- if hdrSig /= 0x05054b50- then return Nothing- else do- sigSize <- getWord16le- getLazyByteString (toEnum $ fromEnum sigSize) >>= return . Just-#endif putDigitalSignature :: Maybe B.ByteString -> Put putDigitalSignature Nothing = return ()
tests/test-zip-archive.hs view
@@ -4,7 +4,6 @@ -- runghc Test.hs import Codec.Archive.Zip-import Control.Applicative import Control.Monad (unless) import Control.Exception (try) import System.Directory hiding (isSymbolicLink)@@ -73,6 +72,7 @@ , testExtractFilesWithPosixAttrs , testArchiveExtractSymlinks , testExtractExternalZipWithSymlinks+ , testExtractOverwriteExternalZipWithSymlinks #endif ] #ifndef _WINDOWS@@ -260,6 +260,27 @@ assertBool "Symbolic link to file is preserved" isFileSymlink assertBool "Target file exists" targetFileExists removeDirectoryRecursive tmpDir++testExtractOverwriteExternalZipWithSymlinks :: FilePath -> Test+testExtractOverwriteExternalZipWithSymlinks tmpDir = TestCase $ do+ archive <- toArchive <$> BL.readFile "tests/zip_with_symlinks.zip"+ extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive+ asserts+ extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive+ asserts+ where+ zipRootDir = "zip_test_dir_with_symlinks"+ symlinkDir = tmpDir </> zipRootDir </> "symlink_to_dir_1"+ symlinkFile = tmpDir </> zipRootDir </> "symlink_to_file_1"+ asserts = do+ isDirSymlink <- pathIsSymbolicLink symlinkDir+ targetDirExists <- doesDirectoryExist symlinkDir+ isFileSymlink <- pathIsSymbolicLink symlinkFile+ targetFileExists <- doesFileExist symlinkFile+ assertBool "Symbolic link to directory is preserved" isDirSymlink+ assertBool "Target directory exists" targetDirExists+ assertBool "Symbolic link to file is preserved" isFileSymlink+ assertBool "Target file exists" targetFileExists testArchiveAndUnzip :: FilePath -> Test testArchiveAndUnzip tmpDir = TestCase $ do
zip-archive.cabal view
@@ -1,5 +1,5 @@ Name: zip-archive-Version: 0.4.1+Version: 0.4.2 Cabal-Version: 2.0 Build-type: Simple Synopsis: Library for creating and modifying zip archives.@@ -26,8 +26,8 @@ As an example of the use of the library, a standalone zip archiver and extracter is provided in the source distribution. Category: Codec-Tested-with: GHC == 7.8.2, GHC == 7.10.3, GHC == 8.0.2,- GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1+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@@ -52,7 +52,7 @@ Default: False Library- Build-depends: base >= 3 && < 5,+ Build-depends: base >= 4.5 && < 5, pretty, containers, binary >= 0.6,@@ -81,7 +81,7 @@ Buildable: False Main-is: Main.hs Hs-Source-Dirs: .- Build-Depends: base >= 4.2 && < 5,+ Build-Depends: base >= 4.5 && < 5, directory >= 1.1, bytestring >= 0.9.0, zip-archive@@ -94,7 +94,7 @@ Type: exitcode-stdio-1.0 Main-Is: test-zip-archive.hs Hs-Source-Dirs: tests- Build-Depends: base >= 4.2 && < 5,+ Build-Depends: base >= 4.5 && < 5, directory >= 1.3, bytestring >= 0.9.0, process, time, HUnit, zip-archive, temporary, filepath Default-Language: Haskell98@@ -103,4 +103,3 @@ cpp-options: -D_WINDOWS else Build-depends: unix- build-tools: unzip