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