diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,18 @@ All notable changes to this project are documented here. +## 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 ``: `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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ It is a binding to the C [libmagic](https://www.darwinsys.com/file/) library. It allows you to determine the type of a file not by looking at its name or extension, but rather by examining the contents itself. -libmagic can provide either a textual description or a MIME content type (and, occasionally, also a character set). The Haskell binding can also provide reports over Haskell strings. +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`). ## Requirements diff --git a/magic.cabal b/magic.cabal --- a/magic.cabal +++ b/magic.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: magic -version: 1.1.1 +version: 1.1.2 synopsis: Interface to C file/magic library description: This package provides a Haskell interface to the C libmagic library. @@ -85,14 +85,15 @@ other-modules: Magic.Utils - Magic.TypesLL default-extensions: EmptyDataDecls ForeignFunctionInterface TypeSynonymInstances - build-depends: base >=4.9 && <5 + build-depends: + , base >=4.9 && <5 + , bytestring >=0.10 && <0.13 if flag(pkgconfig) pkgconfig-depends: libmagic @@ -116,3 +117,4 @@ , filepath >=1.4 && <1.6 , HUnit >=1.6 && <1.7 , magic + , unix >=2.8 && <2.9 diff --git a/src/Magic/Data.hsc b/src/Magic/Data.hsc --- a/src/Magic/Data.hsc +++ b/src/Magic/Data.hsc @@ -12,7 +12,7 @@ to Haskell. -} -module Magic.Data (module Magic.Data) where +module Magic.Data (MagicFlag(..)) where #include "magic.h" @@ -47,6 +47,42 @@ 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 @@ -66,6 +102,24 @@ 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 fromEnum MagicNone = (#{const MAGIC_NONE}) @@ -81,6 +135,24 @@ 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 instance Ord MagicFlag where diff --git a/src/Magic/Init.hsc b/src/Magic/Init.hsc --- a/src/Magic/Init.hsc +++ b/src/Magic/Init.hsc @@ -29,7 +29,6 @@ import Magic.Types import Foreign.C.Types import Magic.Utils -import Magic.TypesLL {- | Create a new magic handle configured with the given flags (see 'MagicFlag'). Before querying anything you must load a database with @@ -57,8 +56,13 @@ withCString s (\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) -foreign import ccall unsafe "magic.h magic_load" +-- 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 diff --git a/src/Magic/Operations.hsc b/src/Magic/Operations.hsc --- a/src/Magic/Operations.hsc +++ b/src/Magic/Operations.hsc @@ -22,20 +22,33 @@ -} module Magic.Operations(-- * Guessing the type - magicFile, magicStdin, - magicString, magicCString, - -- * Other operations - magicSetFlags, magicCompile) + magicFile, magicStdin, magicDescriptor, + magicString, magicCString, magicByteString, + -- * Flags + magicSetFlags, magicGetFlags, + -- * Tunable parameters + magicGetParam, magicSetParam, + -- * Magic databases + magicCompile, magicCheck, magicGetPath, + -- * Library information + magicVersion, magicErrno) where import Foreign.Ptr import Foreign.C.String -import Magic.Types import Foreign.C.Types +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (with) +import Foreign.Storable (peek) import Data.Word +import Data.ByteString (ByteString) +import qualified Data.ByteString.Unsafe as BSU +import System.Posix.Types (Fd) +import Magic.Types import Magic.Utils -import Magic.TypesLL +#include + {- | Identify the file at the given path. The result is in the form selected by the handle's flags (a textual description, a MIME type, an encoding, and so on; see 'MagicFlag'). Raises an 'IOError' if the file cannot be examined. -} @@ -100,6 +113,124 @@ ) 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. + +@since 1.1.2 +-} +magicDescriptor :: Magic -> Fd -> IO String +magicDescriptor magic fd = + withMagicPtr magic (\cmagic -> + do res <- throwErrorIfNull "magicDescriptor" magic + (magic_descriptor cmagic (fromIntegral fd)) + peekCString 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. + +@since 1.1.2 +-} +magicByteString :: Magic -> ByteString -> IO String +magicByteString magic bs = + withMagicPtr magic (\cmagic -> + BSU.unsafeUseAsCStringLen bs (\(cstr, len) -> + do res <- throwErrorIfNull "magicByteString" magic + (magic_buffer cmagic cstr (fromIntegral len)) + peekCString 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. + +@since 1.1.2 +-} +magicGetFlags :: Magic -> IO [MagicFlag] +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)) + +{- | 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 an 'IOError' 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 'Nothing' for the default database. Returns +'True' if the database is valid. + +@since 1.1.2 +-} +magicCheck :: Magic -> Maybe FilePath -> IO Bool +magicCheck m mpath = + withMagicPtr m (\cmagic -> + case mpath of + Nothing -> fmap (== 0) (magic_check cmagic nullPtr) + Just p -> withCString p (fmap (== 0) . magic_check cmagic)) + +{- | The path of the default magic database, honouring the @MAGIC@ environment +variable. + +@since 1.1.2 +-} +magicGetPath :: IO FilePath +magicGetPath = + do res <- magic_getpath nullPtr 0 + if res == nullPtr then return "" else peekCString 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 @@ -115,3 +246,35 @@ -- 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 + +-- 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 diff --git a/src/Magic/Types.hsc b/src/Magic/Types.hsc --- a/src/Magic/Types.hsc +++ b/src/Magic/Types.hsc @@ -14,26 +14,69 @@ Stability : provisional Portability: portable -The core types of the binding: the opaque 'Magic' handle and the 'MagicFlag' -enumeration (re-exported from "Magic.Data"). +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. -} module Magic.Types(Magic, - MagicFlag(..)) + CMagic, + MagicFlag(..), + MagicParam(..)) where import Foreign.ForeignPtr import Magic.Data -import Magic.TypesLL #include +-- | Phantom type standing in for the C @magic_t@ cookie. It appears only as the +-- argument of a 'Foreign.ForeignPtr.ForeignPtr' (the 'Magic' handle) and has no +-- values of its own. +data CMagic + {- | The magic handle: an opaque cookie obtained from @magicOpen@ and passed to the loading and querying functions. Handles are closed (and their memory freed) automatically when they are garbage-collected by Haskell. There is no need to close them explicitly. + +__Thread safety.__ A single @Magic@ handle is /not/ safe for concurrent use: +the underlying @libmagic@ cookie keeps mutable state, so calling operations on +the same handle from multiple threads at once is a data race. Use one handle +per thread, or serialise access to a shared handle (e.g. behind an @MVar@). +Distinct handles are independent and may be used concurrently. Programs doing +blocking work (loading databases, examining files) should also be built with +the threaded runtime (@-threaded@). -} type Magic = ForeignPtr CMagic + +{- | 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) diff --git a/src/Magic/TypesLL.hs b/src/Magic/TypesLL.hs deleted file mode 100644 --- a/src/Magic/TypesLL.hs +++ /dev/null @@ -1,27 +0,0 @@ -{- -*- Mode: haskell; -*- -Haskell magic Interface -Copyright (C) 2005 John Goerzen - -This code is under a 3-clause BSD license; see COPYING for details. --} - -{- | - Module : Magic.TypesLL - Copyright : Copyright (C) 2005 John Goerzen - License : BSD-3-Clause - - Maintainer : Philippe - Stability : provisional - Portability: portable - -Low-level types for the binding. - -Written by John Goerzen. --} - -module Magic.TypesLL(CMagic) -where - --- | Phantom type standing in for the C @magic_t@ cookie. It appears only as the --- argument of a @ForeignPtr@ (the @Magic@ handle) and has no values of its own. -data CMagic diff --git a/src/Magic/Utils.hsc b/src/Magic/Utils.hsc --- a/src/Magic/Utils.hsc +++ b/src/Magic/Utils.hsc @@ -8,32 +8,42 @@ {- | Module : Magic.Utils Copyright : Copyright (C) 2005 John Goerzen - License : BSD + License : BSD-3-Clause - Maintainer : John Goerzen, - Maintainer : jgoerzen\@complete.org + Maintainer : Philippe Stability : provisional Portability: portable -Utils +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, jgoerzen\@complete.org +Written by John Goerzen. -} -module Magic.Utils (flaglist2int, fromMagicPtr, withMagicPtr, checkIntError, - throwErrorIfNull) +module Magic.Utils (flaglist2int, int2flaglist, fromMagicPtr, withMagicPtr, + checkIntError, throwErrorIfNull) where import Foreign import Foreign.C.Error import Foreign.C.String -import Magic.TypesLL 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 = diff --git a/test/Inittest.hs b/test/Inittest.hs --- a/test/Inittest.hs +++ b/test/Inittest.hs @@ -6,11 +6,12 @@ module Inittest(tests) where -import Control.Exception (bracket) +import Control.Exception (IOException, bracket, try) import qualified Data.ByteString as BS import Data.List (isInfixOf, isPrefixOf) import System.Directory (getTemporaryDirectory, removeFile) import System.FilePath (()) +import System.Posix.IO (OpenMode(ReadOnly), closeFd, defaultFileFlags, openFd) import Test.HUnit import Magic @@ -22,6 +23,21 @@ 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 string is detected as plain text. test_textMime :: Test test_textMime = TestCase $ do @@ -48,22 +64,111 @@ withPngFile $ \pngPath -> do result <- withDefault [MagicMimeType] $ \m -> magicFile m pngPath assertEqual "PNG MIME type" "image/png" result - where - -- 8-byte PNG signature followed by the start of an IHDR chunk. - pngBytes = BS.pack - [0x89,0x50,0x4E,0x47,0x0D,0x0A,0x1A,0x0A - ,0x00,0x00,0x00,0x0D,0x49,0x48,0x44,0x52] - 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 +-- | '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 + +-- | '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" 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 among " ++ show fl) + (MagicMimeType `elem` fl && MagicError `elem` fl) + +-- | 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 Nothing + 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` 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 among " ++ show fl) + (MagicMimeType `elem` fl && MagicMimeEncoding `elem` fl) + +-- | 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) + case r of + Left _ -> return () + Right s -> assertFailure ("expected an IOError, 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 IOException String) + e <- magicErrno m + assertBool ("expected a non-zero errno after a failed open, got " ++ show e) + (e /= 0) + tests :: Test tests = TestList - [ TestLabel "text MIME type" test_textMime - , TestLabel "text description" test_textDescription - , TestLabel "PNG MIME type" test_pngMime + [ TestLabel "text MIME type" test_textMime + , TestLabel "text description" test_textDescription + , TestLabel "PNG MIME type" test_pngMime + , 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 "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 ] diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,4 +1,4 @@ -{- arch-tag: Tests main file +{- Tests main file Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. diff --git a/test/runtests.hs b/test/runtests.hs --- a/test/runtests.hs +++ b/test/runtests.hs @@ -1,5 +1,7 @@ -{- arch-tag: Test runner +{- Test runner Copyright (C) 2005 John Goerzen + +This code is under a 3-clause BSD license; see COPYING for details. -} module Main (main) where