77 lines
1.9 KiB
Haskell
77 lines
1.9 KiB
Haskell
{- Interface to libmagic
|
|
-
|
|
- Copyright 2019-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Magic (
|
|
Magic,
|
|
MimeType,
|
|
MimeEncoding,
|
|
initMagicMime,
|
|
getMagicMimeType,
|
|
getMagicMimeEncoding,
|
|
) where
|
|
|
|
import Common
|
|
import Types.Mime
|
|
import Control.Monad.IO.Class
|
|
#ifdef WITH_MAGICMIME
|
|
import Magic
|
|
import Utility.Env
|
|
import Control.Concurrent
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
#else
|
|
type Magic = ()
|
|
#endif
|
|
|
|
initMagicMime :: IO (Maybe Magic)
|
|
#ifdef WITH_MAGICMIME
|
|
initMagicMime = catchMaybeIO $ do
|
|
m <- magicOpen [MagicMime]
|
|
liftIO $ getEnv "GIT_ANNEX_DIR" >>= \case
|
|
Nothing -> magicLoadDefault m
|
|
Just d -> magicLoad m $ fromOsPath $
|
|
toOsPath d
|
|
</> literalOsPath "magic"
|
|
</> literalOsPath "magic.mgc"
|
|
return m
|
|
#else
|
|
initMagicMime = return Nothing
|
|
#endif
|
|
|
|
getMagicMime :: Magic -> OsPath -> IO (Maybe (MimeType, MimeEncoding))
|
|
#ifdef WITH_MAGICMIME
|
|
getMagicMime m f = Just . parse <$> magicConcurrentSafe (magicFile m (fromOsPath f))
|
|
where
|
|
parse s =
|
|
let (mimetype, rest) = separate (== ';') s
|
|
in case rest of
|
|
(' ':'c':'h':'a':'r':'s':'e':'t':'=':mimeencoding) ->
|
|
(mimetype, mimeencoding)
|
|
_ -> (mimetype, "")
|
|
#else
|
|
getMagicMime _ _ = return Nothing
|
|
#endif
|
|
|
|
getMagicMimeType :: MonadIO m => Magic -> OsPath -> m (Maybe MimeType)
|
|
getMagicMimeType m f = liftIO $ fmap fst <$> getMagicMime m f
|
|
|
|
getMagicMimeEncoding :: MonadIO m => Magic -> OsPath -> m(Maybe MimeEncoding)
|
|
getMagicMimeEncoding m f = liftIO $ fmap snd <$> getMagicMime m f
|
|
|
|
#ifdef WITH_MAGICMIME
|
|
{-# NOINLINE mutex #-}
|
|
mutex :: MVar ()
|
|
mutex = unsafePerformIO $ newMVar ()
|
|
|
|
-- Work around a bug, the library is not concurrency safe and will
|
|
-- sometimes access the wrong memory if multiple ones are called at the
|
|
-- same time.
|
|
magicConcurrentSafe :: IO a -> IO a
|
|
magicConcurrentSafe = bracket_ (takeMVar mutex) (putMVar mutex ())
|
|
#endif
|