{-# LINE 1 "src/Magic/Operations.hsc" #-}
{- -*- 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,
                        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 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



{- | Identify the file at the given path. The result is in the form selected by
the handle's flags (a textual description, a MIME type, an encoding, and so on;
see 'MagicFlag'). Raises an 'IOError' if the file cannot be examined. -}
magicFile :: Magic -> FilePath -> IO String
magicFile :: Magic -> FilePath -> IO FilePath
magicFile Magic
magic FilePath
fp =
    Magic -> (Ptr CMagic -> IO FilePath) -> IO FilePath
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
magic (\Ptr CMagic
cmagic ->
    FilePath -> (CString -> IO FilePath) -> IO FilePath
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
fp (\CString
cfp ->
     do res <- FilePath -> Magic -> IO CString -> IO CString
forall a. FilePath -> Magic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull FilePath
"magicFile" Magic
magic (Ptr CMagic -> CString -> IO CString
magic_file Ptr CMagic
cmagic CString
cfp)
        peekCString res
                    )
                       )

{- | Identify the data available on standard input, as 'magicFile' does for a
named file. Raises an 'IOError' if the data cannot be examined. -}
magicStdin :: Magic -> IO String
magicStdin :: Magic -> IO FilePath
magicStdin Magic
magic =
    Magic -> (Ptr CMagic -> IO FilePath) -> IO FilePath
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
magic (\Ptr CMagic
cmagic ->
     do res <- FilePath -> Magic -> IO CString -> IO CString
forall a. FilePath -> Magic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull FilePath
"magicStdin" Magic
magic (Ptr CMagic -> CString -> IO CString
magic_file Ptr CMagic
cmagic CString
forall a. Ptr a
nullPtr)
        peekCString res
                       )

{- | Identify the contents of the given 'String'. Note that the string is
processed strictly, not lazily.

This is convenient for textual data. For binary data prefer 'magicCString' (or
write it to a file and use 'magicFile'): marshalling through 'String' goes via
the current locale encoding, which can corrupt non-textual bytes. Raises an
'IOError' if the data cannot be examined. -}
magicString :: Magic -> String -> IO String
magicString :: Magic -> FilePath -> IO FilePath
magicString Magic
m FilePath
s = FilePath -> (CStringLen -> IO FilePath) -> IO FilePath
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen FilePath
s (Magic -> CStringLen -> IO FilePath
magicCString Magic
m)

{- | Identify the contents of a C string buffer (a pointer and a length). This
is the lower-level primitive behind 'magicString', and the right choice for raw
binary data since it does no encoding conversion. Raises an 'IOError' if the
data cannot be examined. -}
magicCString :: Magic -> CStringLen -> IO String
magicCString :: Magic -> CStringLen -> IO FilePath
magicCString Magic
magic (CString
cstr, Int
len) =
    Magic -> (Ptr CMagic -> IO FilePath) -> IO FilePath
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
magic (\Ptr CMagic
cmagic ->
     do res <- FilePath -> Magic -> IO CString -> IO CString
forall a. FilePath -> Magic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull FilePath
"magicCString" Magic
magic (Ptr CMagic -> CString -> Word64 -> IO CString
magic_buffer Ptr CMagic
cmagic CString
cstr (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
        peekCString res
                    )

{- | Change the flags (see 'MagicFlag') on an existing handle, for example to
switch between textual descriptions and MIME types. Raises an 'IOError' on
failure. -}
magicSetFlags :: Magic -> [MagicFlag] -> IO ()
magicSetFlags :: Magic -> [MagicFlag] -> IO ()
magicSetFlags Magic
m [MagicFlag]
mfl = Magic -> (Ptr CMagic -> IO ()) -> IO ()
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cmagic ->
     FilePath -> Magic -> IO CInt -> IO ()
checkIntError FilePath
"magicSetFlags" Magic
m (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CMagic -> CInt -> IO CInt
magic_setflags Ptr CMagic
cmagic CInt
flags)
    where flags :: CInt
flags = [MagicFlag] -> CInt
flaglist2int [MagicFlag]
mfl

{- | Compile the given colon-separated magic database file(s) into the binary
@.mgc@ form. Each compiled file is named after its source with @.mgc@ appended.
Pass 'Nothing' to compile the default database. Raises an 'IOError' on failure.
-}
magicCompile :: Magic           -- ^ Object to use
             -> Maybe String    -- ^ Colon separated list of databases, or Nothing for default
             -> IO ()
magicCompile :: Magic -> Maybe FilePath -> IO ()
magicCompile Magic
m Maybe FilePath
mstr = Magic -> (Ptr CMagic -> IO ()) -> IO ()
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cm ->
     case Maybe FilePath
mstr of
               Maybe FilePath
Nothing -> Ptr CMagic -> CString -> IO ()
worker Ptr CMagic
cm CString
forall a. Ptr a
nullPtr
               Just FilePath
x -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
x (Ptr CMagic -> CString -> IO ()
worker Ptr CMagic
cm)
                                     )
    where worker :: Ptr CMagic -> CString -> IO ()
worker Ptr CMagic
cm CString
cs = FilePath -> Magic -> IO CInt -> IO ()
checkIntError FilePath
"magicCompile" Magic
m (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CMagic -> CString -> IO CInt
magic_compile Ptr CMagic
cm CString
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 -> IO FilePath
magicDescriptor Magic
magic Fd
fd =
    Magic -> (Ptr CMagic -> IO FilePath) -> IO FilePath
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
magic (\Ptr CMagic
cmagic ->
     do res <- FilePath -> Magic -> IO CString -> IO CString
forall a. FilePath -> Magic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull FilePath
"magicDescriptor" Magic
magic
                 (Ptr CMagic -> CInt -> IO CString
magic_descriptor Ptr CMagic
cmagic (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
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 -> ByteString -> IO FilePath
magicByteString Magic
magic ByteString
bs =
    Magic -> (Ptr CMagic -> IO FilePath) -> IO FilePath
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
magic (\Ptr CMagic
cmagic ->
     ByteString -> (CStringLen -> IO FilePath) -> IO FilePath
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs (\(CString
cstr, Int
len) ->
      do res <- FilePath -> Magic -> IO CString -> IO CString
forall a. FilePath -> Magic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull FilePath
"magicByteString" Magic
magic
                  (Ptr CMagic -> CString -> Word64 -> IO CString
magic_buffer Ptr CMagic
cmagic CString
cstr (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: Magic -> IO [MagicFlag]
magicGetFlags Magic
m =
    Magic -> (Ptr CMagic -> IO [MagicFlag]) -> IO [MagicFlag]
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cmagic ->
     do fl <- Ptr CMagic -> IO CInt
magic_getflags Ptr CMagic
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 :: Magic -> MagicParam -> IO Int
magicGetParam Magic
m MagicParam
p =
    Magic -> (Ptr CMagic -> IO Int) -> IO Int
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cmagic ->
     (Ptr CSize -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr CSize
ptr ->
      do FilePath -> Magic -> IO CInt -> IO ()
checkIntError FilePath
"magicGetParam" Magic
m
           (Ptr CMagic -> CInt -> Ptr () -> IO CInt
magic_getparam Ptr CMagic
cmagic (MagicParam -> CInt
paramToCInt MagicParam
p) (Ptr CSize -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CSize
ptr))
         v <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
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 :: Magic -> MagicParam -> Int -> IO ()
magicSetParam Magic
m MagicParam
p Int
val =
    Magic -> (Ptr CMagic -> IO ()) -> IO ()
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cmagic ->
     CSize -> (Ptr CSize -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val :: CSize) (\Ptr CSize
ptr ->
      FilePath -> Magic -> IO CInt -> IO ()
checkIntError FilePath
"magicSetParam" Magic
m
        (Ptr CMagic -> CInt -> Ptr () -> IO CInt
magic_setparam Ptr CMagic
cmagic (MagicParam -> CInt
paramToCInt MagicParam
p) (Ptr CSize -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CSize
ptr))))

paramToCInt :: MagicParam -> CInt
paramToCInt :: MagicParam -> CInt
paramToCInt MagicParam
p = case MagicParam
p of
    MagicParam
MagicParamIndirMax     -> CInt
0
{-# LINE 186 "src/Magic/Operations.hsc" #-}
    MagicParamNameMax      -> 1
{-# LINE 187 "src/Magic/Operations.hsc" #-}
    MagicParamElfPhnumMax  -> 2
{-# LINE 188 "src/Magic/Operations.hsc" #-}
    MagicParamElfShnumMax  -> 3
{-# LINE 189 "src/Magic/Operations.hsc" #-}
    MagicParamElfNotesMax  -> 4
{-# LINE 190 "src/Magic/Operations.hsc" #-}
    MagicParamRegexMax     -> 5
{-# LINE 191 "src/Magic/Operations.hsc" #-}
    MagicParamBytesMax     -> 6
{-# LINE 192 "src/Magic/Operations.hsc" #-}
    MagicParamEncodingMax  -> 7
{-# LINE 193 "src/Magic/Operations.hsc" #-}
    MagicParamElfShsizeMax -> 8
{-# LINE 194 "src/Magic/Operations.hsc" #-}

{- | 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 :: Magic -> Maybe FilePath -> IO Bool
magicCheck Magic
m Maybe FilePath
mpath =
    Magic -> (Ptr CMagic -> IO Bool) -> IO Bool
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m (\Ptr CMagic
cmagic ->
     case Maybe FilePath
mpath of
       Maybe FilePath
Nothing -> (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (Ptr CMagic -> CString -> IO CInt
magic_check Ptr CMagic
cmagic CString
forall a. Ptr a
nullPtr)
       Just FilePath
p  -> FilePath -> (CString -> IO Bool) -> IO Bool
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
p ((CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO CInt -> IO Bool) -> (CString -> IO CInt) -> CString -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CMagic -> CString -> IO CInt
magic_check Ptr CMagic
cmagic))

{- | The path of the default magic database, honouring the @MAGIC@ environment
variable.

@since 1.1.2
-}
magicGetPath :: IO FilePath
magicGetPath :: IO FilePath
magicGetPath =
    do res <- CString -> CInt -> IO CString
magic_getpath CString
forall a. Ptr a
nullPtr CInt
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 :: IO Int
magicVersion = (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral IO CInt
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 :: Magic -> IO Int
magicErrno Magic
m = Magic -> (Ptr CMagic -> IO Int) -> IO Int
forall a. Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr Magic
m ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr CMagic -> IO CInt) -> Ptr CMagic -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CMagic -> IO CInt
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 -> Word64 -> IO CString
{-# LINE 241 "src/Magic/Operations.hsc" #-}

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

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