Internal.hsc

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | The core stuff
--
-- This is an internal module. It is exposed to allow fine-tuning and workarounds but its API is not stable.
module System.LibFuse3.Internal where

import Control.Applicative ((<|>))
import Control.Exception (Exception, SomeException, bracket_, catch, finally, fromException, handle)
import Control.Monad (unless, void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Data.Bits ((.&.), (.|.))
import Data.Foldable (traverse_)
import Data.Maybe (fromJust)
import Foreign
  ( FunPtr
  , Ptr
  , StablePtr
  , allocaBytes
  , castPtrToStablePtr
  , castStablePtrToPtr
  , copyArray
  , deRefStablePtr
  , free
  , freeHaskellFunPtr
  , freeStablePtr
  , maybeWith
  , newStablePtr
  , nullFunPtr
  , nullPtr
  , peek
  , peekArray
  , peekByteOff
  , poke
  , pokeByteOff
  , with
  )
import Foreign.C (CInt(CInt), CString, Errno, eFAULT, eINVAL, eIO, eNOSYS, eOK, getErrno, peekCString, resetErrno, throwErrno, withCStringLen)
import GHC.IO.Handle (hDuplicateTo)
import System.Clock (TimeSpec)
import System.Environment (getArgs, getProgName)
import System.Exit (ExitCode(ExitFailure, ExitSuccess), exitFailure, exitSuccess, exitWith)
import System.IO (IOMode(ReadMode, WriteMode), SeekMode(AbsoluteSeek, RelativeSeek, SeekFromEnd), hPutStrLn, stderr, stdin, stdout, withFile)
import System.LibFuse3.FileStat (FileStat)
import System.LibFuse3.FileSystemStats (FileSystemStats)
import System.LibFuse3.FuseConfig (FuseConfig, fromCFuseConfig, toCFuseConfig)
import System.LibFuse3.Internal.Resource (daemonizeResourceT, resMallocBytes, resNew, resNewArray, resNewCString, resNewFilePath)
import System.LibFuse3.Utils (pokeCStringLen0, testBitSet, unErrno)
import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files (blockSpecialMode, characterSpecialMode, directoryMode, namedPipeMode, regularFileMode, socketMode, symbolicLinkMode)
import System.Posix.IO (OpenFileFlags, OpenMode(ReadOnly, ReadWrite, WriteOnly), defaultFileFlags)
import System.Posix.Internals (c_access, peekFilePath, withFilePath)
import System.Posix.Process (createSession)
import System.Posix.Types (ByteCount, COff(COff), CSsize, DeviceID, FileMode, FileOffset, GroupID, UserID)
import Text.Printf (hPrintf, printf)

import qualified Control.Monad.Trans.Resource as Res
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import qualified System.LibFuse3.Internal.C as C
import qualified System.Posix.IO
import qualified System.Posix.Signals as Signals

#include <fuse.h>
#include <fuse_lowlevel.h>
#include <sys/xattr.h>

-- | The Unix type of a node in the filesystem.
data EntryType
  = Unknown            -- ^ Unknown entry type
  | NamedPipe
  | CharacterSpecial
  | Directory
  | BlockSpecial
  | RegularFile
  | SymbolicLink
  | Socket
  deriving (Eq, Show)

-- | Converts an 'EntryType' into the corresponding POSIX 'FileMode'.
entryTypeToFileMode :: EntryType -> FileMode
entryTypeToFileMode Unknown          = 0
entryTypeToFileMode NamedPipe        = namedPipeMode
entryTypeToFileMode CharacterSpecial = characterSpecialMode
entryTypeToFileMode Directory        = directoryMode
entryTypeToFileMode BlockSpecial     = blockSpecialMode
entryTypeToFileMode RegularFile      = regularFileMode
entryTypeToFileMode SymbolicLink     = symbolicLinkMode
entryTypeToFileMode Socket           = socketMode

-- | Decodes `EntryType` from a `FileMode`.
fileModeToEntryType :: FileMode -> EntryType
fileModeToEntryType mode
  | fileType == namedPipeMode        = NamedPipe
  | fileType == characterSpecialMode = CharacterSpecial
  | fileType == directoryMode        = Directory
  | fileType == blockSpecialMode     = BlockSpecial
  | fileType == regularFileMode      = RegularFile
  | fileType == symbolicLinkMode     = SymbolicLink
  | fileType == socketMode           = Socket
  | otherwise = Unknown
  where
  fileType = mode .&. (#const S_IFMT)

-- | Passed to `fuseFsync` and `fuseFsyncdir`.
data SyncType
  -- | Synchronize both file content and metadata.
  = FullSync
  -- | Synchronize only the file content.
  | DataSync
  deriving (Eq, Show)

-- | The query type of @access@. Passed to `fuseAccess`.
data AccessMode
  -- | File existence (@F_OK@)
  = FileOK
  -- | Reading, writing and executing permissions (@R_OK@, @W_OK@ and @X_OK@, resp.)
  | PermOK Bool Bool Bool
  deriving (Eq, Show)

-- | Passed to `fuseSetxattr`.
data SetxattrFlag
  -- | Create a new attribute if it does not exist, or replace the value if it already exists (@0@)
  = SetxattrDefault
  -- | Perform a pure create, which fails if the named attribute exists already (@XATTR_CREATE@)
  | SetxattrCreate
  -- | Perform a pure replace operation, which fails if the named attribute does not already exist (@XATTR_REPLACE@)
  | SetxattrReplace
  deriving (Eq, Show)

-- | Tests if access permissions to the file is granted or the file exists.
--
-- Calls @access@. Compared to `System.Posix.Files.fileAccess` and
-- `System.Posix.Files.fileExist`, this function doesn't translate the errno and just
-- returns @()@ to indicate success, or throws an error to indicate failure.
access :: FilePath -> AccessMode -> IO ()
access path mode = do
  e <- accessErrno path mode
  if e == eOK
    then pure ()
    else throwErrno "access"

-- | Same as `access` but returns the `Errno` instead of throwing an exception.
--
-- Returns `eOK` on success.
accessErrno :: FilePath -> AccessMode -> IO Errno
accessErrno path mode = withFilePath path $ \cPath -> do
  let cMode = case mode of
        FileOK -> #const F_OK
        PermOK r w x ->
          (if r then (#const R_OK) else 0) .|.
          (if w then (#const W_OK) else 0) .|.
          (if x then (#const X_OK) else 0)
  resetErrno
  ret <- c_access cPath cMode
  if ret == 0
    then pure eOK
    else getErrno

-- memo: when adding a new field, make sure to update resCFuseOperations
-- | The file system operations.
--
-- All operations are optional. Each field is named against @struct fuse_operations@ in
-- @fuse.h@.
--
-- @fh@ is the file handle type returned by `fuseOpen`, and subsequently passed to all
-- other file operations.
--
-- @dh@ is the directory handle type returned by `fuseOpendir`, and subsequently passed to
-- `fuseReaddir` and `fuseReleasedir`.
data FuseOperations fh dh = FuseOperations
  { -- | Implements 'System.Posix.Files.getSymbolicLinkStatus' operation (POSIX @lstat(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    fuseGetattr :: Maybe (FilePath -> Maybe fh -> IO (Either Errno FileStat))

  , -- | Implements 'System.Posix.Files.readSymbolicLink' operation (POSIX @readlink(2)@).
    --
    -- This function should not append a terminating NUL byte. The returned 'FilePath'
    -- might be truncated depending on caller buffer size.
    fuseReadlink :: Maybe (FilePath -> IO (Either Errno FilePath))

  , -- | Implements 'System.Posix.Files.createDevice' (POSIX @mknod(2)@).
    --
    -- This function will also be called for regular file creation if `fuseCreate` is not defined.
    --
    -- `fileModeToEntryType` is handy to pattern match on the request type of the node.
    fuseMknod :: Maybe (FilePath -> FileMode -> DeviceID -> IO Errno)

  , -- | Implements 'System.Posix.Directory.createDirectory' (POSIX @mkdir(2)@).
    fuseMkdir :: Maybe (FilePath -> FileMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.removeLink' (POSIX @unlink(2)@).
    fuseUnlink :: Maybe (FilePath -> IO Errno)

  , -- | Implements 'Ststen.Posix.Directory.removeDirectory' (POSIX @rmdir(2)@).
    fuseRmdir :: Maybe (FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.createSymbolicLink' (POSIX @symlink(2)@).
    fuseSymlink :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.rename' (POSIX @rename(2)@).
    fuseRename :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.createLink' (POSIX @link(2)@).
    fuseLink :: Maybe (FilePath -> FilePath -> IO Errno)

  , -- | Implements 'System.Posix.Files.setFileMode' (POSIX @chmod(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    fuseChmod :: Maybe (FilePath -> Maybe fh -> FileMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.setOwnerAndGroup' (POSIX @chown(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    fuseChown :: Maybe (FilePath -> Maybe fh -> UserID -> GroupID -> IO Errno)

  , -- | Implements 'System.Posix.Files.setFileSize' (POSIX @truncate(2)@).
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    fuseTruncate :: Maybe (FilePath -> Maybe fh -> FileOffset -> IO Errno)

  , -- | Implements 'System.Posix.Files.openFd' (POSIX @open(2)@).  On success, returns
    -- 'Right' of a filehandle-like value that will be passed to future file operations; on
    -- failure, returns 'Left' of the appropriate 'Errno'.
    --
    --   * Creation flags will be filtered out / handled by the kernel.
    --   * Access modes should be used by this to check if the operation is permitted.
    --   * The filesystem is expected to properly handle the @O_APPEND@ flag and ensure that
    --     each write is appending to the end of the file.
    --   * If this method returns @Left `eNOSYS`@ and @FUSE_CAP_NO_OPEN_SUPPORT@ is set in
    --     @fuse_conn_info.capable@, this is treated as success and future calls to open
    --     will also succeed without being sent to the filesystem process.
    --
    -- TODO allow this method to set @fuse_file_info.direct_io@ and @fuse_file_info.keep_cache@
    fuseOpen :: Maybe (FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh))

  , -- | Implements Unix98 @pread(2)@.
    --
    -- It differs from 'System.Posix.Files.fdRead' by the explicit 'FileOffset' argument.
    fuseRead :: Maybe (FilePath -> fh -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString))

  , -- | Implements Unix98 @pwrite(2)@.
    --
    -- It differs from 'System.Posix.Files.fdWrite' by the explicit 'FileOffset' argument.
    --
    -- Unless @FUSE_CAP_HANDLE_KILLPRIV@ is disabled, this method is expected to reset the
    -- setuid and setgid bits.
    fuseWrite :: Maybe (FilePath -> fh -> B.ByteString -> FileOffset -> IO (Either Errno CInt))

  , -- | Implements @statfs(2)@.
    fuseStatfs :: Maybe (String -> IO (Either Errno FileSystemStats))

  , -- | Called when @close(2)@ has been called on an open file.
    --
    -- Note: this does not mean that the file is released.  This function may be called more
    -- than once for each @open(2)@.  The return value is passed on to the @close(2)@ system
    -- call.
    fuseFlush :: Maybe (FilePath -> fh -> IO Errno)

  , -- | Called when an open file has all file descriptors closed and all memory mappings
    -- unmapped.
    --
    -- For every @open@ call there will be exactly one @release@ call with the same flags.
    -- It is possible to have a file opened more than once, in which case only the last
    -- release will mean that no more reads or writes will happen on the file.
    fuseRelease :: Maybe (FilePath -> fh -> IO ())

  , -- | Implements @fsync(2)@.
    fuseFsync :: Maybe (FilePath -> fh -> SyncType -> IO Errno)

  , -- | Implements @setxattr(2)@.
    --
    -- The parameters are: path, name, value and flags.
    fuseSetxattr :: Maybe (FilePath -> String -> B.ByteString -> SetxattrFlag -> IO Errno)

  , -- | Implements @getxattr(2)@.
    --
    -- The parameters are path and name.
    fuseGetxattr :: Maybe (FilePath -> String -> IO (Either Errno B.ByteString))

  , -- | Implements @listxattr(2)@.
    fuseListxattr :: Maybe (FilePath -> IO (Either Errno [String]))

  , -- | Implements @removexattr(2)@.
    fuseRemovexattr :: Maybe (FilePath -> String -> IO Errno)

  , -- | Implements @opendir(3)@.
    --
    -- This method should check if the open operation is permitted for this directory.
    fuseOpendir :: Maybe (FilePath -> IO (Either Errno dh))

  , -- | Implements @readdir(3)@.
    --
    -- The entire contents of the directory should be returned as a list of tuples
    -- (corresponding to the first mode of operation documented in @fuse.h@).
    --
    -- The returned list should contain entries of \".\" and \"..\".
    --
    -- Each element of the list is a pair of the name and the stat. The name should not
    -- include the path to it. The implementation may return @Nothing@ as the stat; in this
    -- case `fuseGetattr` is called instead.
    fuseReaddir :: Maybe (FilePath -> dh -> IO (Either Errno [(String, Maybe FileStat)]))

  , -- | Implements @closedir(3)@.
    fuseReleasedir :: Maybe (FilePath -> dh -> IO Errno)

  , -- | Synchronize the directory's contents; analogous to `fuseFsync`.
    fuseFsyncdir :: Maybe (FilePath -> dh -> SyncType -> IO Errno)

  , -- | Initializes the filesystem.  This is called before all other operations.
    --
    -- The filesystem may modify `FuseConfig` to configure the API.
    fuseInit :: Maybe (FuseConfig -> IO FuseConfig)

  , -- | Called on filesystem exit to allow cleanup.
    fuseDestroy :: Maybe (IO ())

  , -- | Implements 'System.Posix.Files.fileAccess' and 'System.Posix.Files.fileExist
    -- (POSIX @access(2)@).
    --
    -- Checks file access permissions as requested by an `AccessMode`.
    --
    -- If the @default_permissions@ mount option is given, this method is not called. This
    -- method is also not called under Linux kernel versions 2.4.x
    --
    -- TODO add notes about @default_permissions@ to other relevant handlers
    fuseAccess :: Maybe (FilePath -> AccessMode -> IO Errno)

  , -- | Implements 'System.Posix.Files.openFd' (POSIX @open(2)@). Creates and opens a regular
    -- file.
    --
    -- If this is not implemented, `fuseMknod` and `fuseOpen` methods will be called instead.
    --
    -- See `fuseOpen` for notes on the flags.
    fuseCreate :: Maybe (FilePath -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh))

    -- TODO , fuseLock :: _

  , -- | Implements @utimensat(2)@.
    --
    -- Changes the access and modification times of a file with nanosecond resolution.
    --
    -- @fh@ will always be @Nothing@ if the file is not currently open, but may also be
    -- @Nothing@ even if it is open.
    fuseUtimens :: Maybe (FilePath -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno)

    -- TODO , fuseBmap :: _
    -- TODO , fuseIoctl :: _
    -- TODO , fusePoll :: _
    -- TODO , fuseWriteBuf :: _
    -- TODO , fuseReadBuf :: _
    -- TODO , fuseFlock :: _

  , -- | Implements 'System.Posix.Fcntl.fileAllocate' (@posix_fallocate(3)@). Allocates
    -- space for an open file.
    fuseFallocate :: Maybe (FilePath -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno)

  , -- | Implements @copy_file_range(2)@.
    fuseCopyFileRange :: Maybe (FilePath -> fh -> FileOffset -> FilePath -> fh -> FileOffset -> ByteCount -> CInt -> IO (Either Errno CSsize))

  , -- | Implements 'System.Posix.IO.fdSeek' @lseek(3)@.
    --
    -- /Note:/ This is silently ignored if libfuse doesn't support @lseek@ operation (requires libfuse-3.8.0).
    fuseLseek :: Maybe (FilePath -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset))
  }

-- | An empty set of operations whose fields are @Nothing@.
defaultFuseOperations :: FuseOperations fh dh
defaultFuseOperations = FuseOperations Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

-- | Merges two `FuseOperations` in a left-biased manner.
mergeLFuseOperations :: FuseOperations fh dh -> FuseOperations fh dh -> FuseOperations fh dh
mergeLFuseOperations
  (FuseOperations a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35)
  (FuseOperations b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 b32 b33 b34 b35)
  = FuseOperations (a1 <|> b1) (a2 <|> b2) (a3 <|> b3) (a4 <|> b4) (a5 <|> b5) (a6 <|> b6) (a7 <|> b7) (a8 <|> b8) (a9 <|> b9) (a10 <|> b10) (a11 <|> b11) (a12 <|> b12) (a13 <|> b13) (a14 <|> b14) (a15 <|> b15) (a16 <|> b16) (a17 <|> b17) (a18 <|> b18) (a19 <|> b19) (a20 <|> b20) (a21 <|> b21) (a22 <|> b22) (a23 <|> b23) (a24 <|> b24) (a25 <|> b25) (a26 <|> b26) (a27 <|> b27) (a28 <|> b28) (a29 <|> b29) (a30 <|> b30) (a31 <|> b31) (a32 <|> b32) (a33 <|> b33) (a34 <|> b34) (a35 <|> b35)

-- | Allocates a @fuse_operations@ struct and pokes `FuseOperations` into it.
--
-- Each field of `FuseOperations` is converted into a C function pointer and is assigned
-- to a corresponding field of @struct fuse_operations@.
--
-- The created `C.FuseOperations` has the following invariants:
--
--   - The content of @fuse_file_info.fh@ is a Haskell value of type @StablePtr fh@ or
--     @StablePtr dh@, depending on operations. It is created with `newFH`, accessed with
--     `getFH` and released with `delFH`.
--
--   - Every methods handle Haskell exception with the supplied error handler. Any exceptions
--     not catched by it are catched, logged and returns `eIO`. This means that `exitSuccess`
--     /does not work/ inside `FuseOperations`.
--
--   - NULL filepaths (passed from libfuse if `FuseConfig.nullpathOk` is set) are
--     translated to empty strings.
resCFuseOperations
  :: forall fh dh e
   . Exception e
  => FuseOperations fh dh
  -> ExceptionHandler e
  -> ResourceT IO (Ptr C.FuseOperations)
resCFuseOperations ops handlerRaw = do
  fuseGetattr       <- resC C.mkGetattr       wrapGetattr       (fuseGetattr ops)
  fuseReadlink      <- resC C.mkReadlink      wrapReadlink      (fuseReadlink ops)
  fuseMknod         <- resC C.mkMknod         wrapMknod         (fuseMknod ops)
  fuseMkdir         <- resC C.mkMkdir         wrapMkdir         (fuseMkdir ops)
  fuseUnlink        <- resC C.mkUnlink        wrapUnlink        (fuseUnlink ops)
  fuseRmdir         <- resC C.mkRmdir         wrapRmdir         (fuseRmdir ops)
  fuseSymlink       <- resC C.mkSymlink       wrapSymlink       (fuseSymlink ops)
  fuseRename        <- resC C.mkRename        wrapRename        (fuseRename ops)
  fuseLink          <- resC C.mkLink          wrapLink          (fuseLink ops)
  fuseChmod         <- resC C.mkChmod         wrapChmod         (fuseChmod ops)
  fuseChown         <- resC C.mkChown         wrapChown         (fuseChown ops)
  fuseTruncate      <- resC C.mkTruncate      wrapTruncate      (fuseTruncate ops)
  fuseOpen          <- resC C.mkOpen          wrapOpen          (fuseOpen ops)
  fuseRead          <- resC C.mkRead          wrapRead          (fuseRead ops)
  fuseWrite         <- resC C.mkWrite         wrapWrite         (fuseWrite ops)
  fuseStatfs        <- resC C.mkStatfs        wrapStatfs        (fuseStatfs ops)
  fuseFlush         <- resC C.mkFlush         wrapFlush         (fuseFlush ops)
  fuseRelease       <- resC C.mkRelease       wrapRelease       (fuseRelease ops)
  fuseFsync         <- resC C.mkFsync         wrapFsync         (fuseFsync ops)
  fuseSetxattr      <- resC C.mkSetxattr      wrapSetxattr      (fuseSetxattr ops)
  fuseGetxattr      <- resC C.mkGetxattr      wrapGetxattr      (fuseGetxattr ops)
  fuseListxattr     <- resC C.mkListxattr     wrapListxattr     (fuseListxattr ops)
  fuseRemovexattr   <- resC C.mkRemovexattr   wrapRemovexattr   (fuseRemovexattr ops)
  fuseOpendir       <- resC C.mkOpendir       wrapOpendir       (fuseOpendir ops)
  fuseReaddir       <- resC C.mkReaddir       wrapReaddir       (fuseReaddir ops)
  fuseReleasedir    <- resC C.mkReleasedir    wrapReleasedir    (fuseReleasedir ops)
  fuseFsyncdir      <- resC C.mkFsyncdir      wrapFsyncdir      (fuseFsyncdir ops)
  fuseInit          <- resC C.mkInit          wrapInit          (fuseInit ops)
  fuseDestroy       <- resC C.mkDestroy       wrapDestroy       (fuseDestroy ops)
  fuseAccess        <- resC C.mkAccess        wrapAccess        (fuseAccess ops)
  fuseCreate        <- resC C.mkCreate        wrapCreate        (fuseCreate ops)
  fuseUtimens       <- resC C.mkUtimens       wrapUtimens       (fuseUtimens ops)
  fuseFallocate     <- resC C.mkFallocate     wrapFallocate     (fuseFallocate ops)
  fuseCopyFileRange <- resC C.mkCopyFileRange wrapCopyFileRange (fuseCopyFileRange ops)
  fuseLseek         <- resC C.mkLseek         wrapLseek         (fuseLseek ops)
  fmap snd $ resNew C.FuseOperations
    -- not (yet) implemented methods
    { fuseLock = nullFunPtr
    , fuseBmap = nullFunPtr
    , fuseIoctl = nullFunPtr
    , fusePoll = nullFunPtr
    , fuseWriteBuf = nullFunPtr
    , fuseReadBuf = nullFunPtr
    , fuseFlock = nullFunPtr
    , ..
    }
  where
  -- wraps the supplied handler to make sure no Haskell exceptions are propagated to the C land
  handler :: ExceptionHandler SomeException
  handler se = case fromException se of
    Nothing -> defaultExceptionHandler se
    Just e -> handlerRaw e `catch` defaultExceptionHandler

  -- convert a Haskell function to C one with @wrapMeth@, get its @FunPtr@, and associate it with freeHaskellFunPtr
  resC :: (cfunc -> IO (FunPtr cfunc)) -> (hsfunc -> cfunc) -> Maybe hsfunc -> ResourceT IO (FunPtr cfunc)
  resC _ _ Nothing = pure nullFunPtr
  resC mkMeth wrapMeth (Just hsfunc) = fmap snd $ Res.allocate (mkMeth $ wrapMeth hsfunc) freeHaskellFunPtr

  -- return negated errno as specified by fuse.h. also handle any Haskell exceptions
  handleAsFuseError :: IO Errno -> IO CInt
  handleAsFuseError = handleAsFuseErrorResult . fmap Left -- assumes eOK == 0

  -- return a (successful) result as positive int and a negated errno as negative int
  handleAsFuseErrorResult :: IO (Either Errno CInt) -> IO CInt
  handleAsFuseErrorResult = handleAsFuseErrorIntegral

  handleAsFuseErrorCSsize :: IO (Either Errno CSsize) -> IO CSsize
  handleAsFuseErrorCSsize = handleAsFuseErrorIntegral

  handleAsFuseErrorCOff :: IO (Either Errno COff) -> IO COff
  handleAsFuseErrorCOff = handleAsFuseErrorIntegral

  handleAsFuseErrorIntegral :: Integral a => IO (Either Errno a) -> IO a
  handleAsFuseErrorIntegral = fmap (either (fromIntegral . negate . unErrno) id) . handle (fmap Left . handler)

  peekFilePathOrEmpty :: CString -> IO FilePath
  peekFilePathOrEmpty pFilePath
    | pFilePath == nullPtr = pure ""
    | otherwise            = peekFilePath pFilePath

  peekOpenFileFlagsAndMode :: Ptr C.FuseFileInfo -> IO (OpenFileFlags, OpenMode)
  peekOpenFileFlagsAndMode pFuseFileInfo = do
    (flags :: CInt) <- (#peek struct fuse_file_info, flags) pFuseFileInfo
    let openFileFlags = defaultFileFlags
          { System.Posix.IO.append   = testBitSet flags (#const O_APPEND)
          , System.Posix.IO.nonBlock = testBitSet flags (#const O_NONBLOCK)
          , System.Posix.IO.trunc    = testBitSet flags (#const O_TRUNC)
          }
        openMode
          | testBitSet flags (#const O_RDWR)   = ReadWrite
          | testBitSet flags (#const O_WRONLY) = WriteOnly
          | otherwise = ReadOnly -- O_RDONLY
    pure (openFileFlags, openMode)

  wrapGetattr :: (FilePath -> Maybe fh -> IO (Either Errno FileStat)) -> C.CGetattr
  wrapGetattr go pFilePath pStat pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    mfh <- getFH pFuseFileInfo
    go filePath mfh >>= \case
      Left errno -> pure errno
      Right stat -> do
        poke pStat stat
        pure eOK

  wrapReadlink :: (FilePath -> IO (Either Errno FilePath)) -> C.CReadlink
  wrapReadlink go pFilePath pBuf bufSize = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath >>= \case
      Left errno -> pure errno
      Right target -> do
        -- This will truncate target if it's longer than the buffer can hold,
        -- as specified by fuse.h
        pokeCStringLen0 (pBuf, (fromIntegral bufSize)) target
        pure eOK

  wrapMknod :: (FilePath -> FileMode -> DeviceID -> IO Errno) -> C.CMknod
  wrapMknod go pFilePath mode dev = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath mode dev

  wrapMkdir :: (FilePath -> FileMode -> IO Errno) -> C.CMkdir
  wrapMkdir go pFilePath mode = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath mode

  wrapUnlink :: (FilePath -> IO Errno) -> C.CUnlink
  wrapUnlink go pFilePath = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath

  wrapRmdir :: (FilePath -> IO Errno) -> C.CRmdir
  wrapRmdir go pFilePath = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath

  wrapSymlink :: (FilePath -> FilePath -> IO Errno) -> C.CSymlink
  wrapSymlink go pSource pDestination = handleAsFuseError $ do
    source <- peekFilePath pSource
    destination <- peekFilePath pDestination
    go source destination

  wrapRename :: (FilePath -> FilePath -> IO Errno) -> C.CRename
  wrapRename go pOld pNew _flags = handleAsFuseError $ do
    -- we ignore the rename flags because #define _GNU_SOURCE is needed to use the constants
    -- TODO return EINVAL if flags are specified?
    old <- peekFilePath pOld
    new <- peekFilePath pNew
    go old new

  wrapLink :: (FilePath -> FilePath -> IO Errno) -> C.CLink
  wrapLink go pSource pDestination = handleAsFuseError $ do
    source <- peekFilePath pSource
    destination <- peekFilePath pDestination
    go source destination

  wrapChmod :: (FilePath -> Maybe fh -> FileMode -> IO Errno) -> C.CChmod
  wrapChmod go pFilePath mode pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    mfh <- getFH pFuseFileInfo
    go filePath mfh mode

  wrapChown :: (FilePath -> Maybe fh -> UserID -> GroupID -> IO Errno) -> C.CChown
  wrapChown go pFilePath uid gid pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    mfh <- getFH pFuseFileInfo
    go filePath mfh uid gid

  wrapTruncate :: (FilePath -> Maybe fh -> FileOffset -> IO Errno) -> C.CTruncate
  wrapTruncate go pFilePath off pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    mfh <- getFH pFuseFileInfo
    go filePath mfh off

  wrapOpen :: (FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh)) -> C.COpen
  wrapOpen go pFilePath pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    (openFileFlags, openMode) <- peekOpenFileFlagsAndMode pFuseFileInfo
    go filePath openMode openFileFlags >>= \case
      Left errno -> pure errno
      Right fh -> do
        newFH pFuseFileInfo fh
        pure eOK

  wrapRead :: (FilePath -> fh -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString)) -> C.CRead
  wrapRead go pFilePath pBuf bufSize off pFuseFileInfo = handleAsFuseErrorResult $ do
    filePath <- peekFilePathOrEmpty pFilePath
    fh <- getFHJust pFuseFileInfo
    go filePath fh bufSize off >>= \case
      Left errno -> pure $ Left errno
      Right bytes -> BU.unsafeUseAsCStringLen bytes $ \(pBytes, bytesLen) -> do
        let len = bytesLen `min` fromIntegral bufSize
        copyArray pBuf pBytes len
        pure $ Right $ fromIntegral len

  wrapWrite :: (FilePath -> fh -> B.ByteString -> FileOffset -> IO (Either Errno CInt)) -> C.CWrite
  wrapWrite go pFilePath pBuf bufSize off pFuseFileInfo = handleAsFuseErrorResult $ do
    filePath <- peekFilePathOrEmpty pFilePath
    fh <- getFHJust pFuseFileInfo
    buf <- BU.unsafePackCStringLen (pBuf, fromIntegral bufSize)
    go filePath fh buf off

  wrapStatfs :: (String -> IO (Either Errno FileSystemStats)) -> C.CStatfs
  wrapStatfs go pStr pStatVFS = handleAsFuseError $ do
    str <- peekFilePath pStr
    go str >>= \case
      Left errno -> pure errno
      Right statvfs -> do
        poke pStatVFS statvfs
        pure eOK

  wrapFlush :: (FilePath -> fh -> IO Errno) -> C.CFlush
  wrapFlush go pFilePath pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    fh <- getFHJust pFuseFileInfo
    go filePath fh

  wrapRelease :: (FilePath -> fh -> IO ()) -> C.CRelease
  wrapRelease go pFilePath pFuseFileInfo = go' `finally` delFH pFuseFileInfo
    where
    go' = handleAsFuseError $ do
      filePath <- peekFilePathOrEmpty pFilePath
      fh <- getFHJust pFuseFileInfo
      go filePath fh
      pure eOK

  wrapFsync :: (FilePath -> fh -> SyncType -> IO Errno) -> C.CFsync
  wrapFsync go pFilePath isDataSync pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    fh <- getFHJust pFuseFileInfo
    go filePath fh (if isDataSync /= 0 then DataSync else FullSync)

  wrapSetxattr :: (FilePath -> String -> B.ByteString -> SetxattrFlag -> IO Errno) -> C.CSetxattr
  wrapSetxattr go pFilePath pName pValue valueSize cFlags = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    name <- peekCString pName
    value <- BU.unsafePackCStringLen (pValue, fromIntegral valueSize)
    let eflag = case cFlags of
          0 -> Right SetxattrDefault
          (#const XATTR_CREATE) -> Right SetxattrCreate
          (#const XATTR_REPLACE) -> Right SetxattrReplace
          _ -> Left eINVAL
    either pure (go filePath name value) eflag

  wrapGetxattr :: (FilePath -> String -> IO (Either Errno B.ByteString)) -> C.CGetxattr
  wrapGetxattr go pFilePath pName pValueBuf bufSize = handleAsFuseErrorResult $ do
    filePath <- peekFilePath pFilePath
    name <- peekCString pName
    go filePath name >>= \case
      Left errno -> pure $ Left errno
      Right bytes
        | bufSize == 0 -> pure $ Right $ fromIntegral $ B.length bytes
        | otherwise -> BU.unsafeUseAsCStringLen bytes $ \(pBytes, bytesLen) -> do
            let len = bytesLen `min` fromIntegral bufSize
            copyArray pValueBuf pBytes len
            pure $ Right $ fromIntegral len

  wrapListxattr :: (FilePath -> IO (Either Errno [String])) -> C.CListxattr
  wrapListxattr go pFilePath pBuf bufSize = handleAsFuseErrorResult $ do
    filePath <- peekFilePath pFilePath
    go filePath >>= \case
      Left errno -> pure $ Left errno
      Right names -> withCStringLen (concatMap (<> "\0") names) $ \(pNames, namesLen) ->
        if bufSize == 0
          then pure $ Right $ fromIntegral namesLen
          else do
            let len = namesLen `min` fromIntegral bufSize
            copyArray pBuf pNames len
            pure $ Right $ fromIntegral len

  wrapRemovexattr :: (FilePath -> String -> IO Errno) -> C.CRemovexattr
  wrapRemovexattr go pFilePath pName = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    name <- peekCString pName
    go filePath name

  wrapOpendir :: (FilePath -> IO (Either Errno dh)) -> C.COpendir
  wrapOpendir go pFilePath pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath >>= \case
      Left errno -> pure errno
      Right dh -> do
        newFH pFuseFileInfo dh
        pure eOK

  wrapReaddir :: (FilePath -> dh -> IO (Either Errno [(String, Maybe FileStat)])) -> C.CReaddir
  wrapReaddir go pFilePath pBuf pFillDir _off pFuseFileInfo _readdirFlags = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    dh <- getFHJust pFuseFileInfo
    let fillDir = peekFuseFillDir pFillDir
        fillEntry :: (FilePath, Maybe FileStat) -> IO ()
        fillEntry (fileName, fileStat) =
          withFilePath fileName $ \pFileName ->
          maybeWith with fileStat $ \pFileStat -> do
            _ <- fillDir pBuf pFileName pFileStat 0 0
            pure ()
    go filePath dh >>= \case
      Left errno -> pure errno
      Right entries -> do
        traverse_ fillEntry entries
        pure eOK

  wrapReleasedir :: (FilePath -> dh -> IO Errno) -> C.CReleasedir
  wrapReleasedir go pFilePath pFuseFileInfo = go' `finally` delFH pFuseFileInfo
    where
    go' = handleAsFuseError $ do
      filePath <- peekFilePathOrEmpty pFilePath
      dh <- getFHJust pFuseFileInfo
      go filePath dh

  wrapFsyncdir :: (FilePath -> dh -> SyncType -> IO Errno) -> C.CFsyncdir
  wrapFsyncdir go pFilePath isDataSync pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    dh <- getFHJust pFuseFileInfo
    go filePath dh (if isDataSync /= 0 then DataSync else FullSync)

  wrapInit :: (FuseConfig -> IO FuseConfig) -> C.CInit
  -- TODO implement read/write of fuseConnInfo; watch out for read-only fields
  wrapInit go _fuseConnInfo pFuseConfig = do
    _ <- handle (void . handler) $ do
      -- @pFuseConfig@ is filled beforehand by fuse_opt_parse in libfuse so we pass it
      -- as-is to the callback as the default value.
      fuseConfigOld <- fromCFuseConfig <$> peek pFuseConfig
      fuseConfigNew <- go fuseConfigOld
      -- The return value of the callback is poked back to @pFuseConfig@. Note that, by
      -- doing this the fields of @fuse_config@ which we do /not/ implement are left
      -- unchanged. This is the intended behavior.
      poke pFuseConfig $ toCFuseConfig fuseConfigNew
    pure nullPtr

  wrapDestroy :: IO () -> C.CDestroy
  wrapDestroy go _privateData = handle (void . handler) go

  wrapAccess :: (FilePath -> AccessMode -> IO Errno) -> C.CAccess
  wrapAccess go pFilePath mode = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    go filePath accessMode
    where
    accessMode
      | testBitSet mode (#const F_OK) = FileOK
      | otherwise = PermOK
          (testBitSet mode (#const R_OK))
          (testBitSet mode (#const W_OK))
          (testBitSet mode (#const X_OK))

  wrapCreate :: (FilePath -> OpenMode -> FileMode -> OpenFileFlags -> IO (Either Errno fh)) -> C.CCreate
  wrapCreate go pFilePath mode pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    (openFileFlags, openMode) <- peekOpenFileFlagsAndMode pFuseFileInfo
    go filePath openMode mode openFileFlags >>= \case
      Left errno -> pure errno
      Right fh -> do
        newFH pFuseFileInfo fh
        pure eOK

  wrapUtimens :: (FilePath -> Maybe fh -> TimeSpec -> TimeSpec -> IO Errno) -> C.CUtimens
  wrapUtimens go pFilePath arrTs pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePathOrEmpty pFilePath
    mfh <- getFH pFuseFileInfo
    [atime, mtime] <- peekArray 2 arrTs
    go filePath mfh atime mtime

  wrapFallocate :: (FilePath -> fh -> CInt -> FileOffset -> FileOffset -> IO Errno) -> C.CFallocate
  wrapFallocate go pFilePath mode offset len pFuseFileInfo = handleAsFuseError $ do
    filePath <- peekFilePath pFilePath
    fh <- getFHJust pFuseFileInfo
    go filePath fh mode offset len

  wrapCopyFileRange :: (FilePath -> fh -> FileOffset -> FilePath -> fh -> FileOffset -> ByteCount -> CInt -> IO (Either Errno CSsize)) -> C.CCopyFileRange
  wrapCopyFileRange go pFilePathIn pFuseFileInfoIn offsetIn pFilePathOut pFuseFileInfoOut offsetOut size flags = handleAsFuseErrorCSsize $ do
    filePathIn <- peekFilePath pFilePathIn
    fhIn <- getFHJust pFuseFileInfoIn
    filePathOut <- peekFilePath pFilePathOut
    fhOut <- getFHJust pFuseFileInfoOut
    go filePathIn fhIn offsetIn filePathOut fhOut offsetOut size flags

  wrapLseek :: (FilePath -> fh -> FileOffset -> SeekMode -> IO (Either Errno FileOffset)) -> C.CLseek
  wrapLseek go pFilePath offset whence pFuseFileInfo = handleAsFuseErrorCOff $ do
    filePath <- peekFilePath pFilePath
    fh <- getFHJust pFuseFileInfo
    let emode = case whence of
          (#const SEEK_SET) -> Right AbsoluteSeek
          (#const SEEK_CUR) -> Right RelativeSeek
          (#const SEEK_END) -> Right SeekFromEnd
          _ -> Left eINVAL
    either (pure . Left) (go filePath fh offset) emode

  _dummyToSuppressWarnings :: StablePtr a
  _dummyToSuppressWarnings = error "dummy" eNOSYS

-- | Allocates a @fuse_args@ struct to hold commandline arguments.
resFuseArgs :: String -> [String] -> ResourceT IO (Ptr C.FuseArgs)
resFuseArgs prog args = do
  let allArgs = (prog:args)
      argc = length allArgs
  cArgs <- traverse (fmap snd . resNewCString) allArgs
  pArgv <- fmap snd $ resNewArray cArgs
  -- call FUSE_ARGS_INIT instead?
  fuseArgs <- fmap snd $ resMallocBytes (#size struct fuse_args)
  liftIO $ do
    (#poke struct fuse_args, argc) fuseArgs argc
    (#poke struct fuse_args, argv) fuseArgs pArgv
    (#poke struct fuse_args, allocated) fuseArgs (0::CInt)
  _ <- Res.register $ C.fuse_opt_free_args fuseArgs
  pure fuseArgs

-- | Calls @fuse_parse_cmdline@ to parse the part of the commandline arguments that
-- we care about.
--
-- @fuse_parse_cmdline@ will modify the `C.FuseArgs` struct passed in to remove those
-- arguments; the `C.FuseArgs` struct containing remaining arguments must be passed to
-- @fuse_mount@/@fuse_new@.
--
-- The multithreaded runtime will be used regardless of the threading flag!
-- See the comment in @fuse_session_exit@ for why.
fuseParseCommandLine :: Ptr C.FuseArgs -> IO (Either ExitCode FuseMainArgs)
fuseParseCommandLine pArgs =
  allocaBytes (#size struct fuse_cmdline_opts) $ \pOpts -> do
    retval <- C.fuse_parse_cmdline pArgs pOpts
    if retval /= 0
      -- fuse_parse_cmdline prints an error message
      then pure $ Left $ ExitFailure 1
      else go pOpts
  where
  go pOpts = do
    pMountPoint <- (#peek struct fuse_cmdline_opts, mountpoint) pOpts
    showHelp    <- (/= (0 :: CInt)) <$> (#peek struct fuse_cmdline_opts, show_help) pOpts
    showVersion <- (/= (0 :: CInt)) <$> (#peek struct fuse_cmdline_opts, show_version) pOpts
    -- free fuse_cmdline_opts.mountpoint because it is allocated with realloc (see libfuse's examples)
    let freeMountPoint = free pMountPoint
    flip finally freeMountPoint $ case () of
      _ | showHelp -> do
            printf "usage: %s [options] <mountpoint>\n\n" =<< getProgName
            C.fuse_cmdline_help
            C.fuse_lib_help pArgs
            pure $ Left ExitSuccess
        | showVersion -> do
            ver <- peekCString =<< C.fuse_pkgversion
            printf "FUSE library version %s\n" ver
            C.fuse_lowlevel_version
            pure $ Left ExitSuccess
        | pMountPoint == nullPtr -> do
            progName <- getProgName
            hPrintf stderr "usage: %s [options] <mountpoint>\n" progName
            hPrintf stderr "       %s --help\n" progName
            pure $ Left $ ExitFailure 1
        | otherwise -> do
            mountPoint <- peekFilePath pMountPoint
            foreground <- (/= (0 :: CInt)) <$> (#peek struct fuse_cmdline_opts, foreground) pOpts
            cloneFd <- (#peek struct fuse_cmdline_opts, clone_fd) pOpts
            pure $ Right (foreground, mountPoint, cloneFd)

-- | Parses the commandline arguments and exit if the args are bad or certain informational
-- flag(s) are specified. See `fuseParseCommandLine`.
fuseParseCommandLineOrExit :: Ptr C.FuseArgs -> IO FuseMainArgs
fuseParseCommandLineOrExit pArgs = either exitWith pure =<< fuseParseCommandLine pArgs

-- | Haskell version of @fuse_daemonize@.
--
-- During the fork, transfers all of the resources in `ResourceT` (and its cleanup actions)
-- to the forked process.
--
-- Mimics @daemon()@'s use of @_exit()@ instead of @exit()@; we depend on this in
-- `fuseMainReal`, because otherwise we'll unmount the filesystem when the foreground
-- process exits.
fuseDaemonize :: ResourceT IO a -> ResourceT IO b
fuseDaemonize job = daemonizeResourceT $ do
  liftIO $ do
    _ <- createSession
    changeWorkingDirectory "/"
    -- need to open @/dev/null@ twice because `hDuplicateTo` can't dup a
    -- ReadWriteMode to a ReadMode handle
    withFile "/dev/null" WriteMode $ \devNullOut -> do
      hDuplicateTo devNullOut stdout
      hDuplicateTo devNullOut stderr
    withFile "/dev/null" ReadMode $ \devNullIn -> do
      hDuplicateTo devNullIn stdin
  _ <- job
  liftIO $ exitSuccess

-- | @withSignalHandlers handler io@ installs signal handlers while @io@ is executed.
withSignalHandlers :: IO () -> IO a -> IO a
withSignalHandlers exitHandler = bracket_ setHandlers resetHandlers
  where
  setHandlers = do
    let sigHandler = Signals.Catch exitHandler
    void $ Signals.installHandler Signals.sigINT  sigHandler Nothing
    void $ Signals.installHandler Signals.sigHUP  sigHandler Nothing
    void $ Signals.installHandler Signals.sigTERM sigHandler Nothing
    void $ Signals.installHandler Signals.sigPIPE Signals.Ignore Nothing
  resetHandlers = do
    void $ Signals.installHandler Signals.sigINT  Signals.Default Nothing
    void $ Signals.installHandler Signals.sigHUP  Signals.Default Nothing
    void $ Signals.installHandler Signals.sigTERM Signals.Default Nothing
    void $ Signals.installHandler Signals.sigPIPE Signals.Default Nothing

-- | The parts of @fuse_parse_cmdline@ we are interested in. Passed to `fuseMainReal`.
--
-- @(foreground, mountpoint, clone_fd)@
--
-- So far, we don't interpret the value of @clone_fd@ at all so its type is `CInt`.
type FuseMainArgs = (Bool, String, CInt)

-- | Mounts the filesystem, forks (if requested), and then starts fuse.
fuseMainReal
  :: Ptr C.StructFuse
  -> FuseMainArgs
  -> ResourceT IO a
fuseMainReal = \pFuse (foreground, mountPt, cloneFd) -> do
  let run = if foreground
        then \io -> liftIO $ changeWorkingDirectory "/" >> io
        else fuseDaemonize . liftIO
  cMountPt <- fmap snd $ resNewFilePath mountPt
  mountResult <- snd <$> Res.allocate (C.fuse_mount pFuse cMountPt) (\_ -> C.fuse_unmount pFuse)
  if mountResult == 0
    then run $ procMain pFuse cloneFd
    else liftIO $ fail "fuse_mount failed"
  where
  -- here, we're finally inside the daemon process, we can run the main loop
  procMain pFuse cloneFd = do
    session <- C.fuse_get_session pFuse
    -- Due to some interaction between GHC runtime, calling fuse_session_exit once doesn't
    -- stop fuse_loop_mt_31. On receiving a second signal the loop exits and the filesystem
    -- is unmounted.
    -- Adding the RTS option @--install-signal-handlers=no@ does not fix the issue.
    --
    -- On the other hand, @fusermount3 -u@ successfully unmounts the filesystem on the first
    -- attempt.
    withSignalHandlers (C.fuse_session_exit session) $ do
      retVal <- C.fuse_loop_mt_31 pFuse cloneFd
      if retVal == 0
        then exitSuccess
        else exitFailure

-- | Parses the commandline arguments and runs fuse.
fuseRun :: Exception e => String -> [String] -> FuseOperations fh dh -> ExceptionHandler e -> IO a
fuseRun prog args ops handler = runResourceT $ do
  pArgs <- resFuseArgs prog args
  mainArgs <- liftIO $ fuseParseCommandLineOrExit pArgs
  pOp <- resCFuseOperations ops handler
  pFuse <- fmap snd $ Res.allocate
    (C.fuse_new pArgs pOp (#size struct fuse_operations) nullPtr)
    (\p -> unless (p == nullPtr) $ C.fuse_destroy p)
  if pFuse == nullPtr
    then liftIO exitFailure -- fuse_new prints an error message
    else fuseMainReal pFuse mainArgs

-- | Main function of FUSE.
--
-- This is all that has to be called from the @main@ function. On top of
-- the `FuseOperations` record with filesystem implementation, you must give
-- an exception handler converting Haskell exceptions to `Errno`.
fuseMain :: Exception e => FuseOperations fh dh -> ExceptionHandler e -> IO ()
fuseMain ops handler = do
  -- this used to be implemented using libfuse's fuse_main. Doing this will fork()
  -- from C behind the GHC runtime's back, which deadlocks in GHC 6.8.
  -- Instead, we reimplement fuse_main in Haskell using the forkProcess and the
  -- lower-level fuse_new/fuse_loop_mt API.
  prog <- getProgName
  args <- getArgs
  fuseRun prog args ops handler

-- | An exception handler which converts Haskell exceptions from `FuseOperations` methods to `Errno`.
type ExceptionHandler e = e -> IO Errno

-- | Catches any exception, logs it to stderr, and returns `eIO`.
--
-- Suitable as a default exception handler.
--
-- __NOTE 1__ This differs from the one in the @HFuse@ package which returns `eFAULT`.
--
-- __NOTE 2__ If the filesystem is daemonized (as default), the exceptions will not be logged because
-- stderr is redirected to @\/dev\/null@.
defaultExceptionHandler :: ExceptionHandler SomeException
defaultExceptionHandler e = hPutStrLn stderr (show e) >> pure eIO
  where
  _dummyToSuppressWarnings = error "dummy" eFAULT

-- | Gets a file handle from `C.FuseFileInfo` which is embedded with `newFH`.
--
-- If either the @Ptr `C.FuseFileInfo`@ itself or its @fh@ field is NULL, returns @Nothing@.
getFH :: Ptr C.FuseFileInfo -> IO (Maybe fh)
getFH pFuseFileInfo
  | pFuseFileInfo == nullPtr = pure Nothing
  | otherwise = do
    sptr <- (#peek struct fuse_file_info, fh) pFuseFileInfo
    -- Note that this implementation relies on the fact that @fuse_file_info.fh@ is
    -- @NULL@-initialized before @fuse_operations.open@ and @.opendir@, and remains @NULL@
    -- if they are unimplemented. It's a hack but we check this because because if we
    -- didn't, we'll hit undefined behavior.
    if sptr == nullPtr
      then pure Nothing
      else fmap Just $ deRefStablePtr $ castPtrToStablePtr sptr

-- | Gets a file handle from `C.FuseFileInfo`.
--
-- @
-- getFHJust = fmap fromJust . `getFH`
-- @
--
-- This means you must make sure that `getFH` returns @Just@ or you'll get a Haskell
-- exception. /However/, it's deliberately made lazy so that calling `getFHJust` itself
-- won't throw but trying to use the returned value will.
--
-- This function is implemented this way in order to take care of rare(?) cases in which
-- `fuseRead`\/`fuseReaddir` is implemented but not `fuseOpen`\/`fuseOpendir` resp. In
-- such a case, `newFH` would not be called but only `getFH` would be. Without some
-- protection, we would be dereferencing a non-initialized `StablePtr`, which is
-- /undefined behavior/. Throwing a Haskell exception in a pure code is much better than
-- UB. See the comment in the source of `getFH` if you are interested in more explanation.
getFHJust :: Ptr C.FuseFileInfo -> IO fh
getFHJust = fmap fromJust . getFH

-- | Embeds a file handle into `C.FuseFileInfo`. It should be freed with `delFH` when no
-- longer required.
newFH :: Ptr C.FuseFileInfo -> fh -> IO ()
newFH pFuseFileInfo fh = do
  sptr <- newStablePtr fh
  (#poke struct fuse_file_info, fh) pFuseFileInfo $ castStablePtrToPtr sptr

-- | Frees a file handle in `C.FuseFileInfo` which is embedded with `newFH`.
delFH :: Ptr C.FuseFileInfo -> IO ()
delFH pFuseFileInfo = do
  sptr <- (#peek struct fuse_file_info, fh) pFuseFileInfo
  -- if sptr is NULL, it should mean newFH have not called. See getFH and getFHJust for
  -- more info
  unless (sptr == nullPtr) $
    freeStablePtr $ castPtrToStablePtr sptr

-- | Materializes the callback of @readdir@ to marshal `fuseReaddir`.
foreign import ccall "dynamic"
  peekFuseFillDir :: FunPtr C.FuseFillDir -> C.FuseFillDir