LibZip-0.10.2/0000755000000000000000000000000012047134476011161 5ustar0000000000000000LibZip-0.10.2/runTests.hs0000644000000000000000000000041212047134476013341 0ustar0000000000000000import Tests.MonadicTests (monadicTests) import System.Exit import Test.HUnit allTests = TestList [ "Monadic API" ~: monadicTests ] main = do result <- runTestTT allTests if (errors result + failures result) > 0 then exitFailure else exitSuccess LibZip-0.10.2/LICENSE0000644000000000000000000000277012047134476012174 0ustar0000000000000000Copyright (c) 2009, 2010, Sergey Astanin All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the Sergey Astanin nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. LibZip-0.10.2/LibZip.cabal0000644000000000000000000000202412047134476013334 0ustar0000000000000000Name: LibZip Version: 0.10.2 License: BSD3 License-File: LICENSE Author: Sergey Astanin Maintainer: Sergey Astanin Homepage: http://bitbucket.org/astanin/hs-libzip/ Bug-reports: http://bitbucket.org/astanin/hs-libzip/issues/ Category: Codec, Foreign Synopsis: Bindings to libzip, a library for manipulating zip archives. Description: libzip is a C library for reading, creating, and modifying zip archives. This package allows to use it from Haskell code. Build-Type: Simple Cabal-Version: >= 1.2.3 Tested-With: GHC == 7.4.1, GHC == 7.6.1 Extra-Source-Files: examples/hzip.hs , runTests.hs, Tests/Common.hs , Tests/MonadicTests.hs, Tests/test.zip Library Exposed-Modules: Codec.Archive.LibZip Codec.Archive.LibZip.Types Other-Modules: Codec.Archive.LibZip.Errors Build-Depends: base >= 4.0 && < 5.0 , bindings-libzip >= 0.10 && < 0.11 , bytestring , filepath , time , mtl GHC-Options: -Wall LibZip-0.10.2/Setup.lhs0000644000000000000000000000107712047134476012776 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > import System.Cmd (system) > import System.Exit (ExitCode(..)) > import Distribution.PackageDescription (emptyHookedBuildInfo) > > main = defaultMainWithHooks simpleUserHooks > { runTests = runUnitTests > } > > > runUnitTests _ _ _ _ = > system "runhaskell -lzip -fno-warn-warnings-deprecations runTests.hs" >>= > onExit "\nSome tests did not pass." () > > onExit :: String -> a -> ExitCode -> IO a > onExit errmsg okvalue r = > case r of > ExitSuccess -> return okvalue > _ -> fail errmsg LibZip-0.10.2/Codec/0000755000000000000000000000000012047134476012176 5ustar0000000000000000LibZip-0.10.2/Codec/Archive/0000755000000000000000000000000012047134476013557 5ustar0000000000000000LibZip-0.10.2/Codec/Archive/LibZip.hs0000644000000000000000000005515112047134476015313 0ustar0000000000000000{- | Monadic interface to @libzip@. Most of the operations on zip archive happen within 'Archive' monad (see 'withArchive'). Partial reading of the files in the archive may be performed from within 'Entry' monad (see 'fromFile'). Both 'Archive' and 'Entry' are monad transformers over 'IO', and allow for IO with single and double 'lift'ing respectingly. Note: LibZip does not handle text encodings. Even if its API accepts 'String's (e.g. in 'sourceBuffer'), character codes above 255 should not be used. The user is responsible of proper encoding the text data. /Examples/ List files in the zip archive: @ import System.Environment (getArgs) import Codec.Archive.LibZip main = do (zipfile:_) <- getArgs files <- withArchive [] zipfile $ fileNames [] mapM_ putStrLn files @ Create a zip archive and a add file to the archive: @ import System.Environment (getArgs) import Codec.Archive.LibZip main = do (zipfile:_) <- getArgs withArchive [CreateFlag] zipfile $ do zs <- sourceBuffer \"Hello World!\" addFile \"hello.txt\" zs @ Extract and print a file from the zip archive: @ import System.Environment (getArgs) import Codec.Archive.LibZip main = do (zipfile:file:_) <- getArgs bytes <- withArchive [] zipfile $ fileContents [] file putStrLn bytes @ See also an implementation of a simple zip archiver @hzip.hs@ in the @examples/@ directory of the source distribution. -} module Codec.Archive.LibZip ( -- * Types Archive , Entry , ZipStat(..) -- * Archive operations , withArchive, getZip , numFiles, fileName, nameLocate, fileNames , fileSize, fileSizeIx , fileStat, fileStatIx , deleteFile, deleteFileIx , renameFile, renameFileIx , addFile, addDirectory , replaceFile, replaceFileIx , sourceBuffer, sourceFile, sourceZip , PureSource(..), sourcePure , getComment, setComment, removeComment , getFileComment, getFileCommentIx , setFileComment, setFileCommentIx , removeFileComment, removeFileCommentIx , unchangeFile, unchangeFileIx , unchangeArchive, unchangeAll -- * File reading operations , fromFile, fromFileIx , readBytes, skipBytes, readContents , fileContents, fileContentsIx -- * Flags and options , OpenFlag(..) , FileFlag(..) , ZipCompMethod(..) , ZipEncryptionMethod(..) -- * Exception handling , ZipError(..) , catchZipError -- * Re-exports , lift ) where import Bindings.LibZip import Codec.Archive.LibZip.Types import Codec.Archive.LibZip.Errors import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Word (Word8) import Control.Monad (when) import Control.Monad.State.Strict (StateT(..), MonadState(..), MonadTrans(..), lift, liftM) import Foreign.C.Error (Errno(..), eINVAL) import Foreign.C.String (withCString, withCStringLen, peekCString) import Foreign.C.Types (CInt, CULLong) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen, pokeArray) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Storable (Storable, peek, poke, pokeElemOff, sizeOf) import qualified Control.Exception as E -- -- Types -- -- | Monadic computation with a zip archive. See 'withArchive'. type Archive a = StateT Zip IO a -- | Monadic computation to read from open archive entries. -- See 'fromFile' and 'fromFileIx'. type Entry a = StateT (ZipFile,Integer,[FileFlag]) -- (file, position index, access flags) (StateT Zip IO) -- archive monad a -- -- Archive operations -- -- | Top-level wrapper for operations with an open -- archive. 'withArchive' opens and closes the file -- automatically. On error it throws 'ZipError'. withArchive :: [OpenFlag] -- ^ Checks for consistency or existence. -> FilePath -- ^ Filename of the zip archive. -> Archive a -- ^ Action to do with the archive. -> IO a withArchive flags path action = withCString path $ \path' -> alloca $ \errp -> c'zip_open path' (combine flags) errp >>= \z -> if z == nullPtr then peek errp >>= E.throwIO. errFromCInt else do r <- fst `liftM` runStateT action z e <- c'zip_close z if e /= 0 then get_error z >>= E.throwIO else return r -- | Get the number of entries in the archive. numFiles :: [FileFlag] -> Archive Integer numFiles flags = do z <- getZip lift $ fromIntegral `liftM` c'zip_get_num_entries z (combine flags) -- | Get name of an entry in the archive by its index. fileName :: [FileFlag] -- ^ 'FileUNCHANGED' flag can be used. -> Integer -- ^ Position index of a file in the archive. -> Archive FilePath -- ^ Name of the file in the archive. fileName flags i = do z <- getZip lift $ do n <- c'zip_get_name z (fromIntegral i) (combine flags) doIf' (n /= nullPtr) z $ peekCString n -- | Locate an entry (get its index) in the archive by its name. nameLocate :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Name of the file in the archive. -> Archive (Maybe Integer) -- ^ 'Just' position index if found. nameLocate flags name = do z <- getZip lift $ withCString name $ \name' -> do i <- fromIntegral `liftM` c'zip_name_locate z name' (combine flags) if i < 0 then return Nothing else return (Just i) -- | Get names of all entries (files and directories) in the archive. fileNames :: [FileFlag] -- ^ 'FileUNCHANGED' flag is accepted. -> Archive [FilePath] fileNames flags = do n <- numFiles flags mapM (fileName flags) [0..n-1] -- | Get size of a file in the archive. fileSize :: [FileFlag] -- ^ Filename lookup mode, 'FileUNCHANGED' can be used. -> FilePath -- ^ Name of the file in the archive. -> Archive Integer -- ^ File size. fileSize flags name = fileStat flags name >>= return . zs'size -- | Get size of a file in the archive (by index). fileSizeIx :: [FileFlag] -- ^ 'FileUNCHANGED' is accepted. -> Integer -- ^ Position index of a file in the archive. -> Archive Integer -- ^ File size. fileSizeIx flags i = fileStatIx flags i >>= return . zs'size -- | Get information about a file in the archive. fileStat :: [FileFlag] -- ^ Filename lookup mode, 'FileUNCHANGED' can be used. -> FilePath -- ^ Name of the file in the archive. -> Archive ZipStat -- ^ Infomation about the file. fileStat flags name = do z <- getZip lift $ withCString name $ \name' -> alloca $ \stat -> do c'zip_stat_init stat r <- c'zip_stat z name' (combine flags) stat doIf' (r == 0) z $ toZipStat =<< peek stat -- | Get information about a file in the archive (by index). fileStatIx :: [FileFlag] -- ^ 'FileUNCHANGED' can be used. -> Integer -- ^ Position index of a file in the archive. -> Archive ZipStat -- ^ Information about the file. fileStatIx flags i = do z <- getZip lift $ alloca $ \stat -> do r <- c'zip_stat_index z (fromIntegral i) (combine flags) stat doIf' (r == 0) z $ toZipStat =<< peek stat -- | Delete file from the archive. deleteFile :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Filename. -> Archive () deleteFile flags name = do mbi <- nameLocate flags name maybe (lift $ E.throwIO ErrNOENT) deleteFileIx mbi -- | Delete file (referenced by position index) from the archive. deleteFileIx :: Integer -- ^ Position index of a file in the archive. -> Archive () deleteFileIx i = do z <- getZip r <- lift $ c'zip_delete z (fromIntegral i) if r == 0 then return () else lift $ get_error z >>= E.throwIO -- | Rename file in the archive. renameFile :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Old name. -> FilePath -- ^ New name. -> Archive () renameFile flags oldname newname = do mbi <- nameLocate flags oldname maybe (lift $ E.throwIO ErrNOENT) (\i -> renameFileIx i newname) mbi -- | Rename file (referenced by position index) in the archive. renameFileIx :: Integer -- ^ Position index of a file in the archive. -> FilePath -- ^ New name. -> Archive () renameFileIx i newname = do z <- getZip r <- lift $ withCString newname $ c'zip_rename z (fromIntegral i) if r == 0 then return () else lift $ get_error z >>= E.throwIO -- | Add a file to the archive. addFile :: FilePath -- ^ Name of the file to create. -> ZipSource -- ^ Source where file data is obtained from. -> Archive Int -- ^ Position index of the new file. addFile name src = do z <- getZip lift $ withCString name $ \name' -> do i <- c'zip_add z name' src if i < 0 then c'zip_source_free src >> get_error z >>= E.throwIO else return $ fromIntegral i -- | Add a directory to the archive. addDirectory :: FilePath -- ^ Directory's name in the archive. -> Archive Int -- ^ Position index of the new directory entry. addDirectory name = do z <- getZip r <- lift $ withCString name $ c'zip_add_dir z if r < 0 then lift $ get_error z >>= E.throwIO else return (fromIntegral r) -- | Replace a file in the archive. replaceFile :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ File to replace. -> ZipSource -- ^ Source where the new file data is obtained from. -> Archive () replaceFile flags name src = do mbi <- nameLocate flags name maybe (lift $ c'zip_source_free src >> E.throwIO ErrNOENT) (\i -> replaceFileIx i src >> return ()) mbi -- | Replace a file in the archive (referenced by position index). replaceFileIx :: Integer -- ^ Position index of a file in the archive. -> ZipSource -- ^ Source where the new file data is obtained from -> Archive () replaceFileIx i src = do z <- getZip lift $ do r <- c'zip_replace z (fromIntegral i) src if r < 0 then c'zip_source_free src >> get_error z >>= E.throwIO else return () -- | Create a data source. Note: input is converted to @[Word8]@ internally. sourceBuffer :: (Enum a) => [a] -> Archive ZipSource sourceBuffer src = do let ws = map (toEnum . fromEnum) src :: [Word8] z <- getZip lift $ withArrayLen ws $ \len buf -> do zs <- c'zip_source_buffer z (castPtr buf) (fromIntegral len) 0 if zs == nullPtr then get_error z >>= E.throwIO else return zs -- | Create a data source from a file. sourceFile :: FilePath -- ^ File to open. -> Integer -- ^ Offset from the beginning of the file. -> Integer -- ^ The number of bytes to read. If @0@ or @-1@, -- the read till the end of file. -> Archive ZipSource sourceFile name offset len = do z <- getZip lift $ withCString name $ \name' -> do zs <- c'zip_source_file z name' (fromIntegral offset) (fromIntegral len) if zs == nullPtr then get_error z >>= E.throwIO else return zs -- | Create a data source from a file in the zip archive. sourceZip :: [FileFlag] -- ^ 'FileUNCHANGED' and 'FileRECOMPRESS' can be used. -> Zip -- ^ Source archive. -> Integer -- ^ Position index of a file in the source archive. -> Integer -- ^ Offset from the beginning of the file. -> Integer -- ^ The number of bytes to read. If @0@ or @-1@, -- then read till the end of file. -> Archive ZipSource sourceZip flags srcz srcidx offset len = do z <- getZip lift $ do zs <- c'zip_source_zip z srcz (fromIntegral srcidx) (combine flags) (fromIntegral offset) (fromIntegral len) if zs == nullPtr then get_error z >>= E.throwIO else return zs -- | Create a data source from a 'PureSource'. -- Note: input of @[a]@ is converted to @[Word8]@ internally. sourcePure :: (Enum a, Storable a, Storable st, Integral szt) => PureSource a st szt -> Archive ZipSource sourcePure pureSrc = do z <- getZip lift $ do cb <- mk'zip_source_callback (runPureSource pureSrc) zs <- with (srcState pureSrc) $ \pState -> c'zip_source_function z cb (castPtr pState) if zs == nullPtr then get_error z >>= E.throwIO else return zs -- | Wrapper for a user-provided pure function to be used with 'sourcePure'. -- Data size should be known in advance ('srcSize'). -- The function should support reading by chunks ('readSrc'). data PureSource a st szt = PureSource { srcState :: st -- ^ Initial state of the source. , srcSize :: szt -- ^ Total size of the data. , srcMTime :: Maybe UTCTime -- ^ Modification time (current time if Nothing). , readSrc :: szt -> st -> Maybe (szt, [a], st) -- ^ Read a chunk of the data, return @Just@ the size -- of data read, the data themselves and the new state -- of the source, or @Nothing@ on error. } runPureSource :: (Enum a, Storable a, Storable st, Integral szt) => PureSource a st szt -> (Ptr () -> Ptr () -> CULLong -> C'zip_source_cmd -> IO CULLong) runPureSource src pState pData len cmd | cmd == c'ZIP_SOURCE_OPEN = return 0 | cmd == c'ZIP_SOURCE_READ = do s <- peek (castPtr pState :: Ptr st) case readSrc (src { srcState = s }) (fromIntegral len) s of Just (len',bs,s') -> do pokeArray (castPtr pData :: Ptr Word8) (map (toEnum.fromEnum) bs) poke (castPtr pState) s' return (fromIntegral len') Nothing -> return (-1) | cmd == c'ZIP_SOURCE_CLOSE = return 0 | cmd == c'ZIP_SOURCE_STAT = do t <- maybe getCurrentTime return (srcMTime src) let pt = fromInteger . round . utcTimeToPOSIXSeconds $ t let pStat = castPtr pData c'zip_stat_init pStat stat <- peek pStat let stat' = stat { c'zip_stat'mtime = pt , c'zip_stat'size = fromIntegral $ srcSize src } poke pStat stat' return $ fromIntegral (sizeOf stat') | cmd == c'ZIP_SOURCE_ERROR = do let pErrs = castPtr pData :: Ptr CInt poke pErrs (fromIntegral . fromEnum $ ErrINVAL) let (Errno esys) = eINVAL pokeElemOff pErrs 1 esys return $ fromIntegral (2 * sizeOf esys) | cmd == c'ZIP_SOURCE_FREE = return 0 | otherwise = return (-1) -- | Get zip archive comment. getComment :: [FileFlag] -- ^ 'FileUNCHANGED' can be used. -> Archive (Maybe String) getComment flags = do z <- getZip (c,n) <- lift $ alloca $ \lenp -> do c <- c'zip_get_archive_comment z lenp (combine flags) n <- peek lenp return (c,n) if c == nullPtr then return Nothing else lift $ peekCString c >>= return . Just . take (fromIntegral n) -- | Set zip archive comment. setComment :: String -- ^ Comment message. -> Archive () setComment msg = do z <- getZip r <- lift $ withCStringLen msg $ \(msg',i') -> c'zip_set_archive_comment z msg' (fromIntegral i') if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Remove zip archive comment. removeComment :: Archive () removeComment = do z <- getZip r <- lift $ c'zip_set_archive_comment z nullPtr 0 if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Get comment for a file in the archive. getFileComment :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Filename -> Archive (Maybe String) getFileComment flags name = do mbi <- nameLocate flags name maybe (lift $ E.throwIO ErrNOENT) (getFileCommentIx flags) mbi -- | Get comment for a file in the archive (referenced by position index). getFileCommentIx :: [FileFlag] -- ^ FileUNCHANGED can be used. -> Integer -- ^ Position index of the file. -> Archive (Maybe String) getFileCommentIx flags i = do z <- getZip (c,n) <- lift $ alloca $ \lenp -> do c <- c'zip_get_file_comment z (fromIntegral i) lenp (combine flags) n <- peek lenp return (c,n) if c == nullPtr then return Nothing else lift $ peekCString c >>= return . Just . take (fromIntegral n) -- | Set comment for a file in the archive. setFileComment :: [FileFlag] -- ^ Name lookup mode. -> FilePath -- ^ Filename. -> String -- ^ New file comment. -> Archive () setFileComment flags path comment = do mbi <- nameLocate flags path maybe (lift $ E.throwIO ErrNOENT) (flip setFileCommentIx comment) mbi -- | Set comment for a file in the archive (referenced by position index). setFileCommentIx :: Integer -- ^ Position index of a file in the archive. -> String -- ^ New file comment. -> Archive () setFileCommentIx i comment = do z <- getZip r <- lift $ withCStringLen comment $ \(msg,len) -> c'zip_set_file_comment z (fromIntegral i) msg (fromIntegral len) if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Remove comment for a file in the archive. removeFileComment :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Filename. -> Archive () removeFileComment flags path = do mbi <- nameLocate flags path maybe (lift $ E.throwIO ErrNOENT) removeFileCommentIx mbi -- | Remove comment for a file in the archive (referenced by position index). removeFileCommentIx :: Integer -- ^ Position index of a file in the archive. -> Archive () removeFileCommentIx i = do z <- getZip r <- lift $ c'zip_set_file_comment z (fromIntegral i) nullPtr 0 if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Undo changes to a file in the archive. unchangeFile :: [FileFlag] -- ^ Filename lookup mode. -> FilePath -- ^ Filename. -> Archive () unchangeFile flags name = do mbi <- nameLocate flags name maybe (lift $ E.throw ErrNOENT) unchangeFileIx mbi -- | Undo changes to a file in the archive (referenced by position index). unchangeFileIx :: Integer -- ^ Position index of a file in the archive. -> Archive () unchangeFileIx i = do z <- getZip lift $ do r <- c'zip_unchange z (fromIntegral i) if r < 0 then get_error z >>= E.throwIO else return () -- | Undo global changes to zip archive (revert changes to the archive -- comment and global flags). unchangeArchive :: Archive () unchangeArchive = do z <- getZip lift $ do r <- c'zip_unchange_archive z if r < 0 then get_error z >>= E.throwIO else return () -- | Undo all changes in a zip archive. unchangeAll :: Archive () unchangeAll = do z <- getZip lift $ do r <- c'zip_unchange_all z if r < 0 then get_error z >>= E.throwIO else return () -- -- File reading operations -- -- | Wrapper for operations with a file in the archive. 'fromFile' is normally -- called from within an 'Archive' action (see also 'withArchive'). -- 'fromFile' can be replaced with 'fileContents' to read an entire file at -- once. fromFile :: [FileFlag] -- ^ Filename lookup mode, -- 'FileCOMPRESSED' and 'FileUNCHANGED' can be used. -> FilePath -- ^ Name of the file in the arhive. -> Entry a -- ^ Action with the file. -> Archive a fromFile flags name action = do z <- getZip nameLocate flags name >>= maybe (lift $ get_error z >>= E.throwIO) runAction where runAction i = do z <- getZip zf <- lift $ withCString name $ \n -> c'zip_fopen z n (combine flags) if zf == nullPtr then lift $ get_error z >>= E.throwIO else do r <- fst `liftM` runStateT action (zf,i,flags) e <- lift $ c'zip_fclose zf if e /= 0 then lift $ E.throwIO $ (toEnum . fromIntegral $ e :: ZipError) else return r -- | Wrapper for operations with a file in the archive. File is referenced -- by index (position). 'fromFileIx' is normally called from within -- an 'Archive' action (see also 'withArchive'). 'fromFileIx' can be replaced -- with 'fileContentsIx' to read an entire file at once. fromFileIx :: [FileFlag] -- ^ 'FileCOMPRESSED' and 'FileUNCHANGED' can be used. -> Integer -- ^ Position index of a file in the archive. -> Entry a -- ^ Action with the file. -> Archive a fromFileIx flags i action = do z <- getZip zf <- lift $ c'zip_fopen_index z (fromIntegral i) (combine flags) if zf == nullPtr then lift $ get_error z >>= E.throwIO else do r <- fst `liftM` runStateT action (zf,i,flags) e <- lift $ c'zip_fclose zf if e /= 0 then lift $ E.throwIO $ (toEnum . fromIntegral $ e :: ZipError) else return r -- | Read at most @n@ bytes from the file. readBytes :: (Enum a) => Integer -- ^ The number of bytes to read. -> Entry [a] -- ^ Bytes read. readBytes n = do lift . lift $ when (n > toInteger (maxBound::Int)) (E.throwIO ErrMEMORY) -- allocaArray can't allocate > (maxBound::Int) (zf,_,_) <- get lift . lift $ allocaArray (fromIntegral n) $ \buf -> do nread <- c'zip_fread zf (castPtr buf) (fromIntegral n) if nread < 0 then get_file_error zf >>= E.throwIO else do bs <- peekArray (fromIntegral nread) buf :: IO [Word8] return . map (toEnum . fromEnum) $ bs -- | Skip @n@ bytes from the open file. Note: this is not faster than reading. skipBytes :: Integer -> Entry () skipBytes n = (readBytes n :: Entry [Word8]) >> return () -- | Read entire file contents. readContents :: (Enum a) => Entry [a] -- ^ Contents of the file. readContents = do (_,i,flags) <- get sz <- lift $ fileSizeIx flags i readBytes sz -- | Read entire file. Shortcut for 'readContents' from within 'Archive' monad. fileContents :: (Enum a) => [FileFlag] -> FilePath -> Archive [a] fileContents flags name = fromFile flags name readContents -- | Read entire file (referenced by position index). Shortcut for -- 'readContents' from within 'Archive' monad. fileContentsIx :: (Enum a) => [FileFlag] -> Integer -> Archive [a] fileContentsIx flags i = fromFileIx flags i readContents -- -- Helpers -- -- | Get archive handler. Throw 'ErrINVAL' if the archive is closed. getZip :: Archive Zip getZip = do z <- get if z == nullPtr then lift $ E.throwIO ErrINVAL else return z -- | Get and throw a 'ZipError' if condition fails. Otherwise work normally. doIf :: Bool -> Zip -> (Zip -> IO a) -> IO a doIf cnd z action = if cnd then action z else get_error z >>= E.throwIO -- | Get and throw a 'ZipError' if condition fails. See also 'doIf'. doIf' :: Bool -> Zip -> (IO a) -> IO a doIf' cnd z action = doIf cnd z (const action) LibZip-0.10.2/Codec/Archive/LibZip/0000755000000000000000000000000012047134476014750 5ustar0000000000000000LibZip-0.10.2/Codec/Archive/LibZip/Types.hs0000644000000000000000000003130312047134476016410 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable#-} module Codec.Archive.LibZip.Types ( Zip , ZipFile , ZipSource , ZipStat(..) , toZipStat , OpenFlag(..) , FileFlag(..) , ArchiveFlag(..) , CodecFlag(..) , ZipError(..) , ZipCompMethod(..) , ZipEncryptionMethod(..) , combine ) where import Data.Bits ((.|.)) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Typeable (Typeable) import Data.Word (Word, Word32, Word64) import Foreign.C.String (peekCString) import Foreign.C.Types () import Foreign.Ptr (Ptr, nullPtr) import qualified Control.Exception as E import Bindings.LibZip -- | Handler of the open zip file. type Zip = Ptr C'zip -- | Handler of an open file in the zip archive. type ZipFile = Ptr C'zip_file -- | Handler of data source for new files in the zip archive. type ZipSource = Ptr C'zip_source -- | File statistics expressed in native Haskell types. data ZipStat = ZipStat { zs'valid :: Word64 , zs'name :: String , zs'index :: Integer , zs'size :: Integer , zs'comp_size :: Integer , zs'mtime :: UTCTime , zs'crc :: Word , zs'comp_method :: ZipCompMethod , zs'encryption_method :: ZipEncryptionMethod , zs'flags :: Word32 } deriving (Show, Eq) -- | Convert marshalled stat record. toZipStat :: C'zip_stat -> IO ZipStat toZipStat s = do let valid = fromIntegral $ c'zip_stat'valid s let np = c'zip_stat'name s name <- if (np /= nullPtr) then peekCString np else return "" let idx = fromIntegral $ c'zip_stat'index s let crc = fromIntegral $ c'zip_stat'crc s let mtime = posixSecondsToUTCTime . realToFrac $ c'zip_stat'mtime s let size = fromIntegral $ c'zip_stat'size s let comp_size = fromIntegral $ c'zip_stat'comp_size s let comp_meth = toEnum . fromIntegral $ c'zip_stat'comp_method s let enc_meth = toEnum . fromIntegral $ c'zip_stat'encryption_method s let flags = toEnum . fromIntegral $ c'zip_stat'flags s return $ ZipStat valid name idx size comp_size mtime crc comp_meth enc_meth flags -- | Flags for opening an archive. data OpenFlag = CreateFlag -- ^ Create an archive if it does not exist. | ExclFlag -- ^ Error if the archive already exists. | CheckConsFlag -- ^ Check archive's consistency and error on failure. deriving (Show,Eq) instance Enum OpenFlag where fromEnum CheckConsFlag = c'ZIP_CHECKCONS fromEnum CreateFlag = c'ZIP_CREATE fromEnum ExclFlag = c'ZIP_EXCL toEnum x | x == c'ZIP_CHECKCONS = CheckConsFlag toEnum x | x == c'ZIP_CREATE = CreateFlag toEnum x | x == c'ZIP_EXCL = ExclFlag toEnum _ = undefined -- | Flags for accessing files in the archive. -- Please consult @libzip@ documentation about their use. data FileFlag = FileNOCASE -- ^ Ignore case on name lookup. | FileNODIR -- ^ Ignore directory component. | FileCOMPRESSED -- ^ Read the compressed data. | FileUNCHANGED -- ^ Read the original data, ignore changes. | FileRECOMPRESS -- ^ Force recompression of data. | FileENCRYPTED -- ^ Read encrypted data (implies FileCOMPRESSED). deriving (Show,Eq) instance Enum FileFlag where fromEnum FileCOMPRESSED = c'ZIP_FL_COMPRESSED fromEnum FileNOCASE = c'ZIP_FL_NOCASE fromEnum FileNODIR = c'ZIP_FL_NODIR fromEnum FileRECOMPRESS = c'ZIP_FL_RECOMPRESS fromEnum FileUNCHANGED = c'ZIP_FL_UNCHANGED fromEnum FileENCRYPTED = c'ZIP_FL_ENCRYPTED toEnum x | x == c'ZIP_FL_COMPRESSED = FileCOMPRESSED toEnum x | x == c'ZIP_FL_NOCASE = FileNOCASE toEnum x | x == c'ZIP_FL_NODIR = FileNODIR toEnum x | x == c'ZIP_FL_RECOMPRESS = FileRECOMPRESS toEnum x | x == c'ZIP_FL_UNCHANGED = FileUNCHANGED toEnum x | x == c'ZIP_FL_ENCRYPTED = FileENCRYPTED toEnum _ = undefined -- | @libzip@ archive global flags data ArchiveFlag = ArchiveTORRENT | ArchiveRDONLY deriving (Show, Eq) instance Enum ArchiveFlag where fromEnum ArchiveTORRENT = c'ZIP_AFL_TORRENT fromEnum ArchiveRDONLY = c'ZIP_AFL_RDONLY toEnum x | x == c'ZIP_AFL_TORRENT = ArchiveTORRENT toEnum x | x == c'ZIP_AFL_RDONLY = ArchiveRDONLY toEnum _ = undefined -- | @libzip@ flags for compression and encryption sources data CodecFlag = CodecENCODE deriving (Show, Eq) instance Enum CodecFlag where fromEnum CodecENCODE = c'ZIP_CODEC_ENCODE toEnum x | x == c'ZIP_CODEC_ENCODE = CodecENCODE toEnum _ = undefined -- | @libzip@ error codes. data ZipError = ErrOK -- ^ No error. | ErrMULTIDISK -- ^ Multi-disk zip archives not supported. | ErrRENAME -- ^ Renaming temporary file failed. | ErrCLOSE -- ^ Closing zip archive failed. | ErrSEEK -- ^ Seek error. | ErrREAD -- ^ Read error. | ErrWRITE -- ^ Write error. | ErrCRC -- ^ CRC error. | ErrZIPCLOSED -- ^ Containing zip archive was closed. | ErrNOENT -- ^ No such file. | ErrEXISTS -- ^ File already exists. | ErrOPEN -- ^ Can't open file. | ErrTMPOPEN -- ^ Failure to create temporary file. | ErrZLIB -- ^ Zlib error. | ErrMEMORY -- ^ Malloc error. | ErrCHANGED -- ^ Entry has been changed. | ErrCOMPNOTSUPP -- ^ Compression method not supported. | ErrEOF -- ^ Premature EOF. | ErrINVAL -- ^ Invalid argument. | ErrNOZIP -- ^ Not a zip archive. | ErrINTERNAL -- ^ Internal error. | ErrINCONS -- ^ Zip archive inconsistent. | ErrREMOVE -- ^ Can't remove file. | ErrDELETED -- ^ Entry has been deleted. | ErrENCRNOTSUPP -- ^ Encryption method not supported. | ErrRDONLY -- ^ Read-only archive. | ErrNOPASSWD -- ^ No password provided. | ErrWRONGPASSWD -- ^ Wrong password provided. deriving (Eq, Typeable) instance Enum ZipError where fromEnum ErrCHANGED = c'ZIP_ER_CHANGED fromEnum ErrCLOSE = c'ZIP_ER_CLOSE fromEnum ErrCOMPNOTSUPP = c'ZIP_ER_COMPNOTSUPP fromEnum ErrCRC = c'ZIP_ER_CRC fromEnum ErrDELETED = c'ZIP_ER_DELETED fromEnum ErrEOF = c'ZIP_ER_EOF fromEnum ErrEXISTS = c'ZIP_ER_EXISTS fromEnum ErrINCONS = c'ZIP_ER_INCONS fromEnum ErrINTERNAL = c'ZIP_ER_INTERNAL fromEnum ErrINVAL = c'ZIP_ER_INVAL fromEnum ErrMEMORY = c'ZIP_ER_MEMORY fromEnum ErrMULTIDISK = c'ZIP_ER_MULTIDISK fromEnum ErrNOENT = c'ZIP_ER_NOENT fromEnum ErrNOZIP = c'ZIP_ER_NOZIP fromEnum ErrOK = c'ZIP_ER_OK fromEnum ErrOPEN = c'ZIP_ER_OPEN fromEnum ErrREAD = c'ZIP_ER_READ fromEnum ErrREMOVE = c'ZIP_ER_REMOVE fromEnum ErrRENAME = c'ZIP_ER_RENAME fromEnum ErrSEEK = c'ZIP_ER_SEEK fromEnum ErrTMPOPEN = c'ZIP_ER_TMPOPEN fromEnum ErrWRITE = c'ZIP_ER_WRITE fromEnum ErrZIPCLOSED = c'ZIP_ER_ZIPCLOSED fromEnum ErrZLIB = c'ZIP_ER_ZLIB fromEnum ErrENCRNOTSUPP = c'ZIP_ER_ENCRNOTSUPP fromEnum ErrRDONLY = c'ZIP_ER_RDONLY fromEnum ErrNOPASSWD = c'ZIP_ER_NOPASSWD fromEnum ErrWRONGPASSWD = c'ZIP_ER_WRONGPASSWD toEnum x | x == c'ZIP_ER_CHANGED = ErrCHANGED toEnum x | x == c'ZIP_ER_CLOSE = ErrCLOSE toEnum x | x == c'ZIP_ER_COMPNOTSUPP = ErrCOMPNOTSUPP toEnum x | x == c'ZIP_ER_CRC = ErrCRC toEnum x | x == c'ZIP_ER_DELETED = ErrDELETED toEnum x | x == c'ZIP_ER_EOF = ErrEOF toEnum x | x == c'ZIP_ER_EXISTS = ErrEXISTS toEnum x | x == c'ZIP_ER_INCONS = ErrINCONS toEnum x | x == c'ZIP_ER_INTERNAL = ErrINTERNAL toEnum x | x == c'ZIP_ER_INVAL = ErrINVAL toEnum x | x == c'ZIP_ER_MEMORY = ErrMEMORY toEnum x | x == c'ZIP_ER_MULTIDISK = ErrMULTIDISK toEnum x | x == c'ZIP_ER_NOENT = ErrNOENT toEnum x | x == c'ZIP_ER_NOZIP = ErrNOZIP toEnum x | x == c'ZIP_ER_OK = ErrOK toEnum x | x == c'ZIP_ER_OPEN = ErrOPEN toEnum x | x == c'ZIP_ER_READ = ErrREAD toEnum x | x == c'ZIP_ER_REMOVE = ErrREMOVE toEnum x | x == c'ZIP_ER_RENAME = ErrRENAME toEnum x | x == c'ZIP_ER_SEEK = ErrSEEK toEnum x | x == c'ZIP_ER_TMPOPEN = ErrTMPOPEN toEnum x | x == c'ZIP_ER_WRITE = ErrWRITE toEnum x | x == c'ZIP_ER_ZIPCLOSED = ErrZIPCLOSED toEnum x | x == c'ZIP_ER_ZLIB = ErrZLIB toEnum x | x == c'ZIP_ER_ENCRNOTSUPP = ErrENCRNOTSUPP toEnum x | x == c'ZIP_ER_RDONLY = ErrRDONLY toEnum x | x == c'ZIP_ER_NOPASSWD = ErrNOPASSWD toEnum x | x == c'ZIP_ER_WRONGPASSWD = ErrWRONGPASSWD toEnum _ = undefined instance E.Exception ZipError instance Show ZipError where show ErrOK = "No error" show ErrMULTIDISK = "Multi-disk zip archives not supported" show ErrRENAME = "Renaming temporary file failed" show ErrCLOSE = "Closing zip archive failed" show ErrSEEK = "Seek error" show ErrREAD = "Read error" show ErrWRITE = "Write error" show ErrCRC = "CRC error" show ErrZIPCLOSED = "Containing zip archive was closed" show ErrNOENT = "No such file" show ErrEXISTS = "File already exists" show ErrOPEN = "Can't open file" show ErrTMPOPEN = "Failure to create temporary file" show ErrZLIB = "Zlib error" show ErrMEMORY = "Malloc failure" show ErrCHANGED = "Entry has been changed" show ErrCOMPNOTSUPP = "Compression method not supported" show ErrEOF = "Premature EOF" show ErrINVAL = "Invalid argument" show ErrNOZIP = "Not a zip archive" show ErrINTERNAL = "Internal error" show ErrINCONS = "Zip archive inconsistent" show ErrREMOVE = "Can't remove file" show ErrDELETED = "Entry has been deleted" show ErrENCRNOTSUPP = "Encryption method not supported" show ErrRDONLY = "Read-only archive" show ErrNOPASSWD = "No password provided" show ErrWRONGPASSWD = "Wrong password provided" -- | Compression methods. data ZipCompMethod = CompDEFAULT -- ^ Better of deflate or store. | CompSTORE -- ^ Stored (uncompressed). | CompSHRINK -- ^ Shrunk. | CompREDUCE_1 -- ^ Reduced with factor 1 | CompREDUCE_2 -- ^ Reduced with factor 2 | CompREDUCE_3 -- ^ Reduced with factor 3 | CompREDUCE_4 -- ^ Reduced with factor 4 | CompIMPLODE -- ^ Imploded. | CompDEFLATE -- ^ Deflated. | CompDEFLATE64 -- ^ Deflate64. | CompPKWARE_IMPLODE -- ^ PKWARE imploding. | CompBZIP2 -- ^ Compressed using BZIP2 algorithm. | CompLZMA -- ^ LZMA (EFS) | CompTERSE -- ^ Compressed using IBM TERSE (new). | CompLZ77 -- ^ IBM LZ77 z Architecture (PFS). | CompWAVPACK -- ^ WavPack compressed data. | CompPPMD -- ^ PPMd version I, Rev 1. deriving (Show, Eq) instance Enum ZipCompMethod where fromEnum CompDEFAULT = c'ZIP_CM_DEFAULT fromEnum CompSTORE = c'ZIP_CM_STORE fromEnum CompSHRINK = c'ZIP_CM_SHRINK fromEnum CompREDUCE_1 = c'ZIP_CM_REDUCE_1 fromEnum CompREDUCE_2 = c'ZIP_CM_REDUCE_2 fromEnum CompREDUCE_3 = c'ZIP_CM_REDUCE_3 fromEnum CompREDUCE_4 = c'ZIP_CM_REDUCE_4 fromEnum CompIMPLODE = c'ZIP_CM_IMPLODE fromEnum CompDEFLATE = c'ZIP_CM_DEFLATE fromEnum CompDEFLATE64 = c'ZIP_CM_DEFLATE64 fromEnum CompPKWARE_IMPLODE = c'ZIP_CM_PKWARE_IMPLODE fromEnum CompBZIP2 = c'ZIP_CM_BZIP2 fromEnum CompLZMA = c'ZIP_CM_LZMA fromEnum CompTERSE = c'ZIP_CM_TERSE fromEnum CompLZ77 = c'ZIP_CM_LZ77 fromEnum CompWAVPACK = c'ZIP_CM_WAVPACK fromEnum CompPPMD = c'ZIP_CM_PPMD toEnum x | x == c'ZIP_CM_DEFAULT = CompDEFAULT toEnum x | x == c'ZIP_CM_STORE = CompSTORE toEnum x | x == c'ZIP_CM_SHRINK = CompSHRINK toEnum x | x == c'ZIP_CM_REDUCE_1 = CompREDUCE_1 toEnum x | x == c'ZIP_CM_REDUCE_2 = CompREDUCE_2 toEnum x | x == c'ZIP_CM_REDUCE_3 = CompREDUCE_3 toEnum x | x == c'ZIP_CM_REDUCE_4 = CompREDUCE_4 toEnum x | x == c'ZIP_CM_IMPLODE = CompIMPLODE toEnum x | x == c'ZIP_CM_DEFLATE = CompDEFLATE toEnum x | x == c'ZIP_CM_DEFLATE64 = CompDEFLATE64 toEnum x | x == c'ZIP_CM_PKWARE_IMPLODE = CompPKWARE_IMPLODE toEnum x | x == c'ZIP_CM_BZIP2 = CompBZIP2 toEnum x | x == c'ZIP_CM_LZMA = CompLZMA toEnum x | x == c'ZIP_CM_TERSE = CompTERSE toEnum x | x == c'ZIP_CM_LZ77 = CompLZ77 toEnum x | x == c'ZIP_CM_WAVPACK = CompWAVPACK toEnum x | x == c'ZIP_CM_PPMD = CompPPMD toEnum _ = undefined -- | Encryption methods. data ZipEncryptionMethod = EncryptNONE -- ^ Not encrypted. | EncryptTRAD_PKWARE -- ^ Traditional PKWARE encryption. | EncryptUNKNOWN -- ^ Unknown algorithm. deriving (Show,Eq) instance Enum ZipEncryptionMethod where fromEnum EncryptNONE = c'ZIP_EM_NONE fromEnum EncryptTRAD_PKWARE = c'ZIP_EM_TRAD_PKWARE fromEnum EncryptUNKNOWN = c'ZIP_EM_UNKNOWN toEnum x | x == c'ZIP_EM_NONE = EncryptNONE toEnum x | x == c'ZIP_EM_TRAD_PKWARE = EncryptTRAD_PKWARE toEnum x | x == c'ZIP_EM_UNKNOWN = EncryptUNKNOWN toEnum _ = undefined combine :: (Enum a, Num b) => [a] -> b combine fs = fromIntegral . foldr (.|.) 0 $ map fromEnum fs LibZip-0.10.2/Codec/Archive/LibZip/Errors.hs0000644000000000000000000000224712047134476016565 0ustar0000000000000000-- | Error handling functions. module Codec.Archive.LibZip.Errors ( errFromCInt , get_error , get_file_error , catchZipError ) where import Data.Typeable (Typeable, typeOf) import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (nullPtr) import Foreign.Storable (peek) import qualified Control.Exception as E import Bindings.LibZip import Codec.Archive.LibZip.Types errFromCInt :: CInt -> ZipError errFromCInt = toEnum . fromEnum get_error :: Zip -> IO ZipError get_error z | z == nullPtr = E.throwIO ErrINVAL get_error z = alloca $ \zep -> do c'zip_error_get z zep nullPtr peek zep >>= return . errFromCInt get_file_error :: ZipFile -> IO ZipError get_file_error zf | zf == nullPtr = E.throwIO ErrINVAL | otherwise = alloca $ \zep -> do c'zip_file_error_get zf zep nullPtr peek zep >>= return . errFromCInt -- | Wrapper to catch library errors. catchZipError :: IO a -> (ZipError -> IO a) -> IO a catchZipError f h = E.catchJust ifZipError f h where ifZipError :: (Typeable e, E.Exception e) => e -> Maybe e ifZipError x | typeOf x == typeOf ErrOK = Just x ifZipError _ | otherwise = Nothing LibZip-0.10.2/Tests/0000755000000000000000000000000012047134476012263 5ustar0000000000000000LibZip-0.10.2/Tests/MonadicTests.hs0000644000000000000000000002307512047134476015223 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Tests.MonadicTests where import Codec.Archive.LibZip import Tests.Common import Data.Int (Int64) import Foreign.Storable import Foreign.Ptr (Ptr, castPtr) import System.Directory (doesFileExist, getTemporaryDirectory, removeFile) import System.FilePath (()) import Test.HUnit import qualified Control.Exception as E monadicTests = TestList [ "read list of files" ~: do files <- withArchive [] testzip $ fileNames [] files @?= testfiles , "read file size" ~: do sz <- withArchive [] testzip $ fileSize [] lastfile sz @?= lastfilesize , "case-insensitive file names" ~: do sz <- withArchive [] testzip $ fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile) sz @?= lastfilesize , "open error if exists (with ExclFlag)" ~: do err <- catchZipError (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK) (return . id) err @?= ErrEXISTS , "open error if archive does not exists" ~: do err <- catchZipError (withArchive [] "notexists.zip" $ return ErrOK) (return . id) err @?= ErrOPEN , "read file" ~: do txt <- withArchive [] testzip $ fileContents [] lastfile txt @?= world_txt , "read file by index" ~: do let i = toInteger (length testfiles - 1) txt <- withArchive [] testzip $ fileContentsIx [] i txt @?= world_txt , "skipBytes/readBytes" ~: do txt <- withArchive [] testzip $ fromFile [] lastfile $ do skipBytes 13 readBytes 10 txt @?= (take 10 . drop 13 $ world_txt) , "create an archive/use sourceBuffer" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceBuffer.zip" i <- withArchive [CreateFlag] tmpzip $ do addDirectory "hello" addFile "hello/world.txt" =<< sourceBuffer world_txt tmpzip `doesExistAnd` \f -> do txt <- withArchive [] f $ fileContents [] "hello/world.txt" removeFile f (txt, i) @?= (world_txt, 1) , "create an archive/use sourceFile" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceFile.zip" tmpsrc <- getTmpFileName "test_LibZip_sourceFile.txt" writeFile tmpsrc world_txt withArchive [CreateFlag] tmpzip $ addFile "world.txt" =<< sourceFile tmpsrc 0 0 tmpzip `doesExistAnd` \f -> do txt <- withArchive [] f $ fileContents [] "world.txt" removeFile tmpzip removeFile tmpsrc txt @?= world_txt , "create an archive/use sourceZip" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceZip.zip" withArchive [] testzip $ do zsrc <- getZip lift $ withArchive [CreateFlag] tmpzip $ addFile "world.txt" =<< sourceZip [] zsrc 1 0 0 tmpzip `doesExistAnd` \f -> do txt <- withArchive [] f $ fileContents [] "world.txt" removeFile tmpzip txt @?= world_txt , "create an archive/use sourcePure" ~: do tmpzip <- getTmpFileName "test_LibZip_sourcePure.zip" let src = PureSource { srcState = (0, length world_txt) -- needs a Storable instance , srcSize = length world_txt , srcMTime = Nothing , readSrc = \len (pos,lft) -> let n = min len lft buf = take n . drop pos $ world_txt in Just (n, buf, (pos+n,lft-n)) } withArchive [CreateFlag] tmpzip $ do addFile "world.txt" =<< sourcePure src tmpzip `doesExistAnd` \f -> do txt <- withArchive [] f $ fileContents [] "world.txt" removeFile tmpzip txt @?= world_txt , "delete a file" ~: do let orig = [("one", "one"), ("two", "two")] let final = init orig tmpzip <- getTmpFileName "test_LibZip_delete.zip" mkArchive tmpzip orig fs_orig <- withArchive [] tmpzip $ fileNames [] withArchive [] tmpzip $ deleteFile [] "two" fs_final <- withArchive [] tmpzip $ fileNames [] removeFile tmpzip (fs_orig, fs_final) @?= (map fst orig, map fst final) , "attempt to delete a non-existing file" ~: do tmpzip <- getTmpFileName "test_LibZip_delete_ne.zip" mkArchive tmpzip [("world.txt", world_txt)] r1 <- catchZipError (withArchive [] tmpzip $ deleteFile [] "doesnotexist" >> return ErrOK) (return . id) r2 <- catchZipError (withArchive [] tmpzip $ deleteFileIx 100 >> return ErrOK) (return . id) removeFile tmpzip (r1, r2) @?= (ErrNOENT, ErrINVAL) , "rename a file" ~: do tmpzip <- getTmpFileName "test_LibZip_rename.zip" mkArchive tmpzip [("world.txt", world_txt)] fs <- withArchive [] tmpzip $ do renameFile [] "world.txt" "hello.txt" fileNames [] removeFile tmpzip fs @?= ["hello.txt"] , "attempt to rename a non-existing file" ~: do tmpzip <- getTmpFileName "test_LibZip_rename_ne.zip" mkArchive tmpzip [("world.txt", world_txt)] r <- catchZipError (withArchive [] tmpzip $ do renameFile [] "doesnotexist" "hello.txt" return ErrOK) (return . id) removeFile tmpzip r @?= ErrNOENT , "attempt to rename to an empty name" ~: do tmpzip <- getTmpFileName "test_LibZip_rename_inval.zip" mkArchive tmpzip [("world.txt", world_txt)] r <- catchZipError (withArchive [] tmpzip $ do renameFile [] "world.txt" "" return ErrOK) (return . id) removeFile tmpzip r @?= ErrINVAL , "replace a file" ~: do tmpzip <- getTmpFileName "test_LibZip_replace.zip" mkArchive tmpzip [("hello/",""), ("hello/world.txt", "old contents")] withArchive [] tmpzip $ replaceFile [] "hello/world.txt" =<< sourceBuffer world_txt txt <- withArchive [] tmpzip $ fileContents [] "hello/world.txt" txt @?= world_txt , "set/get/remove archive comment" ~: do c1 <- withArchive [] testzip $ getComment [] tmpzip <- getTmpFileName "test_LibZip_comment.zip" mkArchive tmpzip [("hello/",""), ("hello/world.txt", world_txt)] c2 <- withArchive [] tmpzip $ getComment [] let com = "this is a test" withArchive [] tmpzip $ setComment com c2_added <- withArchive [] tmpzip $ getComment [] withArchive [] tmpzip $ removeComment c2_removed <- withArchive [] tmpzip $ getComment [] removeFile tmpzip (c1, c2, c2_added, c2_removed) @?= (Nothing, Nothing, Just com, Nothing) , "set/get/remove file comment" ~: do tmpzip <- getTmpFileName "test_LibZip_file_comment.zip" let world_path = "hello/world.txt" let world_comm = "this is a test" mkArchive tmpzip [("hello/",undefined), (world_path,world_txt)] let get_comm = withArchive [] tmpzip $ getFileComment [] world_path c_off <- get_comm withArchive [] tmpzip $ setFileComment [] world_path world_comm c_on <- get_comm withArchive [] tmpzip $ removeFileComment [] world_path c_off' <- get_comm removeFile tmpzip (c_off, c_on, c_off') @?= (Nothing, Just world_comm, Nothing) , "unchange file" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange_file.zip" mkArchive tmpzip [("world.txt",world_txt)] c <- withArchive [] tmpzip $ do setFileComment [] "world.txt" "a comment to undo" unchangeFile [] "world.txt" getFileComment [] "world.txt" removeFile tmpzip c @?= Nothing , "unchange archive" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange.zip" mkArchive tmpzip [("world.txt",world_txt)] c <- withArchive [] tmpzip $ do setComment "a comment to undo" unchangeArchive getComment [] removeFile tmpzip c @?= Nothing , "unchange all" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange_all.zip" mkArchive tmpzip [("world.txt",world_txt)] c <- withArchive [] tmpzip $ do setComment "a comment to undo" setFileComment [] "world.txt" "a file comment to undo" unchangeAll c1 <- getComment [] c2 <- getFileComment [] "world.txt" return (c1,c2) removeFile tmpzip c @?= (Nothing,Nothing) ] getTmpFileName basename = do tmpdir <- getTemporaryDirectory let tmpfile = tmpdir basename doesFileExist tmpfile >>= \b -> if b then removeFile tmpfile >> return tmpfile else return tmpfile doesExistAnd filepath assertion = do exists <- doesFileExist filepath if exists then assertion filepath else False @? ( "File " ++ filepath ++ " does not exist." ) -- for sourcePure, requires FlexibleInstances instance Storable (Int,Int) where sizeOf _ = 2 * sizeOf (0::Int) alignment _ = alignment (0::Int) peek ptr = do let ptr' = castPtr ptr :: Ptr Int a <- peekElemOff ptr' 0 b <- peekElemOff ptr' 1 return (a, b) poke ptr (a,b) = do let ptr' = castPtr ptr :: Ptr Int pokeElemOff ptr' 0 $ a pokeElemOff ptr' 1 $ b mkArchive :: (Enum a) => FilePath -> [(FilePath, [a])] -> IO () mkArchive zipname contents = withArchive [CreateFlag] zipname $ mapM_ (\(f,d) -> if last f == '/' then addDirectory f else addFile f =<< sourceBuffer d ) contents LibZip-0.10.2/Tests/Common.hs0000644000000000000000000000103512047134476014046 0ustar0000000000000000module Tests.Common ( testzip, testfiles, lastfile, lastfilesize , world_txt , toUpper, toLower, map2 ) where import Data.Char (toUpper, toLower) testzip = "Tests/test.zip" testfiles = [ "hello/", "hello/world.txt" ] lastfile = last testfiles lastfilesize = 71 :: Integer world_txt = "And God saw everything that he had made,\ \ and behold, it was very good.\n" -- map odd positions with f, even positions with g map2 :: (a -> b) -> (a -> b) -> [a] -> [b] map2 f g [] = [] map2 f g (x:xs) = (f x):map2 g f xs LibZip-0.10.2/Tests/test.zip0000644000000000000000000000043312047134476013766 0ustar0000000000000000PK ;hello/PK;KCGhello/world.txt 0Ulbce\@s`ݫ [vV΄I ~q7C3jb(ZPK ;Ahello/PK;KCG $hello/world.txtPKqLibZip-0.10.2/examples/0000755000000000000000000000000012047134476012777 5ustar0000000000000000LibZip-0.10.2/examples/hzip.hs0000644000000000000000000000713012047134476014306 0ustar0000000000000000-- A utility to list, add or extract files in a zip archive. -- -- This is an example of using LibZip library. -- -- (c) Sergey Astanin 2010 -- License: BSD3 -- import Codec.Archive.LibZip import Control.Monad (liftM, when) import Data.List (intercalate) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getCurrentDirectory, getDirectoryContents, makeRelativeToCurrentDirectory) import System.Environment (getArgs) import System.FilePath (joinPath, splitDirectories, takeDirectory) import System.IO (stderr, hPutStr, hPutStrLn) usage :: String usage = unlines [ "Usage: hzip [l|a|x] archive.zip [files]" , " l list files in the archives" , " a add/update files or directories in the archive recursively" , " x extract files from the archive to the current direcotory" ] main :: IO () main = do args <- getArgs case args of ("l":archive:_) -> list archive ("a":archive:files) -> mapM mkRel files >>= add archive ("x":archive:files) -> getCurrentDirectory >>= \d -> extract d archive files _ -> hPutStr stderr usage where mkRel = makeRelativeToCurrentDirectory list :: FilePath -> IO () list archive = do stats <- withArchive [] archive $ do n <- numFiles [] mapM (fileStatIx []) [0..(n-1)] mapM_ printEntry stats where printEntry e = let sz = padLeft 8 . show $ zs'size e mt = take 16 . show $ zs'mtime e nm = zs'name e in putStrLn $ intercalate " " [ sz, mt, nm ] padLeft n s = let m = max 0 (n - length s) in replicate m ' ' ++ s add :: FilePath -> [FilePath] -> IO () add archive paths = mapM_ (addEntry archive) paths -- not very effective: it opens the archive many times, but it should work addEntry :: FilePath -> FilePath -> IO () addEntry a path = do isADir <- doesDirectoryExist path if isADir then printErrors a path $ do withArchive flags a $ mapM_ checkAddDirectory $ parents path paths <- filter (`notElem` [".",".."]) `liftM` getDirectoryContents path let rpaths = map (\e -> joinPath [path,e]) paths add a rpaths else do printErrors a path $ withArchive flags a $ addOrUpdate path =<< sourceFile path 0 0 where flags = [CreateFlag] parents = scanl1 (\p c -> joinPath [p,c]) . splitDirectories checkAddDirectory p = do e1 <- nameLocate [] p e2 <- nameLocate [] (p ++ "/") if e1 == Nothing && e2 == Nothing then addDirectory p else return (-1) addOrUpdate p src = do exists <- nameLocate [] p case exists of (Just i) -> replaceFileIx i src Nothing -> addFile p src >> return () printErrors a p action = catchZipError ( action >> return () ) ( \ze -> hPutStrLn stderr $ intercalate ": " [a, p, show ze] ) extract :: FilePath -> FilePath -> [FilePath] -> IO () extract outdir archive onlyFiles = withArchive [] archive $ do n <- numFiles [] mapM_ (extractEntry outdir onlyFiles) [0..(n-1)] -- silently overwrites existing files extractEntry :: FilePath -> [FilePath] -> Integer -> Archive () extractEntry outdir onlyFiles i = do name <- fileName [] i let fspath = joinPath [outdir, name] let fsdir = takeDirectory fspath when (null onlyFiles || name `elem` onlyFiles) $ if isDir name then lift $ createDirectoryIfMissing True fsdir else do b <- fileContentsIx [] i lift $ do createDirectoryIfMissing True fsdir writeFile fspath b -- FIXME: should be binary where isDir "" = False isDir f = last f == '/'