packages feed

magic 1.1.2 → 2.0.0

raw patch · 12 files changed

+914/−405 lines, 12 filesdep +deepseqdep +os-stringdep +textdep ~filepath

Dependencies added: deepseq, os-string, text

Dependency ranges changed: filepath

Files

CHANGELOG.md view
@@ -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.
README.md view
@@ -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
magic.cabal view
@@ -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
src/Magic.hs view
@@ -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
src/Magic/Data.hsc view
@@ -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)+  ]
+ src/Magic/FilePath.hs view
@@ -0,0 +1,71 @@+{-  -*- Mode: haskell; -*-+Haskell magic Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <philippedev101\@gmail.com>+   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
src/Magic/Init.hsc view
@@ -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"
+ src/Magic/Internal.hs view
@@ -0,0 +1,203 @@+{-  -*- Mode: haskell; -*-+Haskell magic Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <philippedev101\@gmail.com>+   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 _ = "<magic handle>"++-- | 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
src/Magic/Operations.hsc view
@@ -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 <magic.h>  {- | 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"
src/Magic/Types.hsc view
@@ -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 <magic.h>---- | 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` ()
− src/Magic/Utils.hsc 
@@ -1,84 +0,0 @@-{- -*- Mode: haskell; -*--Haskell magic Interface-Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>--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 <philippedev101\@gmail.com>-   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
test/Inittest.hs view
@@ -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" "<magic handle>" (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     ]