zip-archive 0.3.1.1 → 0.3.2
raw patch · 5 files changed
+94/−17 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Codec.Archive.Zip: OptPreserveSymbolicLinks :: ZipOption
Files
- Main.hs +11/−2
- changelog +11/−0
- src/Codec/Archive/Zip.hs +59/−11
- tests/test-zip-archive.hs +11/−2
- zip-archive.cabal +2/−2
Main.hs view
@@ -44,6 +44,14 @@ , Option ['h'] ["help"] (NoArg Help) "help" ] +quit :: Bool -> String -> IO a+quit failure msg = do+ hPutStr stderr msg+ _ <- exitWith $ if failure+ then ExitFailure 1+ else ExitSuccess+ return undefined+ main :: IO () main = do argv <- getArgs@@ -53,9 +61,10 @@ (o, _, _) | Version `elem` o -> do putStrLn ("version " ++ showVersion version) exitWith ExitSuccess- (o, _, _) | Help `elem` o -> error $ usageInfo header options+ (o, _, _) | Help `elem` o -> quit False $ usageInfo header options (o, (a:as), []) -> return (o, a:as)- (_, _, errs) -> error $ concat errs ++ "\n" ++ usageInfo header options+ (_, [], []) -> quit True $ usageInfo header options+ (_, _, errs) -> quit True $ concat errs ++ "\n" ++ usageInfo header options let verbosity = if Quiet `elem` opts then [] else [OptVerbose] let debug = Debug `elem` opts let cmd = case filter (`notElem` [Quiet, Help, Version, Debug]) opts of
changelog view
@@ -1,3 +1,14 @@+zip-archive 0.3.2++ * Add ZipOption to preserve symbolic links (#37, Tommaso Piazza).+ Add OptPreserveSymbolicLinks constructor to ZipOption. If this option+ is set, symbolic links will be preserved. Symbolic links are not+ supported on Windows.++ * Require binary >= 0.6 (#36).++ * Improve exit handling in zip-archive program.+ zip-archive 0.3.1.1 * readEntry: Read file as a strict ByteString. This avoids
src/Codec/Archive/Zip.hs view
@@ -70,7 +70,7 @@ 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,12 +81,13 @@ import Control.Applicative #endif #ifndef _WINDOWS-import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getFileStatus )+import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink) #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) -- text import qualified Data.Text.Lazy as TL@@ -155,6 +156,7 @@ | 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. deriving (Read, Show, Eq) data ZipException =@@ -252,17 +254,34 @@ readEntry :: [ZipOption] -> FilePath -> IO Entry readEntry opts path = do isDir <- doesDirectoryExist path+#ifdef _WINDOWS+ let isSymLink = False+#else+ fs <- getSymbolicLinkStatus path+ let isSymLink = isSymbolicLink fs+#endif -- make sure directories end in / and deal with the OptLocation option let path' = let p = path ++ (case reverse path of ('/':_) -> ""- _ | isDir -> "/"+ _ | isDir && not isSymLink -> "/"+ _ | isDir && isSymLink -> "" | otherwise -> "") in (case [(l,a) | OptLocation l a <- opts] of ((l,a):_) -> if a then l </> p else l </> takeFileName p _ -> p)- contents <- if isDir- then return B.empty- else B.fromStrict <$> S.readFile path+ contents <-+#ifndef _WINDOWS+ if isSymLink+ then do+ linkTarget <- readSymbolicLink path+ return $ C.pack linkTarget+ else+#endif+ if isDir+ then+ return B.empty+ else+ B.fromStrict <$> S.readFile path #if MIN_VERSION_directory(1,2,0) modEpochTime <- fmap (floor . utcTimeToPOSIXSeconds) $ getModificationTime path@@ -275,7 +294,11 @@ #ifdef _WINDOWS return $ entry #else- do fm <- fmap fileMode $ getFileStatus path+ do+ let fm = if isSymLink+ then symbolicLinkMode+ else fileMode fs+ let modes = fromIntegral $ shiftL (toInteger fm) 16 return $ entry { eExternalFileAttributes = modes, eVersionMadeBy = versionMadeBy }@@ -327,12 +350,17 @@ setFileTimeStamp path (eLastModified entry) -- | Add the specified files to an 'Archive'. If 'OptRecursive' is specified,--- recursively add files contained in directories. If 'OptVerbose' is specified,+-- recursively add files contained in directories. if 'OptPreserveSymbolicLinks'+-- is specified, don't recurse into it. If 'OptVerbose' is specified, -- print messages to stderr. addFilesToArchive :: [ZipOption] -> Archive -> [FilePath] -> IO Archive addFilesToArchive opts archive files = do filesAndChildren <- if OptRecursive `elem` opts+#ifdef _WINDOWS then mapM getDirectoryContentsRecursive files >>= return . nub . concat+#else+ then mapM (getDirectoryContentsRecursive' opts) files >>= return . nub . concat+#endif else return files entries <- mapM (readEntry opts) filesAndChildren return $ foldr addEntryToArchive archive entries@@ -426,18 +454,38 @@ (TOD epochsecs _) = addToClockTime timeSinceEpoch (TOD 0 0) in epochsecs +#ifndef _WINDOWS+getDirectoryContentsRecursive' :: [ZipOption] -> FilePath -> IO [FilePath]+getDirectoryContentsRecursive' opts path = do+ if OptPreserveSymbolicLinks `elem` opts+ then do+ isDir <- doesDirectoryExist path+ if isDir+ then do+ isSymLink <- fmap isSymbolicLink $ getSymbolicLinkStatus path+ if isSymLink+ then return [path]+ else getDirectoryContentsRecursivelyBy (getDirectoryContentsRecursive' opts) path+ else return [path]+ else getDirectoryContentsRecursive path+#endif+ getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive path = do isDir <- doesDirectoryExist path if isDir- then do+ then getDirectoryContentsRecursivelyBy getDirectoryContentsRecursive path+ else return [path]++getDirectoryContentsRecursivelyBy :: (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]+getDirectoryContentsRecursivelyBy exploreMethod path = do contents <- getDirectoryContents path let contents' = map (path </>) $ filter (`notElem` ["..","."]) contents- children <- mapM getDirectoryContentsRecursive contents'+ children <- mapM exploreMethod contents' if path == "." then return (concat children) else return (path : concat children)- else return [path]+ setFileTimeStamp :: FilePath -> Integer -> IO () setFileTimeStamp file epochtime = do
tests/test-zip-archive.hs view
@@ -70,8 +70,10 @@ testFromToArchive :: FilePath -> Test testFromToArchive _tmpDir = TestCase $ do- archive <- addFilesToArchive [OptRecursive] emptyArchive ["LICENSE", "src"]- assertEqual "for (toArchive $ fromArchive archive)" archive (toArchive $ fromArchive archive)+ 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"]+ assertEqual "for (toArchive $ fromArchive archive)" archive2 (toArchive $ fromArchive archive2) testReadWriteEntry :: FilePath -> Test testReadWriteEntry tmpDir = TestCase $ do@@ -89,6 +91,13 @@ 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"]+ assertBool "for recursive and recursive by preserving symlinks addFilesToArchive"+ (length (filesInArchive archive4) < length (filesInArchive archive3))+#endif+ testDeleteEntries :: FilePath -> Test testDeleteEntries _tmpDir = TestCase $ do
zip-archive.cabal view
@@ -1,5 +1,5 @@ Name: zip-archive-Version: 0.3.1.1+Version: 0.3.2 Cabal-Version: >= 1.10 Build-type: Simple Synopsis: Library for creating and modifying zip archives.@@ -35,7 +35,7 @@ Build-depends: base >= 3 && < 5, pretty, containers else Build-depends: base < 3- Build-depends: binary >= 0.5, zlib, filepath, bytestring >= 0.10.0,+ Build-depends: binary >= 0.6, zlib, filepath, bytestring >= 0.10.0, array, mtl, text >= 0.11, old-time, digest >= 0.0.0.1, directory, time Exposed-modules: Codec.Archive.Zip