diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,29 @@ # libarchive +## 2.0.0.0 + + * Fix typo in documentation + * Improve docs + * `archiveReadOpenMemory` now accepts an argument of type `Ptr a` rather + than `Ptr CChar` + * `unpackToDirLazy`, `unpackArchive`, and `archiveUnpackToDir` now occur in the `ArchiveM` monad + * `readArchiveBSL` and `readArchiveBS` now return `Either ArchiveResult [Entry]` rather than + failing silently + * `readArchiveFile` now returns an `ArchiveM [Entry]` rather than returning an + `IO [Entry]` + * `enriesToFile`, `entriesToFile7Zip`, and `entriesToFileZip` now occur in the + `ArchiveM` monad + * Make various parts of an `Entry` optional + * Add `packToFile` functions and `packFiles` functions + * Remove `ArchiveError` newtype, replace it with `ArchiveResult` + * Fix bug in `archiveEntryMTimeIsSet` + * Add `archiveEntryACLEntryInherited`, `archiveEntryACLStyleSolaris`, + `archiveEntryACLStyleSeparatorComma`, `archiveEntryACLStyleCompact` + * Add `archiveReadDiskNoAcl`, `archiveReadDiskNoFFlags` + * Depend on `libarchive` >= 3.4.0 + * Remove `Raw` modules, use c2hs throughout. + * Fix potential bug with lazy bytestrings of nonstandard size + ## 1.0.5.1 * Add `cross` flag diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,8 +6,19 @@ This contains Haskell bindings to [libarchive](http://libarchive.org/). It was created as an alternative to -[tar](http://hackage.haskell.org/package/tar), but it supports more archive -formats. +[tar](http://hackage.haskell.org/package/tar) and +[tar-archive](http://hackage.haskell.org/package/tar-conduit), but it supports +more archive formats. It has a high-level Haskell API for creating and unpacking archives in addition to the C API. Like the `tar` package, it can stream from lazy `ByteString`s. + +## Hacking + +To run the test suite, first run + +``` +./bash/setup +``` + +so that you have appropriate test data downloaded. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.C2Hs (defaultMainC2Hs) + +main :: IO () +main = defaultMainC2Hs diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,55 @@ +module Main (main) where + +import Codec.Archive +import Codec.Archive.Tar (Entries (..), FormatError) +import qualified Codec.Archive.Tar as Tar +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Criterion.Main +import qualified Data.ByteString.Lazy as BSL +import Data.Conduit.Tar as TarConduit +import System.IO.Temp (withSystemTempDirectory) + +roundtrip :: BSL.ByteString -> Either ArchiveResult BSL.ByteString +roundtrip = fmap entriesToBSL . readArchiveBSL + +failTar :: Entries a -> Either a [Tar.Entry] +failTar (Next e es) = (e :) <$> failTar es +failTar Done = Right [] +failTar (Fail e) = Left e + +roundtripTar :: BSL.ByteString -> Either FormatError BSL.ByteString +roundtripTar = fmap Tar.write . failTar . Tar.read + +unpack :: IO (Either ArchiveResult ()) +unpack = withSystemTempDirectory "libarchive" $ + \fp -> runArchiveM $ unpackArchive "test/data/libarchive-1.0.5.1.tar" fp + +unpackHs :: IO (Either ArchiveResult ()) +unpackHs = withSystemTempDirectory "libarchive" $ + \fp -> runArchiveM $ unpackToDirLazy fp =<< liftIO (BSL.readFile "test/data/libarchive-1.0.5.1.tar") + +extractTar :: IO () +extractTar = withSystemTempDirectory "tar" $ + \fp -> Tar.extract fp "test/data/libarchive-1.0.5.1.tar" + +-- I'm not even sure why I'm benchmarking this since it doesn't work +unpackTarConduit :: IO () +unpackTarConduit = withSystemTempDirectory "tar" $ + \fp -> void $ TarConduit.extractTarballLenient "test/data/libarchive-1.0.5.1.tar" (Just fp) + +main :: IO () +main = + defaultMain [ env file $ \ f -> + bgroup "roundtrip" + [ bench "libarchive" $ nf roundtrip f + , bench "tar" $ nf roundtripTar f + ] + , bgroup "unpack" + [ bench "libarchive (via bytestring)" $ nfIO unpackHs + , bench "libarchive (C API)" $ nfIO unpack + , bench "tar" $ nfIO extractTar + , bench "tarConduit" $ nfIO unpackTarConduit + ] + ] + where file = BSL.readFile "test/data/libarchive-1.0.5.1.tar" diff --git a/cabal.project.local b/cabal.project.local deleted file mode 100644 --- a/cabal.project.local +++ /dev/null @@ -1,2 +0,0 @@ -documentation: true -max-backjumps: 40000 diff --git a/libarchive.cabal b/libarchive.cabal --- a/libarchive.cabal +++ b/libarchive.cabal @@ -1,32 +1,36 @@ -cabal-version: 1.18 -name: libarchive -version: 1.0.5.1 -license: BSD3 -license-file: LICENSE -copyright: Copyright: (c) 2018-2019 Vanessa McHale -maintainer: vanessa.mchale@iohk.io -author: Vanessa McHale -tested-with: ghc ==8.4.4 ghc ==8.2.2 ghc ==8.6.4 ghc ==8.0.2 -bug-reports: https://github.com/vmchale/libarchive/issues -synopsis: Haskell interface to libarchive +cabal-version: 1.18 +name: libarchive +version: 2.0.0.0 +license: BSD3 +license-file: LICENSE +copyright: Copyright: (c) 2018-2019 Vanessa McHale +maintainer: vamchale@gmail.com +author: Vanessa McHale +tested-with: ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.1 +bug-reports: https://github.com/vmchale/libarchive/issues +synopsis: Haskell interface to libarchive description: Haskell bindings for [libarchive](https://www.libarchive.org/). Provides the ability to unpack archives, including the ability to unpack archives lazily. -category: Codec -build-type: Simple -extra-source-files: - cabal.project.local -extra-doc-files: README.md - CHANGELOG.md +category: Codec +build-type: Custom +extra-doc-files: + README.md + CHANGELOG.md + source-repository head - type: git + type: git location: https://github.com/vmchale/libarchive +custom-setup + setup-depends: + base -any, + chs-cabal -any + flag cross - description: - Set this flag if cross-compiling - default: False - manual: True + description: Set this flag if cross-compiling + default: False + manual: True library exposed-modules: @@ -34,28 +38,82 @@ Codec.Archive.Foreign Codec.Archive.Foreign.Archive Codec.Archive.Foreign.ArchiveEntry - pkgconfig-depends: libarchive -any - hs-source-dirs: src + + pkgconfig-depends: libarchive (==3.4.0 || >3.4.0) && <4.0 + hs-source-dirs: src other-modules: + Codec.Archive.Foreign.Archive.Macros + Codec.Archive.Foreign.ArchiveEntry.Macros Codec.Archive.Pack Codec.Archive.Pack.Lazy + Codec.Archive.Pack.Common Codec.Archive.Unpack.Lazy Codec.Archive.Unpack - Codec.Archive.Foreign.Common Codec.Archive.Types + Codec.Archive.Types.Foreign + Codec.Archive.Permissions Codec.Archive.Common - default-language: Haskell2010 - ghc-options: -Wall -Wincomplete-uni-patterns - -Wincomplete-record-updates -Wredundant-constraints + Codec.Archive.Monad + + default-language: Haskell2010 + other-extensions: DeriveGeneric DeriveAnyClass + ghc-options: + -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints + build-depends: base >=4.9 && <5, bytestring -any, - composition-prelude -any, + composition-prelude >=2.0.5.0, dlist -any, - filepath -any + filepath -any, + mtl >=2.2.1, + unix-compat >=0.1.2.1, + deepseq >=1.4.0.0 if !flag(cross) - build-tools: c2hs >=0.19.1 + build-tool-depends: c2hs:c2hs >=0.26.1 + + if impl(ghc >=8.4) + ghc-options: -Wmissing-export-lists + +test-suite libarchive-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: + -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + + build-depends: + base -any, + libarchive -any, + hspec -any, + bytestring -any, + directory >=1.2.5.0, + filepath -any + + if impl(ghc >=8.4) + ghc-options: -Wmissing-export-lists + +benchmark libarchive-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: bench + default-language: Haskell2010 + ghc-options: + -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints + + build-depends: + base -any, + libarchive -any, + criterion -any, + bytestring -any, + tar -any, + tar-conduit >=0.2.5, + temporary -any if impl(ghc >=8.4) ghc-options: -Wmissing-export-lists diff --git a/src/Codec/Archive.hs b/src/Codec/Archive.hs --- a/src/Codec/Archive.hs +++ b/src/Codec/Archive.hs @@ -18,20 +18,32 @@ , readArchiveFile , readArchiveBS , readArchiveBSL + , packFiles + , packFilesZip + , packFiles7zip + , packToFile + , packToFileZip + , packToFile7Zip -- * Concrete (Haskell) types + , ArchiveResult (..) , Entry (..) , EntryContent (..) , Ownership (..) , Permissions , ModTime , Id + -- * Archive monad + , ArchiveM + , runArchiveM -- * Permissions helpers , standardPermissions , executablePermissions ) where +import Codec.Archive.Monad import Codec.Archive.Pack import Codec.Archive.Pack.Lazy +import Codec.Archive.Permissions import Codec.Archive.Types import Codec.Archive.Unpack import Codec.Archive.Unpack.Lazy diff --git a/src/Codec/Archive/Common.hs b/src/Codec/Archive/Common.hs --- a/src/Codec/Archive/Common.hs +++ b/src/Codec/Archive/Common.hs @@ -3,11 +3,18 @@ ) where import Codec.Archive.Foreign +import Control.Monad.IO.Class (MonadIO (..)) import Foreign.Ptr --- | Read from an 'Archive' and then free it -actFree :: (Ptr Archive -> IO a) -> Ptr Archive -> IO a -actFree fact a = fact a <* archive_free a +-- | Do something with an 'Archive' and then free it +actFree :: MonadIO m + => (Ptr Archive -> m a) + -> Ptr Archive + -> m a +actFree fact a = fact a <* liftIO (archiveFree a) -actFreeCallback :: (Ptr Archive -> IO a) -> (Ptr Archive, IO ()) -> IO a -actFreeCallback fact (a, freeAct) = fact a <* archive_free a <* freeAct +actFreeCallback :: MonadIO m + => (Ptr Archive -> m a) + -> (Ptr Archive, IO ()) -- ^ 'Ptr' to an 'Archive' and an 'IO' action to clean up when done + -> m a +actFreeCallback fact (a, freeAct) = fact a <* liftIO (archiveFree a) <* liftIO freeAct diff --git a/src/Codec/Archive/Foreign.hs b/src/Codec/Archive/Foreign.hs --- a/src/Codec/Archive/Foreign.hs +++ b/src/Codec/Archive/Foreign.hs @@ -1,7 +1,7 @@ --- | Everything here is stateful and hence takes place in the 'IO' monad. +-- | Import this module to get access to the C API. -- --- Consult @archive.h@ or @archive_entry.h@ for documentation. Functions that --- are deprecated in the C API are not exposed here at all. +-- Functions that +-- are deprecated in the C API are not exposed. module Codec.Archive.Foreign ( module Codec.Archive.Foreign.ArchiveEntry , module Codec.Archive.Foreign.Archive ) where diff --git a/src/Codec/Archive/Foreign/Archive.chs b/src/Codec/Archive/Foreign/Archive.chs --- a/src/Codec/Archive/Foreign/Archive.chs +++ b/src/Codec/Archive/Foreign/Archive.chs @@ -1,903 +1,681 @@ -- | This module corresponds to @archive.h@ -module Codec.Archive.Foreign.Archive ( -- * Direct bindings (read) - archive_read_new - , archive_read_data_skip - , archive_read_data - , archive_read_data_block - , archive_read_free - , archive_read_extract - , archive_read_open_filename - , archive_read_open_filename_w - , archive_read_support_filter_all - , archive_read_support_filter_bzip2 - , archive_read_support_filter_compress - , archive_read_support_filter_gzip - , archive_read_support_filter_grzip - , archive_read_support_filter_lrzip - , archive_read_support_filter_lz4 - , archive_read_support_filter_lzip - , archive_read_support_filter_lzma - , archive_read_support_filter_lzop - , archive_read_support_filter_none - , archive_read_support_filter_program - , archive_read_support_filter_program_signature - , archive_read_support_filter_rpm - , archive_read_support_filter_uu - , archive_read_support_filter_xz - , archive_read_support_format_7zip - , archive_read_support_format_all - , archive_read_support_format_ar - , archive_read_add_passphrase - , archive_read_set_passphrase_callback - , archive_read_extract2 - , archive_read_extract_set_progress_callback - , archive_read_extract_set_skip_file - , archive_read_close - , archive_read_support_format_by_code - , archive_read_support_format_cab - , archive_read_support_format_cpio - , archive_read_support_format_empty - , archive_read_support_format_gnutar - , archive_read_support_format_iso9660 - , archive_read_support_format_lha - , archive_read_support_format_mtree - , archive_read_support_format_rar - , archive_read_support_format_raw - , archive_read_support_format_tar - , archive_read_support_format_warc - , archive_read_support_format_xar - , archive_read_support_format_zip - , archive_read_support_format_zip_streamable - , archive_read_support_format_zip_seekable - , archive_read_set_format - , archive_read_append_filter - , archive_read_append_filter_program - , archive_read_append_filter_program_signature - , archive_read_set_open_callback - , archive_read_set_read_callback - , archive_read_set_seek_callback - , archive_read_set_skip_callback - , archive_read_set_close_callback - , archive_read_set_switch_callback - , archive_read_set_callback_data - , archive_read_set_callback_data2 - , archive_read_add_callback_data - , archive_read_append_callback_data - , archive_read_prepend_callback_data - , archive_read_open1 - , archive_read_open - , archive_read_open2 - , archive_read_open_filenames - , archive_read_open_memory - , archive_read_open_memory2 - , archive_read_open_fd - , archive_read_next_header - , archive_read_next_header2 - , archive_read_header_position - , archiveReadHasEncryptedEntries - , archive_read_format_capabilities - , archive_seek_data - , archive_read_data_into_fd - , archive_read_set_format_option - , archive_read_set_filter_option - , archive_read_set_option - , archive_read_set_options - , archive_read_disk_new - , archive_read_disk_set_symlink_logical - , archive_read_disk_set_symlink_physical - , archive_read_disk_set_symlink_hybrid - , archive_read_disk_entry_from_file - , archive_read_disk_gname - , archive_read_disk_uname - , archive_read_disk_set_standard_lookup - , archive_read_disk_set_gname_lookup - , archive_read_disk_set_uname_lookup - , archive_read_disk_open - , archive_read_disk_open_w - , archive_read_disk_descend - , archiveReadDiskCanDescend - , archive_read_disk_current_filesystem - , archiveReadDiskCurrentFilesystemIsSynthetic - , archiveReadDiskCurrentFilesystemIsRemote - , archive_read_disk_set_atime_restored - , archive_read_disk_set_behavior - , archive_read_disk_set_matching - , archive_read_disk_set_metadata_filter_callback - -- * Direct bindings (write) - , archive_write_set_bytes_per_block - , archive_write_get_bytes_per_block - , archive_write_set_bytes_in_last_block - , archive_write_get_bytes_in_last_block - , archive_write_set_skip_file - , archive_write_add_filter - , archive_write_add_filter_by_name - , archive_write_add_filter_b64encode - , archive_write_add_filter_bzip2 - , archive_write_add_filter_compress - , archive_write_add_filter_grzip - , archive_write_add_filter_gzip - , archive_write_add_filter_lrzip - , archive_write_add_filter_lz4 - , archive_write_add_filter_lzip - , archive_write_add_filter_lzma - , archive_write_add_filter_lzop - , archive_write_add_filter_none - , archive_write_add_filter_program - , archive_write_add_filter_uuencode - , archive_write_add_filter_xz - , archive_write_data - , archive_write_new - , archive_write_free - , archive_write_set_format_pax_restricted - , archive_write_header - , archive_write_set_format - , archive_write_set_format_by_name - , archive_write_set_format_7zip - , archive_write_set_format_ar_bsd - , archive_write_set_format_ar_svr4 - , archive_write_set_format_cpio - , archive_write_set_format_cpio_newc - , archive_write_set_format_gnutar - , archive_write_set_format_iso9660 - , archive_write_set_format_mtree - , archive_write_set_format_mtree_classic - , archive_write_set_format_pax - , archive_write_set_format_raw - , archive_write_set_format_shar - , archive_write_set_format_shar_dump - , archive_write_set_format_ustar - , archive_write_set_format_v7tar - , archive_write_set_format_warc - , archive_write_set_format_xar - , archive_write_set_format_zip - , archive_write_set_format_filter_by_ext - , archive_write_set_format_filter_by_ext_def - , archive_write_zip_set_compression_deflate - , archive_write_zip_set_compression_store - , archive_write_open - , archive_write_open_fd - , archive_write_open_filename - , archive_write_open_filename_w - , archive_write_open_memory - , archive_write_data_block - , archive_write_finish_entry - , archive_write_close - , archive_write_fail - , archive_write_set_format_option - , archive_write_set_filter_option - , archive_write_set_option - , archive_write_set_options - , archive_write_set_passphrase - , archive_write_set_passphrase_callback - , archive_write_disk_new - , archive_write_disk_set_skip_file - , archive_write_disk_set_options - , archive_write_disk_set_standard_lookup - , archive_write_disk_set_group_lookup - , archive_write_disk_set_user_lookup - , archive_write_disk_gid - , archive_write_disk_uid - -- * Direct bindings (archive error) - , archive_errno - , archive_error_string - , archive_format_name - , archive_format - , archive_clear_error - , archive_set_error - , archive_copy_error - , archive_file_count - -- * Direct bindings (archive match) - , archive_match_new - , archive_match_free - , archiveMatchExcluded - , archiveMatchPathExcluded - , archive_match_exclude_pattern - , archive_match_exclude_pattern_w - , archiveMatchExcludePatternFromFile - , archiveMatchExcludePatternFromFileW - , archive_match_include_pattern - , archive_match_include_pattern_w - , archiveMatchIncludePatternFromFile - , archiveMatchIncludePatternFromFileW - , archive_match_path_unmatched_inclusions - , archive_match_path_unmatched_inclusions_next - , archive_match_path_unmatched_inclusions_next_w - , archiveMatchTimeExcluded - , archive_match_include_time - , archive_match_include_date - , archive_match_include_date_w - , archive_match_include_file_time - , archive_match_include_file_time_w - , archive_match_exclude_entry - , archiveMatchOwnerExcluded - , archive_match_include_uid - , archive_match_include_gid - , archive_match_include_uname - , archive_match_include_uname_w - , archive_match_include_gname - , archive_match_include_gname_w - -- * Direct bindings (version\/filter\/miscellaneous) - , archive_version_number - , archive_version_string - , archive_version_details - , archive_free - , archive_filter_count - , archive_filter_bytes - , archive_filter_code - , archive_filter_name - -- * Version macros - , archiveVersionNumber - , archiveVersionOnlyString - , archiveVersionString - -- * Capability macros - , archiveReadFormatCapsNone - , archiveReadFormatCapsEncryptData - , archiveReadFormatCapsEncryptMetadata - -- * Header read macros - , archiveOk - , archiveEOF - , archiveRetry - , archiveWarn - , archiveFailed - , archiveFatal - -- * Time matching macros - , archiveMatchMTime - , archiveMatchCTime - , archiveMatchNewer - , archiveMatchOlder - , archiveMatchEqual - -- * Entry flags - , archiveExtractOwner - , archiveExtractPerm - , archiveExtractTime - , archiveExtractNoOverwrite - , archiveExtractUnlink - , archiveExtractACL - , archiveExtractFFlags - , archiveExtractXattr - , archiveExtractSecureSymlinks - , archiveExtractSecureNoDotDot - , archiveExtractNoAutodir - , archiveExtractSparse - , archiveExtractMacMetadata - , archiveExtractNoHfsCompression - , archiveExtractHfsCompressionForced - , archiveExtractSecureNoAbsolutePaths - , archiveExtractClearNoChangeFFlags - -- * Filters - , archiveFilterNone - , archiveFilterGzip - , archiveFilterBzip2 - , archiveFilterCompress - , archiveFilterProgram - , archiveFilterLzma - , archiveFilterXz - , archiveFilterUu - , archiveFilterRpm - , archiveFilterLzip - , archiveFilterLrzip - , archiveFilterLzop - , archiveFilterGrzip - , archiveFilterLz4 - -- * Formats - , archiveFormatCpio - , archiveFormatShar - , archiveFormatTar - , archiveFormatIso9660 - , archiveFormatZip - , archiveFormatEmpty - , archiveFormatAr - , archiveFormatMtree - , archiveFormatRaw - , archiveFormatXar - , archiveFormatLha - , archiveFormatCab - , archiveFormatRar - , archiveFormat7zip - , archiveFormatWarc - -- * Read disk flags - , archiveReadDiskRestoreATime - , archiveReadDiskHonorNoDump - , archiveReadDiskMacCopyFile - , archiveReadDiskNoTraverseMounts - , archiveReadDiskNoXattr - -- * Abstract types - , Archive - -- * Haskell types - , ArchiveEncryption (..) - -- * Lower-level API types - , ArchiveError - , Flags - , ArchiveFilter - , ArchiveFormat - , ArchiveCapabilities - , ReadDiskFlags - , TimeFlag - -- * Callback types - , ArchiveReadCallback - , ArchiveSkipCallback - , ArchiveSeekCallback - , ArchiveWriteCallback - , ArchiveOpenCallback - , ArchiveCloseCallback - , ArchiveSwitchCallback - , ArchivePassphraseCallback - -- * Callback constructors - , noOpenCallback - , mkReadCallback - , mkSkipCallback - , mkSeekCallback - , mkWriteCallback - , mkOpenCallback - , mkCloseCallback - , mkSwitchCallback - , mkPassphraseCallback - , mkWriteLookup - , mkReadLookup - , mkCleanup - , mkMatch - , mkFilter - ) where - -import Codec.Archive.Foreign.Common -import Control.Composition ((.*), (.**)) -import Data.Bits (Bits (..)) -import Data.Int (Int64) -import Codec.Archive.Types -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import System.Posix.Types (Fd (..)) - --- Miscellaneous -foreign import ccall archive_version_number :: CInt -foreign import ccall archive_version_string :: CString -foreign import ccall archive_version_details :: CString - --- destructors: use "dynamic" instead of "wrapper" (but we don't want that) --- callbacks -foreign import ccall "wrapper" mkReadCallback :: ArchiveReadCallback a b -> IO (FunPtr (ArchiveReadCallback a b)) -foreign import ccall "wrapper" mkSkipCallback :: ArchiveSkipCallback a -> IO (FunPtr (ArchiveSkipCallback a)) -foreign import ccall "wrapper" mkSeekCallback :: ArchiveSeekCallback a -> IO (FunPtr (ArchiveSeekCallback a)) -foreign import ccall "wrapper" mkWriteCallback :: ArchiveWriteCallback a b -> IO (FunPtr (ArchiveWriteCallback a b)) -foreign import ccall "wrapper" mkOpenCallback :: ArchiveOpenCallback a -> IO (FunPtr (ArchiveOpenCallback a)) -foreign import ccall "wrapper" mkCloseCallback :: ArchiveCloseCallback a -> IO (FunPtr (ArchiveCloseCallback a)) -foreign import ccall "wrapper" mkSwitchCallback :: ArchiveSwitchCallback a b -> IO (FunPtr (ArchiveSwitchCallback a b)) -foreign import ccall "wrapper" mkPassphraseCallback :: ArchivePassphraseCallback a -> IO (FunPtr (ArchivePassphraseCallback a)) - --- | Don't use an open callback. This is the recommended argument to 'archive_open_reada -noOpenCallback :: FunPtr (ArchiveOpenCallback a) -noOpenCallback = castPtrToFunPtr nullPtr - -foreign import ccall "wrapper" mkWriteLookup :: (Ptr a -> CString -> Int64 -> IO Int64) -> IO (FunPtr (Ptr a -> CString -> Int64 -> IO Int64)) -foreign import ccall "wrapper" mkReadLookup :: (Ptr a -> Int64 -> IO CString) -> IO (FunPtr (Ptr a -> Int64 -> IO CString)) -foreign import ccall "wrapper" mkCleanup :: (Ptr a -> IO ()) -> IO (FunPtr (Ptr a -> IO ())) - -foreign import ccall "wrapper" mkMatch :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO ()) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO ())) -foreign import ccall "wrapper" preMkFilter :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt)) - -mkFilter :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO Bool) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt)) -mkFilter f = let f' = fmap boolToInt .** f in preMkFilter f' - -boolToInt :: Integral a => Bool -> a -boolToInt False = 0 -boolToInt True = 1 - -type ArchiveReadCallback a b = Ptr Archive -> Ptr a -> Ptr (Ptr b) -> IO CSize -type ArchiveSkipCallback a = Ptr Archive -> Ptr a -> Int64 -> IO Int64 -type ArchiveSeekCallback a = Ptr Archive -> Ptr a -> Int64 -> CInt -> IO Int64 -type ArchiveWriteCallback a b = Ptr Archive -> Ptr a -> Ptr b -> CSize -> IO CSize -type ArchiveOpenCallback a = Ptr Archive -> Ptr a -> IO ArchiveError -type ArchiveCloseCallback a = Ptr Archive -> Ptr a -> IO ArchiveError -type ArchiveSwitchCallback a b = Ptr Archive -> Ptr a -> Ptr b -> IO ArchiveError -type ArchivePassphraseCallback a = Ptr Archive -> Ptr a -> IO CString - --- Archive read -foreign import ccall archive_read_new :: IO (Ptr Archive) -foreign import ccall archive_read_support_filter_all :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_bzip2 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_compress :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_gzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_grzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_lrzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_lz4 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_lzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_lzma :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_lzop :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_none :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_program :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_read_support_filter_program_signature :: Ptr Archive -> CString -> CString -> CSize -> IO ArchiveError -foreign import ccall archive_read_support_filter_rpm :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_uu :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_filter_xz :: Ptr Archive -> IO ArchiveError --- foreign import ccall archive_read_support_filter_zstd :: Ptr Archive -> IO ArchiveError - -foreign import ccall archive_read_support_format_7zip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_all :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_ar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_by_code :: Ptr Archive -> CInt -> IO ArchiveError -foreign import ccall archive_read_support_format_cab :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_cpio :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_empty :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_gnutar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_iso9660 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_lha :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_mtree :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_rar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_raw :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_tar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_warc :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_xar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_zip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_zip_streamable :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_support_format_zip_seekable :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_set_format :: Ptr Archive -> ArchiveFormat -> IO ArchiveError -foreign import ccall archive_read_append_filter :: Ptr Archive -> ArchiveFilter -> IO ArchiveError -foreign import ccall archive_read_append_filter_program :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_read_append_filter_program_signature :: Ptr Archive -> CString -> Ptr a -> CSize -> IO ArchiveError -foreign import ccall archive_read_set_open_callback :: Ptr Archive -> FunPtr (ArchiveOpenCallback a) -> IO ArchiveError -foreign import ccall archive_read_set_read_callback :: Ptr Archive -> FunPtr (ArchiveReadCallback a b) -> IO ArchiveError -foreign import ccall archive_read_set_seek_callback :: Ptr Archive -> FunPtr (ArchiveSeekCallback a) -> IO ArchiveError -foreign import ccall archive_read_set_skip_callback :: Ptr Archive -> FunPtr (ArchiveSkipCallback a) -> IO ArchiveError -foreign import ccall archive_read_set_close_callback :: Ptr Archive -> FunPtr (ArchiveCloseCallback a) -> IO ArchiveError -foreign import ccall archive_read_set_switch_callback :: Ptr Archive -> FunPtr (ArchiveSwitchCallback a b) -> IO ArchiveError -foreign import ccall archive_read_set_callback_data :: Ptr Archive -> Ptr a -> IO ArchiveError -foreign import ccall archive_read_set_callback_data2 :: Ptr Archive -> Ptr a -> CUInt -> IO ArchiveError -foreign import ccall archive_read_add_callback_data :: Ptr Archive -> Ptr a -> CUInt -> IO ArchiveError -foreign import ccall archive_read_append_callback_data :: Ptr Archive -> Ptr a -> IO ArchiveError -foreign import ccall archive_read_prepend_callback_data :: Ptr Archive -> Ptr a -> IO ArchiveError -foreign import ccall archive_read_open1 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_open :: Ptr Archive -> Ptr a -> FunPtr (ArchiveOpenCallback a) -> FunPtr (ArchiveReadCallback a b) -> FunPtr (ArchiveCloseCallback a) -> IO ArchiveError -foreign import ccall archive_read_open2 :: Ptr Archive -> Ptr a -> FunPtr (ArchiveOpenCallback a) -> FunPtr (ArchiveReadCallback a b) -> FunPtr (ArchiveSkipCallback a) -> FunPtr (ArchiveCloseCallback a) -> IO ArchiveError -foreign import ccall archive_read_open_filename :: Ptr Archive -> CString -> CSize -> IO ArchiveError -foreign import ccall archive_read_open_filenames :: Ptr Archive -> Ptr CString -> CSize -> IO ArchiveError -foreign import ccall archive_read_open_filename_w :: Ptr Archive -> CWString -> CSize -> IO ArchiveError -foreign import ccall archive_read_open_memory :: Ptr Archive -> Ptr CChar -> CSize -> IO ArchiveError -foreign import ccall archive_read_open_memory2 :: Ptr Archive -> Ptr a -> CSize -> CSize -> IO ArchiveError -foreign import ccall archive_read_open_fd :: Ptr Archive -> Fd -> CSize -> IO ArchiveError --- foreign import ccall archive_read_open_FILE -foreign import ccall archive_read_next_header :: Ptr Archive -> Ptr (Ptr ArchiveEntry) -> IO ArchiveError -foreign import ccall archive_read_next_header2 :: Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveError -foreign import ccall archive_read_header_position :: Ptr Archive -> IO Int64 -foreign import ccall archive_read_has_encrypted_entries :: Ptr Archive -> IO CInt -foreign import ccall archive_read_format_capabilities :: Ptr Archive -> IO ArchiveCapabilities - -foreign import ccall archive_read_data :: Ptr Archive -> Ptr a -> CSize -> IO CSize -foreign import ccall archive_seek_data :: Ptr Archive -> Int64 -> CInt -> IO Int64 -foreign import ccall archive_read_data_block :: Ptr Archive -> Ptr (Ptr a) -> Ptr CSize -> Ptr Int64 -> IO ArchiveError -foreign import ccall archive_read_data_skip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_data_into_fd :: Ptr Archive -> Fd -> IO ArchiveError - -foreign import ccall archive_read_set_format_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_read_set_filter_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_read_set_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_read_set_options :: Ptr Archive -> CString -> IO ArchiveError - -foreign import ccall archive_read_add_passphrase :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_read_set_passphrase_callback :: Ptr Archive -> Ptr a -> FunPtr (ArchivePassphraseCallback a) -> IO ArchiveError - -foreign import ccall archive_read_extract :: Ptr Archive -> Ptr ArchiveEntry -> Flags -> IO ArchiveError -foreign import ccall archive_read_extract2 :: Ptr Archive -> Ptr ArchiveEntry -> Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_extract_set_progress_callback :: Ptr Archive -> (FunPtr (Ptr a -> IO ())) -> Ptr a -> IO () -foreign import ccall archive_read_extract_set_skip_file :: Ptr Archive -> Int64 -> Int64 -> IO () - -foreign import ccall archive_read_close :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_free :: Ptr Archive -> IO ArchiveError - --- Archive write -foreign import ccall archive_write_new :: IO (Ptr Archive) -foreign import ccall archive_write_set_bytes_per_block :: Ptr Archive -> CInt -> IO ArchiveError -foreign import ccall archive_write_get_bytes_per_block :: Ptr Archive -> IO CInt -foreign import ccall archive_write_set_bytes_in_last_block :: Ptr Archive -> CInt -> IO ArchiveError -foreign import ccall archive_write_get_bytes_in_last_block :: Ptr Archive -> IO CInt -foreign import ccall archive_write_set_skip_file :: Ptr Archive -> Int64 -> Int64 -> IO ArchiveError -foreign import ccall archive_write_add_filter :: Ptr Archive -> ArchiveFilter -> IO ArchiveError -foreign import ccall archive_write_add_filter_by_name :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_add_filter_b64encode :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_bzip2 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_compress :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_grzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_gzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_lrzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_lz4 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_lzip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_lzma :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_lzop :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_none :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_program :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_add_filter_uuencode :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_add_filter_xz :: Ptr Archive -> IO ArchiveError --- foreign import ccall archive_write_add_filter_zstd :: Ptr Archive -> IO ArchiveError - -foreign import ccall archive_write_set_format :: Ptr Archive -> ArchiveFormat -> IO ArchiveError -foreign import ccall archive_write_set_format_by_name :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_set_format_7zip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_ar_bsd :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_ar_svr4 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_cpio :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_cpio_newc :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_gnutar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_iso9660 :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_mtree :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_mtree_classic :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_pax :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_pax_restricted :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_raw :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_shar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_shar_dump :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_ustar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_v7tar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_warc :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_xar :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_zip :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_set_format_filter_by_ext :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_set_format_filter_by_ext_def :: Ptr Archive -> CString -> CString -> IO ArchiveError -foreign import ccall archive_write_zip_set_compression_deflate :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_zip_set_compression_store :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_open :: Ptr Archive -> Ptr a -> FunPtr (ArchiveOpenCallback a) -> FunPtr (ArchiveWriteCallback a b) -> FunPtr (ArchiveCloseCallback a) -> IO ArchiveError -foreign import ccall archive_write_open_fd :: Ptr Archive -> Fd -> IO ArchiveError -foreign import ccall archive_write_open_filename :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_open_filename_w :: Ptr Archive -> CWString -> IO ArchiveError --- foreign import ccall archive_write_open_FILE -foreign import ccall archive_write_open_memory :: Ptr Archive -> Ptr a -> CSize -> Ptr CSize -> IO ArchiveError - -foreign import ccall archive_write_header :: Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveError -foreign import ccall archive_write_data :: Ptr Archive -> Ptr a -> CSize -> IO CSize - -foreign import ccall archive_write_data_block :: Ptr Archive -> Ptr a -> CSize -> Int64 -> IO ArchiveError - -foreign import ccall archive_write_finish_entry :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_close :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_fail :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_free :: Ptr Archive -> IO ArchiveError - -foreign import ccall archive_write_set_format_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_write_set_filter_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_write_set_option :: Ptr Archive -> CString -> CString -> CString -> IO ArchiveError -foreign import ccall archive_write_set_options :: Ptr Archive -> CString -> IO ArchiveError - -foreign import ccall archive_write_set_passphrase :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_write_set_passphrase_callback :: Ptr Archive -> Ptr a -> FunPtr (ArchivePassphraseCallback a) -> IO ArchiveError - -foreign import ccall archive_write_disk_new :: IO (Ptr Archive) -foreign import ccall archive_write_disk_set_skip_file :: Ptr Archive -> Int64 -> Int64 -> IO ArchiveError -foreign import ccall archive_write_disk_set_options :: Ptr Archive -> Flags -> IO ArchiveError - -foreign import ccall archive_write_disk_set_standard_lookup :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_write_disk_set_group_lookup :: Ptr Archive -> Ptr a -> FunPtr (Ptr a -> CString -> Int64 -> IO Int64) -> FunPtr (Ptr a -> IO ()) -> IO ArchiveError -foreign import ccall archive_write_disk_set_user_lookup :: Ptr Archive -> Ptr a -> FunPtr (Ptr a -> CString -> Int64 -> IO Int64) -> FunPtr (Ptr a -> IO ()) -> IO ArchiveError -foreign import ccall archive_write_disk_gid :: Ptr Archive -> CString -> Int64 -> IO Int64 -foreign import ccall archive_write_disk_uid :: Ptr Archive -> CString -> Int64 -> IO Int64 - -foreign import ccall archive_read_disk_new :: IO (Ptr Archive) -foreign import ccall archive_read_disk_set_symlink_logical :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_set_symlink_physical :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_set_symlink_hybrid :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_entry_from_file :: Ptr Archive -> Ptr ArchiveEntry -> Fd -> Ptr Stat -> IO ArchiveError -foreign import ccall archive_read_disk_gname :: Ptr Archive -> Int64 -> IO CString -foreign import ccall archive_read_disk_uname :: Ptr Archive -> Int64 -> IO CString -foreign import ccall archive_read_disk_set_standard_lookup :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_set_gname_lookup :: Ptr Archive -> Ptr a -> FunPtr (Ptr a -> Int64 -> IO CString) -> FunPtr (Ptr a -> IO ()) -> IO ArchiveError -foreign import ccall archive_read_disk_set_uname_lookup :: Ptr Archive -> Ptr a -> FunPtr (Ptr a -> Int64 -> IO CString) -> FunPtr (Ptr a -> IO ()) -> IO ArchiveError -foreign import ccall archive_read_disk_open :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_read_disk_open_w :: Ptr Archive -> CWString -> IO ArchiveError -foreign import ccall archive_read_disk_descend :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_can_descend :: Ptr Archive -> IO CInt -foreign import ccall archive_read_disk_current_filesystem :: Ptr Archive -> IO CInt -foreign import ccall archive_read_disk_current_filesystem_is_synthetic :: Ptr Archive -> IO CInt -foreign import ccall archive_read_disk_current_filesystem_is_remote :: Ptr Archive -> IO CInt -foreign import ccall archive_read_disk_set_atime_restored :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_read_disk_set_behavior :: Ptr Archive -> ReadDiskFlags -> IO ArchiveError - -foreign import ccall archive_read_disk_set_matching :: Ptr Archive -> Ptr Archive -> FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO ()) -> Ptr a -> IO ArchiveError -foreign import ccall archive_read_disk_set_metadata_filter_callback :: Ptr Archive -> FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt) -> Ptr a -> IO ArchiveError - -foreign import ccall archive_free :: Ptr Archive -> IO ArchiveError - -foreign import ccall archive_filter_count :: Ptr Archive -> IO CInt -foreign import ccall archive_filter_bytes :: Ptr Archive -> CInt -> Int64 -foreign import ccall archive_filter_code :: Ptr Archive -> CInt -> IO Int -foreign import ccall archive_filter_name :: Ptr Archive -> CInt -> IO CString - -foreign import ccall archive_errno :: Ptr Archive -> IO CInt -foreign import ccall archive_error_string :: Ptr Archive -> IO CString -foreign import ccall archive_format_name :: Ptr Archive -> IO CString -foreign import ccall archive_format :: Ptr Archive -> IO ArchiveFormat -foreign import ccall archive_clear_error :: Ptr Archive -> IO () -foreign import ccall archive_set_error :: Ptr Archive -> CInt -> CString -> IO () -- TODO: variadic lol -foreign import ccall archive_copy_error :: Ptr Archive -> Ptr Archive -> IO () -foreign import ccall archive_file_count :: Ptr Archive -> IO CInt - -foreign import ccall archive_match_new :: Ptr Archive -foreign import ccall archive_match_free :: Ptr Archive -> IO ArchiveError -foreign import ccall archive_match_excluded :: Ptr Archive -> IO CInt -foreign import ccall archive_match_path_excluded :: Ptr Archive -> Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_match_exclude_pattern :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_match_exclude_pattern_w :: Ptr Archive -> CWString -> IO ArchiveError -foreign import ccall archive_match_exclude_pattern_from_file :: Ptr Archive -> CString -> CInt -> IO ArchiveError -foreign import ccall archive_match_exclude_pattern_from_file_w :: Ptr Archive -> CWString -> CInt -> IO ArchiveError -foreign import ccall archive_match_include_pattern :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_match_include_pattern_w :: Ptr Archive -> CWString -> IO ArchiveError -foreign import ccall archive_match_include_pattern_from_file :: Ptr Archive -> CString -> CInt -> IO ArchiveError -foreign import ccall archive_match_include_pattern_from_file_w :: Ptr Archive -> CString -> CInt -> IO ArchiveError -foreign import ccall archive_match_path_unmatched_inclusions :: Ptr Archive -> IO CInt -foreign import ccall archive_match_path_unmatched_inclusions_next :: Ptr Archive -> Ptr CString -> IO ArchiveError -foreign import ccall archive_match_path_unmatched_inclusions_next_w :: Ptr Archive -> Ptr CWString -> IO ArchiveError -foreign import ccall archive_match_time_excluded :: Ptr Archive -> Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_match_include_time :: Ptr Archive -> TimeFlag -> CTime -> CLong -> IO ArchiveError -foreign import ccall archive_match_include_date :: Ptr Archive -> TimeFlag -> CString -> IO ArchiveError -foreign import ccall archive_match_include_date_w :: Ptr Archive -> TimeFlag -> CWString -> IO ArchiveError -foreign import ccall archive_match_include_file_time :: Ptr Archive -> TimeFlag -> CString -> IO ArchiveError -foreign import ccall archive_match_include_file_time_w :: Ptr Archive -> TimeFlag -> CWString -> IO ArchiveError -foreign import ccall archive_match_exclude_entry :: Ptr Archive -> TimeFlag -> Ptr ArchiveEntry -> IO ArchiveError -foreign import ccall archive_match_owner_excluded :: Ptr Archive -> Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_match_include_gid :: Ptr Archive -> Id -> IO ArchiveError -foreign import ccall archive_match_include_uid :: Ptr Archive -> Id -> IO ArchiveError -foreign import ccall archive_match_include_uname :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_match_include_uname_w :: Ptr Archive -> CWString -> IO ArchiveError -foreign import ccall archive_match_include_gname :: Ptr Archive -> CString -> IO ArchiveError -foreign import ccall archive_match_include_gname_w :: Ptr Archive -> CWString -> IO ArchiveError - -#include - -archiveVersionNumber :: Int -archiveVersionNumber = {# const ARCHIVE_VERSION_NUMBER #} - -archiveVersionOnlyString :: String -archiveVersionOnlyString = {# const ARCHIVE_VERSION_ONLY_STRING #} - -archiveVersionString :: String -archiveVersionString = {# const ARCHIVE_VERSION_STRING #} - --- TODO: make ArchiveError a sum type -archiveOk :: ArchiveError -archiveOk = ArchiveError {# const ARCHIVE_OK #} - -archiveEOF :: ArchiveError -archiveEOF = ArchiveError {# const ARCHIVE_EOF #} - -archiveRetry :: ArchiveError -archiveRetry = ArchiveError ({# const ARCHIVE_RETRY #}) - -archiveWarn :: ArchiveError -archiveWarn = ArchiveError ({# const ARCHIVE_WARN #}) - -archiveFailed :: ArchiveError -archiveFailed = ArchiveError ({# const ARCHIVE_FAILED #}) - -archiveFatal :: ArchiveError -archiveFatal = ArchiveError ({# const ARCHIVE_FATAL #}) - --- Archive filter -archiveFilterNone :: ArchiveFilter -archiveFilterNone = ArchiveFilter {# const ARCHIVE_FILTER_NONE #} - -archiveFilterGzip :: ArchiveFilter -archiveFilterGzip = ArchiveFilter {# const ARCHIVE_FILTER_GZIP #} - -archiveFilterBzip2 :: ArchiveFilter -archiveFilterBzip2 = ArchiveFilter {# const ARCHIVE_FILTER_BZIP2 #} - -archiveFilterCompress :: ArchiveFilter -archiveFilterCompress = ArchiveFilter {# const ARCHIVE_FILTER_COMPRESS #} - -archiveFilterProgram :: ArchiveFilter -archiveFilterProgram = ArchiveFilter {# const ARCHIVE_FILTER_PROGRAM #} - -archiveFilterLzma :: ArchiveFilter -archiveFilterLzma = ArchiveFilter {# const ARCHIVE_FILTER_LZMA #} - -archiveFilterXz :: ArchiveFilter -archiveFilterXz = ArchiveFilter {# const ARCHIVE_FILTER_XZ #} - -archiveFilterUu :: ArchiveFilter -archiveFilterUu = ArchiveFilter {# const ARCHIVE_FILTER_UU #} - -archiveFilterRpm :: ArchiveFilter -archiveFilterRpm = ArchiveFilter {# const ARCHIVE_FILTER_RPM #} - -archiveFilterLzip :: ArchiveFilter -archiveFilterLzip = ArchiveFilter {# const ARCHIVE_FILTER_LZIP #} - -archiveFilterLrzip :: ArchiveFilter -archiveFilterLrzip = ArchiveFilter {# const ARCHIVE_FILTER_LRZIP #} - -archiveFilterLzop :: ArchiveFilter -archiveFilterLzop = ArchiveFilter {# const ARCHIVE_FILTER_LZOP #} - -archiveFilterGrzip :: ArchiveFilter -archiveFilterGrzip = ArchiveFilter {# const ARCHIVE_FILTER_GRZIP #} - -archiveFilterLz4 :: ArchiveFilter -archiveFilterLz4 = ArchiveFilter {# const ARCHIVE_FILTER_LZ4 #} - --- Extraction flags -archiveExtractOwner :: Flags -archiveExtractOwner = Flags {# const ARCHIVE_EXTRACT_OWNER #} - -archiveExtractPerm :: Flags -archiveExtractPerm = Flags {# const ARCHIVE_EXTRACT_PERM #} - -archiveExtractTime :: Flags -archiveExtractTime = Flags {# const ARCHIVE_EXTRACT_TIME #} - -archiveExtractNoOverwrite :: Flags -archiveExtractNoOverwrite = Flags {# const ARCHIVE_EXTRACT_NO_OVERWRITE #} - -archiveExtractUnlink :: Flags -archiveExtractUnlink = Flags {# const ARCHIVE_EXTRACT_UNLINK #} - -archiveExtractACL :: Flags -archiveExtractACL = Flags {# const ARCHIVE_EXTRACT_ACL #} - -archiveExtractFFlags :: Flags -archiveExtractFFlags = Flags {# const ARCHIVE_EXTRACT_FFLAGS #} - -archiveExtractXattr :: Flags -archiveExtractXattr = Flags {# const ARCHIVE_EXTRACT_XATTR #} - -archiveExtractSecureSymlinks :: Flags -archiveExtractSecureSymlinks = Flags {# const ARCHIVE_EXTRACT_SECURE_SYMLINKS #} - -archiveExtractSecureNoDotDot :: Flags -archiveExtractSecureNoDotDot = Flags {# const ARCHIVE_EXTRACT_SECURE_NODOTDOT #} - -archiveExtractNoAutodir :: Flags -archiveExtractNoAutodir = Flags {# const ARCHIVE_EXTRACT_NO_AUTODIR #} - --- archiveExtractNoOverwriteNewer :: Flags --- archiveExtractNoOverwriteNewer = Flags {# const ARCHIVE_NO_OVERWRITE_NEWER #} - -archiveExtractSparse :: Flags -archiveExtractSparse = Flags {# const ARCHIVE_EXTRACT_SPARSE #} - -archiveExtractMacMetadata :: Flags -archiveExtractMacMetadata = Flags {# const ARCHIVE_EXTRACT_MAC_METADATA #} - -archiveExtractNoHfsCompression :: Flags -archiveExtractNoHfsCompression = Flags {# const ARCHIVE_EXTRACT_NO_HFS_COMPRESSION #} - -archiveExtractHfsCompressionForced :: Flags -archiveExtractHfsCompressionForced = Flags {# const ARCHIVE_EXTRACT_HFS_COMPRESSION_FORCED #} - -archiveExtractSecureNoAbsolutePaths :: Flags -archiveExtractSecureNoAbsolutePaths = Flags {# const ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS #} - -archiveExtractClearNoChangeFFlags :: Flags -archiveExtractClearNoChangeFFlags = Flags {# const ARCHIVE_EXTRACT_CLEAR_NOCHANGE_FFLAGS #} - -archiveFormatCpio :: ArchiveFormat -archiveFormatCpio = ArchiveFormat {# const ARCHIVE_FORMAT_CPIO #} - -archiveFormatShar :: ArchiveFormat -archiveFormatShar = ArchiveFormat {# const ARCHIVE_FORMAT_SHAR #} - -archiveFormatTar :: ArchiveFormat -archiveFormatTar = ArchiveFormat {# const ARCHIVE_FORMAT_TAR #} - -archiveFormatIso9660 :: ArchiveFormat -archiveFormatIso9660 = ArchiveFormat {# const ARCHIVE_FORMAT_ISO9660 #} - -archiveFormatZip :: ArchiveFormat -archiveFormatZip = ArchiveFormat {# const ARCHIVE_FORMAT_ZIP #} - -archiveFormatEmpty :: ArchiveFormat -archiveFormatEmpty = ArchiveFormat {# const ARCHIVE_FORMAT_EMPTY #} - -archiveFormatAr :: ArchiveFormat -archiveFormatAr = ArchiveFormat {# const ARCHIVE_FORMAT_AR #} - -archiveFormatMtree :: ArchiveFormat -archiveFormatMtree = ArchiveFormat {# const ARCHIVE_FORMAT_MTREE #} - -archiveFormatRaw :: ArchiveFormat -archiveFormatRaw = ArchiveFormat {# const ARCHIVE_FORMAT_RAW #} - -archiveFormatXar :: ArchiveFormat -archiveFormatXar = ArchiveFormat {# const ARCHIVE_FORMAT_XAR #} - -archiveFormatLha :: ArchiveFormat -archiveFormatLha = ArchiveFormat {# const ARCHIVE_FORMAT_LHA #} - -archiveFormatCab :: ArchiveFormat -archiveFormatCab = ArchiveFormat {# const ARCHIVE_FORMAT_CAB #} - -archiveFormatRar :: ArchiveFormat -archiveFormatRar = ArchiveFormat {# const ARCHIVE_FORMAT_RAR #} - -archiveFormat7zip :: ArchiveFormat -archiveFormat7zip = ArchiveFormat {# const ARCHIVE_FORMAT_7ZIP #} - -archiveFormatWarc :: ArchiveFormat -archiveFormatWarc = ArchiveFormat {# const ARCHIVE_FORMAT_WARC #} - -archiveReadHasEncryptedEntries :: Ptr Archive -> IO ArchiveEncryption -archiveReadHasEncryptedEntries = fmap encryptionResult . archive_read_has_encrypted_entries - -encryptionResult :: CInt -> ArchiveEncryption -encryptionResult 0 = NoEncryption -encryptionResult 1 = HasEncryption -encryptionResult ({# const ARCHIVE_READ_FORMAT_ENCRYPTION_UNSUPPORTED #}) = EncryptionUnsupported -encryptionResult ({# const ARCHIVE_READ_FORMAT_ENCRYPTION_DONT_KNOW #}) = EncryptionUnknown -encryptionResult _ = error "Should not happen." - -archiveReadFormatCapsNone :: ArchiveCapabilities -archiveReadFormatCapsNone = ArchiveCapabilities {# const ARCHIVE_READ_FORMAT_CAPS_NONE #} - -(<<) :: Bits a => a -> Int -> a -m << n = m `shift` n - -archiveReadFormatCapsEncryptData :: ArchiveCapabilities -archiveReadFormatCapsEncryptData = ArchiveCapabilities ({# const ARCHIVE_READ_FORMAT_CAPS_ENCRYPT_DATA #}) - -archiveReadFormatCapsEncryptMetadata :: ArchiveCapabilities -archiveReadFormatCapsEncryptMetadata = ArchiveCapabilities ({# const ARCHIVE_READ_FORMAT_CAPS_ENCRYPT_DATA #}) - -archiveReadDiskCanDescend :: Ptr Archive -> IO Bool -archiveReadDiskCanDescend = fmap intToBool . archive_read_disk_can_descend - -archiveReadDiskCurrentFilesystemIsSynthetic :: Ptr Archive -> IO Bool -archiveReadDiskCurrentFilesystemIsSynthetic = fmap intToBool . archive_read_disk_current_filesystem_is_synthetic - -archiveReadDiskCurrentFilesystemIsRemote :: Ptr Archive -> IO Bool -archiveReadDiskCurrentFilesystemIsRemote = fmap intToBool . archive_read_disk_current_filesystem_is_remote - -archiveReadDiskRestoreATime :: ReadDiskFlags -archiveReadDiskRestoreATime = ReadDiskFlags {# const ARCHIVE_READDISK_RESTORE_ATIME #} - -archiveReadDiskHonorNoDump :: ReadDiskFlags -archiveReadDiskHonorNoDump = ReadDiskFlags {# const ARCHIVE_READDISK_HONOR_NODUMP #} - -archiveReadDiskMacCopyFile :: ReadDiskFlags -archiveReadDiskMacCopyFile = ReadDiskFlags {# const ARCHIVE_READDISK_MAC_COPYFILE #} - -archiveReadDiskNoTraverseMounts :: ReadDiskFlags -archiveReadDiskNoTraverseMounts = ReadDiskFlags {# const ARCHIVE_READDISK_NO_TRAVERSE_MOUNTS #} - -archiveReadDiskNoXattr :: ReadDiskFlags -archiveReadDiskNoXattr = ReadDiskFlags {# const ARCHIVE_READDISK_NO_XATTR #} - --- archiveReadDiskNoAcl :: ReadDiskFlags --- archiveReadDiskNoAcl = ReadDiskFlags {# const ARCHIVE_READDISK_NO_ACL #} - --- archiveReadDiskNoFFlags :: ReadDiskFlags --- archiveReadDiskNoFFlags = ReadDiskFlags {# const ARCHIVE_READDISK_NO_FFLAGS #} - -archiveMatchExcluded :: Ptr Archive -> IO Bool -archiveMatchExcluded = fmap intToBool . archive_match_excluded - -archiveMatchPathExcluded :: Ptr Archive -> Ptr ArchiveEntry -> IO Bool -archiveMatchPathExcluded = fmap intToBool .* archive_match_path_excluded - -archiveMatchExcludePatternFromFile :: Ptr Archive -> CString -> Bool -> IO ArchiveError -archiveMatchExcludePatternFromFile a str b = archive_match_exclude_pattern_from_file a str (boolToInt b) - -archiveMatchExcludePatternFromFileW :: Ptr Archive -> CWString -> Bool -> IO ArchiveError -archiveMatchExcludePatternFromFileW a str b = archive_match_exclude_pattern_from_file_w a str (boolToInt b) - -archiveMatchIncludePatternFromFile :: Ptr Archive -> CString -> Bool -> IO ArchiveError -archiveMatchIncludePatternFromFile a str b = archive_match_include_pattern_from_file a str (boolToInt b) - -archiveMatchIncludePatternFromFileW :: Ptr Archive -> CString -> Bool -> IO ArchiveError -archiveMatchIncludePatternFromFileW a str b = archive_match_include_pattern_from_file_w a str (boolToInt b) - -archiveMatchTimeExcluded :: Ptr Archive -> Ptr ArchiveEntry -> IO Bool -archiveMatchTimeExcluded = fmap intToBool .* archive_match_time_excluded - -archiveMatchMTime :: TimeFlag -archiveMatchMTime = TimeFlag {# const ARCHIVE_MATCH_MTIME #} - -archiveMatchCTime :: TimeFlag -archiveMatchCTime = TimeFlag {# const ARCHIVE_MATCH_CTIME #} - -archiveMatchNewer :: TimeFlag -archiveMatchNewer = TimeFlag {# const ARCHIVE_MATCH_NEWER #} - -archiveMatchOlder :: TimeFlag -archiveMatchOlder = TimeFlag {# const ARCHIVE_MATCH_OLDER #} - -archiveMatchEqual :: TimeFlag -archiveMatchEqual = TimeFlag {# const ARCHIVE_MATCH_EQUAL #} - -archiveMatchOwnerExcluded :: Ptr Archive -> Ptr ArchiveEntry -> IO Bool -archiveMatchOwnerExcluded = fmap intToBool .* archive_match_owner_excluded +-- +-- Functions in this module are stateful and hence take place in the 'IO' +-- monad. +module Codec.Archive.Foreign.Archive ( archiveReadHasEncryptedEntries + -- * Version information + , archiveVersionNumber + , archiveVersionString + , archiveVersionDetails + , archiveZlibVersion + , archiveLiblzmaVersion + , archiveBzlibVersion + , archiveLiblz4Version + , archiveLibzstdVersion + -- * Miscellany + , archiveErrorString + , archiveFormatName + , archiveFormat + , archiveClearError + , archiveSetError + , archiveCopyError + , archiveFileCount + , archiveFilterCount + , archiveFilterBytes + , archiveFilterCode + , archiveFilterName + -- * Read + , archiveReadData + , archiveReadNew + , archiveReadSetOpenCallback + , archiveReadSetSeekCallback + , archiveReadSetSkipCallback + , archiveReadSetSwitchCallback + , archiveReadSetCallbackData2 + , archiveReadAddCallbackData + , archiveReadAppendCallbackData + , archiveReadPrependCallbackData + , archiveReadSetReadCallback + , archiveReadSetCloseCallback + , archiveReadSetCallbackData + , archiveReadSetFormat + , archiveReadOpen + , archiveReadOpenFilename + , archiveReadOpenFilenameW + , archiveReadOpenFilenames + , archiveReadOpenMemory + , archiveReadOpen1 + , archiveReadOpen2 + , archiveReadOpenFd + , archiveReadOpenFILE + , archiveReadNextHeader + , archiveReadNextHeader2 + , archiveReadHeaderPosition + , archiveReadFormatCapabilities + , archiveSeekData + , archiveReadDataBlock + , archiveReadDataIntoFd + , archiveReadSetFormatOption + , archiveReadSetFilterOption + , archiveReadSetOption + , archiveReadSetOptions + , archiveReadAddPassphrase + , archiveReadSetPassphraseCallback + , archiveReadExtract + , archiveReadExtract2 + , archiveReadExtractSetProgressCallback + , archiveReadExtractSetSkipFile + , archiveReadClose + , archiveReadFree + , archiveReadSupportFilterAll + , archiveReadSupportFilterBzip2 + , archiveReadSupportFilterCompress + , archiveReadSupportFilterGzip + , archiveReadSupportFilterGrzip + , archiveReadSupportFilterLrzip + , archiveReadSupportFilterLz4 + , archiveReadSupportFilterLzip + , archiveReadSupportFilterLzma + , archiveReadSupportFilterLzop + , archiveReadSupportFilterNone + , archiveReadSupportFilterProgram + , archiveReadSupportFilterProgramSignature + , archiveReadSupportFilterRpm + , archiveReadSupportFilterUu + , archiveReadSupportFilterXz + , archiveReadSupportFormatAll + , archiveReadSupportFormat7zip + , archiveReadSupportFormatAr + , archiveReadSupportFormatByCode + , archiveReadSupportFormatCab + , archiveReadSupportFormatCpio + , archiveReadSupportFormatEmpty + , archiveReadSupportFormatGnutar + , archiveReadSupportFormatIso9660 + , archiveReadSupportFormatLha + , archiveReadSupportFormatMtree + , archiveReadSupportFormatRar + , archiveReadSupportFormatRar5 + , archiveReadSupportFormatRaw + , archiveReadSupportFormatTar + , archiveReadSupportFormatWarc + , archiveReadSupportFormatXar + , archiveReadSupportFormatZip + , archiveReadSupportFormatZipStreamable + , archiveReadSupportFormatZipSeekable + , archiveReadAppendFilter + , archiveReadAppendFilterProgram + , archiveReadAppendFilterProgramSignature + -- * Write + , archiveWriteOpenMemory + , archiveWriteNew + , archiveWriteData + , archiveWriteOpen + , archiveWriteClose + , archiveWriteHeader + , archiveWriteSetBytesPerBlock + , archiveWriteGetBytesPerBlock + , archiveWriteSetBytesInLastBlock + , archiveWriteGetBytesInLastBlock + , archiveWriteSetSkipFile + , archiveWriteAddFilter + , archiveWriteAddFilterByName + , archiveWriteAddFilterB64encode + , archiveWriteAddFilterBzip2 + , archiveWriteAddFilterCompress + , archiveWriteAddFilterGrzip + , archiveWriteAddFilterLrzip + , archiveWriteAddFilterLz4 + , archiveWriteAddFilterLzma + , archiveWriteAddFilterLzip + , archiveWriteAddFilterLzop + , archiveWriteAddFilterNone + , archiveWriteAddFilterProgram + , archiveWriteAddFilterUuencode + , archiveWriteAddFilterXz + , archiveWriteAddFilterZstd + , archiveWriteSetFormat + , archiveWriteSetFormatByName + , archiveWriteSetFormatArBsd + , archiveWriteSetFormatArSvr4 + , archiveWriteSetFormatCpio + , archiveWriteSetFormatCpioNewc + , archiveWriteSetFormatGnutar + , archiveWriteSetFormatMtree + , archiveWriteSetFormatMtreeClassic + , archiveWriteSetFormatPax + , archiveWriteSetFormatPaxRestricted + , archiveWriteSetFormatZip + , archiveWriteSetFormat7zip + , archiveWriteSetFormatRaw + , archiveWriteSetFormatShar + , archiveWriteSetFormatSharDump + , archiveWriteSetFormatUstar + , archiveWriteSetFormatV7tar + , archiveWriteSetFormatWarc + , archiveWriteSetFormatXar + , archiveWriteSetFormatFilterByExt + , archiveWriteSetFormatFilterByExtDef + , archiveWriteZipSetCompressionDeflate + , archiveWriteZipSetCompressionStore + , archiveWriteOpenFd + , archiveWriteOpenFilenameW + , archiveWriteOpenFilename + , archiveWriteOpenFILE + , archiveWriteDataBlock + , archiveWriteFinishEntry + , archiveWriteFail + , archiveWriteFree + , archiveWriteSetFormatOption + , archiveWriteSetFilterOption + , archiveWriteSetOption + , archiveWriteSetOptions + , archiveWriteSetPassphrase + , archiveWriteSetPassphraseCallback + -- * Write disk + , archiveWriteDiskSetOptions + , archiveWriteDiskNew + , archiveWriteDiskSetSkipFile + , archiveWriteDiskSetStandardLookup + , archiveWriteDiskSetGroupLookup + , archiveWriteDiskSetUserLookup + , archiveWriteDiskGid + , archiveWriteDiskUid + -- * Read disk + , archiveReadDiskNew + , archiveReadDiskSetSymlinkLogical + , archiveReadDiskSetSymlinkPhysical + , archiveReadDiskSetSymlinkHybrid + , archiveReadDiskEntryFromFile + , archiveReadDiskGname + , archiveReadDiskUname + , archiveReadDiskSetStandardLookup + , archiveReadDiskSetGnameLookup + , archiveReadDiskSetUnameLookup + , archiveReadDiskOpen + , archiveReadDiskOpenW + , archiveReadDiskDescend + , archiveReadDiskCanDescend + , archiveReadDiskCurrentFilesystem + , archiveReadDiskCurrentFilesystemIsSynthetic + , archiveReadDiskCurrentFilesystemIsRemote + , archiveReadDiskSetAtimeRestored + , archiveReadDiskSetBehavior + , archiveReadDiskSetMatching + , archiveReadDiskSetMetadataFilterCallback + -- * Version macros + , archiveVersionNumberMacro + , archiveVersionOnlyString + , archiveVersionStringMacro + -- * Capability macros + , archiveReadFormatCapsNone + , archiveReadFormatCapsEncryptData + , archiveReadFormatCapsEncryptMetadata + -- * Time matching macros + , archiveMatchMTime + , archiveMatchCTime + , archiveMatchNewer + , archiveMatchOlder + , archiveMatchEqual + -- * Entry flags + , archiveExtractOwner + , archiveExtractPerm + , archiveExtractTime + , archiveExtractNoOverwrite + , archiveExtractUnlink + , archiveExtractACL + , archiveExtractFFlags + , archiveExtractXattr + , archiveExtractSecureSymlinks + , archiveExtractSecureNoDotDot + , archiveExtractNoAutodir + , archiveExtractSparse + , archiveExtractMacMetadata + , archiveExtractNoHfsCompression + , archiveExtractHfsCompressionForced + , archiveExtractSecureNoAbsolutePaths + , archiveExtractClearNoChangeFFlags + , archiveExtractNoOverwriteNewer + -- * Read disk flags + , archiveReadDiskRestoreATime + , archiveReadDiskHonorNoDump + , archiveReadDiskMacCopyFile + , archiveReadDiskNoTraverseMounts + , archiveReadDiskNoXattr + , archiveFree + , archiveMatchExcluded + , archiveMatchPathExcluded + , archiveMatchSetInclusionRecursion + , archiveMatchExcludePattern + , archiveMatchExcludePatternW + , archiveMatchIncludePattern + , archiveMatchIncludePatternW + , archiveMatchExcludePatternFromFile + , archiveMatchExcludePatternFromFileW + , archiveMatchIncludePatternFromFile + , archiveMatchIncludePatternFromFileW + , archiveMatchPathUnmatchedInclusions + , archiveMatchPathUnmatchedInclusionsNext + , archiveMatchPathUnmatchedInclusionsNextW + , archiveMatchIncludeTime + , archiveMatchIncludeDate + , archiveMatchIncludeDateW + , archiveMatchIncludeFileTime + , archiveMatchIncludeFileTimeW + , archiveMatchTimeExcluded + , archiveMatchOwnerExcluded + , archiveMatchExcludeEntry + , archiveReadDataSkip + , archiveMatchIncludeGname + , archiveMatchIncludeGnameW + , archiveMatchIncludeUname + , archiveMatchIncludeUnameW + , archiveMatchIncludeUid + , archiveMatchIncludeGid + , archiveErrno + -- * Abstract types + , Archive + -- * Haskell types + , ArchiveEncryption (..) + -- * Enum types + , ArchiveFilter (..) + , ArchiveFormat (..) + -- * Lower-level API types + , Flags + , ArchiveCapabilities + , ReadDiskFlags + , TimeFlag + -- * Callback types + , ArchiveReadCallback + , ArchiveSkipCallback + , ArchiveSeekCallback + , ArchiveWriteCallback + , ArchiveOpenCallback + , ArchiveCloseCallback + , ArchiveSwitchCallback + , ArchiveOpenCallbackRaw + , ArchiveCloseCallbackRaw + , ArchiveSwitchCallbackRaw + , ArchivePassphraseCallback + -- * Callback constructors + , noOpenCallback + , mkReadCallback + , mkSkipCallback + , mkSeekCallback + , mkWriteCallback + , mkPassphraseCallback + , mkOpenCallback + , mkCloseCallback + , mkSwitchCallback + , mkWriteLookup + , mkReadLookup + , mkCleanup + , mkMatch + , mkFilter + , mkExcludedCallback + -- * Type synonyms + , ArchiveEntryPtr + , ArchivePtr + , StatPtr + -- * libarchive types + , LaInt64 + , LaSSize + ) where + +{# import qualified Codec.Archive.Types.Foreign #} + +import Codec.Archive.Foreign.Archive.Macros +import Codec.Archive.Types +import Control.Composition ((.*), (.**)) +import Data.Coerce (coerce) +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr +import Foreign.Storable (Storable (peek)) +import System.Posix.Types (Fd (..)) + +-- destructors: use "dynamic" instead of "wrapper" (but we don't want that) +-- callbacks +foreign import ccall "wrapper" mkReadCallback :: ArchiveReadCallback a b -> IO (FunPtr (ArchiveReadCallback a b)) +foreign import ccall "wrapper" mkSkipCallback :: ArchiveSkipCallback a -> IO (FunPtr (ArchiveSkipCallback a)) +foreign import ccall "wrapper" mkSeekCallback :: ArchiveSeekCallback a -> IO (FunPtr (ArchiveSeekCallback a)) +foreign import ccall "wrapper" mkWriteCallback :: ArchiveWriteCallback a b -> IO (FunPtr (ArchiveWriteCallback a b)) +foreign import ccall "wrapper" mkOpenCallbackRaw :: ArchiveOpenCallbackRaw a -> IO (FunPtr (ArchiveOpenCallbackRaw a)) +foreign import ccall "wrapper" mkCloseCallbackRaw :: ArchiveCloseCallbackRaw a -> IO (FunPtr (ArchiveCloseCallbackRaw a)) +foreign import ccall "wrapper" mkSwitchCallbackRaw :: ArchiveSwitchCallbackRaw a b -> IO (FunPtr (ArchiveSwitchCallbackRaw a b)) +foreign import ccall "wrapper" mkPassphraseCallback :: ArchivePassphraseCallback a -> IO (FunPtr (ArchivePassphraseCallback a)) +foreign import ccall "wrapper" mkExcludedCallback :: (ArchivePtr -> Ptr a -> ArchiveEntryPtr -> IO ()) -> IO (FunPtr (ArchivePtr -> Ptr a -> ArchiveEntryPtr -> IO ())) + +-- | Don't use an open callback. This is the recommended argument to 'archiveReadOpen' +noOpenCallback :: FunPtr (ArchiveOpenCallbackRaw a) +noOpenCallback = castPtrToFunPtr nullPtr + +foreign import ccall "wrapper" mkWriteLookup :: (Ptr a -> CString -> LaInt64 -> IO LaInt64) -> IO (FunPtr (Ptr a -> CString -> LaInt64 -> IO LaInt64)) +-- | Also for 'archiveReadDiskSetGnameLookup' and 'archiveReadDiskSetUnameLookup' +foreign import ccall "wrapper" mkReadLookup :: (Ptr a -> LaInt64 -> IO CString) -> IO (FunPtr (Ptr a -> LaInt64 -> IO CString)) + +-- | Can also be used with 'archiveReadExtractSetProgressCallback' +foreign import ccall "wrapper" mkCleanup :: (Ptr a -> IO ()) -> IO (FunPtr (Ptr a -> IO ())) + +foreign import ccall "wrapper" mkMatch :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO ()) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO ())) +foreign import ccall "wrapper" preMkFilter :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt)) + +mkOpenCallback :: ArchiveOpenCallback a -> IO (FunPtr (ArchiveOpenCallbackRaw a)) +mkOpenCallback f = let f' = fmap resultToErr .* f in mkOpenCallbackRaw f' + +mkCloseCallback :: ArchiveCloseCallback a -> IO (FunPtr (ArchiveCloseCallbackRaw a)) +mkCloseCallback f = let f' = fmap resultToErr .* f in mkCloseCallbackRaw f' + +mkSwitchCallback :: ArchiveSwitchCallback a b -> IO (FunPtr (ArchiveSwitchCallbackRaw a b)) +mkSwitchCallback f = let f' = fmap resultToErr .** f in mkSwitchCallbackRaw f' + +mkFilter :: (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO Bool) -> IO (FunPtr (Ptr Archive -> Ptr a -> Ptr ArchiveEntry -> IO CInt)) +mkFilter f = let f' = fmap boolToInt .** f in preMkFilter f' + where boolToInt False = 0 + boolToInt True = 1 + +#include + +{#pointer *archive as ArchivePtr -> Archive #} +{#pointer *archive_entry as ArchiveEntryPtr -> ArchiveEntry #} +{#pointer *stat as StatPtr -> Stat #} +{#pointer *FILE as FilePtr newtype#} + +{#typedef size_t CSize#} +{#typedef wchar_t CWchar#} +{#typedef la_ssize_t LaSSize#} +{#typedef la_int64_t LaInt64#} +{#typedef time_t CTime#} + +{#default in `CWString' [wchar_t*] castPtr#} + +{# fun archive_zlib_version as ^ {} -> `CString' #} +{# fun archive_liblzma_version as ^ {} -> `CString' #} +{# fun archive_bzlib_version as ^ {} -> `CString' #} +{# fun archive_liblz4_version as ^ {} -> `CString' #} +{# fun archive_libzstd_version as ^ {} -> `CString' #} + +{# fun archive_error_string as ^ { `ArchivePtr' } -> `CString' #} +{# fun archive_format_name as ^ { `ArchivePtr' } -> `CString' #} +{# fun archive_format as ^ { `ArchivePtr' } -> `ArchiveFormat' #} +{# fun archive_clear_error as ^ { `ArchivePtr' } -> `()' #} +{# fun archive_set_error as ^ { `ArchivePtr', `CInt', `CString' } -> `()' #} +{# fun archive_copy_error as ^ { `ArchivePtr', `ArchivePtr' } -> `()' #} +{# fun archive_file_count as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_version_number as ^ {} -> `CInt' #} +{# fun archive_version_string as ^ {} -> `String' #} +{# fun archive_version_details as ^ {} -> `String' #} +{# fun archive_filter_count as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_filter_bytes as ^ { `ArchivePtr', `CInt' } -> `LaInt64' #} +{# fun archive_filter_code as ^ { `ArchivePtr', `CInt' } -> `Int' #} +{# fun archive_filter_name as ^ { `ArchivePtr', `CInt' } -> `CString' #} + +{# fun archive_read_new as ^ {} -> `ArchivePtr' #} + +{# fun archive_match_excluded as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_match_path_excluded as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_match_exclude_pattern as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_match_exclude_pattern_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_set_inclusion_recursion as ^ { `ArchivePtr', `Bool' } -> `ArchiveResult' #} +{# fun archive_match_exclude_pattern_from_file as ^ { `ArchivePtr', `CString', `Bool' } -> `ArchiveResult' #} +{# fun archive_match_exclude_pattern_from_file_w as ^ { `ArchivePtr', `CWString', `Bool' } -> `ArchiveResult' #} +{# fun archive_match_include_pattern as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_match_include_pattern_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_include_pattern_from_file as ^ { `ArchivePtr', `CString', `Bool' } -> `ArchiveResult' #} +{# fun archive_match_include_pattern_from_file_w as ^ { `ArchivePtr', `CWString', `Bool' } -> `ArchiveResult' #} +{# fun archive_match_path_unmatched_inclusions as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_match_path_unmatched_inclusions_next as ^ { `ArchivePtr', alloca- `CString' peek* } -> `ArchiveResult' #} +{# fun archive_match_path_unmatched_inclusions_next_w as ^ { `ArchivePtr', alloca- `CWString' peek* } -> `ArchiveResult' #} +{# fun archive_match_time_excluded as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_match_include_time as ^ { `ArchivePtr', coerce `TimeFlag', `CTime', `CLong' } -> `ArchiveResult' #} +{# fun archive_match_include_date as ^ { `ArchivePtr', coerce `TimeFlag', `CString' } -> `ArchiveResult' #} +{# fun archive_match_include_date_w as ^ { `ArchivePtr', coerce `TimeFlag', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_include_file_time as ^ { `ArchivePtr', coerce `TimeFlag', `CString' } -> `ArchiveResult' #} +{# fun archive_match_include_file_time_w as ^ { `ArchivePtr', coerce `TimeFlag', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_exclude_entry as ^ { `ArchivePtr', coerce `TimeFlag', `ArchiveEntryPtr' } -> `ArchiveResult' #} + +{# fun archive_match_owner_excluded as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `Bool' #} + +{# fun archive_read_set_open_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveOpenCallbackRaw a)' } -> `ArchiveResult' #} +{# fun archive_read_set_read_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveReadCallback a b)' } -> `ArchiveResult' #} +{# fun archive_read_set_seek_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveSeekCallback a)' } -> `ArchiveResult' #} +{# fun archive_read_set_skip_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveSeekCallback a)' } -> `ArchiveResult' #} +{# fun archive_read_set_close_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveCloseCallbackRaw a)' } -> `ArchiveResult' #} +{# fun archive_read_set_switch_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (ArchiveSwitchCallbackRaw a n)' } -> `ArchiveResult' #} + +{# fun archive_read_set_callback_data as ^ { `ArchivePtr', castPtr `Ptr a' } -> `ArchiveResult' #} +{# fun archive_read_set_callback_data2 as ^ { `ArchivePtr', castPtr `Ptr a', `CUInt' } -> `ArchiveResult' #} +{# fun archive_read_add_callback_data as ^ { `ArchivePtr', castPtr `Ptr a', `CUInt' } -> `ArchiveResult' #} +{# fun archive_read_append_callback_data as ^ { `ArchivePtr', castPtr `Ptr a' } -> `ArchiveResult' #} +{# fun archive_read_prepend_callback_data as ^ { `ArchivePtr', castPtr `Ptr a' } -> `ArchiveResult' #} + +{# fun archive_read_open1 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_open as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (ArchiveOpenCallbackRaw a)' + , castFunPtr `FunPtr (ArchiveReadCallback a b)' + , castFunPtr `FunPtr (ArchiveCloseCallbackRaw a)' + } -> `ArchiveResult' #} +{# fun archive_read_open2 as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (ArchiveOpenCallbackRaw a)' + , castFunPtr `FunPtr (ArchiveReadCallback a b)' + , castFunPtr `FunPtr (ArchiveSkipCallback a)' + , castFunPtr `FunPtr (ArchiveCloseCallbackRaw a)' + } -> `ArchiveResult' #} + +{# fun archive_read_open_filename as ^ { `ArchivePtr', `CString', `CSize' } -> `ArchiveResult' #} +{# fun archive_read_open_filename_w as ^ { `ArchivePtr', `CWString', `CSize' } -> `ArchiveResult' #} +{# fun archive_read_open_filenames as ^ { `ArchivePtr', id `Ptr CString', `CSize' } -> `ArchiveResult' #} +{# fun archive_read_open_memory as ^ { `ArchivePtr', castPtr `Ptr a', `CSize' } -> `ArchiveResult' #} +{# fun archive_read_open_fd as ^ { `ArchivePtr', coerce `Fd', `CSize' } -> `ArchiveResult' #} +{# fun archive_read_open_FILE as ^ { `ArchivePtr', `FilePtr' } -> `ArchiveResult' #} +{# fun archive_read_next_header as ^ { `ArchivePtr', alloca- `ArchiveEntryPtr' peek* } -> `ArchiveResult' #} +{# fun archive_read_next_header2 as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `ArchiveResult' #} +{# fun archive_read_header_position as ^ { `ArchivePtr' } -> `LaInt64' #} +{# fun archive_read_has_encrypted_entries as ^ { `ArchivePtr' } -> `ArchiveEncryption' encryptionResult #} +{# fun archive_read_format_capabilities as ^ { `ArchivePtr' } -> `ArchiveCapabilities' ArchiveCapabilities #} +{# fun archive_read_data as ^ { `ArchivePtr', castPtr `Ptr a', `CSize' } -> `LaSSize' #} +{# fun archive_seek_data as ^ { `ArchivePtr', `LaInt64', `CInt' } -> `LaInt64' #} +{# fun archive_read_data_block as ^ { `ArchivePtr', castPtr `Ptr (Ptr a)', id `Ptr CSize', id `Ptr LaInt64' } -> `ArchiveResult' #} +{# fun archive_read_data_skip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_data_into_fd as ^ { `ArchivePtr', coerce `Fd' } -> `ArchiveResult' #} +{# fun archive_read_set_format_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_read_set_filter_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_read_set_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_read_set_options as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} + +{# fun archive_read_add_passphrase as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_read_set_passphrase_callback as ^ { `ArchivePtr', castPtr `Ptr a', castFunPtr `FunPtr (ArchivePassphraseCallback a)' } -> `ArchiveResult' #} + +{# fun archive_read_extract as ^ { `ArchivePtr', `ArchiveEntryPtr', coerce `Flags' } -> `ArchiveResult' #} +{# fun archive_read_extract2 as ^ { `ArchivePtr', `ArchiveEntryPtr', `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_extract_set_progress_callback as ^ { `ArchivePtr', castFunPtr `FunPtr (Ptr a -> IO ())', castPtr `Ptr a' } -> `()' id #} +{# fun archive_read_extract_set_skip_file as ^ { `ArchivePtr', `LaInt64', `LaInt64' } -> `()' #} +{# fun archive_read_close as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_free as ^ { `ArchivePtr' } -> `ArchiveResult' #} + +{# fun archive_write_new as ^ {} -> `ArchivePtr' #} +{# fun archive_write_set_bytes_per_block as ^ { `ArchivePtr', `CInt' } -> `ArchiveResult' #} +{# fun archive_write_get_bytes_per_block as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_write_set_bytes_in_last_block as ^ { `ArchivePtr', `CInt' } -> `ArchiveResult' #} +{# fun archive_write_get_bytes_in_last_block as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_write_set_skip_file as ^ { `ArchivePtr', `LaInt64', `LaInt64' } -> `ArchiveResult' #} +{# fun archive_write_add_filter as ^ { `ArchivePtr', `ArchiveFilter' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_by_name as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_b64encode as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_bzip2 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_compress as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_grzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_lrzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_lz4 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_lzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_lzma as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_lzop as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_none as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_program as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_uuencode as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_xz as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_add_filter_zstd as ^ { `ArchivePtr' } -> `ArchiveResult' #} + +{# fun archive_write_set_format as ^ { `ArchivePtr', `ArchiveFormat' } -> `ArchiveResult' #} +{# fun archive_write_set_format_by_name as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_format_7zip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_ar_bsd as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_ar_svr4 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_cpio as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_cpio_newc as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_gnutar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_mtree as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_mtree_classic as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_pax as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_pax_restricted as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_raw as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_shar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_shar_dump as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_ustar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_v7tar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_warc as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_xar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_zip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_set_format_filter_by_ext as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_format_filter_by_ext_def as ^ { `ArchivePtr', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_write_zip_set_compression_deflate as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_zip_set_compression_store as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_open as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (ArchiveOpenCallbackRaw a)' + , castFunPtr `FunPtr (ArchiveWriteCallback a b)' + , castFunPtr `FunPtr (ArchiveCloseCallbackRaw a)' + } -> `ArchiveResult' #} +{# fun archive_write_open_fd as ^ { `ArchivePtr', coerce `Fd' } -> `ArchiveResult' #} +{# fun archive_write_open_filename as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_open_filename_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_write_open_FILE as ^ { `ArchivePtr', `FilePtr' } -> `ArchiveResult' #} +{# fun archive_write_open_memory as ^ { `ArchivePtr', castPtr `Ptr a' , `CSize', alloca- `CSize' peek* } -> `ArchiveResult' #} + +{# fun archive_write_header as ^ { `ArchivePtr', `ArchiveEntryPtr' } -> `ArchiveResult' #} +{# fun archive_write_data as ^ { `ArchivePtr', castPtr `Ptr a', `CSize' } -> `LaSSize' #} +{# fun archive_write_data_block as ^ { `ArchivePtr', castPtr `Ptr a', `CSize', `LaInt64' } -> `LaSSize' #} + +{# fun archive_write_finish_entry as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_close as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_fail as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_free as ^ { `ArchivePtr' } -> `ArchiveResult' #} + +{# fun archive_write_set_format_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_filter_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_option as ^ { `ArchivePtr', `CString', `CString', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_options as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} + +{# fun archive_write_set_passphrase as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_write_set_passphrase_callback as ^ { `ArchivePtr', castPtr `Ptr a', castFunPtr `FunPtr (ArchivePassphraseCallback a)' } -> `ArchiveResult' #} +{# fun archive_write_disk_set_options as ^ { `ArchivePtr', coerce `Flags' } -> `ArchiveResult' #} + +{# fun archive_write_disk_new as ^ {} -> `ArchivePtr' #} +{# fun archive_write_disk_set_skip_file as ^ { `ArchivePtr', `LaInt64', `LaInt64' } -> `ArchiveResult' #} + +{# fun archive_write_disk_set_standard_lookup as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_write_disk_set_group_lookup as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (Ptr a -> CString -> LaInt64 -> IO LaInt64)' + , castFunPtr `FunPtr (Ptr a -> IO ())' + } -> `ArchiveResult' #} +{# fun archive_write_disk_set_user_lookup as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (Ptr a -> CString -> LaInt64 -> IO LaInt64)' + , castFunPtr `FunPtr (Ptr a -> IO ())' + } -> `ArchiveResult' #} +{# fun archive_write_disk_gid as ^ { `ArchivePtr', `CString', `LaInt64' } -> `LaInt64' #} +{# fun archive_write_disk_uid as ^ { `ArchivePtr', `CString', `LaInt64' } -> `LaInt64' #} + +{# fun archive_read_disk_new as ^ {} -> `ArchivePtr' #} +{# fun archive_read_disk_set_symlink_logical as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_set_symlink_physical as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_set_symlink_hybrid as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_entry_from_file as ^ { `ArchivePtr', `ArchiveEntryPtr', coerce `Fd', `StatPtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_gname as ^ { `ArchivePtr', `LaInt64' } -> `CString' #} +{# fun archive_read_disk_uname as ^ { `ArchivePtr', `LaInt64' } -> `CString' #} +{# fun archive_read_disk_set_standard_lookup as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_set_gname_lookup as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (Ptr a -> LaInt64 -> IO CString )' + , castFunPtr `FunPtr (Ptr a -> IO ())' + } -> `ArchiveResult' #} +{# fun archive_read_disk_set_uname_lookup as ^ { `ArchivePtr' + , castPtr `Ptr a' + , castFunPtr `FunPtr (Ptr a -> LaInt64 -> IO CString )' + , castFunPtr `FunPtr (Ptr a -> IO ())' + } -> `ArchiveResult' #} +{# fun archive_read_disk_open as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_read_disk_open_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_read_disk_descend as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_can_descend as ^ { `ArchivePtr' } -> `Bool' #} +{# fun archive_read_disk_current_filesystem as ^ { `ArchivePtr' } -> `CInt' #} +{# fun archive_read_disk_current_filesystem_is_synthetic as ^ { `ArchivePtr' } -> `Bool' #} +{# fun archive_read_disk_current_filesystem_is_remote as ^ { `ArchivePtr' } -> `Bool' #} +{# fun archive_read_disk_set_atime_restored as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_disk_set_behavior as ^ { `ArchivePtr', coerce `Flags' } -> `ArchiveResult' #} + +{# fun archive_read_disk_set_matching as ^ { `ArchivePtr' + , `ArchivePtr' + , castFunPtr `FunPtr (ArchivePtr -> Ptr a -> ArchiveEntryPtr -> IO ())' + , castPtr `Ptr a' + } -> `ArchiveResult' #} +{# fun archive_read_disk_set_metadata_filter_callback as ^ { `ArchivePtr' + , castFunPtr `FunPtr (ArchivePtr -> Ptr a -> ArchiveEntry -> IO CInt)' + , castPtr `Ptr a' + } -> `ArchiveResult' #} + +{# fun archive_free as ^ { `ArchivePtr' } -> `ArchiveResult' #} + +{# fun archive_match_include_gname_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_include_gname as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_match_include_uname_w as ^ { `ArchivePtr', `CWString' } -> `ArchiveResult' #} +{# fun archive_match_include_uname as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_match_include_gid as ^ { `ArchivePtr', coerce `Id' } -> `ArchiveResult' #} +{# fun archive_match_include_uid as ^ { `ArchivePtr', coerce `Id' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_all as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_bzip2 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_compress as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_gzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_grzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_lrzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_lz4 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_lzip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_lzma as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_lzop as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_none as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_program as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_program_signature as ^ { `ArchivePtr', `CString', castPtr `Ptr a', coerce `CSize' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_rpm as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_uu as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_filter_xz as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_7zip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_all as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_ar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_by_code as ^ { `ArchivePtr', `CInt' } -> `ArchiveResult' #} +{# fun archive_read_support_format_cab as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_cpio as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_empty as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_gnutar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_iso9660 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_lha as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_mtree as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_rar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_rar5 as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_raw as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_tar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_warc as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_xar as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_zip as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_zip_streamable as ^ { `ArchivePtr' } -> `ArchiveResult' #} +{# fun archive_read_support_format_zip_seekable as ^ { `ArchivePtr' } -> `ArchiveResult' #} + +{# fun archive_read_set_format as ^ { `ArchivePtr', `ArchiveFormat' } -> `ArchiveResult' #} +{# fun archive_read_append_filter as ^ { `ArchivePtr', `CInt' } -> `ArchiveResult' #} +{# fun archive_read_append_filter_program as ^ { `ArchivePtr', `CString' } -> `ArchiveResult' #} +{# fun archive_read_append_filter_program_signature as ^ { `ArchivePtr', `CString', castPtr `Ptr a', `CSize' } -> `ArchiveResult' #} + +{# fun archive_errno as ^ { `ArchivePtr' } -> `ArchiveResult' #} diff --git a/src/Codec/Archive/Foreign/Archive/Macros.chs b/src/Codec/Archive/Foreign/Archive/Macros.chs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Foreign/Archive/Macros.chs @@ -0,0 +1,167 @@ +module Codec.Archive.Foreign.Archive.Macros ( archiveVersionNumberMacro + , archiveVersionOnlyString + , archiveVersionStringMacro + , archiveReadFormatCapsNone + , archiveReadFormatCapsEncryptData + , archiveReadFormatCapsEncryptMetadata + , archiveMatchMTime + , archiveMatchCTime + , archiveMatchNewer + , archiveMatchOlder + , archiveMatchEqual + , archiveExtractOwner + , archiveExtractPerm + , archiveExtractNoOverwrite + , archiveExtractUnlink + , archiveExtractACL + , archiveExtractFFlags + , archiveExtractXattr + , archiveExtractSecureSymlinks + , archiveExtractSecureNoDotDot + , archiveExtractTime + , archiveExtractNoAutodir + , archiveExtractSparse + , archiveExtractMacMetadata + , archiveExtractNoHfsCompression + , archiveExtractHfsCompressionForced + , archiveExtractSecureNoAbsolutePaths + , archiveExtractClearNoChangeFFlags + , archiveExtractNoOverwriteNewer + , archiveReadDiskRestoreATime + , archiveReadDiskHonorNoDump + , archiveReadDiskMacCopyFile + , archiveReadDiskNoTraverseMounts + , archiveReadDiskNoXattr + , archiveReadDiskNoAcl + , archiveReadDiskNoFFlags + -- * Conversion functions + , resultToErr + , encryptionResult + ) where + +import Codec.Archive.Types +import Data.Bits (Bits (..)) +import Foreign.C.Types + +#include + +archiveVersionNumberMacro :: Int +archiveVersionNumberMacro = {# const ARCHIVE_VERSION_NUMBER #} + +archiveVersionOnlyString :: String +archiveVersionOnlyString = {# const ARCHIVE_VERSION_ONLY_STRING #} + +archiveVersionStringMacro :: String +archiveVersionStringMacro = {# const ARCHIVE_VERSION_STRING #} + +-- Extraction flags +archiveExtractOwner :: Flags +archiveExtractOwner = Flags {# const ARCHIVE_EXTRACT_OWNER #} + +archiveExtractPerm :: Flags +archiveExtractPerm = Flags {# const ARCHIVE_EXTRACT_PERM #} + +archiveExtractTime :: Flags +archiveExtractTime = Flags {# const ARCHIVE_EXTRACT_TIME #} + +archiveExtractNoOverwrite :: Flags +archiveExtractNoOverwrite = Flags {# const ARCHIVE_EXTRACT_NO_OVERWRITE #} + +archiveExtractUnlink :: Flags +archiveExtractUnlink = Flags {# const ARCHIVE_EXTRACT_UNLINK #} + +archiveExtractACL :: Flags +archiveExtractACL = Flags {# const ARCHIVE_EXTRACT_ACL #} + +archiveExtractFFlags :: Flags +archiveExtractFFlags = Flags {# const ARCHIVE_EXTRACT_FFLAGS #} + +archiveExtractXattr :: Flags +archiveExtractXattr = Flags {# const ARCHIVE_EXTRACT_XATTR #} + +archiveExtractSecureSymlinks :: Flags +archiveExtractSecureSymlinks = Flags {# const ARCHIVE_EXTRACT_SECURE_SYMLINKS #} + +archiveExtractSecureNoDotDot :: Flags +archiveExtractSecureNoDotDot = Flags {# const ARCHIVE_EXTRACT_SECURE_NODOTDOT #} + +archiveExtractNoAutodir :: Flags +archiveExtractNoAutodir = Flags {# const ARCHIVE_EXTRACT_NO_AUTODIR #} + +archiveExtractNoOverwriteNewer :: Flags +archiveExtractNoOverwriteNewer = Flags {# const ARCHIVE_EXTRACT_NO_OVERWRITE_NEWER #} + +archiveExtractSparse :: Flags +archiveExtractSparse = Flags {# const ARCHIVE_EXTRACT_SPARSE #} + +archiveExtractMacMetadata :: Flags +archiveExtractMacMetadata = Flags {# const ARCHIVE_EXTRACT_MAC_METADATA #} + +archiveExtractNoHfsCompression :: Flags +archiveExtractNoHfsCompression = Flags {# const ARCHIVE_EXTRACT_NO_HFS_COMPRESSION #} + +archiveExtractHfsCompressionForced :: Flags +archiveExtractHfsCompressionForced = Flags {# const ARCHIVE_EXTRACT_HFS_COMPRESSION_FORCED #} + +archiveExtractSecureNoAbsolutePaths :: Flags +archiveExtractSecureNoAbsolutePaths = Flags {# const ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS #} + +archiveExtractClearNoChangeFFlags :: Flags +archiveExtractClearNoChangeFFlags = Flags {# const ARCHIVE_EXTRACT_CLEAR_NOCHANGE_FFLAGS #} + +encryptionResult :: CInt -> ArchiveEncryption +encryptionResult 0 = NoEncryption +encryptionResult 1 = HasEncryption +encryptionResult ({# const ARCHIVE_READ_FORMAT_ENCRYPTION_UNSUPPORTED #}) = EncryptionUnsupported +encryptionResult ({# const ARCHIVE_READ_FORMAT_ENCRYPTION_DONT_KNOW #}) = EncryptionUnknown +encryptionResult _ = error "Should not happen." + +archiveReadFormatCapsNone :: ArchiveCapabilities +archiveReadFormatCapsNone = ArchiveCapabilities {# const ARCHIVE_READ_FORMAT_CAPS_NONE #} + +(<<) :: Bits a => a -> Int -> a +m << n = m `shift` n + +archiveReadFormatCapsEncryptData :: ArchiveCapabilities +archiveReadFormatCapsEncryptData = ArchiveCapabilities ({# const ARCHIVE_READ_FORMAT_CAPS_ENCRYPT_DATA #}) + +archiveReadFormatCapsEncryptMetadata :: ArchiveCapabilities +archiveReadFormatCapsEncryptMetadata = ArchiveCapabilities ({# const ARCHIVE_READ_FORMAT_CAPS_ENCRYPT_DATA #}) + +archiveReadDiskRestoreATime :: ReadDiskFlags +archiveReadDiskRestoreATime = ReadDiskFlags {# const ARCHIVE_READDISK_RESTORE_ATIME #} + +archiveReadDiskHonorNoDump :: ReadDiskFlags +archiveReadDiskHonorNoDump = ReadDiskFlags {# const ARCHIVE_READDISK_HONOR_NODUMP #} + +archiveReadDiskMacCopyFile :: ReadDiskFlags +archiveReadDiskMacCopyFile = ReadDiskFlags {# const ARCHIVE_READDISK_MAC_COPYFILE #} + +archiveReadDiskNoTraverseMounts :: ReadDiskFlags +archiveReadDiskNoTraverseMounts = ReadDiskFlags {# const ARCHIVE_READDISK_NO_TRAVERSE_MOUNTS #} + +archiveReadDiskNoXattr :: ReadDiskFlags +archiveReadDiskNoXattr = ReadDiskFlags {# const ARCHIVE_READDISK_NO_XATTR #} + +-- | @since 2.0.0.0 +archiveReadDiskNoAcl :: ReadDiskFlags +archiveReadDiskNoAcl = ReadDiskFlags {# const ARCHIVE_READDISK_NO_ACL #} + +-- | @since 2.0.0.0 +archiveReadDiskNoFFlags :: ReadDiskFlags +archiveReadDiskNoFFlags = ReadDiskFlags {# const ARCHIVE_READDISK_NO_FFLAGS #} + +archiveMatchMTime :: TimeFlag +archiveMatchMTime = TimeFlag {# const ARCHIVE_MATCH_MTIME #} + +archiveMatchCTime :: TimeFlag +archiveMatchCTime = TimeFlag {# const ARCHIVE_MATCH_CTIME #} + +archiveMatchNewer :: TimeFlag +archiveMatchNewer = TimeFlag {# const ARCHIVE_MATCH_NEWER #} + +archiveMatchOlder :: TimeFlag +archiveMatchOlder = TimeFlag {# const ARCHIVE_MATCH_OLDER #} + +archiveMatchEqual :: TimeFlag +archiveMatchEqual = TimeFlag {# const ARCHIVE_MATCH_EQUAL #} diff --git a/src/Codec/Archive/Foreign/ArchiveEntry.chs b/src/Codec/Archive/Foreign/ArchiveEntry.chs --- a/src/Codec/Archive/Foreign/ArchiveEntry.chs +++ b/src/Codec/Archive/Foreign/ArchiveEntry.chs @@ -1,166 +1,160 @@ --- | Functions found in @archive_entry.h@ + +-- +-- Functions in this module are stateful and hence take place in the 'IO' +-- monad. module Codec.Archive.Foreign.ArchiveEntry ( -- * Direct bindings (entry) - archive_entry_clear - , archive_entry_clone - , archive_entry_new - , archive_entry_free - , archive_entry_new2 - , archive_entry_atime - , archive_entry_atime_nsec - , archiveEntryATimeIsSet - , archive_entry_birthtime - , archive_entry_birthtime_nsec + archiveEntryClear + , archiveEntryClone + , archiveEntryNew + , archiveEntryFree + , archiveEntryNew2 + , archiveEntryAtime + , archiveEntryAtimeNsec + , archiveEntryAtimeIsSet + , archiveEntryBirthtime + , archiveEntryBirthtimeNsec , archiveEntryBirthtimeIsSet - , archive_entry_ctime - , archive_entry_ctime_nsec - , archiveEntryCTimeIsSet - , archive_entry_dev + , archiveEntryCtime + , archiveEntryCtimeNsec + , archiveEntryCtimeIsSet + , archiveEntryDev , archiveEntryDevIsSet - , archive_entry_devminor - , archive_entry_devmajor - , archive_entry_fflags - , archive_entry_fflags_text - , archive_entry_filetype - , archive_entry_gid - , archive_entry_gname - , archive_entry_gname_utf8 - , archive_entry_gname_w - , archive_entry_hardlink - , archive_entry_hardlink_utf8 - , archive_entry_hardlink_w - , archive_entry_ino - , archive_entry_ino64 + , archiveEntryDevminor + , archiveEntryDevmajor + , archiveEntryFflags + , archiveEntryFflagsText + , archiveEntryFiletype + , archiveEntryGid + , archiveEntryGname + , archiveEntryGnameUtf8 + , archiveEntryGnameW + , archiveEntryHardlink + , archiveEntryHardlinkUtf8 + , archiveEntryHardlinkW + , archiveEntryIno + , archiveEntryIno64 , archiveEntryInoIsSet - , archive_entry_mode - , archive_entry_mtime - , archive_entry_mtime_nsec - , archiveEntryMTimeIsSet - , archive_entry_nlink - , archive_entry_pathname - , archive_entry_pathname_utf8 - , archive_entry_pathname_w - , archive_entry_perm - , archive_entry_rdev - , archive_entry_rdevmajor - , archive_entry_rdevminor - , archive_entry_sourcepath - , archive_entry_sourcepath_w - , archive_entry_size + , archiveEntryMode + , archiveEntryMtime + , archiveEntryMtimeNsec + , archiveEntryMtimeIsSet + , archiveEntryNlink + , archiveEntryPathname + , archiveEntryPathnameUtf8 + , archiveEntryPathnameW + , archiveEntryPerm + , archiveEntryRdev + , archiveEntryRdevmajor + , archiveEntryRdevminor + , archiveEntrySourcepath + , archiveEntrySourcepathW + , archiveEntrySize , archiveEntrySizeIsSet - , archive_entry_strmode - , archive_entry_symlink - , archive_entry_symlink_w - , archive_entry_symlink_utf8 - , archive_entry_uid - , archive_entry_uname - , archive_entry_uname_utf8 - , archive_entry_uname_w + , archiveEntryStrmode + , archiveEntrySymlink + , archiveEntrySymlinkW + , archiveEntrySymlinkUtf8 + , archiveEntryUid + , archiveEntryUname + , archiveEntryUnameUtf8 + , archiveEntryUnameW , archiveEntryIsDataEncrypted , archiveEntryIsMetadataEncrypted , archiveEntryIsEncrypted - , archive_entry_set_atime - , archive_entry_unset_atime - , archive_entry_set_birthtime - , archive_entry_unset_birthtime - , archive_entry_set_ctime - , archive_entry_unset_ctime - , archive_entry_set_dev - , archive_entry_set_devmajor - , archive_entry_set_devminor - , archive_entry_set_fflags - , archive_entry_copy_fflags_text - , archive_entry_copy_fflags_text_w - , archive_entry_set_filetype - , archive_entry_set_gid - , archive_entry_set_gname - , archive_entry_set_gname_utf8 - , archive_entry_copy_gname - , archive_entry_copy_gname_w - , archiveEntryUpdateGNameUtf8 - , archive_entry_set_hardlink - , archive_entry_set_hardlink_utf8 - , archive_entry_copy_hardlink - , archive_entry_copy_hardlink_w + , archiveEntrySetAtime + , archiveEntryUnsetAtime + , archiveEntrySetBirthtime + , archiveEntryUnsetBirthtime + , archiveEntrySetCtime + , archiveEntryUnsetCtime + , archiveEntrySetDev + , archiveEntrySetDevminor + , archiveEntrySetDevmajor + , archiveEntrySetFflags + , archiveEntryCopyFflagsText + , archiveEntryCopyFflagsTextW + , archiveEntrySetFiletype + , archiveEntrySetGid + , archiveEntrySetGname + , archiveEntrySetGnameUtf8 + , archiveEntryCopyGname + , archiveEntryCopyGnameW + , archiveEntryUpdateGnameUtf8 + , archiveEntrySetHardlink + , archiveEntrySetHardlinkUtf8 + , archiveEntryCopyHardlink + , archiveEntryCopyHardlinkW , archiveEntryUpdateHardlinkUtf8 - , archive_entry_set_ino - , archive_entry_set_ino64 - , archive_entry_set_link - , archive_entry_set_link_utf8 - , archive_entry_copy_link - , archive_entry_copy_link_w + , archiveEntrySetIno + , archiveEntrySetIno64 + , archiveEntrySetLink + , archiveEntrySetLinkUtf8 + , archiveEntryCopyLink + , archiveEntryCopyLinkW , archiveEntryUpdateLinkUtf8 - , archive_entry_set_mode - , archive_entry_set_mtime - , archive_entry_unset_mtime - , archive_entry_set_nlink - , archive_entry_set_pathname - , archive_entry_set_pathname_utf8 - , archive_entry_copy_pathname - , archive_entry_copy_pathname_w + , archiveEntrySetMode + , archiveEntrySetMtime + , archiveEntryUnsetMtime + , archiveEntrySetNlink + , archiveEntrySetPathname + , archiveEntrySetPathnameUtf8 + , archiveEntryCopyPathname + , archiveEntryCopyPathnameW , archiveEntryUpdatePathnameUtf8 - , archive_entry_set_perm - , archive_entry_set_rdev - , archive_entry_set_rdevmajor - , archive_entry_set_rdevminor - , archive_entry_set_size - , archive_entry_unset_size - , archive_entry_copy_sourcepath - , archive_entry_copy_sourcepath_w - , archive_entry_set_symlink - , archive_entry_set_symlink_utf8 - , archive_entry_copy_symlink - , archive_entry_copy_symlink_w + , archiveEntrySetPerm + , archiveEntrySetRdev + , archiveEntrySetRdevmajor + , archiveEntrySetRdevminor + , archiveEntrySetSize + , archiveEntryUnsetSize + , archiveEntryCopySourcepath + , archiveEntryCopySourcepathW + , archiveEntrySetSymlink + , archiveEntrySetSymlinkType + , archiveEntrySetSymlinkUtf8 + , archiveEntryCopySymlink + , archiveEntryCopySymlinkW , archiveEntryUpdateSymlinkUtf8 - , archive_entry_set_uid - , archive_entry_set_uname - , archive_entry_set_uname_utf8 - , archive_entry_copy_uname - , archive_entry_copy_uname_w - , archiveEntryUpdateUNameUtf8 - , archive_entry_stat - , archive_entry_copy_stat - , archive_entry_mac_metadata - , archive_entry_copy_mac_metadata - -- * ACL functions - , archive_entry_acl_add_entry - , archive_entry_acl_add_entry_w - , archive_entry_acl_reset - , archive_entry_acl_next - -- , archive_entry_acl_next_w - -- , archive_entry_acl_to_text - -- , archive_entry_acl_to_text_w - -- , archive_entry_acl_from_text - -- , archive_entry_acl_from_text_w - -- , archive_entry_acl_types - -- , archive_entry_count + , archiveEntrySetUid + , archiveEntrySetUname + , archiveEntrySetUnameUtf8 + , archiveEntryCopyUname + , archiveEntryCopyUnameW + , archiveEntryUpdateUnameUtf8 + , archiveEntryStat + , archiveEntryCopyStat + , archiveEntryMacMetadata + , archiveEntryCopyMacMetadata + , archiveEntryAclClear + , archiveEntryAclNext + , archiveEntryAclNextW + , archiveEntryAclReset + , archiveEntryAclToText + , archiveEntryAclToTextW + , archiveEntryAclFromText + , archiveEntryAclFromTextW + , archiveEntryAclTypes + , archiveEntryAclCount + , archiveEntryAclAddEntry + , archiveEntryAclAddEntryW -- * Xattr functions - , archive_entry_xattr_clear - , archive_entry_xattr_add_entry - , archive_entry_xattr_count - , archive_entry_xattr_reset - , archive_entry_xattr_next + , archiveEntryXattrClear + , archiveEntryXattrAddEntry + , archiveEntryXattrCount + , archiveEntryXattrReset + , archiveEntryXattrNext -- * For sparse archives - , archive_entry_sparse_clear - , archive_entry_sparse_add_entry - , archive_entry_sparse_count - , archive_entry_sparse_reset - , archive_entry_sparse_next + , archiveEntrySparseClear + , archiveEntrySparseAddEntry + , archiveEntrySparseCount + , archiveEntrySparseReset + , archiveEntrySparseNext -- * Link resolver - , archive_entry_linkresolver_new - , archive_entry_linkresolver_set_strategy - , archive_entry_linkresolver_free - , archive_entry_linkify - , archive_entry_partial_links - -- * ACL - , archive_entry_acl_clear - -- * File types - , regular - , symlink - , socket - , characterDevice - , blockDevice - , directory - , fifo + , archiveEntryLinkresolverNew + , archiveEntryLinkresolverSetStrategy + , archiveEntryLinkresolverFree + , archiveEntryLinkify + , archiveEntryPartialLinks -- * ACL macros , archiveEntryACLExecute , archiveEntryACLWrite @@ -207,389 +201,197 @@ , Stat , LinkResolver -- * Lower-level API types - , FileType + , FileType (..) , EntryACL + -- * Type synonyms + , ArchiveEntryPtr + , LinkResolverPtr ) where -import Codec.Archive.Foreign.Common +{# import Codec.Archive.Foreign.Archive #} + +import Codec.Archive.Foreign.ArchiveEntry.Macros import Codec.Archive.Types -import Control.Composition ((.*)) -import Data.Int (Int64) -import Data.Word (Word64) +import Data.Coerce (coerce) import Foreign.C.String import Foreign.C.Types -import Foreign.Ptr (Ptr) -import System.Posix.Types (CMode (..)) - -#include - --- Archive entry -foreign import ccall archive_entry_clear :: Ptr ArchiveEntry -> IO (Ptr ArchiveEntry) -foreign import ccall archive_entry_clone :: Ptr ArchiveEntry -> IO (Ptr ArchiveEntry) -foreign import ccall archive_entry_free :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_new :: IO (Ptr ArchiveEntry) -foreign import ccall archive_entry_new2 :: Ptr ArchiveEntry -> IO (Ptr ArchiveEntry) - -foreign import ccall archive_entry_atime :: Ptr ArchiveEntry -> IO CTime -foreign import ccall archive_entry_atime_nsec :: Ptr ArchiveEntry -> IO CLong -foreign import ccall archive_entry_atime_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_birthtime :: Ptr ArchiveEntry -> IO CTime -foreign import ccall archive_entry_birthtime_nsec :: Ptr ArchiveEntry -> IO CLong -foreign import ccall archive_entry_birthtime_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_ctime :: Ptr ArchiveEntry -> IO CTime -foreign import ccall archive_entry_ctime_nsec :: Ptr ArchiveEntry -> IO CLong -foreign import ccall archive_entry_ctime_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_dev :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_dev_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_devmajor :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_devminor :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_filetype :: Ptr ArchiveEntry -> IO FileType -foreign import ccall archive_entry_fflags :: Ptr ArchiveEntry -> CULong -> CULong -> IO () -foreign import ccall archive_entry_fflags_text :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_gid :: Ptr ArchiveEntry -> IO Id -foreign import ccall archive_entry_gname :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_gname_utf8 :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_gname_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_hardlink :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_hardlink_utf8 :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_hardlink_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_ino :: Ptr ArchiveEntry -> IO Int64 -foreign import ccall archive_entry_ino64 :: Ptr ArchiveEntry -> IO Int64 -foreign import ccall archive_entry_ino_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_mode :: Ptr ArchiveEntry -> IO CMode -foreign import ccall archive_entry_mtime :: Ptr ArchiveEntry -> IO CTime -foreign import ccall archive_entry_mtime_nsec :: Ptr ArchiveEntry -> IO CLong -foreign import ccall archive_entry_mtime_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_nlink :: Ptr ArchiveEntry -> IO CUInt -foreign import ccall archive_entry_pathname :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_pathname_utf8 :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_pathname_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_perm :: Ptr ArchiveEntry -> IO CMode -foreign import ccall archive_entry_rdev :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_rdevmajor :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_rdevminor :: Ptr ArchiveEntry -> IO Word64 -foreign import ccall archive_entry_sourcepath :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_sourcepath_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_size :: Ptr ArchiveEntry -> IO Int64 -foreign import ccall archive_entry_size_is_set :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_strmode :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_symlink :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_symlink_utf8 :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_symlink_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_uid :: Ptr ArchiveEntry -> IO Id -foreign import ccall archive_entry_uname :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_uname_utf8 :: Ptr ArchiveEntry -> IO CString -foreign import ccall archive_entry_uname_w :: Ptr ArchiveEntry -> IO CWString -foreign import ccall archive_entry_is_data_encrypted :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_is_metadata_encrypted :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_is_encrypted :: Ptr ArchiveEntry -> IO CInt - -foreign import ccall archive_entry_set_atime :: Ptr ArchiveEntry -> CTime -> CLong -> IO () -foreign import ccall archive_entry_unset_atime :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_set_birthtime :: Ptr ArchiveEntry -> CTime -> CLong -> IO () -foreign import ccall archive_entry_unset_birthtime :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_set_ctime :: Ptr ArchiveEntry -> CTime -> CLong -> IO () -foreign import ccall archive_entry_unset_ctime :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_set_dev :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_devmajor :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_devminor :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_filetype :: Ptr ArchiveEntry -> FileType -> IO () -foreign import ccall archive_entry_set_fflags :: Ptr ArchiveEntry -> CULong -> CULong -> IO () -foreign import ccall archive_entry_copy_fflags_text :: Ptr ArchiveEntry -> CString -> IO CString -foreign import ccall archive_entry_copy_fflags_text_w :: Ptr ArchiveEntry -> CWString -> IO CWString -foreign import ccall archive_entry_set_gid :: Ptr ArchiveEntry -> Id -> IO () -foreign import ccall archive_entry_set_gname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_gname_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_gname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_gname_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_gname_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_set_hardlink :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_hardlink_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_hardlink :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_hardlink_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_hardlink_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_set_ino :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_ino64 :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_link :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_link_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_link :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_link_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_link_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_set_mode :: Ptr ArchiveEntry -> CMode -> IO () -foreign import ccall archive_entry_set_mtime :: Ptr ArchiveEntry -> CTime -> CLong -> IO () -foreign import ccall archive_entry_unset_mtime :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_set_nlink :: Ptr ArchiveEntry -> CUInt -> IO () -foreign import ccall archive_entry_set_pathname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_pathname_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_pathname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_pathname_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_pathname_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_set_perm :: Ptr ArchiveEntry -> CMode -> IO () -foreign import ccall archive_entry_set_rdev :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_rdevmajor :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_rdevminor :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_set_size :: Ptr ArchiveEntry -> Int64 -> IO () -foreign import ccall archive_entry_unset_size :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_copy_sourcepath :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_sourcepath_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_set_symlink :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_symlink_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_symlink :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_symlink_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_symlink_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_set_uid :: Ptr ArchiveEntry -> Id -> IO () -foreign import ccall archive_entry_set_uname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_set_uname_utf8 :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_uname :: Ptr ArchiveEntry -> CString -> IO () -foreign import ccall archive_entry_copy_uname_w :: Ptr ArchiveEntry -> CWString -> IO () -foreign import ccall archive_entry_update_uname_utf8 :: Ptr ArchiveEntry -> CString -> IO CInt -foreign import ccall archive_entry_stat :: Ptr ArchiveEntry -> IO (Ptr Stat) -foreign import ccall archive_entry_copy_stat :: Ptr ArchiveEntry -> Ptr Stat -> IO () -foreign import ccall archive_entry_mac_metadata :: Ptr ArchiveEntry -> Ptr CSize -> IO (Ptr a) -foreign import ccall archive_entry_copy_mac_metadata :: Ptr ArchiveEntry -> Ptr a -> CSize -> IO () - -foreign import ccall archive_entry_acl_clear :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_acl_add_entry :: Ptr ArchiveEntry -> EntryACL -> EntryACL -> EntryACL -> CInt -> CString -> IO ArchiveError -foreign import ccall archive_entry_acl_add_entry_w :: Ptr ArchiveEntry -> EntryACL -> EntryACL -> EntryACL -> CInt -> CWString -> IO ArchiveError -foreign import ccall archive_entry_acl_reset :: Ptr ArchiveEntry -> EntryACL -> IO CInt -foreign import ccall archive_entry_acl_next :: Ptr ArchiveEntry -> EntryACL -> EntryACL -> EntryACL -> EntryACL -> CInt -> Ptr CString -> IO ArchiveError --- foreign import ccall archive_entry_acl_next_w :: Ptr ArchiveEntry -> EntryACL -> EntryACL -> EntryACL -> EntryACL -> CInt -> Ptr CWString -> IO ArchiveError - --- foreign import ccall archive_entry_acl_to_text_w :: Ptr ArchiveEntry -> CSize -> EntryACL -> IO CWString --- foreign import ccall archive_entry_acl_to_text :: Ptr ArchiveEntry -> CSize -> EntryACL -> IO CString --- foreign import ccall archive_entry_acl_from_text :: Ptr ArchiveEntry -> CString -> EntryACL -> IO ArchiveError --- foreign import ccall archive_entry_acl_from_text_w :: Ptr ArchiveEntry -> CWString -> EntryACL -> IO ArchiveError --- foreign import ccall archive_entry_acl_types :: Ptr ArchiveEntry -> IO EntryACL --- foreign import ccall archive_entry_count :: Ptr ArchiveEntry -> EntryACL -> IO CInt - --- don't bother with archive_entry_acl +import Foreign.Ptr (Ptr, castPtr) +import System.PosixCompat.Types (CMode (..), CDev (..)) -foreign import ccall archive_entry_xattr_clear :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_xattr_add_entry :: Ptr ArchiveEntry -> CString -> Ptr a -> CSize -> IO () -foreign import ccall archive_entry_xattr_count :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_xattr_reset :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_xattr_next :: Ptr ArchiveEntry -> Ptr CString -> Ptr (Ptr a) -> Ptr CSize -> IO ArchiveError -- TODO: higher level archiveEntryXattrList? -foreign import ccall archive_entry_sparse_clear :: Ptr ArchiveEntry -> IO () -foreign import ccall archive_entry_sparse_add_entry :: Ptr ArchiveEntry -> Int64 -> Int64 -> IO () -foreign import ccall archive_entry_sparse_count :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_sparse_reset :: Ptr ArchiveEntry -> IO CInt -foreign import ccall archive_entry_sparse_next :: Ptr ArchiveEntry -> Ptr Int64 -> Ptr Int64 -> IO ArchiveError - -foreign import ccall archive_entry_linkresolver_new :: Ptr LinkResolver -foreign import ccall archive_entry_linkresolver_set_strategy :: Ptr LinkResolver -> ArchiveFormat -> IO () -foreign import ccall archive_entry_linkresolver_free :: Ptr LinkResolver -> IO () -foreign import ccall archive_entry_linkify :: Ptr LinkResolver -> Ptr (Ptr ArchiveEntry) -> Ptr (Ptr ArchiveEntry) -> IO () -foreign import ccall archive_entry_partial_links :: Ptr LinkResolver -> Ptr CUInt -> IO (Ptr ArchiveEntry) - --- stupid function to work around some annoying C quirk -mode_t :: Integer -> FileType -mode_t = FileType . fromIntegral . asOctal - --- converts 0020000 to 16384 etc. -asOctal :: Integral a => a -> a -asOctal n | n < 10 = n - | otherwise = 8 * asOctal (n `div` 10) + n `mod` 10 - --- filetype -regular :: FileType -regular = {# const AE_IFREG #} - -symlink :: FileType -symlink = {# const AE_IFLNK #} - -socket :: FileType -socket = {# const AE_IFSOCK #} - -characterDevice :: FileType -characterDevice = {# const AE_IFCHR #} - -blockDevice :: FileType -blockDevice = {# const AE_IFBLK #} - -directory :: FileType -directory = {# const AE_IFDIR #} - -fifo :: FileType -fifo = {# const AE_IFIFO #} - -archiveEntryATimeIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryATimeIsSet = fmap intToBool . archive_entry_atime_is_set - -archiveEntryBirthtimeIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryBirthtimeIsSet = fmap intToBool . archive_entry_birthtime_is_set - -archiveEntryCTimeIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryCTimeIsSet = fmap intToBool . archive_entry_ctime_is_set - -archiveEntryDevIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryDevIsSet = fmap intToBool . archive_entry_dev_is_set - -archiveEntryInoIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryInoIsSet = fmap intToBool . archive_entry_ino_is_set - -archiveEntryMTimeIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntryMTimeIsSet = fmap intToBool . archive_entry_mtime_is_set - -archiveEntrySizeIsSet :: Ptr ArchiveEntry -> IO Bool -archiveEntrySizeIsSet = fmap intToBool . archive_entry_size_is_set - -archiveEntryIsDataEncrypted :: Ptr ArchiveEntry -> IO Bool -archiveEntryIsDataEncrypted = fmap intToBool . archive_entry_is_data_encrypted - -archiveEntryIsMetadataEncrypted :: Ptr ArchiveEntry -> IO Bool -archiveEntryIsMetadataEncrypted = fmap intToBool . archive_entry_is_metadata_encrypted - -archiveEntryIsEncrypted :: Ptr ArchiveEntry -> IO Bool -archiveEntryIsEncrypted = fmap intToBool . archive_entry_is_encrypted - -archiveEntryUpdateGNameUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdateGNameUtf8 = fmap intToBool .* archive_entry_update_gname_utf8 - -archiveEntryUpdateHardlinkUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdateHardlinkUtf8 = fmap intToBool .* archive_entry_update_hardlink_utf8 - -archiveEntryUpdateLinkUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdateLinkUtf8 = fmap intToBool .* archive_entry_update_link_utf8 - -archiveEntryUpdatePathnameUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdatePathnameUtf8 = fmap intToBool .* archive_entry_update_pathname_utf8 - -archiveEntryUpdateSymlinkUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdateSymlinkUtf8 = fmap intToBool .* archive_entry_update_symlink_utf8 - -archiveEntryUpdateUNameUtf8 :: Ptr ArchiveEntry -> CString -> IO Bool -archiveEntryUpdateUNameUtf8 = fmap intToBool .* archive_entry_update_uname_utf8 - -archiveEntryACLExecute :: EntryACL -archiveEntryACLExecute = EntryACL {# const ARCHIVE_ENTRY_ACL_EXECUTE #} - -archiveEntryACLWrite :: EntryACL -archiveEntryACLWrite = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE #} - -archiveEntryACLRead :: EntryACL -archiveEntryACLRead = EntryACL {# const ARCHIVE_ENTRY_ACL_READ #} - -archiveEntryACLReadData :: EntryACL -archiveEntryACLReadData = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_DATA #} - -archiveEntryACLListData :: EntryACL -archiveEntryACLListData = EntryACL {# const ARCHIVE_ENTRY_ACL_LIST_DIRECTORY #} - -archiveEntryACLWriteData :: EntryACL -archiveEntryACLWriteData = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_DATA #} - -archiveEntryACLAddFile :: EntryACL -archiveEntryACLAddFile = EntryACL {# const ARCHIVE_ENTRY_ACL_ADD_FILE #} - -archiveEntryACLAppendData :: EntryACL -archiveEntryACLAppendData = EntryACL {# const ARCHIVE_ENTRY_ACL_APPEND_DATA #} - -archiveEntryACLAddSubdirectory :: EntryACL -archiveEntryACLAddSubdirectory = EntryACL {# const ARCHIVE_ENTRY_ACL_ADD_SUBDIRECTORY #} - -archiveEntryACLReadNamedAttrs :: EntryACL -archiveEntryACLReadNamedAttrs = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_NAMED_ATTRS #} - -archiveEntryACLWriteNamedAttrs :: EntryACL -archiveEntryACLWriteNamedAttrs = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_NAMED_ATTRS #} - -archiveEntryACLDeleteChild :: EntryACL -archiveEntryACLDeleteChild = EntryACL {# const ARCHIVE_ENTRY_ACL_DELETE_CHILD #} - -archiveEntryACLReadAttributes :: EntryACL -archiveEntryACLReadAttributes = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_ATTRIBUTES #} - -archiveEntryACLWriteAttributes :: EntryACL -archiveEntryACLWriteAttributes = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_ATTRIBUTES #} - -archiveEntryACLDelete :: EntryACL -archiveEntryACLDelete = EntryACL {# const ARCHIVE_ENTRY_ACL_DELETE #} - -archiveEntryACLReadACL :: EntryACL -archiveEntryACLReadACL = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_ACL #} - -archiveEntryACLWriteACL :: EntryACL -archiveEntryACLWriteACL = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_ACL #} - -archiveEntryACLWriteOwner :: EntryACL -archiveEntryACLWriteOwner = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_OWNER #} - -archiveEntryACLSynchronize :: EntryACL -archiveEntryACLSynchronize = EntryACL {# const ARCHIVE_ENTRY_ACL_SYNCHRONIZE #} - --- archiveEntryACLEntryInherited :: EntryACL --- archiveEntryACLEntryInherited = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_INHERITED #} - -archiveEntryACLEntryFileInherit :: EntryACL -archiveEntryACLEntryFileInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_FILE_INHERIT #} - -archiveEntryACLEntryDirectoryInherit :: EntryACL -archiveEntryACLEntryDirectoryInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_DIRECTORY_INHERIT #} - -archiveEntryACLEntryNoPropagateInherit :: EntryACL -archiveEntryACLEntryNoPropagateInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_NO_PROPAGATE_INHERIT #} - -archiveEntryACLEntryInheritOnly :: EntryACL -archiveEntryACLEntryInheritOnly = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_INHERIT_ONLY #} - -archiveEntryACLEntrySuccessfulAccess :: EntryACL -archiveEntryACLEntrySuccessfulAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_SUCCESSFUL_ACCESS #} - -archiveEntryACLEntryFailedAccess :: EntryACL -archiveEntryACLEntryFailedAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_FAILED_ACCESS #} - -archiveEntryACLTypeAccess :: EntryACL -archiveEntryACLTypeAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ACCESS #} - -archiveEntryACLTypeDefault :: EntryACL -archiveEntryACLTypeDefault = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_DEFAULT #} - -archiveEntryACLTypeAllow :: EntryACL -archiveEntryACLTypeAllow = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ALLOW #} - -archiveEntryACLTypeDeny :: EntryACL -archiveEntryACLTypeDeny = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_DENY #} - -archiveEntryACLTypeAudit :: EntryACL -archiveEntryACLTypeAudit = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_AUDIT #} - -archiveEntryACLTypeAlarm :: EntryACL -archiveEntryACLTypeAlarm = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ALARM #} - -archiveEntryACLUser :: EntryACL -archiveEntryACLUser = EntryACL {# const ARCHIVE_ENTRY_ACL_USER #} - -archiveEntryACLUserObj :: EntryACL -archiveEntryACLUserObj = EntryACL {# const ARCHIVE_ENTRY_ACL_USER_OBJ #} - -archiveEntryACLGroup :: EntryACL -archiveEntryACLGroup = EntryACL {# const ARCHIVE_ENTRY_ACL_GROUP #} - -archiveEntryACLGroupObj :: EntryACL -archiveEntryACLGroupObj = EntryACL {# const ARCHIVE_ENTRY_ACL_GROUP_OBJ #} +#include -archiveEntryACLMask :: EntryACL -archiveEntryACLMask = EntryACL {# const ARCHIVE_ENTRY_ACL_MASK #} +{#pointer *archive_entry_linkresolver as LinkResolverPtr -> LinkResolver #} -archiveEntryACLOther :: EntryACL -archiveEntryACLOther = EntryACL {# const ARCHIVE_ENTRY_ACL_OTHER #} +{#typedef size_t CSize#} +{#typedef wchar_t CWchar#} +{#typedef mode_t CMode#} +{#typedef time_t CTime#} +{#typedef dev_t CDev#} +{#typedef la_int64_t LaInt64#} +{#default in `CWString' [wchar_t*] castPtr#} +{#default out `CWString' [wchar_t*] castPtr#} -archiveEntryACLEveryone :: EntryACL -archiveEntryACLEveryone = EntryACL {# const ARCHIVE_ENTRY_ACL_EVERYONE #} +ft :: CMode -> Maybe FileType +ft 0 = Nothing +ft i = Just $ toEnum (fromIntegral i) -archiveEntryACLStyleExtraID :: EntryACL -archiveEntryACLStyleExtraID = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_EXTRA_ID #} +uft :: Maybe FileType -> CUInt +uft Nothing = 0 +uft (Just ft') = fromIntegral (fromEnum ft') -archiveEntryACLStyleMarkDefault :: EntryACL -archiveEntryACLStyleMarkDefault = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_MARK_DEFAULT #} +{# fun archive_entry_clear as ^ { `ArchiveEntryPtr' } -> `ArchiveEntryPtr' #} +{# fun archive_entry_clone as ^ { `ArchiveEntryPtr' } -> `ArchiveEntryPtr' #} +{# fun archive_entry_new as ^ {} -> `ArchiveEntryPtr' #} +{# fun archive_entry_free as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_new2 as ^ { `ArchivePtr' } -> `ArchiveEntryPtr' #} +{# fun archive_entry_atime as ^ { `ArchiveEntryPtr' } -> `CTime' #} +{# fun archive_entry_atime_nsec as ^ { `ArchiveEntryPtr' } -> `CLong' #} +{# fun archive_entry_birthtime as ^ { `ArchiveEntryPtr' } -> `CTime' #} +{# fun archive_entry_birthtime_nsec as ^ { `ArchiveEntryPtr' } -> `CLong' #} +{# fun archive_entry_ctime as ^ { `ArchiveEntryPtr' } -> `CTime' #} +{# fun archive_entry_ctime_nsec as ^ { `ArchiveEntryPtr' } -> `CLong' #} +{# fun archive_entry_dev as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_devminor as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_devmajor as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_fflags as ^ { `ArchiveEntryPtr', `CULong', `CULong' } -> `()' #} +{# fun archive_entry_fflags_text as ^ { `ArchiveEntryPtr' } -> `CString' #} +-- | Here a 'Nothing' means a hardlink +{# fun archive_entry_filetype as ^ { `ArchiveEntryPtr' } -> `Maybe FileType' ft #} +{# fun archive_entry_gid as ^ { `ArchiveEntryPtr' } -> `LaInt64' #} +{# fun archive_entry_gname as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_gname_utf8 as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_gname_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_hardlink as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_hardlink_utf8 as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_hardlink_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_ino as ^ { `ArchiveEntryPtr' } -> `LaInt64' #} +{# fun archive_entry_ino64 as ^ { `ArchiveEntryPtr' } -> `LaInt64' #} +{# fun archive_entry_mode as ^ { `ArchiveEntryPtr' } -> `CMode' #} +{# fun archive_entry_mtime as ^ { `ArchiveEntryPtr' } -> `CTime' #} +{# fun archive_entry_mtime_nsec as ^ { `ArchiveEntryPtr' } -> `CLong' #} +{# fun archive_entry_nlink as ^ { `ArchiveEntryPtr' } -> `CUInt' #} +{# fun archive_entry_pathname as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_pathname_utf8 as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_pathname_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_perm as ^ { `ArchiveEntryPtr' } -> `CMode' #} +{# fun archive_entry_rdev as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_rdevmajor as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_rdevminor as ^ { `ArchiveEntryPtr' } -> `CDev' #} +{# fun archive_entry_sourcepath as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_sourcepath_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_size as ^ { `ArchiveEntryPtr' } -> `LaInt64' #} +{# fun archive_entry_strmode as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_symlink as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_symlink_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_symlink_utf8 as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_uid as ^ { `ArchiveEntryPtr' } -> `LaInt64' #} +{# fun archive_entry_uname as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_uname_utf8 as ^ { `ArchiveEntryPtr' } -> `CString' #} +{# fun archive_entry_uname_w as ^ { `ArchiveEntryPtr' } -> `CWString' #} +{# fun archive_entry_set_atime as ^ { `ArchiveEntryPtr', `CTime', `CLong' } -> `()' #} +{# fun archive_entry_unset_atime as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_set_birthtime as ^ { `ArchiveEntryPtr', `CTime', `CLong' } -> `()' #} +{# fun archive_entry_unset_birthtime as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_set_ctime as ^ { `ArchiveEntryPtr', `CTime', `CLong' } -> `()' #} +{# fun archive_entry_unset_ctime as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_set_dev as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_devmajor as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_devminor as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_fflags as ^ { `ArchiveEntryPtr', `CULong', `CULong' } -> `()' #} +{# fun archive_entry_copy_fflags_text as ^ { `ArchiveEntryPtr', `CString' } -> `CString' #} +{# fun archive_entry_copy_fflags_text_w as ^ { `ArchiveEntryPtr', `CWString' } -> `CWString' #} +-- | Here a 'Nothing' means a hardlink +{# fun archive_entry_set_filetype as ^ { `ArchiveEntryPtr', uft `Maybe FileType' } -> `()' #} +{# fun archive_entry_set_gid as ^ { `ArchiveEntryPtr', `LaInt64' } -> `()' #} +{# fun archive_entry_set_gname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_gname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_gname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_gname_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_hardlink as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_hardlink_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_hardlink as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_hardlink_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_ino as ^ { `ArchiveEntryPtr', `LaInt64' } -> `()' #} +{# fun archive_entry_set_ino64 as ^ { `ArchiveEntryPtr', `LaInt64' } -> `()' #} +{# fun archive_entry_set_link as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_link_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_link as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_link_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_mode as ^ { `ArchiveEntryPtr', `CMode' } -> `()' #} +{# fun archive_entry_set_mtime as ^ { `ArchiveEntryPtr', `CTime', `CLong' } -> `()' #} +{# fun archive_entry_unset_mtime as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_set_nlink as ^ { `ArchiveEntryPtr', `CUInt' } -> `()' #} +{# fun archive_entry_set_pathname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_pathname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_pathname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_pathname_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_perm as ^ { `ArchiveEntryPtr', `CMode' } -> `()' #} +{# fun archive_entry_set_rdev as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_rdevmajor as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_rdevminor as ^ { `ArchiveEntryPtr', `CDev' } -> `()' #} +{# fun archive_entry_set_size as ^ { `ArchiveEntryPtr', `LaInt64' } -> `()' #} +{# fun archive_entry_unset_size as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_copy_sourcepath as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_sourcepath_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_symlink as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_symlink_type as ^ { `ArchiveEntryPtr', `Symlink' } -> `()' #} +{# fun archive_entry_set_symlink_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_symlink as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_symlink_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_set_uid as ^ { `ArchiveEntryPtr', `LaInt64' } -> `()' #} +{# fun archive_entry_set_uname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_set_uname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_uname as ^ { `ArchiveEntryPtr', `CString' } -> `()' #} +{# fun archive_entry_copy_uname_w as ^ { `ArchiveEntryPtr', `CWString' } -> `()' #} +{# fun archive_entry_stat as ^ { `ArchiveEntryPtr' } -> `StatPtr' #} +{# fun archive_entry_copy_stat as ^ { `ArchiveEntryPtr', `StatPtr' } -> `()' #} +{# fun archive_entry_mac_metadata as ^ { `ArchiveEntryPtr', castPtr `Ptr CSize' } -> `Ptr a' castPtr #} +{# fun archive_entry_copy_mac_metadata as ^ { `ArchiveEntryPtr', castPtr `Ptr a', `CSize' } -> `()' #} --- archiveEntryACLStyleSolaris :: EntryACL --- archiveEntryACLStyleSolaris = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_SOLARIS #} +{# fun archive_entry_acl_clear as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_acl_add_entry as ^ { `ArchiveEntryPtr', coerce `EntryACL', coerce `EntryACL', coerce `EntryACL', `CInt', `CString' } -> `CInt' #} +{# fun archive_entry_acl_add_entry_w as ^ { `ArchiveEntryPtr', coerce `EntryACL', coerce `EntryACL', coerce `EntryACL', `CInt', `CWString' } -> `CInt' #} +{# fun archive_entry_acl_reset as ^ { `ArchiveEntryPtr', coerce `EntryACL' } -> `CInt' #} +{# fun archive_entry_acl_next as ^ { `ArchiveEntryPtr', coerce `EntryACL', castPtr `Ptr EntryACL', castPtr `Ptr EntryACL', castPtr `Ptr EntryACL', id `Ptr CInt', id `Ptr CString' } -> `CInt' #} +{# fun archive_entry_acl_next_w as ^ { `ArchiveEntryPtr', coerce `EntryACL', castPtr `Ptr EntryACL', castPtr `Ptr EntryACL', castPtr `Ptr EntryACL', id `Ptr CInt', id `Ptr CWString' } -> `CInt' #} +{# fun archive_entry_acl_to_text_w as ^ { `ArchiveEntryPtr', castPtr `Ptr LaSSize', coerce `EntryACL' } -> `CWString' #} +{# fun archive_entry_acl_to_text as ^ { `ArchiveEntryPtr', castPtr `Ptr LaSSize', coerce `EntryACL' } -> `CString' #} +{# fun archive_entry_acl_from_text as ^ { `ArchiveEntryPtr', `CString', coerce `EntryACL' } -> `CInt' #} +{# fun archive_entry_acl_from_text_w as ^ { `ArchiveEntryPtr', `CWString', coerce `EntryACL' } -> `CInt' #} +{# fun archive_entry_acl_types as ^ { `ArchiveEntryPtr' } -> `EntryACL' coerce #} +{# fun archive_entry_acl_count as ^ { `ArchiveEntryPtr', coerce `EntryACL' } -> `CInt' #} --- archiveEntryACLStyleSeparatorComma :: EntryACL --- archiveEntryACLStyleSeparatorComma = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_SEPARATOR_COMMA #} +{# fun archive_entry_xattr_clear as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_xattr_add_entry as ^ { `ArchiveEntryPtr', `CString', castPtr `Ptr a', `CSize' } -> `()' #} +{# fun archive_entry_xattr_count as ^ { `ArchiveEntryPtr' } -> `CInt' #} +{# fun archive_entry_xattr_reset as ^ { `ArchiveEntryPtr' } -> `CInt' #} +{# fun archive_entry_xattr_next as ^ { `ArchiveEntryPtr', id `Ptr CString', castPtr `Ptr (Ptr a)', id `Ptr CSize' } -> `CInt' #} +{# fun archive_entry_sparse_clear as ^ { `ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_sparse_add_entry as ^ { `ArchiveEntryPtr', `LaInt64', `LaInt64' } -> `()' #} +{# fun archive_entry_sparse_count as ^ { `ArchiveEntryPtr' } -> `CInt' #} +{# fun archive_entry_sparse_reset as ^ { `ArchiveEntryPtr' } -> `CInt' #} +{# fun archive_entry_sparse_next as ^ { `ArchiveEntryPtr', id `Ptr LaInt64', id `Ptr LaInt64' } -> `CInt' #} +{# fun archive_entry_linkresolver_new as ^ {} -> `LinkResolverPtr' #} +{# fun archive_entry_linkresolver_set_strategy as ^ { `LinkResolverPtr', `ArchiveFormat' } -> `()' #} +{# fun archive_entry_linkresolver_free as ^ { `LinkResolverPtr' } -> `()' #} +{# fun archive_entry_linkify as ^ { `LinkResolverPtr', id `Ptr ArchiveEntryPtr', id `Ptr ArchiveEntryPtr' } -> `()' #} +{# fun archive_entry_partial_links as ^ { `LinkResolverPtr', id `Ptr CUInt' } -> `Ptr ArchiveEntry' id #} --- archiveEntryACLStyleCompact :: EntryACL --- archiveEntryACLStyleCompact = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_COMPACT #} +{# fun archive_entry_atime_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_birthtime_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_ctime_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_dev_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_ino_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_mtime_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_size_is_set as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_is_data_encrypted as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_is_metadata_encrypted as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_is_encrypted as ^ { `ArchiveEntryPtr' } -> `Bool' #} +{# fun archive_entry_update_gname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} +{# fun archive_entry_update_hardlink_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} +{# fun archive_entry_update_link_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} +{# fun archive_entry_update_pathname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} +{# fun archive_entry_update_symlink_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} +{# fun archive_entry_update_uname_utf8 as ^ { `ArchiveEntryPtr', `CString' } -> `Bool' #} diff --git a/src/Codec/Archive/Foreign/ArchiveEntry/Macros.chs b/src/Codec/Archive/Foreign/ArchiveEntry/Macros.chs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Foreign/ArchiveEntry/Macros.chs @@ -0,0 +1,185 @@ +module Codec.Archive.Foreign.ArchiveEntry.Macros ( archiveEntryACLExecute + , archiveEntryACLWrite + , archiveEntryACLRead + , archiveEntryACLReadData + , archiveEntryACLListData + , archiveEntryACLWriteData + , archiveEntryACLAddFile + , archiveEntryACLAppendData + , archiveEntryACLAddSubdirectory + , archiveEntryACLReadNamedAttrs + , archiveEntryACLWriteNamedAttrs + , archiveEntryACLDeleteChild + , archiveEntryACLReadAttributes + , archiveEntryACLWriteAttributes + , archiveEntryACLDelete + , archiveEntryACLReadACL + , archiveEntryACLWriteACL + , archiveEntryACLWriteOwner + , archiveEntryACLSynchronize + , archiveEntryACLEntryFileInherit + , archiveEntryACLEntryDirectoryInherit + , archiveEntryACLEntryNoPropagateInherit + , archiveEntryACLEntryInheritOnly + , archiveEntryACLEntrySuccessfulAccess + , archiveEntryACLEntryFailedAccess + , archiveEntryACLTypeAccess + , archiveEntryACLTypeDefault + , archiveEntryACLTypeAllow + , archiveEntryACLTypeDeny + , archiveEntryACLTypeAudit + , archiveEntryACLTypeAlarm + , archiveEntryACLUser + , archiveEntryACLUserObj + , archiveEntryACLGroup + , archiveEntryACLGroupObj + , archiveEntryACLMask + , archiveEntryACLOther + , archiveEntryACLEveryone + , archiveEntryACLStyleExtraID + , archiveEntryACLStyleMarkDefault + , archiveEntryACLEntryInherited + , archiveEntryACLStyleSolaris + , archiveEntryACLStyleSeparatorComma + , archiveEntryACLStyleCompact + ) where + +import Codec.Archive.Types + +#include + +archiveEntryACLExecute :: EntryACL +archiveEntryACLExecute = EntryACL {# const ARCHIVE_ENTRY_ACL_EXECUTE #} + +archiveEntryACLWrite :: EntryACL +archiveEntryACLWrite = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE #} + +archiveEntryACLRead :: EntryACL +archiveEntryACLRead = EntryACL {# const ARCHIVE_ENTRY_ACL_READ #} + +archiveEntryACLReadData :: EntryACL +archiveEntryACLReadData = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_DATA #} + +archiveEntryACLListData :: EntryACL +archiveEntryACLListData = EntryACL {# const ARCHIVE_ENTRY_ACL_LIST_DIRECTORY #} + +archiveEntryACLWriteData :: EntryACL +archiveEntryACLWriteData = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_DATA #} + +archiveEntryACLAddFile :: EntryACL +archiveEntryACLAddFile = EntryACL {# const ARCHIVE_ENTRY_ACL_ADD_FILE #} + +archiveEntryACLAppendData :: EntryACL +archiveEntryACLAppendData = EntryACL {# const ARCHIVE_ENTRY_ACL_APPEND_DATA #} + +archiveEntryACLAddSubdirectory :: EntryACL +archiveEntryACLAddSubdirectory = EntryACL {# const ARCHIVE_ENTRY_ACL_ADD_SUBDIRECTORY #} + +archiveEntryACLReadNamedAttrs :: EntryACL +archiveEntryACLReadNamedAttrs = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_NAMED_ATTRS #} + +archiveEntryACLWriteNamedAttrs :: EntryACL +archiveEntryACLWriteNamedAttrs = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_NAMED_ATTRS #} + +archiveEntryACLDeleteChild :: EntryACL +archiveEntryACLDeleteChild = EntryACL {# const ARCHIVE_ENTRY_ACL_DELETE_CHILD #} + +archiveEntryACLReadAttributes :: EntryACL +archiveEntryACLReadAttributes = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_ATTRIBUTES #} + +archiveEntryACLWriteAttributes :: EntryACL +archiveEntryACLWriteAttributes = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_ATTRIBUTES #} + +archiveEntryACLDelete :: EntryACL +archiveEntryACLDelete = EntryACL {# const ARCHIVE_ENTRY_ACL_DELETE #} + +archiveEntryACLReadACL :: EntryACL +archiveEntryACLReadACL = EntryACL {# const ARCHIVE_ENTRY_ACL_READ_ACL #} + +archiveEntryACLWriteACL :: EntryACL +archiveEntryACLWriteACL = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_ACL #} + +archiveEntryACLWriteOwner :: EntryACL +archiveEntryACLWriteOwner = EntryACL {# const ARCHIVE_ENTRY_ACL_WRITE_OWNER #} + +archiveEntryACLSynchronize :: EntryACL +archiveEntryACLSynchronize = EntryACL {# const ARCHIVE_ENTRY_ACL_SYNCHRONIZE #} + +-- | @since 2.0.0.0 +archiveEntryACLEntryInherited :: EntryACL +archiveEntryACLEntryInherited = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_INHERITED #} + +archiveEntryACLEntryFileInherit :: EntryACL +archiveEntryACLEntryFileInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_FILE_INHERIT #} + +archiveEntryACLEntryDirectoryInherit :: EntryACL +archiveEntryACLEntryDirectoryInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_DIRECTORY_INHERIT #} + +archiveEntryACLEntryNoPropagateInherit :: EntryACL +archiveEntryACLEntryNoPropagateInherit = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_NO_PROPAGATE_INHERIT #} + +archiveEntryACLEntryInheritOnly :: EntryACL +archiveEntryACLEntryInheritOnly = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_INHERIT_ONLY #} + +archiveEntryACLEntrySuccessfulAccess :: EntryACL +archiveEntryACLEntrySuccessfulAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_SUCCESSFUL_ACCESS #} + +archiveEntryACLEntryFailedAccess :: EntryACL +archiveEntryACLEntryFailedAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_ENTRY_FAILED_ACCESS #} + +archiveEntryACLTypeAccess :: EntryACL +archiveEntryACLTypeAccess = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ACCESS #} + +archiveEntryACLTypeDefault :: EntryACL +archiveEntryACLTypeDefault = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_DEFAULT #} + +archiveEntryACLTypeAllow :: EntryACL +archiveEntryACLTypeAllow = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ALLOW #} + +archiveEntryACLTypeDeny :: EntryACL +archiveEntryACLTypeDeny = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_DENY #} + +archiveEntryACLTypeAudit :: EntryACL +archiveEntryACLTypeAudit = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_AUDIT #} + +archiveEntryACLTypeAlarm :: EntryACL +archiveEntryACLTypeAlarm = EntryACL {# const ARCHIVE_ENTRY_ACL_TYPE_ALARM #} + +archiveEntryACLUser :: EntryACL +archiveEntryACLUser = EntryACL {# const ARCHIVE_ENTRY_ACL_USER #} + +archiveEntryACLUserObj :: EntryACL +archiveEntryACLUserObj = EntryACL {# const ARCHIVE_ENTRY_ACL_USER_OBJ #} + +archiveEntryACLGroup :: EntryACL +archiveEntryACLGroup = EntryACL {# const ARCHIVE_ENTRY_ACL_GROUP #} + +archiveEntryACLGroupObj :: EntryACL +archiveEntryACLGroupObj = EntryACL {# const ARCHIVE_ENTRY_ACL_GROUP_OBJ #} + +archiveEntryACLMask :: EntryACL +archiveEntryACLMask = EntryACL {# const ARCHIVE_ENTRY_ACL_MASK #} + +archiveEntryACLOther :: EntryACL +archiveEntryACLOther = EntryACL {# const ARCHIVE_ENTRY_ACL_OTHER #} + +archiveEntryACLEveryone :: EntryACL +archiveEntryACLEveryone = EntryACL {# const ARCHIVE_ENTRY_ACL_EVERYONE #} + +archiveEntryACLStyleExtraID :: EntryACL +archiveEntryACLStyleExtraID = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_EXTRA_ID #} + +archiveEntryACLStyleMarkDefault :: EntryACL +archiveEntryACLStyleMarkDefault = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_MARK_DEFAULT #} + +-- | @since 2.0.0.0 +archiveEntryACLStyleSolaris :: EntryACL +archiveEntryACLStyleSolaris = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_SOLARIS #} + +-- | @since 2.0.0.0 +archiveEntryACLStyleSeparatorComma :: EntryACL +archiveEntryACLStyleSeparatorComma = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_SEPARATOR_COMMA #} + +-- | @since 2.0.0.0 +archiveEntryACLStyleCompact :: EntryACL +archiveEntryACLStyleCompact = EntryACL {# const ARCHIVE_ENTRY_ACL_STYLE_COMPACT #} diff --git a/src/Codec/Archive/Foreign/Common.hs b/src/Codec/Archive/Foreign/Common.hs deleted file mode 100644 --- a/src/Codec/Archive/Foreign/Common.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Codec.Archive.Foreign.Common ( intToBool ) where - -import Foreign.C.Types - --- TODO: this should check against ArchiveFatal or whatnot? -intToBool :: CInt -> Bool -intToBool = toEnum . fromIntegral diff --git a/src/Codec/Archive/Monad.hs b/src/Codec/Archive/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Monad.hs @@ -0,0 +1,63 @@ +module Codec.Archive.Monad ( handle + , ignore + , runArchiveM + -- * Bracketed resources within 'ArchiveM' + , withCStringArchiveM + , useAsCStringLenArchiveM + , allocaArchiveM + , allocaBytesArchiveM + , ArchiveM + ) where + +import Codec.Archive.Types +import Control.Monad (void) +import Control.Monad.Except (ExceptT, runExceptT, throwError) +import Control.Monad.IO.Class +import Data.ByteString (useAsCStringLen) +import qualified Data.ByteString as BS +import Foreign.C.String +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Ptr (Ptr) +import Foreign.Storable (Storable) + +type ArchiveM = ExceptT ArchiveResult IO + +-- for things we don't think is going to fail +ignore :: IO ArchiveResult -> ArchiveM () +ignore = void . liftIO + +runArchiveM :: ArchiveM a -> IO (Either ArchiveResult a) +runArchiveM = runExceptT + +handle :: IO ArchiveResult -> ArchiveM () +handle act = do + res <- liftIO act + case res of + ArchiveOk -> pure () + ArchiveRetry -> pure () + x -> throwError x + +flipExceptIO :: IO (Either a b) -> ExceptT a IO b +flipExceptIO act = do + res <- liftIO act + case res of + Right x -> pure x + Left y -> throwError y + +genBracket :: (a -> (b -> IO (Either c d)) -> IO (Either c d)) -- ^ Function like 'withCString' we are trying to lift + -> a -- ^ Fed to @b@ + -> (b -> ExceptT c IO d) -- ^ The action + -> ExceptT c IO d +genBracket f x = flipExceptIO . f x . (runExceptT .) + +allocaArchiveM :: Storable a => (Ptr a -> ExceptT b IO c) -> ExceptT b IO c +allocaArchiveM = genBracket (pure alloca) () + +allocaBytesArchiveM :: Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c +allocaBytesArchiveM = genBracket allocaBytes + +withCStringArchiveM :: String -> (CString -> ExceptT a IO b) -> ExceptT a IO b +withCStringArchiveM = genBracket withCString + +useAsCStringLenArchiveM :: BS.ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b +useAsCStringLenArchiveM = genBracket useAsCStringLen diff --git a/src/Codec/Archive/Pack.hs b/src/Codec/Archive/Pack.hs --- a/src/Codec/Archive/Pack.hs +++ b/src/Codec/Archive/Pack.hs @@ -5,52 +5,71 @@ , entriesToBSzip , entriesToBS7zip , packEntries + , noFail + , packToFile + , packToFileZip + , packToFile7Zip ) where import Codec.Archive.Foreign +import Codec.Archive.Monad +import Codec.Archive.Pack.Common import Codec.Archive.Types -import Control.Monad (void) -import Data.ByteString (packCStringLen, useAsCStringLen) -import qualified Data.ByteString as BS -import Data.Foldable (traverse_) -import Data.Semigroup (Sum (..)) +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.ByteString (packCStringLen) +import qualified Data.ByteString as BS +import Data.Coerce (coerce) +import Data.Foldable (sequenceA_, traverse_) +import Data.Semigroup (Sum (..)) import Foreign.C.String -import Foreign.Marshal.Alloc (alloca, allocaBytes) -import Foreign.Ptr (Ptr) -import Foreign.Storable (peek) -import System.IO.Unsafe (unsafePerformIO) +import Foreign.C.Types (CLLong (..), CLong (..)) +import Foreign.Ptr (Ptr) +import System.IO.Unsafe (unsafeDupablePerformIO) -contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> IO () +maybeDo :: Applicative f => Maybe (f ()) -> f () +maybeDo = sequenceA_ + +contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM () contentAdd (NormalFile contents) a entry = do - archive_entry_set_filetype entry regular - archive_entry_set_size entry (fromIntegral (BS.length contents)) - void $ archive_write_header a entry - useAsCStringLen contents $ \(buff, sz) -> - void $ archive_write_data a buff (fromIntegral sz) + liftIO $ archiveEntrySetFiletype entry (Just FtRegular) + liftIO $ archiveEntrySetSize entry (fromIntegral (BS.length contents)) + handle $ archiveWriteHeader a entry + useAsCStringLenArchiveM contents $ \(buff, sz) -> + liftIO $ void $ archiveWriteData a buff (fromIntegral sz) contentAdd Directory a entry = do - archive_entry_set_filetype entry directory - void $ archive_write_header a entry + liftIO $ archiveEntrySetFiletype entry (Just FtDirectory) + handle $ archiveWriteHeader a entry contentAdd (Symlink fp) a entry = do - archive_entry_set_filetype entry symlink - withCString fp $ \fpc -> - archive_entry_set_symlink entry fpc - void $ archive_write_header a entry + liftIO $ archiveEntrySetFiletype entry (Just FtLink) + liftIO $ withCString fp $ \fpc -> + archiveEntrySetSymlink entry fpc + handle $ archiveWriteHeader a entry +contentAdd (Hardlink fp) a entry = do + liftIO $ archiveEntrySetFiletype entry Nothing + liftIO $ withCString fp $ \fpc -> + archiveEntrySetHardlink entry fpc + handle $ archiveWriteHeader a entry +withMaybeCString :: Maybe String -> (Maybe CString -> IO a) -> IO a +withMaybeCString (Just x) f = withCString x (f . Just) +withMaybeCString Nothing f = f Nothing + setOwnership :: Ownership -> Ptr ArchiveEntry -> IO () setOwnership (Ownership uname gname uid gid) entry = - withCString uname $ \unameC -> - withCString gname $ \gnameC -> - sequence_ - [ archive_entry_set_uname entry unameC - , archive_entry_set_gname entry gnameC - , archive_entry_set_uid entry uid - , archive_entry_set_gid entry gid + withMaybeCString uname $ \unameC -> + withMaybeCString gname $ \gnameC -> + traverse_ maybeDo + [ archiveEntrySetUname entry <$> unameC + , archiveEntrySetGname entry <$> gnameC + , Just (archiveEntrySetUid entry (coerce uid)) + , Just (archiveEntrySetGid entry (coerce gid)) ] setTime :: ModTime -> Ptr ArchiveEntry -> IO () -setTime (time', nsec) entry = archive_entry_set_mtime entry time' nsec +setTime (time', nsec) entry = archiveEntrySetMtime entry time' nsec -packEntries :: (Foldable t) => Ptr Archive -> t Entry -> IO () +packEntries :: (Foldable t) => Ptr Archive -> t Entry -> ArchiveM () packEntries a = traverse_ (archiveEntryAdd a) -- Get a number of bytes appropriate for creating the archive. @@ -60,46 +79,79 @@ contentSz (NormalFile str) = fromIntegral $ BS.length str contentSz Directory = 0 contentSz (Symlink fp) = fromIntegral $ length fp + contentSz (Hardlink fp) = fromIntegral $ length fp --idk if this is right -- | Returns a 'BS.ByteString' containing a tar archive with the 'Entry's -- -- @since 1.0.0.0 entriesToBS :: Foldable t => t Entry -> BS.ByteString -entriesToBS = unsafePerformIO . entriesToBSGeneral archive_write_set_format_pax_restricted +entriesToBS = unsafeDupablePerformIO . noFail . entriesToBSGeneral archiveWriteSetFormatPaxRestricted {-# NOINLINE entriesToBS #-} -- | Returns a 'BS.ByteString' containing a @.7z@ archive with the 'Entry's -- -- @since 1.0.0.0 entriesToBS7zip :: Foldable t => t Entry -> BS.ByteString -entriesToBS7zip = unsafePerformIO . entriesToBSGeneral archive_write_set_format_7zip +entriesToBS7zip = unsafeDupablePerformIO . noFail . entriesToBSGeneral archiveWriteSetFormat7zip {-# NOINLINE entriesToBS7zip #-} -- | Returns a 'BS.ByteString' containing a zip archive with the 'Entry's -- -- @since 1.0.0.0 entriesToBSzip :: Foldable t => t Entry -> BS.ByteString -entriesToBSzip = unsafePerformIO . entriesToBSGeneral archive_write_set_format_zip +entriesToBSzip = unsafeDupablePerformIO . noFail . entriesToBSGeneral archiveWriteSetFormatZip {-# NOINLINE entriesToBSzip #-} +-- This is for things we don't think will fail. When making a 'BS.ByteString' +-- from a bunch of 'Entry's, for instance, we don't anticipate any errors +noFail :: ArchiveM a -> IO a +noFail act = do + res <- runArchiveM act + case res of + Right x -> pure x + Left _ -> error "Should not fail." + -- | Internal function to be used with 'archive_write_set_format_pax' etc. -entriesToBSGeneral :: (Foldable t) => (Ptr Archive -> IO ArchiveError) -> t Entry -> IO BS.ByteString +entriesToBSGeneral :: (Foldable t) => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BS.ByteString entriesToBSGeneral modifier hsEntries' = do - a <- archive_write_new - void $ modifier a - alloca $ \used -> - allocaBytes bufSize $ \buffer -> do - void $ archive_write_open_memory a buffer bufSize used - packEntries a hsEntries' - void $ archive_write_close a - usedSz <- peek used - res <- curry packCStringLen buffer (fromIntegral usedSz) - void $ archive_write_free a - pure res + a <- liftIO archiveWriteNew + ignore $ modifier a + allocaBytesArchiveM bufSize $ \buffer -> do + (err, usedSz) <- liftIO $ archiveWriteOpenMemory a buffer bufSize + handle (pure err) + packEntries a hsEntries' + handle $ archiveWriteClose a + res <- liftIO $ curry packCStringLen buffer (fromIntegral usedSz) + ignore $ archiveFree a + pure res where bufSize :: Integral a => a bufSize = entriesSz hsEntries' +filePacker :: (Traversable t) => (FilePath -> t Entry -> ArchiveM ()) -> FilePath -> t FilePath -> ArchiveM () +filePacker f tar fps = f tar =<< liftIO (traverse mkEntry fps) + +-- | @since 2.0.0.0 +packToFile :: Traversable t + => FilePath -- ^ @.tar@ archive to be created + -> t FilePath -- ^ Files to include + -> ArchiveM () +packToFile = filePacker entriesToFile + +-- | @since 2.0.0.0 +packToFileZip :: Traversable t + => FilePath + -> t FilePath + -> ArchiveM () +packToFileZip = filePacker entriesToFileZip + +-- | @since 2.0.0.0 +packToFile7Zip :: Traversable t + => FilePath + -> t FilePath + -> ArchiveM () +packToFile7Zip = filePacker entriesToFile7Zip + -- | Write some entries to a file, creating a tar archive. This is more -- efficient than -- @@ -108,44 +160,44 @@ -- @ -- -- @since 1.0.0.0 -entriesToFile :: Foldable t => FilePath -> t Entry -> IO () -entriesToFile = entriesToFileGeneral archive_write_set_format_pax_restricted +entriesToFile :: Foldable t => FilePath -> t Entry -> ArchiveM () +entriesToFile = entriesToFileGeneral archiveWriteSetFormatPaxRestricted -- this is the recommended format; it is a tar archive -- | Write some entries to a file, creating a zip archive. -- -- @since 1.0.0.0 -entriesToFileZip :: Foldable t => FilePath -> t Entry -> IO () -entriesToFileZip = entriesToFileGeneral archive_write_set_format_zip +entriesToFileZip :: Foldable t => FilePath -> t Entry -> ArchiveM () +entriesToFileZip = entriesToFileGeneral archiveWriteSetFormatZip -- | Write some entries to a file, creating a @.7z@ archive. -- -- @since 1.0.0.0 -entriesToFile7Zip :: Foldable t => FilePath -> t Entry -> IO () -entriesToFile7Zip = entriesToFileGeneral archive_write_set_format_7zip +entriesToFile7Zip :: Foldable t => FilePath -> t Entry -> ArchiveM () +entriesToFile7Zip = entriesToFileGeneral archiveWriteSetFormat7zip -entriesToFileGeneral :: Foldable t => (Ptr Archive -> IO ArchiveError) -> FilePath -> t Entry -> IO () +entriesToFileGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> FilePath -> t Entry -> ArchiveM () entriesToFileGeneral modifier fp hsEntries' = do - a <- archive_write_new - void $ modifier a - withCString fp $ \fpc -> - void $ archive_write_open_filename a fpc + a <- liftIO archiveWriteNew + ignore $ modifier a + withCStringArchiveM fp $ \fpc -> + handle $ archiveWriteOpenFilename a fpc packEntries a hsEntries' - void $ archive_write_free a + ignore $ archiveFree a -withArchiveEntry :: (Ptr ArchiveEntry -> IO a) -> IO a +withArchiveEntry :: MonadIO m => (Ptr ArchiveEntry -> m a) -> m a withArchiveEntry fact = do - entry <- archive_entry_new + entry <- liftIO archiveEntryNew res <- fact entry - archive_entry_free entry + liftIO $ archiveEntryFree entry pure res -archiveEntryAdd :: Ptr Archive -> Entry -> IO () +archiveEntryAdd :: Ptr Archive -> Entry -> ArchiveM () archiveEntryAdd a (Entry fp contents perms owner mtime) = withArchiveEntry $ \entry -> do - withCString fp $ \fpc -> - archive_entry_set_pathname entry fpc - archive_entry_set_perm entry perms - setOwnership owner entry - setTime mtime entry + liftIO $ withCString fp $ \fpc -> + archiveEntrySetPathname entry fpc + liftIO $ archiveEntrySetPerm entry perms + liftIO $ setOwnership owner entry + liftIO $ maybeDo (setTime <$> mtime <*> pure entry) contentAdd contents a entry diff --git a/src/Codec/Archive/Pack/Common.hs b/src/Codec/Archive/Pack/Common.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Pack/Common.hs @@ -0,0 +1,25 @@ +module Codec.Archive.Pack.Common ( mkEntry ) where + +import Codec.Archive.Types +import qualified Data.ByteString as BS +import System.PosixCompat.Files (fileGroup, fileMode, fileOwner, + getFileStatus, isDirectory, + isRegularFile, isSymbolicLink, + readSymbolicLink) + +mkContent :: FilePath -> IO EntryContent +mkContent fp = do + status <- getFileStatus fp + let res = (isRegularFile status, isDirectory status, isSymbolicLink status) + case res of + (True, False, False) -> NormalFile <$> BS.readFile fp + (False, True, False) -> pure Directory + (False, False, True) -> Symlink <$> readSymbolicLink fp + (_, _, _) -> error "inconsistent read result" + +mkEntry :: FilePath -> IO Entry +mkEntry fp = do + status <- getFileStatus fp + content' <- mkContent fp + pure $ Entry fp content' (fileMode status) (Ownership Nothing Nothing (fromIntegral $ fileOwner status) (fromIntegral $ fileGroup status)) Nothing + diff --git a/src/Codec/Archive/Pack/Lazy.hs b/src/Codec/Archive/Pack/Lazy.hs --- a/src/Codec/Archive/Pack/Lazy.hs +++ b/src/Codec/Archive/Pack/Lazy.hs @@ -1,57 +1,81 @@ module Codec.Archive.Pack.Lazy ( entriesToBSL , entriesToBSL7zip , entriesToBSLzip + , packFiles + , packFilesZip + , packFiles7zip ) where import Codec.Archive.Foreign +import Codec.Archive.Monad import Codec.Archive.Pack +import Codec.Archive.Pack.Common import Codec.Archive.Types -import Control.Monad (void) -import Data.ByteString (packCStringLen) -import qualified Data.ByteString.Lazy as BSL -import qualified Data.DList as DL -import Data.Foldable (toList) -import Data.Functor (($>)) -import Data.IORef (modifyIORef', newIORef, readIORef) -import Foreign.Marshal.Alloc (free, mallocBytes) +import Control.Composition ((.@)) +import Control.Monad.IO.Class (liftIO) +import Data.ByteString (packCStringLen) +import qualified Data.ByteString.Lazy as BSL +import qualified Data.DList as DL +import Data.Foldable (toList) +import Data.Functor (($>)) +import Data.IORef (modifyIORef', newIORef, readIORef) +import Foreign.Marshal.Alloc (free, mallocBytes) import Foreign.Ptr -import System.IO.Unsafe (unsafePerformIO) +import System.IO.Unsafe (unsafeDupablePerformIO) +packer :: (Traversable t) => (t Entry -> BSL.ByteString) -> t FilePath -> IO BSL.ByteString +packer = traverse mkEntry .@ fmap + +-- | Pack files into a tar archive +-- +-- @since 2.0.0.0 +packFiles :: Traversable t + => t FilePath -- ^ Filepaths relative to the current directory + -> IO BSL.ByteString +packFiles = packer entriesToBSL + +-- | @since 2.0.0.0 +packFilesZip :: Traversable t => t FilePath -> IO BSL.ByteString +packFilesZip = packer entriesToBSLzip + +-- | @since 2.0.0.0 +packFiles7zip :: Traversable t => t FilePath -> IO BSL.ByteString +packFiles7zip = packer entriesToBSL7zip + -- | @since 1.0.5.0 entriesToBSLzip :: Foldable t => t Entry -> BSL.ByteString -entriesToBSLzip = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_zip +entriesToBSLzip = unsafeDupablePerformIO . noFail . entriesToBSLGeneral archiveWriteSetFormatZip {-# NOINLINE entriesToBSLzip #-} -- | @since 1.0.5.0 entriesToBSL7zip :: Foldable t => t Entry -> BSL.ByteString -entriesToBSL7zip = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_7zip +entriesToBSL7zip = unsafeDupablePerformIO . noFail . entriesToBSLGeneral archiveWriteSetFormat7zip {-# NOINLINE entriesToBSL7zip #-} -- | In general, this will be more efficient than 'entriesToBS' -- -- @since 1.0.5.0 entriesToBSL :: Foldable t => t Entry -> BSL.ByteString -entriesToBSL = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_pax_restricted +entriesToBSL = unsafeDupablePerformIO . noFail . entriesToBSLGeneral archiveWriteSetFormatPaxRestricted {-# NOINLINE entriesToBSL #-} --- I'm not sure if this actually streams anything or not but like... -entriesToBSLGeneral :: Foldable t => (Ptr Archive -> IO ArchiveError) -> t Entry -> IO BSL.ByteString +entriesToBSLGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BSL.ByteString entriesToBSLGeneral modifier hsEntries' = do - a <- archive_write_new - bsRef <- newIORef mempty - oc <- mkOpenCallback doNothing - wc <- mkWriteCallback (writeBSL bsRef) - cc <- mkCloseCallback (\_ ptr -> freeHaskellFunPtr oc *> freeHaskellFunPtr wc *> free ptr $> archiveOk) - nothingPtr <- mallocBytes 0 - void $ modifier a - void $ archive_write_open a nothingPtr oc wc cc + a <- liftIO archiveWriteNew + bsRef <- liftIO $ newIORef mempty + oc <- liftIO $ mkOpenCallback doNothing + wc <- liftIO $ mkWriteCallback (writeBSL bsRef) + cc <- liftIO $ mkCloseCallback (\_ ptr -> freeHaskellFunPtr oc *> freeHaskellFunPtr wc *> free ptr $> ArchiveOk) + nothingPtr <- liftIO $ mallocBytes 0 + ignore $ modifier a + handle $ archiveWriteOpen a nothingPtr oc wc cc packEntries a hsEntries' - void $ archive_write_free a - BSL.fromChunks . toList <$> readIORef bsRef + ignore $ archiveFree a + BSL.fromChunks . toList <$> liftIO (readIORef bsRef) <* liftIO (freeHaskellFunPtr cc) where writeBSL bsRef _ _ bufPtr sz = do - let bytesRead = min sz (32 * 1024) + let bytesRead = min (fromIntegral sz) (32 * 1024) bsl <- packCStringLen (bufPtr, fromIntegral bytesRead) modifyIORef' bsRef (`DL.snoc` bsl) pure bytesRead - doNothing _ _ = pure archiveOk + doNothing _ _ = pure ArchiveOk diff --git a/src/Codec/Archive/Permissions.hs b/src/Codec/Archive/Permissions.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Permissions.hs @@ -0,0 +1,12 @@ +module Codec.Archive.Permissions ( standardPermissions + , executablePermissions + ) where + +import Codec.Archive.Types + +standardPermissions :: Permissions +standardPermissions = 0o644 + +-- | Also used for directories +executablePermissions :: Permissions +executablePermissions = 0o755 diff --git a/src/Codec/Archive/Types.hs b/src/Codec/Archive/Types.hs --- a/src/Codec/Archive/Types.hs +++ b/src/Codec/Archive/Types.hs @@ -1,62 +1,60 @@ -module Codec.Archive.Types ( -- * Abstract data types - Archive - , ArchiveEntry - , Stat - , LinkResolver - -- * Concrete (Haskell) data types - , Entry (..) +module Codec.Archive.Types ( -- * Concrete (Haskell) data types + Entry (..) , EntryContent (..) , Ownership (..) , ModTime , Id , Permissions , ArchiveEncryption (..) - -- * Macros - , Flags (..) - , ArchiveError (..) - , ArchiveFilter (..) - , ArchiveFormat (..) - , FileType (..) - , ArchiveCapabilities (..) - , ReadDiskFlags (..) - , TimeFlag (..) - , EntryACL (..) - -- * Values - , standardPermissions - , executablePermissions + , ArchiveResult (..) + -- * Foreign types + , module Codec.Archive.Types.Foreign + -- * Callbacks + , ArchiveOpenCallback + , ArchiveCloseCallback + , ArchiveSwitchCallback + -- * Marshalling functions + , errorRes + , resultToErr ) where -import Data.Bits (Bits (..)) -import qualified Data.ByteString as BS -import Data.Int (Int64) -import Data.Semigroup -import Foreign.C.Types (CInt, CLong, CTime) -import System.Posix.Types (CMode (..)) +import Codec.Archive.Types.Foreign +import qualified Data.ByteString as BS +import Data.Int (Int64) +import Foreign.C.Types (CInt, CLong, CTime) +import Foreign.Ptr (Ptr) +import System.Posix.Types (CMode (..)) --- | Abstract type -data Archive +type ArchiveOpenCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult +type ArchiveCloseCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult +type ArchiveSwitchCallback a b = Ptr Archive -> Ptr a -> Ptr b -> IO ArchiveResult --- | Abstract type -data ArchiveEntry +resultToErr :: ArchiveResult -> CInt +resultToErr = fromIntegral . fromEnum -data Stat +errorRes :: Integral a => a -> ArchiveResult +errorRes = toEnum . fromIntegral -data LinkResolver +data ArchiveEncryption = HasEncryption + | NoEncryption + | EncryptionUnsupported + | EncryptionUnknown -- TODO: support everything here: http://hackage.haskell.org/package/tar/docs/Codec-Archive-Tar-Entry.html#t:EntryContent data EntryContent = NormalFile !BS.ByteString | Directory | Symlink !FilePath + | Hardlink !FilePath data Entry = Entry { filepath :: !FilePath , content :: !EntryContent , permissions :: !Permissions , ownership :: !Ownership - , time :: !ModTime + , time :: !(Maybe ModTime) } -data Ownership = Ownership { userName :: !String - , groupName :: !String +data Ownership = Ownership { userName :: !(Maybe String) + , groupName :: !(Maybe String) , ownerId :: !Id , groupId :: !Id } @@ -66,59 +64,3 @@ -- | A user or group ID type Id = Int64 - -standardPermissions :: Permissions -standardPermissions = 0o644 - -executablePermissions :: Permissions -executablePermissions = 0o755 - -newtype ArchiveFormat = ArchiveFormat CInt - deriving (Eq) - -newtype FileType = FileType CMode - deriving (Eq) - --- TODO: make this a sum type ? -newtype ArchiveError = ArchiveError CInt - deriving (Eq) - -newtype Flags = Flags CInt - -newtype ReadDiskFlags = ReadDiskFlags CInt - -newtype TimeFlag = TimeFlag CInt - -newtype EntryACL = EntryACL CInt - -newtype ArchiveFilter = ArchiveFilter CInt - -newtype ArchiveCapabilities = ArchiveCapabilities CInt - deriving (Eq) - -data ArchiveEncryption = HasEncryption - | NoEncryption - | EncryptionUnsupported - | EncryptionUnknown - -instance Semigroup ArchiveCapabilities where - (<>) (ArchiveCapabilities x) (ArchiveCapabilities y) = ArchiveCapabilities (x .|. y) - -instance Monoid ArchiveCapabilities where - mempty = ArchiveCapabilities 0 - mappend = (<>) - -instance Semigroup ReadDiskFlags where - (<>) (ReadDiskFlags x) (ReadDiskFlags y) = ReadDiskFlags (x .|. y) - -instance Semigroup Flags where - (<>) (Flags x) (Flags y) = Flags (x .|. y) - -instance Monoid Flags where - mempty = Flags 0 - mappend = (<>) - -instance Semigroup EntryACL where - (<>) (EntryACL x) (EntryACL y) = EntryACL (x .|. y) - --- TODO: `has` function for EntryACL diff --git a/src/Codec/Archive/Types/Foreign.chs b/src/Codec/Archive/Types/Foreign.chs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/Types/Foreign.chs @@ -0,0 +1,175 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Codec.Archive.Types.Foreign ( -- * Callbacks + ArchiveReadCallback + , ArchiveSkipCallback + , ArchiveSeekCallback + , ArchiveWriteCallback + , ArchiveCloseCallbackRaw + , ArchiveOpenCallbackRaw + , ArchiveSwitchCallbackRaw + , ArchivePassphraseCallback + -- * Abstract types + , Archive + , ArchiveEntry + , Stat + , LinkResolver + -- * Enum types + , ArchiveResult (..) + , FileType (..) + , Symlink (..) + -- * Macros + , Flags (..) + , ArchiveFilter (..) + , ArchiveFormat (..) + , ArchiveCapabilities (..) + , ReadDiskFlags (..) + , TimeFlag (..) + , EntryACL (..) + -- * libarchive types + , LaInt64 + , LaSSize + ) where + +import Control.DeepSeq (NFData) +import Data.Bits (Bits (..)) +import Foreign.C.String (CString) +import Foreign.C.Types (CInt, CSize) +import Foreign.Ptr (Ptr) +import GHC.Generics (Generic) + +#include +#include + +type LaInt64 = {# type la_int64_t #} +type LaSSize = {# type la_ssize_t #} + +{# enum define ArchiveResult { ARCHIVE_OK as ArchiveOk + , ARCHIVE_EOF as ArchiveEOF + , ARCHIVE_RETRY as ArchiveRetry + , ARCHIVE_WARN as ArchiveWarn + , ARCHIVE_FAILED as ArchiveFailed + , ARCHIVE_FATAL as ArchiveFatal + } deriving (Eq, Show, Generic, NFData) + #} + +{# enum define FileType { AE_IFREG as FtRegular + , AE_IFLNK as FtLink + , AE_IFSOCK as FtSocket + , AE_IFCHR as FtCharacter + , AE_IFBLK as FtBlock + , AE_IFDIR as FtDirectory + , AE_IFIFO as FtFifo + } deriving (Eq) + #} + +{# enum define Symlink { AE_SYMLINK_TYPE_UNDEFINED as SymlinkUndefined + , AE_SYMLINK_TYPE_FILE as SymlinkFile + , AE_SYMLINK_TYPE_DIRECTORY as SymlinkDirectory + } deriving (Eq) + #} + +{# enum define ArchiveFilter { ARCHIVE_FILTER_NONE as ArchiveFilterNone + , ARCHIVE_FILTER_GZIP as ArchiveFilterGzip + , ARCHIVE_FILTER_BZIP2 as ArchiveFilterBzip2 + , ARCHIVE_FILTER_COMPRESS as ArchiveFilterCompress + , ARCHIVE_FILTER_PROGRAM as ArchiveFilterProgram + , ARCHIVE_FILTER_LZMA as ArchiveFilterLzma + , ARCHIVE_FILTER_XZ as ArchiveFilterXz + , ARCHIVE_FILTER_UU as ArchiveFilterUu + , ARCHIVE_FILTER_RPM as ArchiveFilterRpm + , ARCHIVE_FILTER_LZIP as ArchiveFilterLzip + , ARCHIVE_FILTER_LRZIP as ArchiveFilterLrzip + , ARCHIVE_FILTER_LZOP as ArchiveFilterLzop + , ARCHIVE_FILTER_GRZIP as ArchiveFilterGrzip + , ARCHIVE_FILTER_LZ4 as ArchiveFilterLz4 + , ARCHIVE_FILTER_ZSTD as ArchiveFilterZstd + } + #} + +{# enum define ArchiveFormat { ARCHIVE_FORMAT_CPIO as ArchiveFormatCpio + , ARCHIVE_FORMAT_CPIO_POSIX as ArchiveFormatCpioPosix + , ARCHIVE_FORMAT_CPIO_BIN_LE as ArchiveFormatCpioBinLe + , ARCHIVE_FORMAT_CPIO_BIN_BE as ArchiveFormatCpioBinBe + , ARCHIVE_FORMAT_CPIO_SVR4_NOCRC as ArchiveFormatCpioSvr4Nocrc + , ARCHIVE_FORMAT_CPIO_SVR4_CRC as ArchiveFormatCpioSvr4Crc + , ARCHIVE_FORMAT_CPIO_AFIO_LARGE as ArchiveFormatCpioAfioLarge + , ARCHIVE_FORMAT_SHAR as ArchiveFormatShar + , ARCHIVE_FORMAT_SHAR_BASE as ArchiveFormatSharBase + , ARCHIVE_FORMAT_SHAR_DUMP as ArchiveFormatSharDump + , ARCHIVE_FORMAT_TAR as ArchiveFormatTar + , ARCHIVE_FORMAT_TAR_USTAR as ArchiveFormatTarUstar + , ARCHIVE_FORMAT_TAR_PAX_INTERCHANGE as ArchiveFormatTarPaxInterchange + , ARCHIVE_FORMAT_TAR_PAX_RESTRICTED as ArchiveFormatTarPaxRestricted + , ARCHIVE_FORMAT_TAR_GNUTAR as ArchiveFormatTarGnutar + , ARCHIVE_FORMAT_ISO9660 as ArchiveFormatIso9660 + , ARCHIVE_FORMAT_ISO9660_ROCKRIDGE as ArchiveFormatIso9660Rockridge + , ARCHIVE_FORMAT_ZIP as ArchiveFormatZip + , ARCHIVE_FORMAT_EMPTY as ArchiveFormatEmpty + , ARCHIVE_FORMAT_AR as ArchiveFormatAr + , ARCHIVE_FORMAT_AR_GNU as ArchiveFormatArGnu + , ARCHIVE_FORMAT_AR_BSD as ArchiveFormatArBsd + , ARCHIVE_FORMAT_MTREE as ArchiveFormatMtree + , ARCHIVE_FORMAT_RAW as ArchiveFormatRaw + , ARCHIVE_FORMAT_XAR as ArchiveFormatXar + , ARCHIVE_FORMAT_LHA as ArchiveFormatLha + , ARCHIVE_FORMAT_CAB as ArchiveFormatCab + , ARCHIVE_FORMAT_RAR as ArchiveFormatRar + , ARCHIVE_FORMAT_7ZIP as ArchiveFormat7zip + , ARCHIVE_FORMAT_WARC as ArchiveFormatWarc + , ARCHIVE_FORMAT_RAR_V5 as ArchiveFormatRarV5 + } deriving (Eq) + #} + +-- | Abstract type +data Archive + +-- | Abstract type +data ArchiveEntry + +data Stat + +data LinkResolver + +type ArchiveReadCallback a b = Ptr Archive -> Ptr a -> Ptr (Ptr b) -> IO LaSSize +type ArchiveSkipCallback a = Ptr Archive -> Ptr a -> LaInt64 -> IO LaInt64 +type ArchiveSeekCallback a = Ptr Archive -> Ptr a -> LaInt64 -> CInt -> IO LaInt64 +type ArchiveWriteCallback a b = Ptr Archive -> Ptr a -> Ptr b -> CSize -> IO LaSSize +type ArchiveOpenCallbackRaw a = Ptr Archive -> Ptr a -> IO CInt +type ArchiveCloseCallbackRaw a = Ptr Archive -> Ptr a -> IO CInt +type ArchiveSwitchCallbackRaw a b = Ptr Archive -> Ptr a -> Ptr b -> IO CInt +type ArchivePassphraseCallback a = Ptr Archive -> Ptr a -> IO CString + +newtype Flags = Flags CInt + +newtype ReadDiskFlags = ReadDiskFlags CInt + +newtype TimeFlag = TimeFlag CInt + +newtype EntryACL = EntryACL CInt + +newtype ArchiveCapabilities = ArchiveCapabilities CInt + deriving (Eq) + +instance Semigroup ArchiveCapabilities where + (<>) (ArchiveCapabilities x) (ArchiveCapabilities y) = ArchiveCapabilities (x .|. y) + +instance Monoid ArchiveCapabilities where + mempty = ArchiveCapabilities 0 + mappend = (<>) + +instance Semigroup ReadDiskFlags where + (<>) (ReadDiskFlags x) (ReadDiskFlags y) = ReadDiskFlags (x .|. y) + +instance Semigroup Flags where + (<>) (Flags x) (Flags y) = Flags (x .|. y) + +instance Monoid Flags where + mempty = Flags 0 + mappend = (<>) + +instance Semigroup EntryACL where + (<>) (EntryACL x) (EntryACL y) = EntryACL (x .|. y) + +-- TODO: `has` function for EntryACL diff --git a/src/Codec/Archive/Unpack.hs b/src/Codec/Archive/Unpack.hs --- a/src/Codec/Archive/Unpack.hs +++ b/src/Codec/Archive/Unpack.hs @@ -8,47 +8,47 @@ import Codec.Archive.Common import Codec.Archive.Foreign +import Codec.Archive.Monad import Codec.Archive.Types -import Control.Monad (void, (<=<)) -import Data.ByteString (useAsCStringLen) -import qualified Data.ByteString as BS +import Control.Monad (void, (<=<)) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bifunctor (first) +import qualified Data.ByteString as BS import Foreign.C.String -import Foreign.Marshal.Alloc (alloca, allocaBytes) -import Foreign.Ptr (Ptr) -import Foreign.Storable (Storable (..)) -import System.FilePath (()) -import System.IO.Unsafe (unsafePerformIO) - +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr, nullPtr) +import System.FilePath (()) +import System.IO.Unsafe (unsafeDupablePerformIO) -- | Read an archive contained in a 'BS.ByteString'. The format of the archive is -- automatically detected. -- -- @since 1.0.0.0 -readArchiveBS :: BS.ByteString -> [Entry] -readArchiveBS = unsafePerformIO . (actFree hsEntries <=< bsToArchive) +readArchiveBS :: BS.ByteString -> Either ArchiveResult [Entry] +readArchiveBS = unsafeDupablePerformIO . runArchiveM . (actFree hsEntries <=< bsToArchive) {-# NOINLINE readArchiveBS #-} -bsToArchive :: BS.ByteString -> IO (Ptr Archive) +bsToArchive :: BS.ByteString -> ArchiveM (Ptr Archive) bsToArchive bs = do - a <- archive_read_new - void $ archive_read_support_format_all a - useAsCStringLen bs $ - \(charPtr, sz) -> - void $ archive_read_open_memory a charPtr (fromIntegral sz) + a <- liftIO archiveReadNew + ignore $ archiveReadSupportFormatAll a + useAsCStringLenArchiveM bs $ + \(buf, sz) -> + handle $ archiveReadOpenMemory a buf (fromIntegral sz) pure a -- | Read an archive from a file. The format of the archive is automatically -- detected. -- -- @since 1.0.0.0 -readArchiveFile :: FilePath -> IO [Entry] +readArchiveFile :: FilePath -> ArchiveM [Entry] readArchiveFile = actFree hsEntries <=< archiveFile -archiveFile :: FilePath -> IO (Ptr Archive) -archiveFile fp = withCString fp $ \cpath -> do - a <- archive_read_new - void $ archive_read_support_format_all a - void $ archive_read_open_filename a cpath 10240 +archiveFile :: FilePath -> ArchiveM (Ptr Archive) +archiveFile fp = withCStringArchiveM fp $ \cpath -> do + a <- liftIO archiveReadNew + ignore $ archiveReadSupportFormatAll a + handle $ archiveReadOpenFilename a cpath 10240 pure a -- | This is more efficient than @@ -58,31 +58,31 @@ -- @ unpackArchive :: FilePath -- ^ Filepath pointing to archive -> FilePath -- ^ Dirctory to unpack in - -> IO () + -> ArchiveM () unpackArchive tarFp dirFp = do a <- archiveFile tarFp unpackEntriesFp a dirFp - void $ archive_read_free a + ignore $ archiveFree a readEntry :: Ptr Archive -> Ptr ArchiveEntry -> IO Entry readEntry a entry = Entry - <$> (peekCString =<< archive_entry_pathname entry) + <$> (peekCString =<< archiveEntryPathname entry) <*> readContents a entry - <*> archive_entry_perm entry + <*> archiveEntryPerm entry <*> readOwnership entry <*> readTimes entry -- | Yield the next entry in an archive -getHsEntry :: Ptr Archive -> IO (Maybe Entry) +getHsEntry :: MonadIO m => Ptr Archive -> m (Maybe Entry) getHsEntry a = do - entry <- getEntry a + entry <- liftIO $ getEntry a case entry of Nothing -> pure Nothing - Just x -> Just <$> readEntry a x + Just x -> Just <$> liftIO (readEntry a x) -- | Return a list of 'Entry's. -hsEntries :: Ptr Archive -> IO [Entry] +hsEntries :: MonadIO m => Ptr Archive -> m [Entry] hsEntries a = do next <- getHsEntry a case next of @@ -90,61 +90,79 @@ Just x -> (x:) <$> hsEntries a -- | Unpack an archive in a given directory -unpackEntriesFp :: Ptr Archive -> FilePath -> IO () +unpackEntriesFp :: Ptr Archive -> FilePath -> ArchiveM () unpackEntriesFp a fp = do - res <- getEntry a + res <- liftIO $ getEntry a case res of Nothing -> pure () Just x -> do - preFile <- archive_entry_pathname x - file <- peekCString preFile + preFile <- liftIO $ archiveEntryPathname x + file <- liftIO $ peekCString preFile let file' = fp file - withCString file' $ \fileC -> - archive_entry_set_pathname x fileC - void $ archive_read_extract a x archiveExtractTime - archive_entry_set_pathname x preFile - void $ archive_read_data_skip a + liftIO $ withCString file' $ \fileC -> + archiveEntrySetPathname x fileC + ignore $ archiveReadExtract a x archiveExtractTime + liftIO $ archiveEntrySetPathname x preFile + ignore $ archiveReadDataSkip a unpackEntriesFp a fp readBS :: Ptr Archive -> Int -> IO BS.ByteString readBS a sz = allocaBytes sz $ \buff -> - archive_read_data a buff (fromIntegral sz) *> + archiveReadData a buff (fromIntegral sz) *> BS.packCStringLen (buff, sz) readContents :: Ptr Archive -> Ptr ArchiveEntry -> IO EntryContent -readContents a entry = go =<< archive_entry_filetype entry - where go ft | ft == regular = NormalFile <$> (readBS a =<< sz) - | ft == symlink = Symlink <$> (peekCString =<< archive_entry_symlink entry) - | ft == directory = pure Directory - | otherwise = error "Unsupported filetype" - sz = fromIntegral <$> archive_entry_size entry +readContents a entry = go =<< archiveEntryFiletype entry + where go Nothing = Hardlink <$> (peekCString =<< archiveEntryHardlink entry) + go (Just FtRegular) = NormalFile <$> (readBS a =<< sz) + go (Just FtLink) = Symlink <$> (peekCString =<< archiveEntrySymlink entry) + go (Just FtDirectory) = pure Directory + go (Just _) = error "Unsupported filetype" + sz = fromIntegral <$> archiveEntrySize entry +archiveGetterHelper :: (Ptr ArchiveEntry -> IO a) -> (Ptr ArchiveEntry -> IO Bool) -> Ptr ArchiveEntry -> IO (Maybe a) +archiveGetterHelper get check entry = do + check' <- check entry + if check' + then Just <$> get entry + else pure Nothing + +archiveGetterNull :: (Ptr ArchiveEntry -> IO CString) -> Ptr ArchiveEntry -> IO (Maybe String) +archiveGetterNull get entry = do + res <- get entry + if res == nullPtr + then pure Nothing + else fmap Just (peekCString res) + readOwnership :: Ptr ArchiveEntry -> IO Ownership readOwnership entry = Ownership - <$> (peekCString =<< archive_entry_uname entry) - <*> (peekCString =<< archive_entry_gname entry) - <*> archive_entry_uid entry - <*> archive_entry_gid entry + <$> archiveGetterNull archiveEntryUname entry + <*> archiveGetterNull archiveEntryGname entry + <*> (fromIntegral <$> archiveEntryUid entry) + <*> (fromIntegral <$> archiveEntryGid entry) -readTimes :: Ptr ArchiveEntry -> IO ModTime -readTimes entry = - (,) <$> archive_entry_mtime entry <*> archive_entry_mtime_nsec entry +readTimes :: Ptr ArchiveEntry -> IO (Maybe ModTime) +readTimes = archiveGetterHelper go archiveEntryMtimeIsSet + where go entry = + (,) <$> archiveEntryMtime entry <*> archiveEntryMtimeNsec entry -- | Get the next 'ArchiveEntry' in an 'Archive' getEntry :: Ptr Archive -> IO (Maybe (Ptr ArchiveEntry)) -getEntry a = alloca $ \ptr -> do - let done res = not (res == archiveOk || res == archiveRetry) - stop <- done <$> archive_read_next_header a ptr - if stop - then pure Nothing - else Just <$> peek ptr +getEntry a = do + let done ArchiveOk = False + done ArchiveRetry = False + done _ = True + (stop, res) <- first done <$> archiveReadNextHeader a + pure $ if stop + then Nothing + else Just res unpackToDir :: FilePath -- ^ Directory to unpack in -> BS.ByteString -- ^ 'BS.ByteString' containing archive - -> IO () + -> ArchiveM () unpackToDir fp bs = do a <- bsToArchive bs unpackEntriesFp a fp - void $ archive_read_free a + void $ liftIO $ archiveFree a diff --git a/src/Codec/Archive/Unpack/Lazy.hs b/src/Codec/Archive/Unpack/Lazy.hs --- a/src/Codec/Archive/Unpack/Lazy.hs +++ b/src/Codec/Archive/Unpack/Lazy.hs @@ -4,71 +4,89 @@ import Codec.Archive.Common import Codec.Archive.Foreign +import Codec.Archive.Monad import Codec.Archive.Types import Codec.Archive.Unpack -import Control.Monad (void, (<=<)) -import Data.ByteString (useAsCStringLen) -import qualified Data.ByteString.Lazy as BSL -import Data.Functor (($>)) -import Data.IORef (modifyIORef, newIORef, readIORef) +import Control.Composition ((.**)) +import Control.Monad (void, (<=<)) +import Control.Monad.IO.Class +import Data.ByteString (useAsCStringLen) +import qualified Data.ByteString.Lazy as BSL +import Data.Foldable (traverse_) +import Data.Functor (($>)) +import Data.IORef (modifyIORef, newIORef, readIORef, + writeIORef) import Foreign.C.Types -import Foreign.Marshal.Alloc (free, mallocBytes) +import Foreign.Marshal.Alloc (free, mallocBytes, reallocBytes) import Foreign.Ptr -import Foreign.Storable (poke) -import System.IO.Unsafe (unsafePerformIO) +import Foreign.Storable (poke) +import System.IO.Unsafe (unsafeDupablePerformIO) foreign import ccall memcpy :: Ptr a -- ^ Destination -> Ptr b -- ^ Source -> CSize -- ^ Size -> IO (Ptr a) -- ^ Pointer to destination +hmemcpy :: Ptr a -> Ptr b -> CSize -> IO () +hmemcpy = void .** memcpy + -- | In general, this will be more efficient than 'unpackToDir' -- +-- The 'BSL.ByteString' chunks should be @32k@ bytes. +-- -- @since 1.0.4.0 unpackToDirLazy :: FilePath -- ^ Directory to unpack in -> BSL.ByteString -- ^ 'BSL.ByteString' containing archive - -> IO () + -> ArchiveM () unpackToDirLazy fp bs = do (a, act) <- bslToArchive bs unpackEntriesFp a fp - void $ archive_read_free a - act + ignore $ archiveFree a + liftIO act -- | Read an archive lazily. The format of the archive is automatically -- detected. -- -- In general, this will be more efficient than 'readArchiveBS' -- +-- The 'BSL.ByteString' chunks should be @32k@ bytes. +-- -- @since 1.0.4.0 -readArchiveBSL :: BSL.ByteString -> [Entry] -readArchiveBSL = unsafePerformIO . (actFreeCallback hsEntries <=< bslToArchive) +readArchiveBSL :: BSL.ByteString -> Either ArchiveResult [Entry] +readArchiveBSL = unsafeDupablePerformIO . runArchiveM . (actFreeCallback hsEntries <=< bslToArchive) +{-# NOINLINE readArchiveBSL #-} -- | Lazily stream a 'BSL.ByteString' --- @since 1.0.4.0 bslToArchive :: BSL.ByteString - -> IO (Ptr Archive, IO ()) -- ^ Returns an 'IO' action to be used to clean up after we're done with the archive + -> ArchiveM (Ptr Archive, IO ()) -- ^ Returns an 'IO' action to be used to clean up after we're done with the archive bslToArchive bs = do - a <- archive_read_new - void $ archive_read_support_format_all a - bufPtr <- mallocBytes (32 * 1024) -- default to 32k byte chunks; should really do something more rigorous - bsChunksRef <- newIORef bsChunks - rc <- mkReadCallback (readBSL bsChunksRef bufPtr) - cc <- mkCloseCallback (\_ ptr -> freeHaskellFunPtr rc *> free ptr $> archiveOk) - nothingPtr <- mallocBytes 0 - sequence_ [ archive_read_set_read_callback a rc - , archive_read_set_close_callback a cc - , archive_read_set_callback_data a nothingPtr - , archive_read_open1 a - ] + a <- liftIO archiveReadNew + ignore $ archiveReadSupportFormatAll a + bufPtr <- liftIO $ mallocBytes (32 * 1024) -- default to 32k byte chunks + bsChunksRef <- liftIO $ newIORef bsChunks + bufSzRef <- liftIO $ newIORef (32 * 1024) + rc <- liftIO $ mkReadCallback (readBSL bsChunksRef bufSzRef bufPtr) + cc <- liftIO $ mkCloseCallback (\_ ptr -> freeHaskellFunPtr rc *> free ptr $> ArchiveOk) + nothingPtr <- liftIO $ mallocBytes 0 + let seqErr = traverse_ handle + seqErr [ archiveReadSetReadCallback a rc + , archiveReadSetCloseCallback a cc + , archiveReadSetCallbackData a nothingPtr + , archiveReadOpen1 a + ] pure (a, freeHaskellFunPtr cc *> free bufPtr) - where readBSL bsRef bufPtr _ _ dataPtr = do + where readBSL bsRef bufSzRef bufPtr _ _ dataPtr = do bs' <- readIORef bsRef case bs' of [] -> pure 0 (x:_) -> do modifyIORef bsRef tail useAsCStringLen x $ \(charPtr, sz) -> do - void $ memcpy bufPtr charPtr (fromIntegral sz) - poke dataPtr bufPtr $> fromIntegral sz + bufSz <- readIORef bufSzRef + bufPtr' <- if sz > bufSz + then writeIORef bufSzRef sz *> reallocBytes bufPtr sz + else pure bufPtr + hmemcpy bufPtr' charPtr (fromIntegral sz) + poke dataPtr bufPtr' $> fromIntegral sz bsChunks = BSL.toChunks bs diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,24 @@ +module Main ( main ) where + +import Codec.Archive +import qualified Data.ByteString.Lazy as BSL +import Data.Either (isRight) +import Data.Foldable (traverse_) +import System.Directory (doesDirectoryExist, listDirectory) +import System.FilePath (()) +import Test.Hspec + +roundtrip :: FilePath -> IO (Either ArchiveResult BSL.ByteString) +roundtrip = fmap (fmap entriesToBSL . readArchiveBSL) . BSL.readFile + +testFp :: FilePath -> Spec +testFp fp = parallel $ it ("sucessfully packs/unpacks itself (" ++ fp ++ ")") $ + roundtrip fp >>= (`shouldSatisfy` isRight) + +main :: IO () +main = do + dir <- doesDirectoryExist "test/data" + tarballs <- if dir then listDirectory "test/data" else pure [] + hspec $ + describe "roundtrip" $ traverse_ testFp + (("test/data" ) <$> tarballs)