magic 1.1 → 2.0.0

raw patch · 22 files changed

Files

• CHANGELOG.md +53/−0
• Magic.hs +0/−35
• Magic/Data.hsc +0/−77
• Magic/Init.hsc +0/−58
• Magic/Operations.hsc +0/−102
• Magic/Types.hsc +0/−42
• Magic/TypesLL.hs +0/−26
• Magic/Utils.hsc +0/−77
• README.md +71/−0
• Setup.hs +2/−0
• Setup.lhs +0/−7
• magic.cabal +133/−31
• src/Magic.hs +74/−0
• src/Magic/Data.hsc +273/−0
• src/Magic/FilePath.hs +71/−0
• src/Magic/Init.hsc +74/−0
• src/Magic/Internal.hs +203/−0
• src/Magic/Operations.hsc +314/−0
• src/Magic/Types.hsc +62/−0
• test/Inittest.hs +304/−0
• test/Tests.hs +13/−0
• test/runtests.hs +18/−0

@@ -0,0 +1,53 @@+# Changelog for `magic`++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.++- Added the remaining `MagicFlag` constructors from `<magic.h>`: `MagicApple`, `MagicExtension`, `MagicCompressTransp`, `MagicNoCompressFork`, `MagicNodesc`, and the whole no-check family (`MagicNoCheckCompress`, `…Tar`, `…Soft`, `…Apptype`, `…Elf`, `…Text`, `…Cdf`, `…Csv`, `…Tokens`, `…Encoding`, `…Json`, `…Simh`) plus `MagicNoCheckBuiltin`.+- Added new operations in `Magic.Operations`: `magicDescriptor` (identify an open file descriptor), `magicByteString` (binary-safe identification of a strict `ByteString`), `magicGetFlags`, `magicGetParam`/`magicSetParam` with the new `MagicParam` type, `magicCheck`, `magicGetPath`, `magicVersion`, and `magicErrno`.+- `magicGetParam`/`magicSetParam` require `libmagic` >= 5.21; `magicGetFlags` requires >= 5.05. All current systems are well past this.+- New dependency: `bytestring` (a GHC boot library) for the `ByteString` entry points.+- Moved the `CMagic` phantom type (the tag behind the `Magic` handle) into `Magic.Types` and removed the internal `Magic.TypesLL` module. `CMagic` is now documented and linkable from the exposed `Magic.Types`. Documentation polish throughout: full Haddock coverage with no warnings, `@since` annotations on the new API, and default values listed for each `MagicParam`.+- `magic_load` is now imported as a `safe` foreign call (it was `unsafe`). It reads and parses the magic database from disk (blocking I/O), so under the threaded runtime loading a database no longer stalls other Haskell threads or blocks garbage collection. No API change.+- Documented the thread-safety contract of the `Magic` handle: a single handle is not safe for concurrent use (serialise access or use one per thread); distinct handles are independent.++## 1.1.1 (2026-06-09)++No API changes: this release is a drop-in replacement for 1.1.++- New maintainer: Philippe (<philippedev101@gmail.com>); package handed over from John Goerzen.+- Modernised the Cabal package description (`cabal-version: 2.4`, proper `library`/`test-suite` stanzas, `source-repository`, `tested-with`).+- Added an automatic `pkgconfig` flag: libmagic is now located via pkg-config when available, falling back transparently to plain `extra-libraries` linking otherwise.+- Moved library sources under `src/` and tests under `test/` (no code or module-name changes).+- Revived the original HUnit test suite in place: completed the unfinished `Inittest` module with real tests exercising the bindings against the system magic database, and fixed the runner to exit non-zero on failure.+- Added a GitHub Actions CI workflow building and testing across GHC 9.6 / 9.8 / 9.10 / 9.12.+- Removed dead imports so the library builds `-Wall`-clean.+- Ships the `unsafe`-FFI fix (use safe FFI calls for blocking I/O) that was merged upstream after the 1.1 Hackage release but never published.++## 1.1 (2014-10) and earlier++Releases by John Goerzen. See the git history for details.

@@ -1,35 +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-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Top-level Magic module.--Written by John Goerzen, jgoerzen\@complete.org--Foo bar--}--module Magic (-- * Basic Types-             module Magic.Types,-             -- * Initialization-             module Magic.Init,-             -- * Operation-             module Magic.Operations-            )-where-import Magic.Types-import Magic.Init-import Magic.Operations

@@ -1,77 +0,0 @@--- AUTO-GENERATED FILE, DO NOT EDIT.  GENERATED BY utils/genconsts.hs-{- |-   Module     : Magic.Data-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Haskell types for libmagic constants--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.Data (module Magic.Data) where--#include "magic.h"---data MagicFlag =-   MagicNone- | MagicDebug- | MagicSymlink- | MagicCompress- | MagicDevices- | MagicMimeType- | MagicMimeEncoding- | MagicMime- | MagicContinue- | MagicCheck- | MagicPreserveAtime- | MagicRaw- | MagicError- | UnknownMagicFlag Int-- deriving (Show)--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 x = UnknownMagicFlag x-- 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 (UnknownMagicFlag x) = x--instance Ord MagicFlag where- compare x y = compare (fromEnum x) (fromEnum y)--instance Eq MagicFlag where- x == y = (fromEnum x) == (fromEnum y)--

@@ -1,58 +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.Init-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Initialization and shutdown for magic programs--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.Init(magicOpen, magicLoad, magicLoadDefault)-where--import Foreign.Ptr-import Foreign.C.String-import Magic.Types-import Foreign.C.Types-import Magic.Utils-import Magic.TypesLL-import Foreign.Marshal.Utils--{- | Create a Magic object.  You must call either 'magicLoadDefault'-or 'magicLoad' after this.--}-magicOpen :: [MagicFlag] -> IO Magic-magicOpen mfl =-    fromMagicPtr "magicOpen" (magic_open flags)-    where flags = flaglist2int mfl--{- | Load the system's default magic database. -}-magicLoadDefault :: Magic -> IO ()-magicLoadDefault m = withMagicPtr m (\cmagic ->-    checkIntError "magicLoadDefault" m $ magic_load cmagic nullPtr)--{- | Load the specified magic database(s).  The given string may contain-multiple colon-separated pathnames. -}-magicLoad :: Magic -> String -> IO ()-magicLoad m s = withMagicPtr m (\cmagic ->-    withCString s (\cs ->-     checkIntError "magicLoad" m $ magic_load cmagic cs))-    -foreign import ccall unsafe "magic.h magic_open"-  magic_open :: CInt -> IO (Ptr CMagic)--foreign import ccall unsafe "magic.h magic_load"-  magic_load :: Ptr CMagic -> CString -> IO CInt

@@ -1,102 +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.Init-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Initialization and shutdown for magic programs--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.Operations(-- * Guessing the type-                        magicFile, magicStdin,-                        magicString, magicCString,-                        -- * Other operations-                        magicSetFlags, magicCompile)-where--import Foreign.Ptr-import Foreign.C.String-import Magic.Types-import Foreign.C.Types-import Data.Word-import Foreign.C.String-import Foreign.C.Error-import Magic.Utils-import Magic.TypesLL-import Foreign.Marshal.Utils--{- | Calls the Magic system on the specified file. -}-magicFile :: Magic -> FilePath -> IO String-magicFile magic fp =-    withMagicPtr magic (\cmagic ->-    withCString fp (\cfp ->-     do res <- throwErrorIfNull "magicFile" magic (magic_file cmagic cfp)-        peekCString res-                    )-                       )--{- | Calls the Magic system on stdin. -}-magicStdin :: Magic -> IO String-magicStdin magic =-    withMagicPtr magic (\cmagic ->-     do res <- throwErrorIfNull "magicStdin" magic (magic_file cmagic nullPtr)-        peekCString res-                       )--{- | Calls the Magic system to process the given String.  Please note:-it is not evaluated lazily. -}-magicString :: Magic -> String -> IO String-magicString m s = withCStringLen s (magicCString m)--{- | Lower-level function used to call the Magic system to process a C -string. -}-magicCString :: Magic -> CStringLen -> IO String-magicCString magic (cstr, len) =-    withMagicPtr magic (\cmagic ->-     do res <- throwErrorIfNull "magicCString" magic (magic_buffer cmagic cstr (fromIntegral len))-        peekCString res-                    )--{- | Change the flags on an already-created object. -}-magicSetFlags :: Magic -> [MagicFlag] -> IO ()-magicSetFlags m mfl = withMagicPtr m (\cmagic ->-     checkIntError "magicSetFlags" m $ magic_setflags cmagic flags)-    where flags = flaglist2int mfl--{- | Compile the colon-separated list of database file(s).  The compiled files-created have .mgc added to the names of the argument.--}-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)-                                     )-    where worker cm cs = checkIntError "magicCompile" m $ magic_compile cm cs--foreign import ccall unsafe "magic.h magic_file"-  magic_file :: Ptr CMagic -> CString -> IO CString--foreign import ccall unsafe "magic.h magic_buffer"-  magic_buffer :: Ptr CMagic -> CString -> #{type size_t} -> IO CString--foreign import ccall unsafe "magic.h magic_setflags"-  magic_setflags :: Ptr CMagic -> CInt -> IO CInt--foreign import ccall unsafe "magic.h magic_compile"-  magic_compile :: Ptr CMagic -> CString -> IO CInt

@@ -1,42 +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.Types-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Types for magic programs.--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.Types(Magic,-                   MagicFlag(..))-where-import Foreign.Ptr-import Data.Word-import Data.Int-import Foreign.C.Types-import Foreign.ForeignPtr-import Magic.Data-import Magic.TypesLL--#include <magic.h>--{- | Main Magic object type.--Magic objects are automatically closed (and memory freed) when they are-garbage-collected by Haskell.  There is no need to explicitly close them.--}-type Magic = ForeignPtr CMagic-

@@ -1,26 +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.TypesLL-   Copyright  : Copyright (C) 2005 John Goerzen-   License    : BSD--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Low-Types for magic programs.--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.TypesLL(CMagic)-where--data CMagic

@@ -1,77 +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--   Maintainer : John Goerzen,-   Maintainer : jgoerzen\@complete.org-   Stability  : provisional-   Portability: portable--Utils--Written by John Goerzen, jgoerzen\@complete.org--}--module Magic.Utils (flaglist2int, fromMagicPtr, withMagicPtr, checkIntError,-                    throwErrorIfNull)-where--import Foreign-import Foreign.C.Error-import Foreign.C.String-import Foreign.ForeignPtr-import Magic.TypesLL-import Magic.Types-import Data.Bits-import Foreign.C.Types-import Magic.Data--flaglist2int :: [MagicFlag] -> CInt-flaglist2int mfl =-    foldl (\c f -> c .|. (fromIntegral . fromEnum $ f)) 0 mfl--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

@@ -0,0 +1,71 @@+# magic++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 strict `ByteString`). Results come back as `Text`.++## Requirements++You need the C `libmagic` library and its development headers installed before building. It is part of the [`file`](https://www.darwinsys.com/file/) package.++| Platform | Install |+|----------|---------|+| Debian / Ubuntu | `apt-get install libmagic-dev` |+| Fedora | `dnf install file-devel` |+| Arch | `pacman -S file` |+| macOS (Homebrew) | `brew install libmagic` |+| Nix | `file` / `file.dev` |++## Building++With `cabal`:++```sh+cabal build+cabal test+```++With `stack`:++```sh+stack build+stack test+```++libmagic is located automatically via pkg-config. If pkg-config cannot find it (for example, an unusual install location), point Cabal at the library directly:++```sh+cabal build \+  --extra-lib-dirs=/path/to/lib \+  --extra-include-dirs=/path/to/include+```++## Usage++Add `magic` to your `build-depends`. The easiest way in is `Magic.FilePath`, which takes ordinary `String` paths:++```haskell+import Magic.FilePath          -- convenience facade: ordinary String paths+import qualified Data.Text.IO as T++main :: IO ()+main = do+  magic <- magicOpen MagicMimeType+  magicLoadDefault magic+  mime <- magicFile magic "some-file.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-haskell was written by John Goerzen <jgoerzen@complete.org>, who created it in 2005 and maintained it for nearly two decades. It is now maintained by Philippe, with development at <https://github.com/philippedev101/magic-haskell>.++## License++3-clause BSD. See the `COPYING` file included with the package.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,7 +0,0 @@-#!/usr/bin/env runhugs-arch-tag: Main setup script--> import Distribution.Simple--> main = defaultMain-

@@ -1,31 +1,133 @@-Extra-Libraries: magic--- End detected settings section.  Everything below here should not--- need editing.-Name: magic-Version: 1.1-license: BSD3-Maintainer: John Goerzen <jgoerzen@complete.org>-Author: John Goerzen-Stability: Alpha-Copyright: Copyright (c) 2005-2009 John Goerzen-build-type: Simple-license-file: COPYING-Category: Text-Synopsis: Interface to C file/magic library-Description:  This package provides a Haskell interface to the C libmagic library.- With it, you can determine the type of a file by examining its contents- rather than its name.  The Haskell interface provides a full-featured- binding.--- C-Sources: glue/glue.c-Exposed-Modules: Magic,- Magic.Data,- Magic.Types,- Magic.Init,- Magic.Operations-Other-Modules: Magic.Utils,- Magic.TypesLL-Build-Depends: base >= 3 && < 5-GHC-Options: -O2--- CC-Options: -Iglue-Extensions: ForeignFunctionInterface, TypeSynonymInstances,-            EmptyDataDecls+cabal-version:      2.4+name:               magic+version:            2.0.0+synopsis:           Interface to C file/magic library+description:+  This package provides a Haskell interface to the C libmagic library.+  With it, you can determine the type of a file by examining its contents+  rather than its name.  The Haskell interface provides a full-featured+  binding.+  .+  Note: this package requires the C libmagic library (part of the @file@+  package) and its development headers to be installed at build time.++category:           Text+license:            BSD-3-Clause+license-file:       COPYING+author:             John Goerzen+maintainer:         Philippe <philippedev101@gmail.com>+copyright:          Copyright (c) 2005-2009 John Goerzen+homepage:           https://github.com/philippedev101/magic-haskell+bug-reports:        https://github.com/philippedev101/magic-haskell/issues+build-type:         Simple+extra-doc-files:+  README.md+  CHANGELOG.md++tested-with:+  GHC ==9.6.7+   || ==9.8.4+   || ==9.10.3+   || ==9.12.4++source-repository head+  type:     git+  location: https://github.com/philippedev101/magic-haskell.git++flag pkgconfig+  description:+    Use pkg-config to locate the C libmagic library. Enabled by default;+    because this flag is automatic, Cabal's solver transparently falls back+    to plain @extra-libraries@ linking when pkg-config or libmagic.pc is+    unavailable.+  default: True+  manual:  False++flag dev+  description: Turn on developer settings, notably -Werror.+  default:     False+  manual:      True++-- Strict warning set shared by all components. Based on -Weverything with the+-- pedantic / Safe-Haskell / style categories that the existing bindings cannot+-- satisfy without source changes disabled. The genuine bug-catching warnings+-- (unused bindings, incomplete patterns, name shadowing, missing local/export+-- signatures, type defaults, ...) remain ON. -Werror is opt-in via the `dev`+-- flag so a normal build, Hackage, or Stackage is never broken by a future+-- GHC introducing new warnings.+common warnings+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missing-deriving-strategies+    -Wno-missing-import-lists+    -Wno-missing-kind-signatures+    -Wno-missing-safe-haskell-mode+    -Wno-prepositive-qualified-module+    -Wno-safe+    -Wno-unsafe++  if flag(dev)+    ghc-options: -Werror++library+  import:           warnings+  hs-source-dirs:   src+  default-language: Haskell2010+  exposed-modules:+    Magic+    Magic.Data+    Magic.Types+    Magic.Init+    Magic.Operations+    Magic.FilePath++  other-modules:+    Magic.Internal++  default-extensions:+    EmptyDataDecls+    ForeignFunctionInterface+    TypeSynonymInstances++  build-depends:+    , 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+    extra-libraries:   magic++test-suite magic-test+  import:           warnings+  type:             exitcode-stdio-1.0+  main-is:          runtests.hs+  hs-source-dirs:   test+  ghc-options:      -threaded -with-rtsopts=-N+  other-modules:+    Inittest+    Tests++  default-language: Haskell2010+  build-depends:+    , base        >=4.9  && <5+    , bytestring  >=0.10 && <0.13+    , deepseq     >=1.4     && <1.6+    , directory   >=1.2     && <1.4+    , filepath    >=1.4.100 && <1.6+    , HUnit       >=1.6   && <1.7+    , magic+    , text        >=1.2.3 && <2.2+    , unix        >=2.8   && <2.9

@@ -0,0 +1,74 @@+{- -*- 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+   Copyright  : Copyright (C) 2005 John Goerzen+   License    : BSD-3-Clause++   Maintainer : Philippe <philippedev101\@gmail.com>+   Stability  : provisional+   Portability: portable++Haskell bindings to the C @libmagic@ library, which identifies the type of a+file by inspecting its contents rather than its name. It can report a textual+description, a MIME type, or a character-set encoding.++This top-level module re-exports the whole interface: the types in+"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' 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+>   magicLoadDefault magic               -- load the system database+>   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 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+             module Magic.Operations+            )+where+import Magic.Types+import Magic.Data+import Magic.Init+import Magic.Operations

@@ -0,0 +1,273 @@+-- AUTO-GENERATED FILE, DO NOT EDIT.  GENERATED BY utils/genconsts.hs+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PatternSynonyms #-}+{- |+   Module     : Magic.Data+   Copyright  : Copyright (C) 2005 John Goerzen+   License    : BSD-3-Clause++   Maintainer : Philippe <philippedev101\@gmail.com>+   Stability  : provisional+   Portability: portable++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+  ( 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)++-- | 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 NFData MagicFlags where rnf (MagicFlags x) = x `seq` ()++-- | Flags combine by bitwise-or.+instance Semigroup MagicFlags where+  MagicFlags a <> MagicFlags b = MagicFlags (a .|. b)++-- | 'mempty' is the empty flag set ('MagicNone').+instance Monoid MagicFlags where+  mempty = MagicFlags 0++-- | 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)+  ]

@@ -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

@@ -0,0 +1,74 @@+{- -*- 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.Init+   Copyright  : Copyright (C) 2005 John Goerzen+   License    : BSD-3-Clause++   Maintainer : Philippe <philippedev101\@gmail.com>+   Stability  : provisional+   Portability: portable++Creating a magic handle and loading magic databases into it. A handle returned+by 'magicOpen' must be given a database with 'magicLoadDefault' or 'magicLoad'+before it can be queried with the functions in "Magic.Operations".++Written by John Goerzen.+-}++module Magic.Init(magicOpen, magicLoad, magicLoadDefault)+where++import Foreign.Ptr+import Foreign.C.String+import Magic.Internal (Magic, CMagic, fromMagicPtr, withMagicPtr, checkIntError, withSearchPathCString)+import Magic.Data (MagicFlags(..))+import Foreign.C.Types+import System.OsPath (OsPath)++{- | 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 :: MagicFlags -> IO Magic+magicOpen (MagicFlags flags) =+    fromMagicPtr "magicOpen" (magic_open flags)++{- | 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. 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"+  magic_open :: CInt -> IO (Ptr CMagic)++-- Reads and parses the (potentially multi-megabyte) magic database from disk:+-- blocking I/O, so this must be a safe call. A safe call lets other Haskell+-- threads run during the load and does not stall garbage collection, whereas+-- an unsafe call would block the capability for the whole load.+foreign import ccall safe "magic.h magic_load"+  magic_load :: Ptr CMagic -> CString -> IO CInt

@@ -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

@@ -0,0 +1,314 @@+{- -*- 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.Operations+   Copyright  : Copyright (C) 2005 John Goerzen+   License    : BSD-3-Clause++   Maintainer : Philippe <philippedev101\@gmail.com>+   Stability  : provisional+   Portability: portable++Querying the type of files and in-memory data, and other operations on a magic+handle. The handle must first be created with @magicOpen@ and populated with+@magicLoadDefault@ or @magicLoad@ (see "Magic.Init").++Written by John Goerzen.+-}++module Magic.Operations(-- * Guessing the type+                        magicFile, magicStdin, magicDescriptor,+                        magicCString, magicByteString,+                        -- * Flags+                        magicSetFlags, magicGetFlags,+                        -- * Tunable parameters+                        magicGetParam, magicSetParam,+                        -- * Magic databases+                        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 (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 t'MagicFlags'). Raises a @MagicException@ if the file cannot be+examined. -}+magicFile :: Magic -> OsPath -> IO Text+magicFile magic fp =+    withMagicPtr magic (\cmagic ->+    withOsPathCString fp (\cfp ->+     do res <- throwErrorIfNull "magicFile" magic (magic_file cmagic cfp)+        peekCStringText res+                    )+                       )++{- | Identify the data available on standard input, as 'magicFile' does for a+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)+        peekCStringText res+                       )++{- | 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))+        peekCStringText res+                    )++{- | 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 -> MagicFlags -> IO ()+magicSetFlags m (MagicFlags flags) = withMagicPtr m (\cmagic ->+     checkIntError "magicSetFlags" m $ magic_setflags cmagic flags)++{- | 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 -> [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+a @MagicException@ if the descriptor cannot be examined.++@since 1.1.2+-}+magicDescriptor :: Magic -> Fd -> IO Text+magicDescriptor magic fd =+    withMagicPtr magic (\cmagic ->+     do res <- throwErrorIfNull "magicDescriptor" magic+                 (magic_descriptor cmagic (fromIntegral fd))+        peekCStringText res)++{- | 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 Text+magicByteString magic bs =+    withMagicPtr magic (\cmagic ->+     BSU.unsafeUseAsCStringLen bs (\(cstr, len) ->+      do res <- throwErrorIfNull "magicByteString" magic+                  (magic_buffer cmagic cstr (fromIntegral len))+         peekCStringText res))++{- | 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 MagicFlags+magicGetFlags m =+    withMagicPtr m (\cmagic ->+     do fl <- magic_getflags cmagic+        if fl < 0+           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').++@since 1.1.2+-}+magicGetParam :: Magic -> MagicParam -> IO Int+magicGetParam m p =+    withMagicPtr m (\cmagic ->+     alloca (\ptr ->+      do checkIntError "magicGetParam" m+           (magic_getparam cmagic (paramToCInt p) (castPtr ptr))+         v <- peek ptr+         return (fromIntegral (v :: CSize))))++{- | Set a tunable parameter (see 'MagicParam'), for example to cap the number+of bytes scanned in untrusted input. Raises a @MagicException@ on failure.++@since 1.1.2+-}+magicSetParam :: Magic -> MagicParam -> Int -> IO ()+magicSetParam m p val =+    withMagicPtr m (\cmagic ->+     with (fromIntegral val :: CSize) (\ptr ->+      checkIntError "magicSetParam" m+        (magic_setparam cmagic (paramToCInt p) (castPtr ptr))))++paramToCInt :: MagicParam -> CInt+paramToCInt p = case p of+    MagicParamIndirMax     -> #{const MAGIC_PARAM_INDIR_MAX}+    MagicParamNameMax      -> #{const MAGIC_PARAM_NAME_MAX}+    MagicParamElfPhnumMax  -> #{const MAGIC_PARAM_ELF_PHNUM_MAX}+    MagicParamElfShnumMax  -> #{const MAGIC_PARAM_ELF_SHNUM_MAX}+    MagicParamElfNotesMax  -> #{const MAGIC_PARAM_ELF_NOTES_MAX}+    MagicParamRegexMax     -> #{const MAGIC_PARAM_REGEX_MAX}+    MagicParamBytesMax     -> #{const MAGIC_PARAM_BYTES_MAX}+    MagicParamEncodingMax  -> #{const MAGIC_PARAM_ENCODING_MAX}+    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 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 -> [OsPath] -> IO Bool+magicCheck m ps =+    withMagicPtr m (\cmagic ->+     case ps of+       [] -> fmap (== 0) (magic_check cmagic nullPtr)+       _  -> withSearchPathCString ps (fmap (== 0) . magic_check cmagic))++{- | 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 [OsPath]+magicGetPath =+    do res <- magic_getpath nullPtr 0+       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).++@since 1.1.2+-}+magicVersion :: IO Int+magicVersion = fmap fromIntegral magic_version++{- | The @errno@ recorded by the last failing operation on the handle, or @0@ if+the last failure was not caused by a system error.++@since 1.1.2+-}+magicErrno :: Magic -> IO Int+magicErrno m = withMagicPtr m (fmap fromIntegral . magic_errno)++-- Does file I/O -> safe+foreign import ccall safe "magic.h magic_file"+  magic_file :: Ptr CMagic -> CString -> IO CString++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_buffer"+  magic_buffer :: Ptr CMagic -> CString -> #{type size_t} -> IO CString++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_setflags"+  magic_setflags :: Ptr CMagic -> CInt -> IO CInt++-- Does file I/O -> safe+foreign import ccall safe "magic.h magic_compile"+  magic_compile :: Ptr CMagic -> CString -> IO CInt++-- Reads the descriptor -> safe+foreign import ccall safe "magic.h magic_descriptor"+  magic_descriptor :: Ptr CMagic -> CInt -> IO CString++-- 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"+  magic_getflags :: Ptr CMagic -> IO CInt++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_getparam"+  magic_getparam :: Ptr CMagic -> CInt -> Ptr () -> IO CInt++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_setparam"+  magic_setparam :: Ptr CMagic -> CInt -> Ptr () -> IO CInt++-- Reads an environment variable -> unsafe+foreign import ccall unsafe "magic.h magic_getpath"+  magic_getpath :: CString -> CInt -> IO CString++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_version"+  magic_version :: IO CInt++-- Does not do I/O -> unsafe+foreign import ccall unsafe "magic.h magic_errno"+  magic_errno :: Ptr CMagic -> IO CInt

@@ -0,0 +1,62 @@+{-  -*- 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 DeriveGeneric #-}++{- |+   Module     : Magic.Types+   Copyright  : Copyright (C) 2005 John Goerzen+   License    : BSD-3-Clause++   Maintainer : Philippe <philippedev101\@gmail.com>+   Stability  : provisional+   Portability: portable++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,+                   MagicException(..),+                   MagicParam(..))+where+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+"Magic.Operations"). Lowering these (especially 'MagicParamBytesMax') is a way+to cap the effort spent on untrusted input. Defaults below are those documented+for @libmagic@ 5.45.++@since 1.1.2+-}+data MagicParam+    = -- | Maximum number of levels of recursion when following indirect magic. (Default: 15.)+      MagicParamIndirMax+    | -- | Maximum length of a name used by name\/use magic. (Default: 30.)+      MagicParamNameMax+    | -- | Maximum number of ELF program header sections processed. (Default: 128.)+      MagicParamElfPhnumMax+    | -- | Maximum number of ELF section header sections processed. (Default: 32768.)+      MagicParamElfShnumMax+    | -- | Maximum number of ELF notes processed. (Default: 256.)+      MagicParamElfNotesMax+    | -- | Maximum length of a regex search. (Default: 8192.)+      MagicParamRegexMax+    | -- | Maximum number of bytes read from a file before giving up. (Default: 1048576, i.e. 1 MiB.)+      MagicParamBytesMax+    | -- | Maximum number of bytes scanned when guessing a text encoding.+      MagicParamEncodingMax+    | -- | Maximum size of an ELF section processed.+      MagicParamElfShsizeMax+  deriving (Show, Eq, Ord, Enum, Bounded, Generic)++instance NFData MagicParam where rnf x = x `seq` ()+

@@ -0,0 +1,304 @@+{-+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This code is under a 3-clause BSD license; see COPYING for details.+-}++module Inittest(tests) where++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 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.FilePath+import qualified Magic as M++-- | Open a handle with the given flags and load the default database.+withDefault :: MagicFlags -> (Magic -> IO a) -> IO a+withDefault flags act = do+    m <- magicOpen flags+    magicLoadDefault m+    act m++-- 8-byte PNG signature followed by the start of an IHDR chunk.+pngBytes :: BS.ByteString+pngBytes = BS.pack+    [0x89,0x50,0x4E,0x47,0x0D,0x0A,0x1A,0x0A+    ,0x00,0x00,0x00,0x0D,0x49,0x48,0x44,0x52]++-- | Run an action with a temporary file holding the PNG bytes.+withPngFile :: (FilePath -> IO b) -> IO b+withPngFile act = do+    dir <- getTemporaryDirectory+    let pngPath = dir </> "magic-test-sample.png"+    bracket (BS.writeFile pngPath pngBytes >> return pngPath)+            removeFile+            act++-- | A small in-memory byte string is detected as plain text.+test_textMime :: Test+test_textMime = TestCase $ do+    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` T.unpack result)++-- | The textual description of plain text mentions \"text\".+test_textDescription :: Test+test_textDescription = TestCase $ do+    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` T.unpack result)++-- | A file whose contents start with the PNG signature is recognised as a PNG.+test_pngMime :: Test+test_pngMime = TestCase $+    withPngFile $ \pngPath -> do+        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" (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 ->+            bracket (openFd pngPath ReadOnly defaultFileFlags) closeFd+                    (magicDescriptor m)+        assertEqual "PNG MIME via descriptor" "image/png" (T.unpack result)++-- | 'magicVersion' reports a sane (positive) library version.+test_version :: Test+test_version = TestCase $ do+    v <- magicVersion+    assertBool ("expected a positive libmagic version, got " ++ show v) (v > 0)++-- | Flags set with 'magicSetFlags' are read back by 'magicGetFlags'.+test_getFlags :: Test+test_getFlags = TestCase $+    withDefault MagicNone $ \m -> do+        magicSetFlags m (MagicMimeType <> MagicError)+        fl <- magicGetFlags m+        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+        magicSetParam m MagicParamBytesMax 4096+        v <- magicGetParam m MagicParamBytesMax+        assertEqual "bytes-max round-trip" 4096 v++-- | The system's default magic database validates with 'magicCheck'.+test_check :: Test+test_check = TestCase $ do+    ok <- withDefault MagicNone $ \m -> magicCheck m []+    assertBool "default magic database should be valid" ok++-- | 'magicGetPath' returns a non-empty default database path.+test_getPath :: Test+test_getPath = TestCase $ do+    p <- magicGetPath+    assertBool "expected a non-empty default magic path" (not (null p))++-- | A newly added flag ('MagicExtension') maps to the right value end-to-end:+-- it makes libmagic report candidate file extensions.+test_extension :: Test+test_extension = TestCase $+    withPngFile $ \pngPath -> do+        result <- withDefault MagicExtension $ \m -> magicFile m pngPath+        assertBool ("expected 'png' among extensions, got: " ++ show 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+        fl <- magicGetFlags m+        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 MagicException Text)+    case r of+        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+        _ <- try (magicFile m "/no/such/magic/file")+                 :: 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+    ]

@@ -0,0 +1,13 @@+{- Tests main file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This code is under a 3-clause BSD license; see COPYING for details.+-}++module Tests(tests) where++import Test.HUnit+import qualified Inittest++tests :: Test+tests = TestList [TestLabel "init" Inittest.tests]

@@ -0,0 +1,18 @@+{- Test runner+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This code is under a 3-clause BSD license; see COPYING for details.+-}++module Main (main) where++import Control.Monad (when)+import System.Exit (exitFailure)+import Test.HUnit++import Tests++main :: IO ()+main = do+    cs <- runTestTT tests+    when (errors cs > 0 || failures cs > 0) exitFailure