zip-archive 0.3.2 → 0.3.2.1
raw patch · 5 files changed
+194/−47 lines, 5 filesdep ~basedep ~directorybinary-added
Dependency ranges changed: base, directory
Files
- changelog +6/−0
- src/Codec/Archive/Zip.hs +66/−10
- tests/test-zip-archive.hs +112/−28
- tests/zip_with_symlinks.zip binary
- zip-archive.cabal +10/−9
changelog view
@@ -1,3 +1,9 @@+zip-archive 0.3.2.1++ * Fixes for handling of symbolic links (#39, Tommaso Piazza).++ * Fixes for symbolic link tests, and additional tests.+ zip-archive 0.3.2 * Add ZipOption to preserve symbolic links (#37, Tommaso Piazza).
src/Codec/Archive/Zip.hs view
@@ -48,10 +48,18 @@ , findEntryByPath , fromEntry , toEntry+#ifndef _WINDOWS+ , isEntrySymbolicLink+ , symbolicLinkEntryTarget+ , entryCMode+#endif -- * IO functions for working with zip archives , readEntry , writeEntry+#ifndef _WINDOWS+ , writeSymbolicLinkEntry+#endif , addFilesToArchive , extractFilesFromArchive @@ -65,12 +73,13 @@ import Data.Binary import Data.Binary.Get import Data.Binary.Put-import Data.List ( nub, find, intercalate )+import Data.List ( nub, find, intercalate, partition) import Data.Data (Data)+import Data.Maybe (fromJust) import Data.Typeable (Typeable) import Text.Printf import System.FilePath-import System.Directory ( doesDirectoryExist, getDirectoryContents, createDirectoryIfMissing, )+import System.Directory ( doesDirectoryExist, getDirectoryContents, createDirectoryIfMissing ) import Control.Monad ( when, unless, zipWithM ) import qualified Control.Exception as E import System.Directory ( getModificationTime )@@ -81,13 +90,14 @@ import Control.Applicative #endif #ifndef _WINDOWS-import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink)+import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink, unionFileModes, createSymbolicLink )+import System.Posix.Types ( CMode(..) ) #endif -- from bytestring import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Char8 as C (pack)+import qualified Data.ByteString.Lazy.Char8 as C (pack, unpack) -- text import qualified Data.Text.Lazy as TL@@ -260,7 +270,7 @@ fs <- getSymbolicLinkStatus path let isSymLink = isSymbolicLink fs #endif- -- make sure directories end in / and deal with the OptLocation option+ -- make sure directories end in / and deal with the OptLocation option let path' = let p = path ++ (case reverse path of ('/':_) -> "" _ | isDir && not isSymLink -> "/"@@ -296,7 +306,7 @@ #else do let fm = if isSymLink- then symbolicLinkMode+ then unionFileModes symbolicLinkMode (fileMode fs) else fileMode fs let modes = fromIntegral $ shiftL (toInteger fm) 16@@ -342,13 +352,50 @@ #ifndef _WINDOWS let modes = fromIntegral $ shiftR (eExternalFileAttributes entry) 16 when (eVersionMadeBy entry .&. 0xFF00 == 0x0300 &&- modes /= 0) $ setFileMode path modes+ modes /= 0) $ setFileMode path modes #endif- -- Note that last modified times are supported only for POSIX, not for -- Windows. setFileTimeStamp path (eLastModified 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 opts entry = do+ if OptPreserveSymbolicLinks `notElem` opts+ then writeEntry opts entry+ else do+ if (isEntrySymbolicLink entry)+ then do+ let prefixPath = case [d | OptDestination d <- opts] of+ (x:_) -> x+ _ -> ""+ let targetPath = fromJust . symbolicLinkEntryTarget $ entry+ let symlinkPath = prefixPath </> eRelativePath entry+ when (OptVerbose `elem` opts) $ do+ hPutStrLn stderr $ "linking " ++ symlinkPath ++ " to " ++ targetPath+ createSymbolicLink targetPath symlinkPath+ else writeEntry opts entry+++-- | 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 | isEntrySymbolicLink entry = Just . C.unpack $ fromEntry entry+ | otherwise = Nothing++-- | Check if an 'Entry' represents a symbolic link+isEntrySymbolicLink :: Entry -> Bool+isEntrySymbolicLink entry = entryCMode entry .&. symbolicLinkMode == symbolicLinkMode++-- | Get the 'eExternalFileAttributes' of an 'Entry' as a 'CMode' a.k.a. 'FileMode'+entryCMode :: Entry -> CMode+entryCMode entry = CMode (fromIntegral $ shiftR (eExternalFileAttributes entry) 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,@@ -370,8 +417,17 @@ -- Note that the last-modified time is set correctly only in POSIX, -- not in Windows. extractFilesFromArchive :: [ZipOption] -> Archive -> IO ()-extractFilesFromArchive opts archive =- mapM_ (writeEntry opts) $ zEntries archive+extractFilesFromArchive opts archive = do+ if OptPreserveSymbolicLinks `elem` opts+ then do+#ifdef _WINDOWS+ mapM_ (writeEntry opts) $ zEntries archive+#else+ let (symbolicLinkEntries, nonSymbolicLinkEntries) = partition isEntrySymbolicLink $ zEntries archive+ mapM_ (writeEntry opts) $ nonSymbolicLinkEntries+ mapM_ (writeSymbolicLinkEntry opts) $ symbolicLinkEntries+#endif+ else mapM_ (writeEntry opts) $ zEntries archive -------------------------------------------------------------------------------- -- Internal functions for reading and writing zip binary format.
tests/test-zip-archive.hs view
@@ -4,17 +4,21 @@ -- runghc Test.hs import Codec.Archive.Zip-import System.Directory+import Control.Applicative+import System.Directory hiding (isSymbolicLink) import Test.HUnit.Base import Test.HUnit.Text import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL-import Control.Applicative import System.Exit import System.IO.Temp (withTempDirectory) #ifndef _WINDOWS+import System.FilePath.Posix import System.Posix.Files+import System.Process (callCommand)+#else+import System.FilePath.Windows #endif -- define equality for Archives so timestamps aren't distinguished if they@@ -25,6 +29,23 @@ && (all id $ zipWith (\x y -> x { eLastModified = eLastModified x `div` 2 } == y { eLastModified = eLastModified y `div` 2 }) (zEntries a1) (zEntries a2)) +#ifndef _WINDOWS++createTestDirectoryWithSymlinks :: FilePath -> FilePath -> IO FilePath+createTestDirectoryWithSymlinks prefixDir baseDir = do+ let testDir = prefixDir </> baseDir+ createDirectoryIfMissing True testDir+ createDirectoryIfMissing True (testDir </> "1")+ writeFile (testDir </> "1/file.txt") "hello"+ cwd <- getCurrentDirectory+ createFileLink (cwd </> testDir </> "1/file.txt") (testDir </> "link_to_file")+ createSymbolicLink (cwd </> testDir </> "1") (testDir </> "link_to_directory")+ return testDir++#endif+++ main :: IO Counts main = withTempDirectory "." "test-zip-archive." $ \tmpDir -> do res <- runTestTT $ TestList $ map (\f -> f tmpDir)@@ -37,6 +58,9 @@ , testExtractFiles #ifndef _WINDOWS , testExtractFilesWithPosixAttrs+ , testArchiveExtractSymlinks+ , testExtractExternalZipWithSymlinks+ , testArchiveAndUnzip #endif ] exitWith $ case (failures res + errors res) of@@ -46,8 +70,8 @@ testReadWriteArchive :: FilePath -> Test testReadWriteArchive tmpDir = TestCase $ do archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"]- BL.writeFile (tmpDir ++ "/test1.zip") $ fromArchive archive- archive' <- toArchive <$> BL.readFile (tmpDir ++ "/test1.zip")+ BL.writeFile (tmpDir </> "test1.zip") $ fromArchive archive+ archive' <- toArchive <$> BL.readFile (tmpDir </> "test1.zip") assertEqual "for writing and reading test1.zip" archive archive' assertEqual "for writing and reading test1.zip" archive archive' @@ -69,11 +93,14 @@ BL.empty (fromEntry f) testFromToArchive :: FilePath -> Test-testFromToArchive _tmpDir = TestCase $ do+testFromToArchive tmpDir = TestCase $ do archive1 <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"] assertEqual "for (toArchive $ fromArchive archive)" archive1 (toArchive $ fromArchive archive1)- archive2 <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive ["tests/test_dir_with_symlinks"]+#ifndef _WINDOWS+ testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks"+ archive2 <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir] assertEqual "for (toArchive $ fromArchive archive)" archive2 (toArchive $ fromArchive archive2)+#endif testReadWriteEntry :: FilePath -> Test testReadWriteEntry tmpDir = TestCase $ do@@ -81,19 +108,22 @@ setCurrentDirectory tmpDir writeEntry [] entry setCurrentDirectory ".."- entry' <- readEntry [] (tmpDir ++ "/zip-archive.cabal")+ entry' <- readEntry [] (tmpDir </> "zip-archive.cabal") let entry'' = entry' { eRelativePath = eRelativePath entry, eLastModified = eLastModified entry } assertEqual "for readEntry -> writeEntry -> readEntry" entry entry'' testAddFilesOptions :: FilePath -> Test-testAddFilesOptions _tmpDir = TestCase $ do+testAddFilesOptions tmpDir = TestCase $ do archive1 <- addFilesToArchive [OptVerbose] emptyArchive ["LICENSE", "src"] archive2 <- addFilesToArchive [OptRecursive, OptVerbose] archive1 ["LICENSE", "src"] assertBool "for recursive and nonrecursive addFilesToArchive" (length (filesInArchive archive1) < length (filesInArchive archive2)) #ifndef _WINDOWS- archive3 <- addFilesToArchive [OptVerbose, OptRecursive] emptyArchive ["tests/test_dir_with_symlinks"]- archive4 <- addFilesToArchive [OptVerbose, OptRecursive, OptPreserveSymbolicLinks] emptyArchive ["tests/test_dir_with_symlinks"]+ testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks2"+ archive3 <- addFilesToArchive [OptVerbose, OptRecursive] emptyArchive [testDir]+ archive4 <- addFilesToArchive [OptVerbose, OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir]+ mapM_ putStrLn $ filesInArchive archive3+ mapM_ putStrLn $ filesInArchive archive4 assertBool "for recursive and recursive by preserving symlinks addFilesToArchive" (length (filesInArchive archive4) < length (filesInArchive archive3)) #endif@@ -108,33 +138,87 @@ testExtractFiles :: FilePath -> Test testExtractFiles tmpDir = TestCase $ do- createDirectory (tmpDir ++ "/dir1")- createDirectory (tmpDir ++ "/dir1/dir2")+ createDirectory (tmpDir </> "dir1")+ createDirectory (tmpDir </> "dir1/dir2") let hiMsg = BS.pack "hello there" let helloMsg = BS.pack "Hello there. This file is very long. Longer than 31 characters."- BS.writeFile (tmpDir ++ "/dir1/hi") hiMsg- BS.writeFile (tmpDir ++ "/dir1/dir2/hello") helloMsg- archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir ++ "/dir1")]- removeDirectoryRecursive (tmpDir ++ "/dir1")+ BS.writeFile (tmpDir </> "dir1/hi") hiMsg+ BS.writeFile (tmpDir </> "dir1/dir2/hello") helloMsg+ archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir </> "dir1")]+ removeDirectoryRecursive (tmpDir </> "dir1") extractFilesFromArchive [OptVerbose] archive- hi <- BS.readFile (tmpDir ++ "/dir1/hi")- hello <- BS.readFile (tmpDir ++ "/dir1/dir2/hello")- assertEqual ("contents of " ++ tmpDir ++ "/dir1/hi") hiMsg hi- assertEqual ("contents of " ++ tmpDir ++ "/dir1/dir2/hello") helloMsg hello+ hi <- BS.readFile (tmpDir </> "dir1/hi")+ hello <- BS.readFile (tmpDir </> "dir1/dir2/hello")+ assertEqual ("contents of " </> tmpDir </> "dir1/hi") hiMsg hi+ assertEqual ("contents of " </> tmpDir </> "dir1/dir2/hello") helloMsg hello #ifndef _WINDOWS+ testExtractFilesWithPosixAttrs :: FilePath -> Test testExtractFilesWithPosixAttrs tmpDir = TestCase $ do- createDirectory (tmpDir ++ "/dir3")+ createDirectory (tmpDir </> "dir3") let hiMsg = "hello there"- writeFile (tmpDir ++ "/dir3/hi") hiMsg+ writeFile (tmpDir </> "dir3/hi") hiMsg let perms = unionFileModes ownerReadMode $ unionFileModes ownerWriteMode ownerExecuteMode- setFileMode (tmpDir ++ "/dir3/hi") perms- archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir ++ "/dir3")]- removeDirectoryRecursive (tmpDir ++ "/dir3")+ setFileMode (tmpDir </> "dir3/hi") perms+ archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir </> "dir3")]+ removeDirectoryRecursive (tmpDir </> "dir3") extractFilesFromArchive [OptVerbose] archive- hi <- readFile (tmpDir ++ "/dir3/hi")- fm <- fmap fileMode $ getFileStatus (tmpDir ++ "/dir3/hi")+ hi <- readFile (tmpDir </> "dir3/hi")+ fm <- fmap fileMode $ getFileStatus (tmpDir </> "dir3/hi") assertEqual "file modes" perms (intersectFileModes perms fm)- assertEqual ("contents of " ++ tmpDir ++ "/dir3/hi") hiMsg hi+ assertEqual ("contents of " </> tmpDir </> "dir3/hi") hiMsg hi++testArchiveExtractSymlinks :: FilePath -> Test+testArchiveExtractSymlinks tmpDir = TestCase $ do+ testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks3"+ let locationDir = "location_dir"+ archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks, OptLocation locationDir True] emptyArchive [testDir]+ removeDirectoryRecursive testDir+ let destination = "test_dest"+ extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination destination] archive+ isDirSymlink <- pathIsSymbolicLink (destination </> locationDir </> testDir </> "link_to_directory")+ isFileSymlink <- pathIsSymbolicLink (destination </> locationDir </> testDir </> "link_to_file")+ assertBool "Symbolic link to directory is preserved" isDirSymlink+ assertBool "Symbolic link to file is preserved" isFileSymlink+ removeDirectoryRecursive destination++testExtractExternalZipWithSymlinks :: FilePath -> Test+testExtractExternalZipWithSymlinks tmpDir = TestCase $ do+ archive <- toArchive <$> BL.readFile "tests/zip_with_symlinks.zip"+ extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive+ let zipRootDir = "zip_test_dir_with_symlinks"+ symlinkDir = tmpDir </> zipRootDir </> "symlink_to_dir_1"+ symlinkFile = tmpDir </> zipRootDir </> "symlink_to_file_1"+ 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+ removeDirectoryRecursive tmpDir++testArchiveAndUnzip :: FilePath -> Test+testArchiveAndUnzip tmpDir = TestCase $ do+ let dir = "test_dir_with_symlinks4"+ testDir <- createTestDirectoryWithSymlinks tmpDir dir+ archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir]+ removeDirectoryRecursive testDir+ let zipFile = tmpDir </> "testUnzip.zip"+ BL.writeFile zipFile $ fromArchive archive+ callCommand $ "unzip " ++ zipFile+ let symlinkDir = testDir </> "link_to_directory"+ symlinkFile = testDir </> "link_to_file"+ 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+ removeDirectoryRecursive tmpDir+ #endif
+ tests/zip_with_symlinks.zip view
binary file changed (absent → 1042 bytes)
zip-archive.cabal view
@@ -1,23 +1,24 @@ Name: zip-archive-Version: 0.3.2+Version: 0.3.2.1 Cabal-Version: >= 1.10 Build-type: Simple Synopsis: Library for creating and modifying zip archives. Description: The zip-archive library provides functions for creating, modifying, and extracting files from zip archives. Category: Codec-Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.2+Tested-with: GHC == 7.8.2, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2 License: BSD3 License-file: LICENSE Homepage: http://github.com/jgm/zip-archive Author: John MacFarlane Maintainer: jgm@berkeley.edu-Extra-Source-Files: changelog,- README.markdown,- tests/test4.zip,- tests/test4/a.txt,- tests/test4/b.bin,+Extra-Source-Files: changelog+ README.markdown+ tests/test4.zip+ tests/test4/a.txt+ tests/test4/b.bin "tests/test4/c/with spaces.txt"+ tests/zip_with_symlinks.zip Source-repository head type: git@@ -65,8 +66,8 @@ Main-Is: test-zip-archive.hs Hs-Source-Dirs: tests Build-Depends: base >= 4.2 && < 5,- directory, bytestring >= 0.9.0, process, time, old-time,- HUnit, zip-archive, temporary+ directory >= 1.3.1, bytestring >= 0.9.0, process, time, old-time, + HUnit, zip-archive, temporary, filepath Default-Language: Haskell98 Ghc-Options: -Wall if os(windows)