diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,27 @@ All notable changes to this project are documented here. +## 2.0.0 (2026-06-09) + +A modernizing redesign, and the first release in which `magic` is genuinely safe and correct under real-world use. The reasons to upgrade: + +- **Thread-safe handles.** `Magic` is now an opaque handle whose operations are serialised by an internal per-handle lock, so sharing one handle across threads is safe (it was previously a silent data race). Use distinct handles for parallelism. (`Magic` was the transparent synonym `type Magic = ForeignPtr CMagic`, so the `CMagic` phantom type is no longer exported.) +- **Correct on any filename.** Paths are now `OsPath`, which stores the OS-native path bytes verbatim and avoids the lossy locale round-trip that `String` paths suffer on unusual filenames. `magicFile` takes an `OsPath`; `magicLoad`, `magicCompile`, and `magicCheck` take `[OsPath]` (the empty list means the default database); `magicGetPath` returns `[OsPath]`. The new `Magic.FilePath` module offers the whole API with ordinary `String` paths for convenience. +- **Correct on any in-memory data.** Removed `magicString`, which round-tripped data through the locale encoding and corrupted non-text bytes. Identify in-memory data with `magicByteString` (raw bytes) or `magicCString` (a raw pointer). +- **Memory-safe loading from memory.** Restored `magicLoadBuffers :: Magic -> [ByteString] -> IO ()` (removed in 1.1.2): the handle now retains the supplied buffers for its lifetime, so embedding and loading a compiled database from memory is memory-safe. +- **Typed, catchable errors.** Failures raise a dedicated `MagicException` carrying the failing operation and `libmagic`'s message, with a readable `displayException`, instead of a generic `IOError`. (`magicOpen` still raises an `errno` `IOError`, as there is no handle yet to query.) +- **Correct, ergonomic flags.** A `MagicFlags` bit-mask newtype replaces the old `MagicFlag` enumeration, whose `Enum`-as-bit-mask design mishandled aliased and composite constants. Combine flags with `(<>)`, start from `mempty`, test with `hasFlag`, narrow with `removeFlags`; each flag is a pattern synonym, and `show` prints the set flags by name. +- **`Text` results.** `magicFile`, `magicStdin`, `magicCString`, `magicByteString`, and `magicDescriptor` return `Text`. +- **Good-citizen instances.** Added `Generic` and `NFData` for `MagicFlags`, `MagicParam`, and `MagicException`. + +### Migrating from 1.x + +- Results are `Text`: add `Data.Text.unpack` where you still need `String`. +- In-memory data: `magicString` becomes `magicByteString` (pass a `ByteString`). +- Flags: `magicOpen [MagicMimeType, MagicError]` becomes `magicOpen (MagicMimeType <> MagicError)`, and `[]` becomes `mempty`. +- Paths: adopt `OsPath`, or `import Magic.FilePath` to keep `String` paths. +- Catch `MagicException` instead of `IOException`. + ## 1.1.2 (2026-06-09) Backwards-compatible additions: existing code continues to work unchanged. This release rounds out the binding to cover (almost) all of `libmagic`'s public API. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ It is a binding to the C [libmagic](https://www.darwinsys.com/file/) library. It allows you to determine the type of a file not by looking at its name or extension, but rather by examining the contents itself. -libmagic can provide either a textual description or a MIME content type (and, occasionally, also a character set). The Haskell binding can examine files, open file descriptors, and in-memory data (as a `String` or, for binary content, a strict `ByteString`). +libmagic can provide either a textual description or a MIME content type (and, occasionally, also a character set). The Haskell binding can examine files, open file descriptors, and in-memory data (as a strict `ByteString`). Results come back as `Text`. ## Requirements @@ -42,18 +42,25 @@ ## Usage -You can simply add `magic` to your `build-depends` to enable this library. +Add `magic` to your `build-depends`. The easiest way in is `Magic.FilePath`, which takes ordinary `String` paths: ```haskell -import Magic +import Magic.FilePath -- convenience facade: ordinary String paths +import qualified Data.Text.IO as T main :: IO () main = do - magic <- magicOpen [MagicMimeType] + magic <- magicOpen MagicMimeType magicLoadDefault magic mime <- magicFile magic "some-file.png" - putStrLn mime -- e.g. "image/png" + T.putStrLn mime -- e.g. "image/png" ``` + +### `Magic` vs `Magic.FilePath` + +`import Magic` is the primary API. It is the same in every way except that paths are `OsPath` instead of `String`. Prefer it when filename correctness matters. + +`Magic.FilePath` is a drop-in facade that converts paths through the locale's filesystem encoding (`encodeFS` / `decodeFS`). For ordinary ASCII/UTF-8 filenames under a UTF-8 locale that is perfectly fine. What you give up: a `String` path cannot faithfully represent every path the operating system can. Filenames containing bytes that are not valid in the current locale (raw non-UTF-8 bytes on Unix, names created under a different `LANG`/`LC_*`, and so on) may be corrupted or fail to round-trip, so you can fail to open a file that exists, or open the wrong one, and the outcome depends on the environment. `OsPath` stores the OS-native path bytes verbatim, so it represents any path losslessly and independently of the locale. ## Author & history diff --git a/magic.cabal b/magic.cabal --- a/magic.cabal +++ b/magic.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: magic -version: 1.1.2 +version: 2.0.0 synopsis: Interface to C file/magic library description: This package provides a Haskell interface to the C libmagic library. @@ -82,9 +82,10 @@ Magic.Types Magic.Init Magic.Operations + Magic.FilePath other-modules: - Magic.Utils + Magic.Internal default-extensions: EmptyDataDecls @@ -92,9 +93,18 @@ TypeSynonymInstances build-depends: - , base >=4.9 && <5 - , bytestring >=0.10 && <0.13 + , base >=4.9 && <5 + , bytestring >=0.10 && <0.13 + , deepseq >=1.4 && <1.6 + , filepath >=1.4.100 && <1.6 + , text >=1.2.3 && <2.2 + -- The OsString internal types (used to marshal OsPath to a C string without a + -- lossy locale round-trip) live in os-string on GHC >= 9.10; on 9.6/9.8 they + -- are provided by filepath itself. + if impl(ghc >= 9.10) + build-depends: os-string >=2.0 && <2.1 + if flag(pkgconfig) pkgconfig-depends: libmagic else @@ -105,6 +115,7 @@ type: exitcode-stdio-1.0 main-is: runtests.hs hs-source-dirs: test + ghc-options: -threaded -with-rtsopts=-N other-modules: Inittest Tests @@ -113,8 +124,10 @@ build-depends: , base >=4.9 && <5 , bytestring >=0.10 && <0.13 - , directory >=1.2 && <1.4 - , filepath >=1.4 && <1.6 - , HUnit >=1.6 && <1.7 + , deepseq >=1.4 && <1.6 + , directory >=1.2 && <1.4 + , filepath >=1.4.100 && <1.6 + , HUnit >=1.6 && <1.7 , magic - , unix >=2.8 && <2.9 + , text >=1.2.3 && <2.2 + , unix >=2.8 && <2.9 diff --git a/src/Magic.hs b/src/Magic.hs --- a/src/Magic.hs +++ b/src/Magic.hs @@ -22,28 +22,46 @@ "Magic.Types", the initialization functions in "Magic.Init", and the querying functions in "Magic.Operations". +If you just want to pass ordinary @String@ paths, start with "Magic.FilePath", +a drop-in facade over this module. The functions here take +'System.OsPath.OsPath' instead, which represents any filename losslessly and +independently of the locale (see the note below). + A typical session creates a handle, loads the system magic database, then -queries files or in-memory data. The flags passed to 'magicOpen' (see -'MagicFlag') choose what kind of answer comes back: +queries files or in-memory data. The flags passed to 'magicOpen' choose what +kind of answer comes back (see t'MagicFlags'); combine them with @('<>')@ and +use 'mempty' (i.e. 'MagicNone') for the defaults: +> {-# LANGUAGE QuasiQuotes #-} > import Magic +> import System.OsPath (osp) +> import qualified Data.Text.IO as T > > main :: IO () > main = do -> magic <- magicOpen [MagicMimeType] -- ask for MIME types +> magic <- magicOpen MagicMimeType -- ask for MIME types > magicLoadDefault magic -- load the system database -> mime <- magicFile magic "/etc/passwd" -> putStrLn mime -- e.g. "text/plain" +> mime <- magicFile magic [osp|/etc/passwd|] +> T.putStrLn mime -- e.g. "text/plain" +Paths here are 'System.OsPath.OsPath', which stores the OS-native path bytes +verbatim and so represents any path the system can, without a lossy locale +round-trip. The "Magic.FilePath" facade offers the same API with @String@ +paths for convenience; it is fine for ordinary filenames, but cannot faithfully +represent names whose bytes are invalid in the current locale. + Handles are closed and their memory freed automatically when they are -garbage-collected (see 'Magic'); there is no explicit close. On failure the -operations in this library raise an 'IOError'. +garbage-collected (see t'Magic'); there is no explicit close. On failure, most +operations raise a t'MagicException'; 'magicOpen' raises an 'IOError' (from +@errno@) if the handle cannot be allocated. Originally written by John Goerzen. -} module Magic (-- * Basic Types module Magic.Types, + -- * Flags + module Magic.Data, -- * Initialization module Magic.Init, -- * Operation @@ -51,5 +69,6 @@ ) where import Magic.Types +import Magic.Data import Magic.Init import Magic.Operations diff --git a/src/Magic/Data.hsc b/src/Magic/Data.hsc --- a/src/Magic/Data.hsc +++ b/src/Magic/Data.hsc @@ -1,4 +1,6 @@ -- AUTO-GENERATED FILE, DO NOT EDIT. GENERATED BY utils/genconsts.hs +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE PatternSynonyms #-} {- | Module : Magic.Data Copyright : Copyright (C) 2005 John Goerzen @@ -8,157 +10,264 @@ Stability : provisional Portability: portable -The 'MagicFlag' enumeration, mapping the C @libmagic@ @MAGIC_*@ constants -to Haskell. +The t'MagicFlags' bit-mask, mapping the C @libmagic@ @MAGIC_*@ constants to +Haskell. Flags are combined with @('<>')@, tested with 'hasFlag', and narrowed +with 'removeFlags'; the empty set ('mempty') is 'MagicNone'. -} -module Magic.Data (MagicFlag(..)) where +module Magic.Data + ( MagicFlags(..) + , hasFlag + , removeFlags + , pattern MagicNone + , pattern MagicDebug + , pattern MagicSymlink + , pattern MagicCompress + , pattern MagicDevices + , pattern MagicMimeType + , pattern MagicMimeEncoding + , pattern MagicMime + , pattern MagicContinue + , pattern MagicCheck + , pattern MagicPreserveAtime + , pattern MagicRaw + , pattern MagicError + , pattern MagicApple + , pattern MagicExtension + , pattern MagicCompressTransp + , pattern MagicNoCompressFork + , pattern MagicNodesc + , pattern MagicNoCheckCompress + , pattern MagicNoCheckTar + , pattern MagicNoCheckSoft + , pattern MagicNoCheckApptype + , pattern MagicNoCheckElf + , pattern MagicNoCheckText + , pattern MagicNoCheckCdf + , pattern MagicNoCheckCsv + , pattern MagicNoCheckTokens + , pattern MagicNoCheckEncoding + , pattern MagicNoCheckJson + , pattern MagicNoCheckSimh + , pattern MagicNoCheckBuiltin + ) where #include "magic.h" +import Control.DeepSeq (NFData(rnf)) +import Data.Bits ((.&.), (.|.), complement, popCount) +import Data.List (intercalate) +import Foreign.C.Types (CInt) +import GHC.Generics (Generic) --- | Flags that control how @libmagic@ examines a file and what it --- reports. Combine them in the list passed to @magicOpen@ or --- @magicSetFlags@. -data MagicFlag - = -- | No special handling; return a textual description (the default). - MagicNone - | -- | Print debugging messages to stderr. - MagicDebug - | -- | Follow symbolic links. - MagicSymlink - | -- | Look inside compressed files. - MagicCompress - | -- | Look at the contents of block or character special devices. - MagicDevices - | -- | Return a MIME type string instead of a textual description. - MagicMimeType - | -- | Return the MIME encoding (character set) instead of a textual description. - MagicMimeEncoding - | -- | Return both the MIME type and the encoding. - MagicMime - | -- | Return all matches, not just the first. - MagicContinue - | -- | Check the magic database for consistency and report problems. - MagicCheck - | -- | Preserve the access time of examined files. - MagicPreserveAtime - | -- | Do not translate unprintable characters to octal escapes. - MagicRaw - | -- | Treat errors while examining a file as real errors instead of embedding them in the result. - MagicError - | -- | Return the Apple creator and type. - MagicApple - | -- | Return a slash-separated list of valid file extensions for the detected type. - MagicExtension - | -- | Report on the compressed contents only, without mentioning the compression itself (transparent decompression). - MagicCompressTransp - | -- | Do not allow decompression that requires forking a helper process. - MagicNoCompressFork - | -- | Composite of 'MagicExtension', 'MagicMime' and 'MagicApple': return identifiers rather than a textual description. - MagicNodesc - | -- | Do not look inside compressed files. - MagicNoCheckCompress - | -- | Do not examine tar archives. - MagicNoCheckTar - | -- | Do not consult the magic database entries (soft magic). - MagicNoCheckSoft - | -- | Do not check for an application type (e.g. EMX). - MagicNoCheckApptype - | -- | Do not examine ELF details. - MagicNoCheckElf - | -- | Do not examine text files. - MagicNoCheckText - | -- | Do not examine CDF (Microsoft Compound Document) files. - MagicNoCheckCdf - | -- | Do not examine CSV files. - MagicNoCheckCsv - | -- | Do not look for known text tokens. - MagicNoCheckTokens - | -- | Do not check text encodings. - MagicNoCheckEncoding - | -- | Do not examine JSON files. - MagicNoCheckJson - | -- | Do not examine SIMH tape files. - MagicNoCheckSimh - | -- | Disable all built-in tests; consult only the magic database. - MagicNoCheckBuiltin - | -- | A flag value returned by libmagic that these bindings do not - -- recognise, carrying its raw integer value. - UnknownMagicFlag Int - deriving (Show) +-- | A set of @libmagic@ flags, represented as the underlying C bit-mask. +-- Combine flags with @('<>')@, start from 'mempty' (no flags), test +-- membership with 'hasFlag', and narrow with 'removeFlags'. The +-- v'MagicFlags' constructor is an escape hatch for passing a raw mask; +-- prefer the pattern synonyms below. +-- +-- @since 2.0.0 +newtype MagicFlags = MagicFlags CInt + deriving (Eq, Ord, Generic) -instance Enum MagicFlag where - toEnum (#{const MAGIC_NONE}) = MagicNone - toEnum (#{const MAGIC_DEBUG}) = MagicDebug - toEnum (#{const MAGIC_SYMLINK}) = MagicSymlink - toEnum (#{const MAGIC_COMPRESS}) = MagicCompress - toEnum (#{const MAGIC_DEVICES}) = MagicDevices - toEnum (#{const MAGIC_MIME_TYPE}) = MagicMimeType - toEnum (#{const MAGIC_MIME_ENCODING}) = MagicMimeEncoding - toEnum (#{const MAGIC_MIME}) = MagicMime - toEnum (#{const MAGIC_CONTINUE}) = MagicContinue - toEnum (#{const MAGIC_CHECK}) = MagicCheck - toEnum (#{const MAGIC_PRESERVE_ATIME}) = MagicPreserveAtime - toEnum (#{const MAGIC_RAW}) = MagicRaw - toEnum (#{const MAGIC_ERROR}) = MagicError - toEnum (#{const MAGIC_APPLE}) = MagicApple - toEnum (#{const MAGIC_EXTENSION}) = MagicExtension - toEnum (#{const MAGIC_COMPRESS_TRANSP}) = MagicCompressTransp - toEnum (#{const MAGIC_NO_COMPRESS_FORK}) = MagicNoCompressFork - toEnum (#{const MAGIC_NODESC}) = MagicNodesc - toEnum (#{const MAGIC_NO_CHECK_COMPRESS}) = MagicNoCheckCompress - toEnum (#{const MAGIC_NO_CHECK_TAR}) = MagicNoCheckTar - toEnum (#{const MAGIC_NO_CHECK_SOFT}) = MagicNoCheckSoft - toEnum (#{const MAGIC_NO_CHECK_APPTYPE}) = MagicNoCheckApptype - toEnum (#{const MAGIC_NO_CHECK_ELF}) = MagicNoCheckElf - toEnum (#{const MAGIC_NO_CHECK_TEXT}) = MagicNoCheckText - toEnum (#{const MAGIC_NO_CHECK_CDF}) = MagicNoCheckCdf - toEnum (#{const MAGIC_NO_CHECK_CSV}) = MagicNoCheckCsv - toEnum (#{const MAGIC_NO_CHECK_TOKENS}) = MagicNoCheckTokens - toEnum (#{const MAGIC_NO_CHECK_ENCODING}) = MagicNoCheckEncoding - toEnum (#{const MAGIC_NO_CHECK_JSON}) = MagicNoCheckJson - toEnum (#{const MAGIC_NO_CHECK_SIMH}) = MagicNoCheckSimh - toEnum (#{const MAGIC_NO_CHECK_BUILTIN}) = MagicNoCheckBuiltin - toEnum x = UnknownMagicFlag x +instance NFData MagicFlags where rnf (MagicFlags x) = x `seq` () - fromEnum MagicNone = (#{const MAGIC_NONE}) - fromEnum MagicDebug = (#{const MAGIC_DEBUG}) - fromEnum MagicSymlink = (#{const MAGIC_SYMLINK}) - fromEnum MagicCompress = (#{const MAGIC_COMPRESS}) - fromEnum MagicDevices = (#{const MAGIC_DEVICES}) - fromEnum MagicMimeType = (#{const MAGIC_MIME_TYPE}) - fromEnum MagicMimeEncoding = (#{const MAGIC_MIME_ENCODING}) - fromEnum MagicMime = (#{const MAGIC_MIME}) - fromEnum MagicContinue = (#{const MAGIC_CONTINUE}) - fromEnum MagicCheck = (#{const MAGIC_CHECK}) - fromEnum MagicPreserveAtime = (#{const MAGIC_PRESERVE_ATIME}) - fromEnum MagicRaw = (#{const MAGIC_RAW}) - fromEnum MagicError = (#{const MAGIC_ERROR}) - fromEnum MagicApple = (#{const MAGIC_APPLE}) - fromEnum MagicExtension = (#{const MAGIC_EXTENSION}) - fromEnum MagicCompressTransp = (#{const MAGIC_COMPRESS_TRANSP}) - fromEnum MagicNoCompressFork = (#{const MAGIC_NO_COMPRESS_FORK}) - fromEnum MagicNodesc = (#{const MAGIC_NODESC}) - fromEnum MagicNoCheckCompress = (#{const MAGIC_NO_CHECK_COMPRESS}) - fromEnum MagicNoCheckTar = (#{const MAGIC_NO_CHECK_TAR}) - fromEnum MagicNoCheckSoft = (#{const MAGIC_NO_CHECK_SOFT}) - fromEnum MagicNoCheckApptype = (#{const MAGIC_NO_CHECK_APPTYPE}) - fromEnum MagicNoCheckElf = (#{const MAGIC_NO_CHECK_ELF}) - fromEnum MagicNoCheckText = (#{const MAGIC_NO_CHECK_TEXT}) - fromEnum MagicNoCheckCdf = (#{const MAGIC_NO_CHECK_CDF}) - fromEnum MagicNoCheckCsv = (#{const MAGIC_NO_CHECK_CSV}) - fromEnum MagicNoCheckTokens = (#{const MAGIC_NO_CHECK_TOKENS}) - fromEnum MagicNoCheckEncoding = (#{const MAGIC_NO_CHECK_ENCODING}) - fromEnum MagicNoCheckJson = (#{const MAGIC_NO_CHECK_JSON}) - fromEnum MagicNoCheckSimh = (#{const MAGIC_NO_CHECK_SIMH}) - fromEnum MagicNoCheckBuiltin = (#{const MAGIC_NO_CHECK_BUILTIN}) - fromEnum (UnknownMagicFlag x) = x +-- | Flags combine by bitwise-or. +instance Semigroup MagicFlags where + MagicFlags a <> MagicFlags b = MagicFlags (a .|. b) -instance Ord MagicFlag where - compare x y = compare (fromEnum x) (fromEnum y) +-- | 'mempty' is the empty flag set ('MagicNone'). +instance Monoid MagicFlags where + mempty = MagicFlags 0 -instance Eq MagicFlag where - x == y = (fromEnum x) == (fromEnum y) +-- | Prints the set flags by name (e.g. @MagicMimeType <> MagicError@), or +-- @MagicNone@ when empty. Any bits not corresponding to a known flag are +-- shown as a raw @MagicFlags n@ term. +instance Show MagicFlags where + showsPrec p fs = + case names of + [] -> showString "MagicNone" + [n] -> showString n + _ -> showParen (p > 6) (showString (intercalate " <> " names)) + where + MagicFlags raw = fs + set = [ (n, v) | (n, MagicFlags v) <- allNamedFlags, popCount v == 1, raw .&. v == v ] + covered = foldr (\(_, v) acc -> v .|. acc) (0 :: CInt) set + leftover = raw .&. complement covered + names = map fst set ++ [ "MagicFlags " ++ show leftover | leftover /= (0 :: CInt) ] +-- | @'hasFlag' fs flag@ is 'True' when every bit of @flag@ is set in @fs@. +-- Works for composite flags too (e.g. @fs \`hasFlag\` 'MagicMime'@). Note +-- that @fs \`hasFlag\` 'MagicNone'@ is always 'True' (the empty set is a +-- subset of everything). +-- +-- @since 2.0.0 +hasFlag :: MagicFlags -> MagicFlags -> Bool +hasFlag (MagicFlags x) (MagicFlags m) = x .&. m == m +-- | @'removeFlags' fs drop@ clears every bit of @drop@ from @fs@ (set +-- difference), e.g. @flags \`removeFlags\` 'MagicError'@. +-- +-- @since 2.0.0 +removeFlags :: MagicFlags -> MagicFlags -> MagicFlags +removeFlags (MagicFlags a) (MagicFlags b) = MagicFlags (a .&. complement b) + +-- | No special handling; return a textual description (the default). This is 'mempty'. +pattern MagicNone :: MagicFlags +pattern MagicNone = MagicFlags (#{const MAGIC_NONE}) + +-- | Print debugging messages to stderr. +pattern MagicDebug :: MagicFlags +pattern MagicDebug = MagicFlags (#{const MAGIC_DEBUG}) + +-- | Follow symbolic links. +pattern MagicSymlink :: MagicFlags +pattern MagicSymlink = MagicFlags (#{const MAGIC_SYMLINK}) + +-- | Look inside compressed files. +pattern MagicCompress :: MagicFlags +pattern MagicCompress = MagicFlags (#{const MAGIC_COMPRESS}) + +-- | Look at the contents of block or character special devices. +pattern MagicDevices :: MagicFlags +pattern MagicDevices = MagicFlags (#{const MAGIC_DEVICES}) + +-- | Return a MIME type string instead of a textual description. +pattern MagicMimeType :: MagicFlags +pattern MagicMimeType = MagicFlags (#{const MAGIC_MIME_TYPE}) + +-- | Return the MIME encoding (character set) instead of a textual description. +pattern MagicMimeEncoding :: MagicFlags +pattern MagicMimeEncoding = MagicFlags (#{const MAGIC_MIME_ENCODING}) + +-- | Return both the MIME type and the encoding (@'MagicMimeType' '<>' 'MagicMimeEncoding'@). +pattern MagicMime :: MagicFlags +pattern MagicMime = MagicFlags (#{const MAGIC_MIME}) + +-- | Return all matches, not just the first. +pattern MagicContinue :: MagicFlags +pattern MagicContinue = MagicFlags (#{const MAGIC_CONTINUE}) + +-- | Check the magic database for consistency and report problems. +pattern MagicCheck :: MagicFlags +pattern MagicCheck = MagicFlags (#{const MAGIC_CHECK}) + +-- | Preserve the access time of examined files. +pattern MagicPreserveAtime :: MagicFlags +pattern MagicPreserveAtime = MagicFlags (#{const MAGIC_PRESERVE_ATIME}) + +-- | Do not translate unprintable characters to octal escapes. +pattern MagicRaw :: MagicFlags +pattern MagicRaw = MagicFlags (#{const MAGIC_RAW}) + +-- | Treat errors while examining a file as real errors instead of embedding them in the result. +pattern MagicError :: MagicFlags +pattern MagicError = MagicFlags (#{const MAGIC_ERROR}) + +-- | Return the Apple creator and type. +pattern MagicApple :: MagicFlags +pattern MagicApple = MagicFlags (#{const MAGIC_APPLE}) + +-- | Return a slash-separated list of valid file extensions for the detected type. +pattern MagicExtension :: MagicFlags +pattern MagicExtension = MagicFlags (#{const MAGIC_EXTENSION}) + +-- | Report on the compressed contents only, without mentioning the compression itself (transparent decompression). +pattern MagicCompressTransp :: MagicFlags +pattern MagicCompressTransp = MagicFlags (#{const MAGIC_COMPRESS_TRANSP}) + +-- | Do not allow decompression that requires forking a helper process. +pattern MagicNoCompressFork :: MagicFlags +pattern MagicNoCompressFork = MagicFlags (#{const MAGIC_NO_COMPRESS_FORK}) + +-- | Composite of 'MagicExtension', 'MagicMime' and 'MagicApple': return identifiers rather than a textual description. +pattern MagicNodesc :: MagicFlags +pattern MagicNodesc = MagicFlags (#{const MAGIC_NODESC}) + +-- | Do not look inside compressed files. +pattern MagicNoCheckCompress :: MagicFlags +pattern MagicNoCheckCompress = MagicFlags (#{const MAGIC_NO_CHECK_COMPRESS}) + +-- | Do not examine tar archives. +pattern MagicNoCheckTar :: MagicFlags +pattern MagicNoCheckTar = MagicFlags (#{const MAGIC_NO_CHECK_TAR}) + +-- | Do not consult the magic database entries (soft magic). +pattern MagicNoCheckSoft :: MagicFlags +pattern MagicNoCheckSoft = MagicFlags (#{const MAGIC_NO_CHECK_SOFT}) + +-- | Do not check for an application type (e.g. EMX). +pattern MagicNoCheckApptype :: MagicFlags +pattern MagicNoCheckApptype = MagicFlags (#{const MAGIC_NO_CHECK_APPTYPE}) + +-- | Do not examine ELF details. +pattern MagicNoCheckElf :: MagicFlags +pattern MagicNoCheckElf = MagicFlags (#{const MAGIC_NO_CHECK_ELF}) + +-- | Do not examine text files. +pattern MagicNoCheckText :: MagicFlags +pattern MagicNoCheckText = MagicFlags (#{const MAGIC_NO_CHECK_TEXT}) + +-- | Do not examine CDF (Microsoft Compound Document) files. +pattern MagicNoCheckCdf :: MagicFlags +pattern MagicNoCheckCdf = MagicFlags (#{const MAGIC_NO_CHECK_CDF}) + +-- | Do not examine CSV files. +pattern MagicNoCheckCsv :: MagicFlags +pattern MagicNoCheckCsv = MagicFlags (#{const MAGIC_NO_CHECK_CSV}) + +-- | Do not look for known text tokens. +pattern MagicNoCheckTokens :: MagicFlags +pattern MagicNoCheckTokens = MagicFlags (#{const MAGIC_NO_CHECK_TOKENS}) + +-- | Do not check text encodings. +pattern MagicNoCheckEncoding :: MagicFlags +pattern MagicNoCheckEncoding = MagicFlags (#{const MAGIC_NO_CHECK_ENCODING}) + +-- | Do not examine JSON files. +pattern MagicNoCheckJson :: MagicFlags +pattern MagicNoCheckJson = MagicFlags (#{const MAGIC_NO_CHECK_JSON}) + +-- | Do not examine SIMH tape files. +pattern MagicNoCheckSimh :: MagicFlags +pattern MagicNoCheckSimh = MagicFlags (#{const MAGIC_NO_CHECK_SIMH}) + +-- | Disable all built-in tests; consult only the magic database. +pattern MagicNoCheckBuiltin :: MagicFlags +pattern MagicNoCheckBuiltin = MagicFlags (#{const MAGIC_NO_CHECK_BUILTIN}) + +-- Every named flag, used by the 'Show' instance to print flags by name. +allNamedFlags :: [(String, MagicFlags)] +allNamedFlags = + [ ("MagicNone", MagicNone) + , ("MagicDebug", MagicDebug) + , ("MagicSymlink", MagicSymlink) + , ("MagicCompress", MagicCompress) + , ("MagicDevices", MagicDevices) + , ("MagicMimeType", MagicMimeType) + , ("MagicMimeEncoding", MagicMimeEncoding) + , ("MagicMime", MagicMime) + , ("MagicContinue", MagicContinue) + , ("MagicCheck", MagicCheck) + , ("MagicPreserveAtime", MagicPreserveAtime) + , ("MagicRaw", MagicRaw) + , ("MagicError", MagicError) + , ("MagicApple", MagicApple) + , ("MagicExtension", MagicExtension) + , ("MagicCompressTransp", MagicCompressTransp) + , ("MagicNoCompressFork", MagicNoCompressFork) + , ("MagicNodesc", MagicNodesc) + , ("MagicNoCheckCompress", MagicNoCheckCompress) + , ("MagicNoCheckTar", MagicNoCheckTar) + , ("MagicNoCheckSoft", MagicNoCheckSoft) + , ("MagicNoCheckApptype", MagicNoCheckApptype) + , ("MagicNoCheckElf", MagicNoCheckElf) + , ("MagicNoCheckText", MagicNoCheckText) + , ("MagicNoCheckCdf", MagicNoCheckCdf) + , ("MagicNoCheckCsv", MagicNoCheckCsv) + , ("MagicNoCheckTokens", MagicNoCheckTokens) + , ("MagicNoCheckEncoding", MagicNoCheckEncoding) + , ("MagicNoCheckJson", MagicNoCheckJson) + , ("MagicNoCheckSimh", MagicNoCheckSimh) + , ("MagicNoCheckBuiltin", MagicNoCheckBuiltin) + ] diff --git a/src/Magic/FilePath.hs b/src/Magic/FilePath.hs new file mode 100644 --- /dev/null +++ b/src/Magic/FilePath.hs @@ -0,0 +1,71 @@ +{- -*- Mode: haskell; -*- +Haskell magic Interface +Copyright (C) 2005 John Goerzen + +This code is under a 3-clause BSD license; see COPYING for details. +-} + +{- | + Module : Magic.FilePath + Copyright : Copyright (C) 2005 John Goerzen + License : BSD-3-Clause + + Maintainer : Philippe + Stability : provisional + Portability: portable + +A convenience facade over "Magic" that takes ordinary 'FilePath's instead of +'System.OsPath.OsPath's. Import this module /instead of/ "Magic" if you prefer +@String@ paths: + +> import Magic.FilePath + +Everything else (the handle, flags, in-memory and descriptor queries, and so on) +is re-exported unchanged from "Magic". + +The 'FilePath' wrappers convert with 'System.OsPath.encodeFS' / +'System.OsPath.decodeFS', which go through the locale's filesystem encoding. For +ordinary ASCII/UTF-8 filenames under a UTF-8 locale this is fine. But a +'FilePath' cannot faithfully represent every path the operating system can: +names whose bytes are not valid in the current locale (raw non-UTF-8 bytes on +Unix, or names created under a different locale) may be corrupted or fail to +round-trip, so a call can fail to open a file that exists, or open the wrong +one. The @OsPath@ functions in "Magic" store the path bytes verbatim and avoid +this entirely; prefer them when correctness on arbitrary filenames matters. + +@since 2.0.0 +-} + +module Magic.FilePath + ( module Magic + , magicFile + , magicLoad + , magicCompile + , magicCheck + , magicGetPath + ) where + +import Magic hiding (magicFile, magicLoad, magicCompile, magicCheck, magicGetPath) +import qualified Magic as O +import Data.Text (Text) +import System.OsPath (decodeFS, encodeFS) + +-- | 'Magic.magicFile' taking a 'FilePath'. +magicFile :: Magic -> FilePath -> IO Text +magicFile m p = O.magicFile m =<< encodeFS p + +-- | 'Magic.magicLoad' taking 'FilePath's (empty list = the default database). +magicLoad :: Magic -> [FilePath] -> IO () +magicLoad m ps = O.magicLoad m =<< mapM encodeFS ps + +-- | 'Magic.magicCompile' taking 'FilePath's (empty list = the default database). +magicCompile :: Magic -> [FilePath] -> IO () +magicCompile m ps = O.magicCompile m =<< mapM encodeFS ps + +-- | 'Magic.magicCheck' taking 'FilePath's (empty list = the default database). +magicCheck :: Magic -> [FilePath] -> IO Bool +magicCheck m ps = O.magicCheck m =<< mapM encodeFS ps + +-- | 'Magic.magicGetPath' returning 'FilePath's. +magicGetPath :: IO [FilePath] +magicGetPath = O.magicGetPath >>= mapM decodeFS diff --git a/src/Magic/Init.hsc b/src/Magic/Init.hsc --- a/src/Magic/Init.hsc +++ b/src/Magic/Init.hsc @@ -26,35 +26,41 @@ import Foreign.Ptr import Foreign.C.String -import Magic.Types +import Magic.Internal (Magic, CMagic, fromMagicPtr, withMagicPtr, checkIntError, withSearchPathCString) +import Magic.Data (MagicFlags(..)) import Foreign.C.Types -import Magic.Utils +import System.OsPath (OsPath) -{- | Create a new magic handle configured with the given flags (see -'MagicFlag'). Before querying anything you must load a database with -'magicLoadDefault' or 'magicLoad'. +{- | Create a new magic handle configured with the given flags. Combine flags +with @('<>')@ (see t'MagicFlags'), or pass 'mempty' for the defaults. Before +querying anything you must load a database with 'magicLoadDefault' or +'magicLoad'. The handle is freed automatically when it is garbage-collected. Raises an 'IOError' if the handle cannot be created. -} -magicOpen :: [MagicFlag] -> IO Magic -magicOpen mfl = +magicOpen :: MagicFlags -> IO Magic +magicOpen (MagicFlags flags) = fromMagicPtr "magicOpen" (magic_open flags) - where flags = flaglist2int mfl -{- | Load the system's default magic database into the handle. Raises an -'IOError' if the database cannot be loaded. -} +{- | Load the system's default magic database into the handle. Raises a +@MagicException@ if the database cannot be loaded. -} magicLoadDefault :: Magic -> IO () magicLoadDefault m = withMagicPtr m (\cmagic -> checkIntError "magicLoadDefault" m $ magic_load cmagic nullPtr) -{- | Load the given magic database(s) into the handle. The argument may be a -single path or several colon-separated paths. Raises an 'IOError' if a database -cannot be loaded. -} -magicLoad :: Magic -> String -> IO () -magicLoad m s = withMagicPtr m (\cmagic -> - withCString s (\cs -> - checkIntError "magicLoad" m $ magic_load cmagic cs)) +{- | Load the given magic database(s) into the handle. Pass the empty list to +load the system default (equivalent to 'magicLoadDefault'). Raises a +@MagicException@ if a database cannot be loaded. + +(libmagic joins the list with the platform search-path separator, so a path +that itself contains that separator cannot be represented.) -} +magicLoad :: Magic -> [OsPath] -> IO () +magicLoad m ps = withMagicPtr m (\cmagic -> + case ps of + [] -> checkIntError "magicLoad" m $ magic_load cmagic nullPtr + _ -> withSearchPathCString ps (\cs -> + checkIntError "magicLoad" m $ magic_load cmagic cs)) -- Allocates the cookie, no file I/O -> unsafe foreign import ccall unsafe "magic.h magic_open" diff --git a/src/Magic/Internal.hs b/src/Magic/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Magic/Internal.hs @@ -0,0 +1,203 @@ +{- -*- Mode: haskell; -*- +Haskell magic Interface +Copyright (C) 2005 John Goerzen + +This code is under a 3-clause BSD license; see COPYING for details. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} + +{- | + Module : Magic.Internal + Copyright : Copyright (C) 2005 John Goerzen + License : BSD-3-Clause + + Maintainer : Philippe + Stability : provisional + Portability: portable + +Internal representation of the t'Magic' handle, the t'MagicException' error type, +and the helpers shared by the other modules. Not part of the public API: it is +exposed only so the rest of the package can build, and may change without a +major-version bump. +-} + +module Magic.Internal + ( CMagic + , Magic(..) + , MagicException(..) + , fromMagicPtr + , withMagicPtr + , checkIntError + , throwErrorIfNull + , peekCStringText + , withOsPathCString + , withSearchPathCString + , peekSearchPath + ) where + +import Control.Concurrent.MVar (MVar, newMVar, withMVar) +import Control.DeepSeq (NFData(rnf)) +import Control.Exception (Exception, displayException, throwIO) +import GHC.Generics (Generic) +import qualified Data.ByteString as BS +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding.Error (lenientDecode) +import Foreign +import Foreign.C.Error (throwErrnoIfNull) +import Foreign.C.String (CString) +import Foreign.C.Types (CInt) +import System.OsPath (OsPath) + +#if defined(mingw32_HOST_OS) +import Data.List (intercalate) +import Foreign.C.String (peekCString, withCString) +import System.OsPath (decodeFS, encodeFS) +#else +import qualified Data.ByteString.Short as SBS +import System.OsString.Internal.Types (OsString(OsString, getOsString), PosixString(PosixString, getPosixString)) +#endif + +-- | Phantom type standing in for the C @magic_t@ cookie. It appears only as the +-- argument of a 'ForeignPtr' inside the t'Magic' handle and has no values of its +-- own. +data CMagic + +{- | The magic handle: an opaque cookie obtained from @magicOpen@ and passed to +the loading and querying functions. + +Handles are closed (and their memory freed) automatically when they are +garbage-collected; there is no need to close them explicitly. + +__Thread safety.__ Operations on a single handle are serialised by an internal +lock, so it is safe to share one handle across threads (concurrent calls simply +take turns). For genuine parallelism, use one handle per thread; distinct +handles are independent. Programs doing blocking work (loading databases, +examining files) should use the threaded runtime (@-threaded@). +-} +data Magic = Magic !(ForeignPtr CMagic) !(MVar [BS.ByteString]) +-- The MVar is both the per-handle lock and the store that keeps any buffers +-- passed to magicLoadBuffers alive for the lifetime of the handle (libmagic +-- retains, rather than copies, those buffers). + +-- | The handle is opaque; it shows as a fixed placeholder. +instance Show Magic where + show _ = "" + +-- | The exception raised when a @libmagic@ operation fails. Carries the name of +-- the operation that failed and the message reported by @libmagic@. +-- +-- @since 2.0.0 +data MagicException = MagicException + { magicErrorContext :: !Text -- ^ the operation that failed, e.g. @\"magicFile\"@ + , magicErrorMessage :: !Text -- ^ @libmagic@'s error message + } deriving (Show, Eq, Generic) + +instance NFData MagicException where + rnf (MagicException c m) = rnf c `seq` rnf m + +instance Exception MagicException where + displayException (MagicException ctx msg) = T.unpack ctx ++ ": " ++ T.unpack msg + +-- | Read a NUL-terminated C string into 'Text', decoding UTF-8 leniently +-- (replacing invalid bytes). Avoids the locale round-trip through 'String'. +peekCStringText :: CString -> IO Text +peekCStringText cs = decodeUtf8With lenientDecode <$> BS.packCString cs + +-- | Build a handle from a C cookie-returning action, attaching the +-- @magic_close@ finalizer. Raises an 'IOError' (from @errno@) if the action +-- returns @NULL@. +fromMagicPtr :: String -> IO (Ptr CMagic) -> IO Magic +fromMagicPtr caller action = + do ptr <- throwErrnoIfNull caller action + fp <- newForeignPtr magic_close ptr + mv <- newMVar [] + return (Magic fp mv) + +-- | Run an action on the raw handle pointer, holding the per-handle lock and +-- keeping the handle alive for the whole action. +withMagicPtr :: Magic -> (Ptr CMagic -> IO a) -> IO a +withMagicPtr (Magic fp mv) act = withMVar mv (\_ -> withForeignPtr fp act) + +-- Turn libmagic's last error into a 'MagicException'. Accesses the handle +-- lock-free because it is only ever called from inside an operation that +-- already holds the lock (so re-taking it would deadlock). +throwError :: String -> Magic -> IO a +throwError caller (Magic fp _) = + withForeignPtr fp (\cmagic -> + do errormsg <- magic_error cmagic + msg <- if errormsg /= nullPtr + then peekCStringText errormsg + else return (T.pack "got error code but no error message") + throwIO (MagicException (T.pack caller) msg)) + +-- | Raise a t'MagicException' if the C action returns a non-zero (failure) code. +checkIntError :: String -> Magic -> IO CInt -> IO () +checkIntError caller m action = + do res <- action + if res == 0 then return () else throwError caller m + +-- | Raise a t'MagicException' if the C action returns a @NULL@ pointer. +throwErrorIfNull :: String -> Magic -> IO (Ptr a) -> IO (Ptr a) +throwErrorIfNull caller m action = + do res <- action + if res == nullPtr then throwError caller m else return res + +foreign import ccall unsafe "magic.h &magic_close" + magic_close :: FunPtr (Ptr CMagic -> IO ()) + +foreign import ccall unsafe "magic.h magic_error" + magic_error :: Ptr CMagic -> IO CString + +-- Marshalling between 'OsPath' and the C @const char*@ that libmagic expects. +-- On POSIX an 'OsPath' is exactly the path bytes the OS uses, which is exactly +-- what libmagic wants, so they pass through untouched (no lossy locale round +-- trip). On Windows we fall back to the locale encoding (a libmagic build for +-- Windows is a rarity). + +#if defined(mingw32_HOST_OS) + +withOsPathCString :: OsPath -> (CString -> IO a) -> IO a +withOsPathCString p k = decodeFS p >>= \s -> withCString s k + +withSearchPathCString :: [OsPath] -> (CString -> IO a) -> IO a +withSearchPathCString ps k = + do ss <- mapM decodeFS ps + withCString (intercalate ";" ss) k + +peekSearchPath :: CString -> IO [OsPath] +peekSearchPath cs = + do s <- peekCString cs + mapM encodeFS (filter (not . null) (splitOn ';' s)) + where + splitOn :: Char -> String -> [String] + splitOn c s = case break (== c) s of + (a, []) -> [a] + (a, _:rest) -> a : splitOn c rest + +#else + +osPathBytes :: OsPath -> BS.ByteString +osPathBytes = SBS.fromShort . getPosixString . getOsString + +bytesOsPath :: BS.ByteString -> OsPath +bytesOsPath = OsString . PosixString . SBS.toShort + +-- | Run an action with the path marshalled to a NUL-terminated C string. +withOsPathCString :: OsPath -> (CString -> IO a) -> IO a +withOsPathCString = BS.useAsCString . osPathBytes + +-- | Marshal a search path: the paths joined by the @:@ separator. +withSearchPathCString :: [OsPath] -> (CString -> IO a) -> IO a +withSearchPathCString ps = + BS.useAsCString (BS.intercalate (BS.singleton 0x3a) (map osPathBytes ps)) + +-- | Read a @:@-separated C search-path string back into a list of paths. +peekSearchPath :: CString -> IO [OsPath] +peekSearchPath cs = + (map bytesOsPath . filter (not . BS.null) . BS.split 0x3a) <$> BS.packCString cs + +#endif diff --git a/src/Magic/Operations.hsc b/src/Magic/Operations.hsc --- a/src/Magic/Operations.hsc +++ b/src/Magic/Operations.hsc @@ -23,137 +23,136 @@ module Magic.Operations(-- * Guessing the type magicFile, magicStdin, magicDescriptor, - magicString, magicCString, magicByteString, + magicCString, magicByteString, -- * Flags magicSetFlags, magicGetFlags, -- * Tunable parameters magicGetParam, magicSetParam, -- * Magic databases - magicCompile, magicCheck, magicGetPath, + magicCompile, magicCheck, magicLoadBuffers, + magicGetPath, -- * Library information magicVersion, magicErrno) where +import Control.Concurrent.MVar (modifyMVar_) +import Control.Exception (throwIO) +import qualified Data.Text as T +import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (withArray) import Foreign.Marshal.Utils (with) import Foreign.Storable (peek) import Data.Word import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as BSU +import Data.Text (Text) +import System.OsPath (OsPath) import System.Posix.Types (Fd) -import Magic.Types -import Magic.Utils +import Magic.Types (MagicParam(..)) +import Magic.Data (MagicFlags(..)) +import Magic.Internal (Magic(..), CMagic, MagicException(..), withMagicPtr, throwErrorIfNull, checkIntError, peekCStringText, withOsPathCString, withSearchPathCString, peekSearchPath) #include {- | Identify the file at the given path. The result is in the form selected by the handle's flags (a textual description, a MIME type, an encoding, and so on; -see 'MagicFlag'). Raises an 'IOError' if the file cannot be examined. -} -magicFile :: Magic -> FilePath -> IO String +see t'MagicFlags'). Raises a @MagicException@ if the file cannot be +examined. -} +magicFile :: Magic -> OsPath -> IO Text magicFile magic fp = withMagicPtr magic (\cmagic -> - withCString fp (\cfp -> + withOsPathCString fp (\cfp -> do res <- throwErrorIfNull "magicFile" magic (magic_file cmagic cfp) - peekCString res + peekCStringText res ) ) {- | Identify the data available on standard input, as 'magicFile' does for a -named file. Raises an 'IOError' if the data cannot be examined. -} -magicStdin :: Magic -> IO String +named file. Raises a @MagicException@ if the data cannot be +examined. -} +magicStdin :: Magic -> IO Text magicStdin magic = withMagicPtr magic (\cmagic -> do res <- throwErrorIfNull "magicStdin" magic (magic_file cmagic nullPtr) - peekCString res + peekCStringText res ) -{- | Identify the contents of the given 'String'. Note that the string is -processed strictly, not lazily. - -This is convenient for textual data. For binary data prefer 'magicCString' (or -write it to a file and use 'magicFile'): marshalling through 'String' goes via -the current locale encoding, which can corrupt non-textual bytes. Raises an -'IOError' if the data cannot be examined. -} -magicString :: Magic -> String -> IO String -magicString m s = withCStringLen s (magicCString m) - -{- | Identify the contents of a C string buffer (a pointer and a length). This -is the lower-level primitive behind 'magicString', and the right choice for raw -binary data since it does no encoding conversion. Raises an 'IOError' if the -data cannot be examined. -} -magicCString :: Magic -> CStringLen -> IO String +{- | Identify the contents of a C string buffer (a pointer and a length). The +lowest-level in-memory primitive; for ordinary use prefer 'magicByteString'. +Raises a @MagicException@ if the data cannot be examined. -} +magicCString :: Magic -> CStringLen -> IO Text magicCString magic (cstr, len) = withMagicPtr magic (\cmagic -> do res <- throwErrorIfNull "magicCString" magic (magic_buffer cmagic cstr (fromIntegral len)) - peekCString res + peekCStringText res ) -{- | Change the flags (see 'MagicFlag') on an existing handle, for example to -switch between textual descriptions and MIME types. Raises an 'IOError' on +{- | Change the flags (see t'MagicFlags') on an existing handle, for example to +switch between textual descriptions and MIME types. Raises a @MagicException@ on failure. -} -magicSetFlags :: Magic -> [MagicFlag] -> IO () -magicSetFlags m mfl = withMagicPtr m (\cmagic -> +magicSetFlags :: Magic -> MagicFlags -> IO () +magicSetFlags m (MagicFlags flags) = withMagicPtr m (\cmagic -> checkIntError "magicSetFlags" m $ magic_setflags cmagic flags) - where flags = flaglist2int mfl -{- | Compile the given colon-separated magic database file(s) into the binary -@.mgc@ form. Each compiled file is named after its source with @.mgc@ appended. -Pass 'Nothing' to compile the default database. Raises an 'IOError' on failure. +{- | Compile the given magic database file(s) into the binary @.mgc@ form. Each +compiled file is named after its source with @.mgc@ appended. Pass the empty +list to compile the default database. Raises a @MagicException@ on failure. + +(libmagic joins the list with the platform search-path separator, so a path +that itself contains that separator cannot be represented.) -} -magicCompile :: Magic -- ^ Object to use - -> Maybe String -- ^ Colon separated list of databases, or Nothing for default - -> IO () -magicCompile m mstr = withMagicPtr m (\cm -> - case mstr of - Nothing -> worker cm nullPtr - Just x -> withCString x (worker cm) - ) +magicCompile :: Magic -> [OsPath] -> IO () +magicCompile m ps = withMagicPtr m (\cm -> + case ps of + [] -> worker cm nullPtr + _ -> withSearchPathCString ps (worker cm)) where worker cm cs = checkIntError "magicCompile" m $ magic_compile cm cs {- | Identify the data behind an open file descriptor, as 'magicFile' does for a named file. Useful for sockets, pipes, or files you have already opened. Raises -an 'IOError' if the descriptor cannot be examined. +a @MagicException@ if the descriptor cannot be examined. @since 1.1.2 -} -magicDescriptor :: Magic -> Fd -> IO String +magicDescriptor :: Magic -> Fd -> IO Text magicDescriptor magic fd = withMagicPtr magic (\cmagic -> do res <- throwErrorIfNull "magicDescriptor" magic (magic_descriptor cmagic (fromIntegral fd)) - peekCString res) + peekCStringText res) -{- | Identify the contents of a strict 'ByteString'. Unlike 'magicString' this -does no encoding conversion, so it is the right choice for binary data. Raises -an 'IOError' if the data cannot be examined. +{- | Identify the contents of a strict 'ByteString'. Does no encoding +conversion, so it is the right way to examine in-memory data. Raises a +@MagicException@ if the data cannot be examined. @since 1.1.2 -} -magicByteString :: Magic -> ByteString -> IO String +magicByteString :: Magic -> ByteString -> IO Text magicByteString magic bs = withMagicPtr magic (\cmagic -> BSU.unsafeUseAsCStringLen bs (\(cstr, len) -> do res <- throwErrorIfNull "magicByteString" magic (magic_buffer cmagic cstr (fromIntegral len)) - peekCString res)) + peekCStringText res)) -{- | Read the flags currently set on the handle (see 'magicSetFlags'). Composite -masks are returned decomposed into their individual flags. Raises an 'IOError' -if the running @libmagic@ does not support querying flags. +{- | Read the flags currently set on the handle (see 'magicSetFlags'). Test the +result with @hasFlag@. Raises a @MagicException@ if the running @libmagic@ does not +support querying flags. @since 1.1.2 -} -magicGetFlags :: Magic -> IO [MagicFlag] +magicGetFlags :: Magic -> IO MagicFlags magicGetFlags m = withMagicPtr m (\cmagic -> do fl <- magic_getflags cmagic if fl < 0 - then ioError (userError - "magicGetFlags: magic_getflags is unsupported by this libmagic") - else return (int2flaglist fl)) + then throwIO (MagicException (T.pack "magicGetFlags") + (T.pack "magic_getflags is unsupported by this libmagic")) + else return (MagicFlags fl)) {- | Read a tunable parameter (see 'MagicParam'). @@ -169,7 +168,7 @@ return (fromIntegral (v :: CSize)))) {- | Set a tunable parameter (see 'MagicParam'), for example to cap the number -of bytes scanned in untrusted input. Raises an 'IOError' on failure. +of bytes scanned in untrusted input. Raises a @MagicException@ on failure. @since 1.1.2 -} @@ -193,27 +192,58 @@ MagicParamElfShsizeMax -> #{const MAGIC_PARAM_ELF_SHSIZE_MAX} {- | Check the validity of the given magic database file(s) without compiling -them, as @file -c@ does. Pass 'Nothing' for the default database. Returns -'True' if the database is valid. +them, as @file -c@ does. Pass the empty list for the default database. Returns +'True' if the database is valid. (libmagic joins the list with the platform +search-path separator, so a path that itself contains that separator cannot be +represented.) @since 1.1.2 -} -magicCheck :: Magic -> Maybe FilePath -> IO Bool -magicCheck m mpath = +magicCheck :: Magic -> [OsPath] -> IO Bool +magicCheck m ps = withMagicPtr m (\cmagic -> - case mpath of - Nothing -> fmap (== 0) (magic_check cmagic nullPtr) - Just p -> withCString p (fmap (== 0) . magic_check cmagic)) + case ps of + [] -> fmap (== 0) (magic_check cmagic nullPtr) + _ -> withSearchPathCString ps (fmap (== 0) . magic_check cmagic)) -{- | The path of the default magic database, honouring the @MAGIC@ environment -variable. +{- | Load magic from one or more in-memory compiled databases (the @.mgc@ binary +form produced by 'magicCompile'), rather than from files. This lets a program +embed its magic database. +@libmagic@ keeps (does not copy) the supplied buffers for the lifetime of the +handle, so the handle retains references to the given 'ByteString's to keep +their memory alive until it is closed. Raises a @MagicException@ on failure. + +@since 2.0.0 +-} +magicLoadBuffers :: Magic -> [ByteString] -> IO () +magicLoadBuffers (Magic fp mv) bufs = + modifyMVar_ mv $ \retained -> + do withForeignPtr fp $ \cmagic -> + withBuffers bufs $ \pls -> + withArray (map fst pls) $ \pptr -> + withArray (map snd pls) $ \sptr -> + checkIntError "magicLoadBuffers" (Magic fp mv) + (magic_load_buffers cmagic pptr sptr (fromIntegral (length bufs))) + -- Keep the buffers reachable (and so, being pinned, validly addressable) + -- for as long as the handle lives. + return (bufs ++ retained) + where + withBuffers :: [ByteString] -> ([(Ptr Word8, CSize)] -> IO a) -> IO a + withBuffers [] k = k [] + withBuffers (b:bs) k = + BSU.unsafeUseAsCStringLen b (\(p, l) -> + withBuffers bs (\rest -> k ((castPtr p, fromIntegral l) : rest))) + +{- | The default magic database search path, honouring the @MAGIC@ environment +variable, as a list of paths. + @since 1.1.2 -} -magicGetPath :: IO FilePath +magicGetPath :: IO [OsPath] magicGetPath = do res <- magic_getpath nullPtr 0 - if res == nullPtr then return "" else peekCString res + if res == nullPtr then return [] else peekSearchPath res {- | The version of the @libmagic@ library in use, encoded as a single integer (for example @545@ for version 5.45). @@ -254,6 +284,10 @@ -- Validates a database file -> safe foreign import ccall safe "magic.h magic_check" magic_check :: Ptr CMagic -> CString -> IO CInt + +-- Parses (potentially large) in-memory databases -> safe +foreign import ccall safe "magic.h magic_load_buffers" + magic_load_buffers :: Ptr CMagic -> Ptr (Ptr Word8) -> Ptr CSize -> CSize -> IO CInt -- Does not do I/O -> unsafe foreign import ccall unsafe "magic.h magic_getflags" diff --git a/src/Magic/Types.hsc b/src/Magic/Types.hsc --- a/src/Magic/Types.hsc +++ b/src/Magic/Types.hsc @@ -5,6 +5,8 @@ This code is under a 3-clause BSD license; see COPYING for details. -} +{-# LANGUAGE DeriveGeneric #-} + {- | Module : Magic.Types Copyright : Copyright (C) 2005 John Goerzen @@ -14,42 +16,18 @@ Stability : provisional Portability: portable -The core types of the binding: the opaque 'Magic' handle, the 'MagicFlag' -enumeration (re-exported from "Magic.Data") and the 'MagicParam' tunables. - -Written by John Goerzen. +The core types of the binding: the opaque t'Magic' handle, the t'MagicException' +error type (both defined in "Magic.Internal"), and the 'MagicParam' tunables. +The flag bit-mask lives in "Magic.Data". -} module Magic.Types(Magic, - CMagic, - MagicFlag(..), + MagicException(..), MagicParam(..)) where -import Foreign.ForeignPtr -import Magic.Data - -#include - --- | Phantom type standing in for the C @magic_t@ cookie. It appears only as the --- argument of a 'Foreign.ForeignPtr.ForeignPtr' (the 'Magic' handle) and has no --- values of its own. -data CMagic - -{- | The magic handle: an opaque cookie obtained from @magicOpen@ and passed to -the loading and querying functions. - -Handles are closed (and their memory freed) automatically when they are -garbage-collected by Haskell. There is no need to close them explicitly. - -__Thread safety.__ A single @Magic@ handle is /not/ safe for concurrent use: -the underlying @libmagic@ cookie keeps mutable state, so calling operations on -the same handle from multiple threads at once is a data race. Use one handle -per thread, or serialise access to a shared handle (e.g. behind an @MVar@). -Distinct handles are independent and may be used concurrently. Programs doing -blocking work (loading databases, examining files) should also be built with -the threaded runtime (@-threaded@). --} -type Magic = ForeignPtr CMagic +import Control.DeepSeq (NFData(rnf)) +import GHC.Generics (Generic) +import Magic.Internal (Magic, MagicException(..)) {- | Tunable limits that bound how hard @libmagic@ works when examining data, read and written with @magicGetParam@ and @magicSetParam@ (see @@ -78,5 +56,7 @@ MagicParamEncodingMax | -- | Maximum size of an ELF section processed. MagicParamElfShsizeMax - deriving (Show, Eq, Ord, Enum, Bounded) + deriving (Show, Eq, Ord, Enum, Bounded, Generic) + +instance NFData MagicParam where rnf x = x `seq` () diff --git a/src/Magic/Utils.hsc b/src/Magic/Utils.hsc deleted file mode 100644 --- a/src/Magic/Utils.hsc +++ /dev/null @@ -1,84 +0,0 @@ -{- -*- Mode: haskell; -*- -Haskell magic Interface -Copyright (C) 2005 John Goerzen - -This code is under a 3-clause BSD license; see COPYING for details. --} - -{- | - Module : Magic.Utils - Copyright : Copyright (C) 2005 John Goerzen - License : BSD-3-Clause - - Maintainer : Philippe - Stability : provisional - Portability: portable - -Internal marshalling helpers shared by the other modules: converting between -'MagicFlag' lists and the C bit-mask, wrapping the C handle in a 'ForeignPtr', -and turning C error returns into 'IOError's. - -Written by John Goerzen. --} - -module Magic.Utils (flaglist2int, int2flaglist, fromMagicPtr, withMagicPtr, - checkIntError, throwErrorIfNull) -where - -import Foreign -import Foreign.C.Error -import Foreign.C.String -import Magic.Types -import Foreign.C.Types - -flaglist2int :: [MagicFlag] -> CInt -flaglist2int mfl = - foldl (\c f -> c .|. (fromIntegral . fromEnum $ f)) 0 mfl - --- | Decode a C bit-mask into the list of set 'MagicFlag's. Each set bit is --- mapped to its individual flag, so composite values come back decomposed --- (e.g. the MIME mask yields @['MagicMimeType', 'MagicMimeEncoding']@). -int2flaglist :: CInt -> [MagicFlag] -int2flaglist flags = - [ toEnum v - | i <- [0 .. finiteBitSize flags - 1] - , testBit flags i - , let v = bit i :: Int ] - -fromMagicPtr :: String -> IO (Ptr CMagic) -> IO Magic -fromMagicPtr caller action = - do ptr <- throwErrnoIfNull caller action - newForeignPtr magic_close ptr - -throwErrorIfNull :: String -> Magic -> IO (Ptr a) -> IO (Ptr a) -throwErrorIfNull caller m action = - do res <- action - if res == nullPtr - then throwError caller m - else return res - -withMagicPtr :: Magic -> (Ptr CMagic -> IO a) -> IO a -withMagicPtr m = withForeignPtr m - -throwError :: String -> Magic -> IO a -throwError caller m = withMagicPtr m (\cmagic -> - do errormsg <- magic_error cmagic - if errormsg /= nullPtr - then do em <- peekCString errormsg - fail $ caller ++ ": " ++ em - else fail $ caller ++ ": got error code but no error message" - ) - -checkIntError :: String -> Magic -> IO CInt -> IO () -checkIntError caller m action = - do res <- action - if res == 0 - then return () - else throwError caller m - - -foreign import ccall unsafe "magic.h &magic_close" - magic_close :: FunPtr (Ptr CMagic -> IO ()) - -foreign import ccall unsafe "magic.h magic_error" - magic_error :: Ptr CMagic -> IO CString diff --git a/test/Inittest.hs b/test/Inittest.hs --- a/test/Inittest.hs +++ b/test/Inittest.hs @@ -6,18 +6,28 @@ module Inittest(tests) where -import Control.Exception (IOException, bracket, try) +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Control.DeepSeq (rnf) +import Control.Exception (SomeException, bracket, displayException, try) +import Control.Monad (forM, forM_) import qualified Data.ByteString as BS -import Data.List (isInfixOf, isPrefixOf) -import System.Directory (getTemporaryDirectory, removeFile) +import qualified Data.ByteString.Char8 as BS8 +import Data.List (isInfixOf, isPrefixOf, isSuffixOf) +import Data.Text (Text) +import qualified Data.Text as T +import System.Directory (doesFileExist, getTemporaryDirectory, removeFile) import System.FilePath (()) +import System.Mem (performMajorGC) +import System.OsPath (encodeFS) import System.Posix.IO (OpenMode(ReadOnly), closeFd, defaultFileFlags, openFd) import Test.HUnit -import Magic +import Magic.FilePath +import qualified Magic as M -- | Open a handle with the given flags and load the default database. -withDefault :: [MagicFlag] -> (Magic -> IO a) -> IO a +withDefault :: MagicFlags -> (Magic -> IO a) -> IO a withDefault flags act = do m <- magicOpen flags magicLoadDefault m @@ -38,48 +48,55 @@ removeFile act --- | A small in-memory string is detected as plain text. +-- | A small in-memory byte string is detected as plain text. test_textMime :: Test test_textMime = TestCase $ do - result <- withDefault [MagicMimeType] $ \m -> - magicString m "Hello, world!\nThis is just some plain ASCII text.\n" + result <- withDefault MagicMimeType $ \m -> + magicByteString m (BS8.pack "Hello, world!\nThis is just some plain ASCII text.\n") assertBool ("expected a text/* MIME type, got: " ++ show result) - ("text/" `isPrefixOf` result) + ("text/" `isPrefixOf` T.unpack result) -- | The textual description of plain text mentions \"text\". test_textDescription :: Test test_textDescription = TestCase $ do - result <- withDefault [MagicNone] $ \m -> - magicString m "The quick brown fox jumps over the lazy dog.\n" + result <- withDefault MagicNone $ \m -> + magicByteString m (BS8.pack "The quick brown fox jumps over the lazy dog.\n") assertBool ("expected a description mentioning 'text', got: " ++ show result) - ("text" `isInfixOf` result) + ("text" `isInfixOf` T.unpack result) -- | A file whose contents start with the PNG signature is recognised as a PNG. --- --- Binary content must be detected via a file (raw bytes); passing binary --- data through 'magicString' would corrupt the high bytes via the locale --- encoding. test_pngMime :: Test test_pngMime = TestCase $ withPngFile $ \pngPath -> do - result <- withDefault [MagicMimeType] $ \m -> magicFile m pngPath - assertEqual "PNG MIME type" "image/png" result + result <- withDefault MagicMimeType $ \m -> magicFile m pngPath + assertEqual "PNG MIME type" "image/png" (T.unpack result) +-- | The primary "Magic" API identifies a file given as an 'OsPath'. +test_osPathFile :: Test +test_osPathFile = TestCase $ + withPngFile $ \pngPath -> do + p <- encodeFS pngPath + result <- do + m <- M.magicOpen M.MagicMimeType + M.magicLoadDefault m + M.magicFile m p + assertEqual "PNG MIME via OsPath" "image/png" (T.unpack result) + -- | 'magicByteString' identifies binary data directly, without an intermediate -- file and without locale-encoding corruption. test_byteStringMime :: Test test_byteStringMime = TestCase $ do - result <- withDefault [MagicMimeType] $ \m -> magicByteString m pngBytes - assertEqual "PNG MIME via ByteString" "image/png" result + result <- withDefault MagicMimeType $ \m -> magicByteString m pngBytes + assertEqual "PNG MIME via ByteString" "image/png" (T.unpack result) -- | 'magicDescriptor' identifies the data behind an open file descriptor. test_descriptorMime :: Test test_descriptorMime = TestCase $ withPngFile $ \pngPath -> do - result <- withDefault [MagicMimeType] $ \m -> + result <- withDefault MagicMimeType $ \m -> bracket (openFd pngPath ReadOnly defaultFileFlags) closeFd (magicDescriptor m) - assertEqual "PNG MIME via descriptor" "image/png" result + assertEqual "PNG MIME via descriptor" "image/png" (T.unpack result) -- | 'magicVersion' reports a sane (positive) library version. test_version :: Test @@ -90,16 +107,51 @@ -- | Flags set with 'magicSetFlags' are read back by 'magicGetFlags'. test_getFlags :: Test test_getFlags = TestCase $ - withDefault [MagicNone] $ \m -> do - magicSetFlags m [MagicMimeType, MagicError] + withDefault MagicNone $ \m -> do + magicSetFlags m (MagicMimeType <> MagicError) fl <- magicGetFlags m - assertBool ("expected MimeType and Error among " ++ show fl) - (MagicMimeType `elem` fl && MagicError `elem` fl) + assertBool ("expected MimeType and Error set in " ++ show fl) + (hasFlag fl MagicMimeType && hasFlag fl MagicError) +-- | Pure laws and helpers of the 'MagicFlags' algebra: monoid identity, +-- 'hasFlag' (including its edge cases), 'removeFlags', and the name-printing +-- 'Show' (composites decompose into their atomic flags). +test_flagAlgebra :: Test +test_flagAlgebra = TestCase $ do + assertEqual "mempty is MagicNone" MagicNone (mempty :: MagicFlags) + assertEqual "right identity" MagicMimeType (MagicMimeType <> mempty) + let both = MagicMimeType <> MagicError + assertBool "contains a set flag" (hasFlag both MagicError) + assertBool "lacks an unset flag" (not (hasFlag MagicMimeType MagicError)) + assertBool "empty is a subset" (hasFlag MagicMimeType MagicNone) + let dropped = removeFlags both MagicError + assertBool "removed flag is gone" (not (hasFlag dropped MagicError)) + assertBool "other flag remains" (hasFlag dropped MagicMimeType) + assertEqual "removing an absent flag is a no-op" + MagicMimeType (removeFlags MagicMimeType MagicError) + assertEqual "show of the empty set" "MagicNone" (show MagicNone) + assertEqual "show of one flag" "MagicMimeType" (show MagicMimeType) + assertEqual "show decomposes composites" + "MagicMimeType <> MagicMimeEncoding" (show MagicMime) + +-- | The opaque 'Magic' handle shows as a fixed placeholder. +test_showHandle :: Test +test_showHandle = TestCase $ do + m <- magicOpen MagicNone + assertEqual "handle shows as placeholder" "" (show m) + +-- | The 'NFData' instances force values fully without bottoming. +test_nfdata :: Test +test_nfdata = TestCase $ + rnf (MagicMimeType <> MagicError) `seq` + rnf MagicParamBytesMax `seq` + rnf (MagicException (T.pack "ctx") (T.pack "msg")) `seq` + assertBool "NFData forces flags, params, and exceptions without error" True + -- | A parameter set with 'magicSetParam' is read back by 'magicGetParam'. test_params :: Test test_params = TestCase $ - withDefault [MagicNone] $ \m -> do + withDefault MagicNone $ \m -> do magicSetParam m MagicParamBytesMax 4096 v <- magicGetParam m MagicParamBytesMax assertEqual "bytes-max round-trip" 4096 v @@ -107,7 +159,7 @@ -- | The system's default magic database validates with 'magicCheck'. test_check :: Test test_check = TestCase $ do - ok <- withDefault [MagicNone] $ \m -> magicCheck m Nothing + ok <- withDefault MagicNone $ \m -> magicCheck m [] assertBool "default magic database should be valid" ok -- | 'magicGetPath' returns a non-empty default database path. @@ -121,54 +173,132 @@ test_extension :: Test test_extension = TestCase $ withPngFile $ \pngPath -> do - result <- withDefault [MagicExtension] $ \m -> magicFile m pngPath + result <- withDefault MagicExtension $ \m -> magicFile m pngPath assertBool ("expected 'png' among extensions, got: " ++ show result) - ("png" `isInfixOf` result) + ("png" `isInfixOf` T.unpack result) -- | The composite 'MagicMime' mask is read back decomposed into its component -- flags by 'magicGetFlags'. test_getFlagsComposite :: Test test_getFlagsComposite = TestCase $ - withDefault [MagicNone] $ \m -> do - magicSetFlags m [MagicMime] + withDefault MagicNone $ \m -> do + magicSetFlags m MagicMime fl <- magicGetFlags m - assertBool ("expected MimeType and MimeEncoding among " ++ show fl) - (MagicMimeType `elem` fl && MagicMimeEncoding `elem` fl) + assertBool ("expected MimeType and MimeEncoding set in " ++ show fl) + (hasFlag fl MagicMimeType && hasFlag fl MagicMimeEncoding) -- | With 'MagicError' set, examining a missing file raises an 'IOError' rather -- than embedding the message in the result. test_errorRaised :: Test test_errorRaised = TestCase $ do - r <- withDefault [MagicError] $ \m -> - try (magicFile m "/no/such/magic/file") :: IO (Either IOException String) + r <- withDefault MagicError $ \m -> + try (magicFile m "/no/such/magic/file") :: IO (Either MagicException Text) case r of - Left _ -> return () - Right s -> assertFailure ("expected an IOError, got: " ++ show s) + Left e -> do + assertEqual "exception carries the operation as its context" + "magicFile" (T.unpack (magicErrorContext e)) + assertBool "exception carries a non-empty libmagic message" + (not (T.null (magicErrorMessage e))) + assertBool ("displayException is prefixed with the context, got: " + ++ displayException e) + ("magicFile: " `isPrefixOf` displayException e) + Right s -> assertFailure ("expected a MagicException, got: " ++ show s) -- | After a failed operation, 'magicErrno' reports the underlying system error. test_errno :: Test test_errno = TestCase $ - withDefault [MagicError] $ \m -> do + withDefault MagicError $ \m -> do _ <- try (magicFile m "/no/such/magic/file") - :: IO (Either IOException String) + :: IO (Either MagicException Text) e <- magicErrno m assertBool ("expected a non-zero errno after a failed open, got " ++ show e) (e /= 0) +-- | 'magicLoadBuffers' loads a compiled database from memory, and the handle +-- keeps the buffer alive: after dropping the local reference and forcing a GC, +-- the handle still works. Skipped (passes trivially) when no compiled @.mgc@ +-- database can be located, to avoid depending on the host layout. +test_loadBuffers :: Test +test_loadBuffers = TestCase $ do + mfile <- findCompiledMagic + case mfile of + Nothing -> return () -- no compiled database available here + Just f -> do + m <- magicOpen MagicMimeType + -- Load from a buffer that goes out of scope immediately afterwards. + do buf <- BS.readFile f + magicLoadBuffers m [buf] + performMajorGC -- try to reclaim the now-unreferenced buffer + result <- magicByteString m pngBytes + assertEqual "PNG MIME after magicLoadBuffers (buffer survived GC)" + "image/png" (T.unpack result) + +-- | 'magicLoad' with a non-empty path list (exercises the search-path +-- marshalling, joining the paths for libmagic). Loads a located compiled +-- database explicitly, then identifies data. Skipped when none is found. +test_loadFromPath :: Test +test_loadFromPath = TestCase $ do + mfile <- findCompiledMagic + case mfile of + Nothing -> return () + Just f -> do + result <- do + m <- magicOpen MagicMimeType + magicLoad m [f] -- non-empty list -> withSearchPathCString + magicByteString m pngBytes + assertEqual "PNG MIME after magicLoad from an explicit path" + "image/png" (T.unpack result) + +-- | Many concurrent calls on a single shared handle all succeed (exercises the +-- per-handle lock; run under the threaded RTS with @-N@). +test_concurrent :: Test +test_concurrent = TestCase $ + withDefault MagicMimeType $ \m -> do + let n = 32 :: Int + done <- newEmptyMVar + forM_ [1 .. n] $ \_ -> forkIO $ do + r <- try (magicByteString m pngBytes) :: IO (Either SomeException Text) + putMVar done r + results <- forM [1 .. n] $ \_ -> takeMVar done + let ok :: Either SomeException Text -> Bool + ok (Right s) = T.unpack s == "image/png" + ok (Left _) = False + assertBool "every concurrent call returned image/png" (all ok results) + +-- | Locate a compiled magic database from the default search path. +findCompiledMagic :: IO (Maybe FilePath) +findCompiledMagic = do + paths <- magicGetPath + firstExisting (filter (".mgc" `isSuffixOf`) + (concatMap (\p -> [p, p ++ ".mgc"]) paths)) + where + firstExisting :: [FilePath] -> IO (Maybe FilePath) + firstExisting [] = return Nothing + firstExisting (f:fs) = do + e <- doesFileExist f + if e then return (Just f) else firstExisting fs + tests :: Test tests = TestList [ TestLabel "text MIME type" test_textMime , TestLabel "text description" test_textDescription , TestLabel "PNG MIME type" test_pngMime + , TestLabel "PNG MIME (OsPath)" test_osPathFile , TestLabel "PNG MIME (ByteString)" test_byteStringMime , TestLabel "PNG MIME (descriptor)" test_descriptorMime , TestLabel "library version" test_version , TestLabel "get/set flags" test_getFlags , TestLabel "composite flags" test_getFlagsComposite + , TestLabel "flag algebra" test_flagAlgebra + , TestLabel "show handle" test_showHandle + , TestLabel "NFData instances" test_nfdata , TestLabel "extension flag" test_extension , TestLabel "get/set params" test_params , TestLabel "check database" test_check , TestLabel "default path" test_getPath , TestLabel "error raised" test_errorRaised , TestLabel "errno after failure" test_errno + , TestLabel "load buffers" test_loadBuffers + , TestLabel "load from path" test_loadFromPath + , TestLabel "concurrent handle use" test_concurrent ]