packages feed

libarchive-conduit (empty) → 0.1.0.0

raw patch · 6 files changed

+198/−0 lines, 6 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, resourcet, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Thomas Tuegel++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 Thomas Tuegel 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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ libarchive-conduit.cabal view
@@ -0,0 +1,40 @@+name:                libarchive-conduit+version:             0.1.0.0+synopsis:            Read many archive formats with libarchive and conduit+license:             BSD3+license-file:        LICENSE+author:              Thomas Tuegel+maintainer:          ttuegel@gmail.com+copyright:           2014 Thomas Tuegel+category:            Codec+build-type:          Simple+cabal-version:       >=1.10+bug-reports: https://github.com/ttuegel/libarchive-conduit/issues+description:+  @libarchive-conduit@ reads archives with @libarchive@. All of the many+  formats understood by @libarchive@ are supported. Resource use is+  managed in Haskell with the @conduit@ library. The interface is very+  simple; archives are read from disk and their contents are presende as+  a stream of pairs @(FilePath, ByteString)@ of the path to each file+  and its contents, respectively.++source-repository head+  type: git+  location: https://github.com/ttuegel/libarchive-conduit.git++library+  exposed-modules:+    Codec.Archive+    Codec.Archive.Read+    Codec.Archive.Util+  other-extensions:+    ForeignFunctionInterface+  build-depends:+      base >=4.6 && <5+    , bytestring >=0.10+    , conduit >=1.2+    , resourcet >=1.1+    , transformers >=0.3+  hs-source-dirs: src+  default-language: Haskell2010+  extra-libraries: archive
+ src/Codec/Archive.hs view
@@ -0,0 +1,32 @@+module Codec.Archive+       ( sourceArchive+       , ArchiveException(..)+       ) where++import Control.Monad (void)+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import Data.Conduit++import Codec.Archive.Read+import Codec.Archive.Util (ArchiveException(..))++-- | Stream an archive from disk as a 'Source' of paths in the archive and their+-- contents. The archive may be in any format supported by libarchive. The+-- contents of each file is presented as a strict 'ByteString' because+-- libarchive only supports streaming archives in order; if lazy 'ByteString's+-- were used, the evaluation order could become inconsistent. Throws an+-- 'ArchiveException' if an error occurs.+sourceArchive :: MonadResource m+              => FilePath  -- ^ path to archive+              -> Source m (FilePath, ByteString)+              -- ^ stream of paths in archive and their contents+sourceArchive path = bracketP (readArchive path) free go+  where+    free = void . archiveReadFree+    go p = do+        mentry <- liftIO $ getNextEntry p+        case mentry of+            Nothing -> return ()+            Just entry -> yield entry >> go p
+ src/Codec/Archive/Read.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Codec.Archive.Read where++import Control.Monad (when)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Foreign+import Foreign.C.String+import Foreign.C.Types++import Codec.Archive.Util++foreign import ccall "archive.h archive_read_new"+    archiveReadNew :: IO (Ptr Archive)++foreign import ccall "archive.h archive_read_free"+    archiveReadFree :: Ptr Archive -> IO CInt++foreign import ccall "archive.h archive_read_support_filter_all"+    archiveReadSupportFilterAll :: Ptr Archive -> IO ()++foreign import ccall "archive.h archive_read_support_format_all"+    archiveReadSupportFormatAll :: Ptr Archive -> IO ()++foreign import ccall "archive.h archive_read_open_filename"+    archiveReadOpenFilename :: Ptr Archive -> CString -> CSize -> IO CInt++foreign import ccall "archive.h archive_read_next_header"+    archiveReadNextHeader :: Ptr Archive -> Ptr (Ptr Entry) -> IO CInt++foreign import ccall "archive.h archive_read_data"+    archiveReadData :: Ptr Archive -> CString -> CSize -> IO CSize++foreign import ccall "archive.h archive_entry_pathname"+    archiveEntryPathname :: Ptr Entry -> IO CString++foreign import ccall "archive.h archive_entry_size"+    archiveEntrySize :: Ptr Entry -> IO CSize++readArchive :: FilePath -> IO (Ptr Archive)+readArchive path = do+    p <- archiveReadNew+    archiveReadSupportFilterAll p+    archiveReadSupportFormatAll p+    _ <- withCString path $ \cpath ->+        archiveReadOpenFilename p cpath (64 * 1024) >>= checkArchiveError p+    return p++getNextEntry :: Ptr Archive -> IO (Maybe (FilePath, ByteString))+getNextEntry archive = alloca $ \pentry -> do+    eof <- archiveReadNextHeader archive pentry >>= checkArchiveError archive+    if eof then return Nothing+      else do+        entry <- peek pentry+        path <- archiveEntryPathname entry >>= peekCString+        size <- archiveEntrySize entry+        dat <- allocaArray (fromIntegral size) $ \dat -> do+            size' <- archiveReadData archive dat size+            when (size' < 0) $ throwArchiveException archive+            B.packCStringLen (dat, fromIntegral size')+        return $ Just (path, dat)
+ src/Codec/Archive/Util.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ForeignFunctionInterface #-}++module Codec.Archive.Util where++import Control.Exception+import Data.Typeable+import Foreign+import Foreign.C++data Archive++data Entry++data ArchiveException = ArchiveException String+  deriving (Show, Typeable)++instance Exception ArchiveException++checkArchiveError :: Ptr Archive -> CInt -> IO Bool+checkArchiveError archive code+    | code >= 0 = return $ code == 1+    | otherwise = throwArchiveException archive++foreign import ccall "archive.h archive_error_string"+    archiveErrorString :: Ptr Archive -> IO CString++throwArchiveException :: Ptr Archive -> IO a+throwArchiveException archive = do+    pstr <- archiveErrorString archive+    str <- peekCString pstr+    throw $ ArchiveException str