1{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE CPP #-}
3-- Test suite for Codec.Archive.Zip
4-- runghc Test.hs
5
6import Codec.Archive.Zip
7import Control.Applicative
8import Control.Monad (unless)
9import Control.Exception (try)
10import System.Directory hiding (isSymbolicLink)
11import Test.HUnit.Base
12import Test.HUnit.Text
13import qualified Data.ByteString.Char8 as BS
14import qualified Data.ByteString.Lazy as BL
15import qualified Data.ByteString.Lazy.Char8 as BLC
16import System.Exit
17import System.IO.Temp (withTempDirectory)
18
19#ifndef _WINDOWS
20import System.FilePath.Posix
21import System.Posix.Files
22import System.Process (rawSystem)
23#else
24import System.FilePath.Windows
25#endif
26
27-- define equality for Archives so timestamps aren't distinguished if they
28-- correspond to the same MSDOS datetime.
29instance Eq Archive where
30  (==) a1 a2 =  zSignature a1 == zSignature a2
31             && zComment a1 == zComment a2
32             && (all id $ zipWith (\x y -> x { eLastModified = eLastModified x `div` 2  } ==
33                                           y { eLastModified = eLastModified y `div` 2  }) (zEntries a1) (zEntries a2))
34
35#ifndef _WINDOWS
36
37createTestDirectoryWithSymlinks :: FilePath -> FilePath -> IO FilePath
38createTestDirectoryWithSymlinks prefixDir  baseDir = do
39  let testDir = prefixDir </> baseDir
40  createDirectoryIfMissing True testDir
41  createDirectoryIfMissing True (testDir </> "1")
42  writeFile (testDir </> "1/file.txt") "hello"
43  cwd <- getCurrentDirectory
44  createSymbolicLink (cwd </> testDir </> "1/file.txt") (testDir </> "link_to_file")
45  createSymbolicLink (cwd </> testDir </> "1") (testDir </> "link_to_directory")
46  return testDir
47
48#endif
49
50
51
52main :: IO Counts
53main = withTempDirectory "." "test-zip-archive." $ \tmpDir -> do
54#ifndef _WINDOWS
55  ec <- rawSystem "which" ["unzip"]
56  let unzipInPath = ec == ExitSuccess
57  unless unzipInPath $
58    putStrLn "\n\nunzip is not in path; skipping testArchiveAndUnzip\n"
59#endif
60  res   <- runTestTT $ TestList $ map (\f -> f tmpDir) $
61                                [ testReadWriteArchive
62                                , testReadExternalZip
63                                , testFromToArchive
64                                , testReadWriteEntry
65                                , testAddFilesOptions
66                                , testDeleteEntries
67                                , testExtractFiles
68                                , testExtractFilesFailOnEncrypted
69                                , testPasswordProtectedRead
70                                , testIncorrectPasswordRead
71                                , testEvilPath
72#ifndef _WINDOWS
73                                , testExtractFilesWithPosixAttrs
74                                , testArchiveExtractSymlinks
75                                , testExtractExternalZipWithSymlinks
76#endif
77                                ]
78#ifndef _WINDOWS
79                                ++ [testArchiveAndUnzip | unzipInPath]
80#endif
81  exitWith $ case (failures res + errors res) of
82                     0 -> ExitSuccess
83                     n -> ExitFailure n
84
85testReadWriteArchive :: FilePath -> Test
86testReadWriteArchive tmpDir = TestCase $ do
87  archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"]
88  BL.writeFile (tmpDir </> "test1.zip") $ fromArchive archive
89  archive' <- toArchive <$> BL.readFile (tmpDir </> "test1.zip")
90  assertEqual "for writing and reading test1.zip" archive archive'
91  assertEqual "for writing and reading test1.zip" archive archive'
92
93testReadExternalZip :: FilePath -> Test
94testReadExternalZip _tmpDir = TestCase $ do
95  archive <- toArchive <$> BL.readFile "tests/test4.zip"
96  let files = filesInArchive archive
97  assertEqual "for results of filesInArchive"
98    ["test4/","test4/a.txt","test4/b.bin","test4/c/",
99     "test4/c/with spaces.txt"] files
100  bContents <- BL.readFile "tests/test4/b.bin"
101  case findEntryByPath "test4/b.bin" archive of
102       Nothing  -> assertFailure "test4/b.bin not found in archive"
103       Just f   -> do
104                    assertEqual "for text4/b.bin file entry"
105                      NoEncryption (eEncryptionMethod f)
106                    assertEqual "for contents of test4/b.bin in archive"
107                      bContents (fromEntry f)
108  case findEntryByPath "test4/" archive of
109       Nothing  -> assertFailure "test4/ not found in archive"
110       Just f   -> assertEqual "for contents of test4/ in archive"
111                      BL.empty (fromEntry f)
112
113testFromToArchive :: FilePath -> Test
114testFromToArchive tmpDir = TestCase $ do
115  archive1 <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"]
116  assertEqual "for (toArchive $ fromArchive archive)" archive1 (toArchive $ fromArchive archive1)
117#ifndef _WINDOWS
118  testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks"
119  archive2 <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir]
120  assertEqual "for (toArchive $ fromArchive archive)" archive2 (toArchive $ fromArchive archive2)
121#endif
122
123testReadWriteEntry :: FilePath -> Test
124testReadWriteEntry tmpDir = TestCase $ do
125  entry <- readEntry [] "zip-archive.cabal"
126  setCurrentDirectory tmpDir
127  writeEntry [] entry
128  setCurrentDirectory ".."
129  entry' <- readEntry [] (tmpDir </> "zip-archive.cabal")
130  let entry'' = entry' { eRelativePath = eRelativePath entry, eLastModified = eLastModified entry }
131  assertEqual "for readEntry -> writeEntry -> readEntry" entry entry''
132
133testAddFilesOptions :: FilePath -> Test
134testAddFilesOptions tmpDir = TestCase $ do
135  archive1 <- addFilesToArchive [OptVerbose] emptyArchive ["LICENSE", "src"]
136  archive2 <- addFilesToArchive [OptRecursive, OptVerbose] archive1 ["LICENSE", "src"]
137  assertBool "for recursive and nonrecursive addFilesToArchive"
138     (length (filesInArchive archive1) < length (filesInArchive archive2))
139#ifndef _WINDOWS
140  testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks2"
141  archive3 <- addFilesToArchive [OptVerbose, OptRecursive] emptyArchive [testDir]
142  archive4 <- addFilesToArchive [OptVerbose, OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir]
143  mapM_ putStrLn $ filesInArchive archive3
144  mapM_ putStrLn $ filesInArchive archive4
145  assertBool "for recursive and recursive by preserving symlinks addFilesToArchive"
146     (length (filesInArchive archive4) < length (filesInArchive archive3))
147#endif
148
149
150testDeleteEntries :: FilePath -> Test
151testDeleteEntries _tmpDir = TestCase $ do
152  archive1 <- addFilesToArchive [] emptyArchive ["LICENSE", "src"]
153  let archive2 = deleteEntryFromArchive "LICENSE" archive1
154  let archive3 = deleteEntryFromArchive "src" archive2
155  assertEqual "for deleteFilesFromArchive" emptyArchive archive3
156
157testEvilPath :: FilePath -> Test
158testEvilPath _tmpDir = TestCase $ do
159  archive <- toArchive <$> BL.readFile "tests/zip_with_evil_path.zip"
160  result <- try $ extractFilesFromArchive [] archive :: IO (Either ZipException ())
161  case result of
162    Left err -> assertBool "Wrong exception" $ err == UnsafePath "../evil"
163    Right _ -> assertFailure "extractFilesFromArchive should have failed"
164
165testExtractFiles :: FilePath -> Test
166testExtractFiles tmpDir = TestCase $ do
167  createDirectory (tmpDir </> "dir1")
168  createDirectory (tmpDir </> "dir1/dir2")
169  let hiMsg = BS.pack "hello there"
170  let helloMsg = BS.pack "Hello there. This file is very long.  Longer than 31 characters."
171  BS.writeFile (tmpDir </> "dir1/hi") hiMsg
172  BS.writeFile (tmpDir </> "dir1/dir2/hello") helloMsg
173  archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir </> "dir1")]
174  removeDirectoryRecursive (tmpDir </> "dir1")
175  extractFilesFromArchive [OptVerbose] archive
176  hi <- BS.readFile (tmpDir </> "dir1/hi")
177  hello <- BS.readFile (tmpDir </> "dir1/dir2/hello")
178  assertEqual ("contents of " </> tmpDir </> "dir1/hi") hiMsg hi
179  assertEqual ("contents of " </> tmpDir </> "dir1/dir2/hello") helloMsg hello
180
181testExtractFilesFailOnEncrypted :: FilePath -> Test
182testExtractFilesFailOnEncrypted tmpDir = TestCase $ do
183  let dir = tmpDir </> "fail-encrypted"
184  createDirectory dir
185
186  archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip"
187  result <- try $ extractFilesFromArchive [OptDestination dir] archive :: IO (Either ZipException ())
188  removeDirectoryRecursive dir
189
190  case result of
191    Left err -> assertBool "Wrong exception" $ err == CannotWriteEncryptedEntry "test.txt"
192    Right _ -> assertFailure "extractFilesFromArchive should have failed"
193
194testPasswordProtectedRead :: FilePath -> Test
195testPasswordProtectedRead _tmpDir = TestCase $ do
196  archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip"
197
198  assertEqual "for results of filesInArchive" ["test.txt"] (filesInArchive archive)
199  case findEntryByPath "test.txt" archive of
200       Nothing  -> assertFailure "test.txt not found in archive"
201       Just f   -> do
202            assertBool "for encrypted test.txt file entry"
203              (isEncryptedEntry f)
204            assertEqual "for contents of test.txt in archive"
205              (Just $ BLC.pack "SUCCESS\n") (fromEncryptedEntry "s3cr3t" f)
206
207testIncorrectPasswordRead :: FilePath -> Test
208testIncorrectPasswordRead _tmpDir = TestCase $ do
209  archive <- toArchive <$> BL.readFile "tests/zip_with_password.zip"
210  case findEntryByPath "test.txt" archive of
211       Nothing  -> assertFailure "test.txt not found in archive"
212       Just f   -> do
213            assertEqual "for contents of test.txt in archive"
214              Nothing (fromEncryptedEntry "INCORRECT" f)
215
216#ifndef _WINDOWS
217
218testExtractFilesWithPosixAttrs :: FilePath -> Test
219testExtractFilesWithPosixAttrs tmpDir = TestCase $ do
220  createDirectory (tmpDir </> "dir3")
221  let hiMsg = "hello there"
222  writeFile (tmpDir </> "dir3/hi") hiMsg
223  let perms = unionFileModes ownerReadMode $ unionFileModes ownerWriteMode ownerExecuteMode
224  setFileMode (tmpDir </> "dir3/hi") perms
225  archive <- addFilesToArchive [OptRecursive] emptyArchive [(tmpDir </> "dir3")]
226  removeDirectoryRecursive (tmpDir </> "dir3")
227  extractFilesFromArchive [OptVerbose] archive
228  hi <- readFile (tmpDir </> "dir3/hi")
229  fm <- fmap fileMode $ getFileStatus (tmpDir </> "dir3/hi")
230  assertEqual "file modes" perms (intersectFileModes perms fm)
231  assertEqual ("contents of " </> tmpDir </> "dir3/hi") hiMsg hi
232
233testArchiveExtractSymlinks :: FilePath -> Test
234testArchiveExtractSymlinks tmpDir = TestCase $ do
235  testDir <- createTestDirectoryWithSymlinks tmpDir "test_dir_with_symlinks3"
236  let locationDir = "location_dir"
237  archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks, OptLocation locationDir True] emptyArchive [testDir]
238  removeDirectoryRecursive testDir
239  let destination = "test_dest"
240  extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination destination] archive
241  isDirSymlink <- pathIsSymbolicLink (destination </> locationDir </> testDir </> "link_to_directory")
242  isFileSymlink <- pathIsSymbolicLink (destination </> locationDir </> testDir </> "link_to_file")
243  assertBool "Symbolic link to directory is preserved" isDirSymlink
244  assertBool "Symbolic link to file is preserved" isFileSymlink
245  removeDirectoryRecursive destination
246
247testExtractExternalZipWithSymlinks :: FilePath -> Test
248testExtractExternalZipWithSymlinks tmpDir = TestCase $ do
249  archive <- toArchive <$> BL.readFile "tests/zip_with_symlinks.zip"
250  extractFilesFromArchive [OptPreserveSymbolicLinks, OptDestination tmpDir] archive
251  let zipRootDir = "zip_test_dir_with_symlinks"
252      symlinkDir = tmpDir </> zipRootDir </> "symlink_to_dir_1"
253      symlinkFile = tmpDir </> zipRootDir </> "symlink_to_file_1"
254  isDirSymlink <- pathIsSymbolicLink symlinkDir
255  targetDirExists <- doesDirectoryExist symlinkDir
256  isFileSymlink <- pathIsSymbolicLink symlinkFile
257  targetFileExists <- doesFileExist symlinkFile
258  assertBool "Symbolic link to directory is preserved" isDirSymlink
259  assertBool "Target directory exists" targetDirExists
260  assertBool "Symbolic link to file is preserved" isFileSymlink
261  assertBool "Target file exists" targetFileExists
262  removeDirectoryRecursive tmpDir
263
264testArchiveAndUnzip :: FilePath -> Test
265testArchiveAndUnzip tmpDir = TestCase $ do
266  let dir = "test_dir_with_symlinks4"
267  testDir <- createTestDirectoryWithSymlinks tmpDir dir
268  archive <- addFilesToArchive [OptRecursive, OptPreserveSymbolicLinks] emptyArchive [testDir]
269  removeDirectoryRecursive testDir
270  let zipFile = tmpDir </> "testUnzip.zip"
271  BL.writeFile zipFile $ fromArchive archive
272  ec <- rawSystem "unzip" [zipFile]
273  assertBool "unzip succeeds" $ ec == ExitSuccess
274  let symlinkDir = testDir </> "link_to_directory"
275      symlinkFile = testDir </> "link_to_file"
276  isDirSymlink <- pathIsSymbolicLink symlinkDir
277  targetDirExists <- doesDirectoryExist symlinkDir
278  isFileSymlink <- pathIsSymbolicLink symlinkFile
279  targetFileExists <- doesFileExist symlinkFile
280  assertBool "Symbolic link to directory is preserved" isDirSymlink
281  assertBool "Target directory exists" targetDirExists
282  assertBool "Symbolic link to file is preserved" isFileSymlink
283  assertBool "Target file exists" targetFileExists
284  removeDirectoryRecursive tmpDir
285
286#endif
287