module System.Fuse
    ( 
      
      module Foreign.C.Error
    , FuseOperations(..)
    , defaultFuseOps
    , fuseMain 
    , fuseRun 
    , defaultExceptionHandler 
      
    , FileStat(..)
    , EntryType(..)
    , FileSystemStats(..)
    , SyncType(..)
      
    , getFuseContext 
    , FuseContext(fuseCtxUserID, fuseCtxGroupID, fuseCtxProcessID)
      
    , entryTypeToFileMode 
    , fileModeToEntryType 
    , OpenMode(..)
    , OpenFileFlags(..)
    , intersectFileModes 
    , unionFileModes 
    ) where
import Prelude hiding ( Read )
import Control.Monad
import Control.Exception as E(Exception, handle, finally, SomeException)
import qualified Data.ByteString.Char8    as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe   as B
import Foreign
import Foreign.C
import Foreign.C.Error
import Foreign.Marshal
import System.Environment ( getProgName, getArgs )
import System.IO ( hPutStrLn, stderr, withFile, stdin, stdout, IOMode(..) )
import System.Posix.Types
import System.Posix.Files ( accessModes, intersectFileModes, unionFileModes )
import System.Posix.Directory(changeWorkingDirectory)
import System.Posix.Process(forkProcess,createSession,exitImmediately)
import System.Posix.IO ( OpenMode(..), OpenFileFlags(..) )
import qualified System.Posix.Signals as Signals
import GHC.IO.Handle(hDuplicateTo)
import System.Exit
import qualified System.IO.Error as IO(catch,ioeGetErrorString)
data FileStat = FileStat { statEntryType :: EntryType
                         , statFileMode :: FileMode
                         , statLinkCount :: LinkCount
                         , statFileOwner :: UserID
                         , statFileGroup :: GroupID
                         , statSpecialDeviceID :: DeviceID
                         , statFileSize :: FileOffset
                         , statBlocks :: Integer
                         , statAccessTime :: EpochTime
                         , statModificationTime :: EpochTime
                         , statStatusChangeTime :: EpochTime
                         }
    deriving Show
fileStatToCStat :: FileStat -> Ptr CStat -> IO ()
fileStatToCStat stat pStat = do
    let mode = (entryTypeToFileMode (statEntryType stat)
             `unionFileModes`
               (statFileMode stat `intersectFileModes` accessModes))
    let block_count = (fromIntegral (statBlocks stat) :: (Int64))
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))   pStat mode
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20))  pStat (statLinkCount  stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24))    pStat (statFileOwner  stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 28))    pStat (statFileGroup  stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32))   pStat (statSpecialDeviceID stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 44))   pStat (statFileSize   stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) pStat block_count
    ((\hsc_ptr -> pokeByteOff hsc_ptr 64))  pStat (statAccessTime stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 72))  pStat (statModificationTime stat)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 80))  pStat (statStatusChangeTime stat)
data EntryType
    = Unknown            
    | NamedPipe
    | CharacterSpecial
    | Directory
    | BlockSpecial
    | RegularFile
    | SymbolicLink
    | Socket
      deriving(Show)
entryTypeToDT :: EntryType -> Int
entryTypeToDT Unknown          = (0)
entryTypeToDT NamedPipe        = (1)
entryTypeToDT CharacterSpecial = (2)
entryTypeToDT Directory        = (4)
entryTypeToDT BlockSpecial     = (6)
entryTypeToDT RegularFile      = (8)
entryTypeToDT SymbolicLink     = (10)
entryTypeToDT Socket           = (12)
fileTypeModes :: FileMode
fileTypeModes = (61440)
blockSpecialMode :: FileMode
blockSpecialMode = (24576)
characterSpecialMode :: FileMode
characterSpecialMode = (8192)
namedPipeMode :: FileMode
namedPipeMode = (4096)
regularFileMode :: FileMode
regularFileMode = (32768)
directoryMode :: FileMode
directoryMode = (16384)
symbolicLinkMode :: FileMode
symbolicLinkMode = (40960)
socketMode :: FileMode
socketMode = (49152)
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
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
    where fileType = mode .&. (61440)
data FileSystemStats = FileSystemStats
    { fsStatBlockSize :: Integer
      
    , fsStatBlockCount :: Integer
      
    , fsStatBlocksFree :: Integer
      
    , fsStatBlocksAvailable :: Integer
      
    , fsStatFileCount :: Integer
      
    , fsStatFilesFree :: Integer
      
    , fsStatMaxNameLength :: Integer
      
    }
data SyncType
    = FullSync
    
    
    | DataSync
    
    deriving (Eq, Enum)
data FuseContext = FuseContext
    { fuseCtxUserID :: UserID
    , fuseCtxGroupID :: GroupID
    , fuseCtxProcessID :: ProcessID
    }
getFuseContext :: IO FuseContext
getFuseContext =
    do pCtx <- fuse_get_context
       userID <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pCtx
       groupID <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pCtx
       processID <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) pCtx
       return $ FuseContext { fuseCtxUserID = userID
                            , fuseCtxGroupID = groupID
                            , fuseCtxProcessID = processID
                            }
data FuseOperations fh = FuseOperations
      { 
        
        fuseGetFileStat :: FilePath -> IO (Either Errno FileStat),
        
        
        
        fuseReadSymbolicLink :: FilePath -> IO (Either Errno FilePath),
        
        
        fuseCreateDevice :: FilePath -> EntryType -> FileMode
                         -> DeviceID -> IO Errno,
        
        
        fuseCreateDirectory :: FilePath -> FileMode -> IO Errno,
        
        fuseRemoveLink :: FilePath -> IO Errno,
        
        
        fuseRemoveDirectory :: FilePath -> IO Errno,
        
        
        fuseCreateSymbolicLink :: FilePath -> FilePath -> IO Errno,
        
        fuseRename :: FilePath -> FilePath -> IO Errno,
        
        fuseCreateLink :: FilePath -> FilePath -> IO Errno,
        
        fuseSetFileMode :: FilePath -> FileMode -> IO Errno,
        
        
        fuseSetOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO Errno,
        
        fuseSetFileSize :: FilePath -> FileOffset -> IO Errno,
        
        
        fuseSetFileTimes :: FilePath -> EpochTime -> EpochTime -> IO Errno,
        
        
        
        
        
        
        
        
        fuseOpen :: FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh),
        
        
        
        
        
        fuseRead :: FilePath -> fh -> ByteCount -> FileOffset
                 -> IO (Either Errno B.ByteString),
        
        
        fuseWrite :: FilePath -> fh -> B.ByteString -> FileOffset
                  -> IO (Either Errno ByteCount),
        
        fuseGetFileSystemStats :: String -> IO (Either Errno FileSystemStats),
        
        
        
        
        fuseFlush :: FilePath -> fh -> IO Errno,
        
        
        
        
        
        
        fuseRelease :: FilePath -> fh -> IO (),
        
        fuseSynchronizeFile :: FilePath -> SyncType -> IO Errno,
        
        
        fuseOpenDirectory :: FilePath -> IO Errno,
        
        
        
        fuseReadDirectory :: FilePath -> IO (Either Errno [(FilePath, FileStat)]),
        
        fuseReleaseDirectory :: FilePath -> IO Errno,
        
        
        fuseSynchronizeDirectory :: FilePath -> SyncType -> IO Errno,
        
        
        
        
        fuseAccess :: FilePath -> Int -> IO Errno, 
        
        
        fuseInit :: IO (),
        
        fuseDestroy :: IO ()
      }
defaultFuseOps :: FuseOperations fh
defaultFuseOps =
    FuseOperations { fuseGetFileStat = \_ -> return (Left eNOSYS)
                   , fuseReadSymbolicLink = \_ -> return (Left eNOSYS)
                   , fuseCreateDevice = \_ _ _ _ ->  return eNOSYS
                   , fuseCreateDirectory = \_ _ -> return eNOSYS
                   , fuseRemoveLink = \_ -> return eNOSYS
                   , fuseRemoveDirectory = \_ -> return eNOSYS
                   , fuseCreateSymbolicLink = \_ _ -> return eNOSYS
                   , fuseRename = \_ _ -> return eNOSYS
                   , fuseCreateLink = \_ _ -> return eNOSYS
                   , fuseSetFileMode = \_ _ -> return eNOSYS
                   , fuseSetOwnerAndGroup = \_ _ _ -> return eNOSYS
                   , fuseSetFileSize = \_ _ -> return eNOSYS
                   , fuseSetFileTimes = \_ _ _ -> return eNOSYS
                   , fuseOpen =   \_ _ _   -> return (Left eNOSYS)
                   , fuseRead =   \_ _ _ _ -> return (Left eNOSYS)
                   , fuseWrite =  \_ _ _ _ -> return (Left eNOSYS)
                   , fuseGetFileSystemStats = \_ -> return (Left eNOSYS)
                   , fuseFlush = \_ _ -> return eOK
                   , fuseRelease = \_ _ -> return ()
                   , fuseSynchronizeFile = \_ _ -> return eNOSYS
                   , fuseOpenDirectory = \_ -> return eNOSYS
                   , fuseReadDirectory = \_ -> return (Left eNOSYS)
                   , fuseReleaseDirectory = \_ -> return eNOSYS
                   , fuseSynchronizeDirectory = \_ _ -> return eNOSYS
                   , fuseAccess = \_ _ -> return eNOSYS
                   , fuseInit = return ()
                   , fuseDestroy = return ()
                   }
withFuseArgs :: String -> [String] -> (Ptr CFuseArgs -> IO b) -> IO b
withFuseArgs prog args f =
    do let allArgs = (prog:args)
           argc = length allArgs
       withMany withCString allArgs (\ cArgs ->
           withArray cArgs $ (\ pArgv ->
               allocaBytes ((12)) (\ fuseArgs ->
                    do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) fuseArgs argc
                       ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) fuseArgs pArgv
                       ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fuseArgs (0::CInt)
                       finally (f fuseArgs)
                               (fuse_opt_free_args fuseArgs))))
withStructFuse :: forall e fh b. Exception e => Ptr CFuseChan -> Ptr CFuseArgs -> FuseOperations fh -> (e -> IO Errno) -> (Ptr CStructFuse -> IO b) -> IO b
withStructFuse pFuseChan pArgs ops handler f =
    allocaBytes ((164)) $ \ pOps -> do
      bzero pOps ((164))
      mkGetAttr    wrapGetAttr    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 0))    pOps
      mkReadLink   wrapReadLink   >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 4))   pOps 
      
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))    pOps nullPtr
      mkMkNod      wrapMkNod      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 12))      pOps 
      mkMkDir      wrapMkDir      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 16))      pOps 
      mkUnlink     wrapUnlink     >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 20))     pOps 
      mkRmDir      wrapRmDir      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 24))      pOps 
      mkSymLink    wrapSymLink    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 28))    pOps 
      mkRename     wrapRename     >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 32))     pOps 
      mkLink       wrapLink       >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 36))       pOps 
      mkChMod      wrapChMod      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 40))      pOps 
      mkChOwn      wrapChOwn      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 44))      pOps 
      mkTruncate   wrapTruncate   >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 48))   pOps 
      
      mkUTime      wrapUTime      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 52))      pOps 
      mkOpen       wrapOpen       >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 56))       pOps 
      mkRead       wrapRead       >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 60))       pOps 
      mkWrite      wrapWrite      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 64))      pOps 
      mkStatFS     wrapStatFS     >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 68))     pOps
      mkFlush      wrapFlush      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 72))      pOps
      mkRelease    wrapRelease    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 76))    pOps 
      mkFSync      wrapFSync      >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 80))      pOps
      
      ((\hsc_ptr -> pokeByteOff hsc_ptr 84))    pOps nullPtr
      ((\hsc_ptr -> pokeByteOff hsc_ptr 88))    pOps nullPtr
      ((\hsc_ptr -> pokeByteOff hsc_ptr 92))   pOps nullPtr
      ((\hsc_ptr -> pokeByteOff hsc_ptr 96)) pOps nullPtr
      mkOpenDir    wrapOpenDir    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 100))    pOps
      mkReadDir    wrapReadDir    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 104))    pOps
      mkReleaseDir wrapReleaseDir >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 108)) pOps
      mkFSyncDir   wrapFSyncDir   >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 112))   pOps
      mkAccess     wrapAccess     >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 124))     pOps
      mkInit       wrapInit       >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 116))       pOps
      mkDestroy    wrapDestroy    >>= ((\hsc_ptr -> pokeByteOff hsc_ptr 120))    pOps
      structFuse <- fuse_new pFuseChan pArgs pOps ((164)) nullPtr 
      if structFuse == nullPtr
        then fail ""
        else E.finally (f structFuse)
                       (fuse_destroy structFuse)
    where fuseHandler :: e -> IO CInt
          fuseHandler e = handler e >>= return . unErrno
          wrapGetAttr :: CGetAttr
          wrapGetAttr pFilePath pStat = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 eitherFileStat <- (fuseGetFileStat ops) filePath
                 case eitherFileStat of
                   Left (Errno errno) -> return ( errno)
                   Right stat         -> do fileStatToCStat stat pStat
                                            return okErrno
          wrapReadLink :: CReadLink
          wrapReadLink pFilePath pBuf bufSize = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 return ( unErrno eNOSYS)
                 eitherTarget <- (fuseReadSymbolicLink ops) filePath
                 case eitherTarget of
                   Left (Errno errno) -> return ( errno)
                   Right target ->
                   
                   
                     do pokeCStringLen0 (pBuf, (fromIntegral bufSize)) target
                        return okErrno
          wrapMkNod :: CMkNod
          wrapMkNod pFilePath mode dev = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseCreateDevice ops) filePath
                                      (fileModeToEntryType mode) mode dev
                 return ( errno)
          wrapMkDir :: CMkDir
          wrapMkDir pFilePath mode = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseCreateDirectory ops) filePath mode
                 return ( errno)
          wrapUnlink :: CUnlink
          wrapUnlink pFilePath = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseRemoveLink ops) filePath
                 return ( errno)
          wrapRmDir :: CRmDir
          wrapRmDir pFilePath = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseRemoveDirectory ops) filePath
                 return ( errno)
          wrapSymLink :: CSymLink
          wrapSymLink pSource pDestination = handle fuseHandler $
              do source <- peekCString pSource
                 destination <- peekCString pDestination
                 (Errno errno) <- (fuseCreateSymbolicLink ops) source destination
                 return ( errno)
          wrapRename :: CRename
          wrapRename pOld pNew = handle fuseHandler $
              do old <- peekCString pOld
                 new <- peekCString pNew
                 (Errno errno) <- (fuseRename ops) old new
                 return ( errno)
          wrapLink :: CLink
          wrapLink pSource pDestination = handle fuseHandler $
              do source <- peekCString pSource
                 destination <- peekCString pDestination
                 (Errno errno) <- (fuseCreateLink ops) source destination
                 return ( errno)
          wrapChMod :: CChMod
          wrapChMod pFilePath mode = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseSetFileMode ops) filePath mode
                 return ( errno)
          wrapChOwn :: CChOwn
          wrapChOwn pFilePath uid gid = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseSetOwnerAndGroup ops) filePath uid gid
                 return ( errno)
          wrapTruncate :: CTruncate
          wrapTruncate pFilePath off = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseSetFileSize ops) filePath off
                 return ( errno)
          wrapUTime :: CUTime
          wrapUTime pFilePath pUTimBuf = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 accessTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pUTimBuf
                 modificationTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pUTimBuf
                 (Errno errno) <- (fuseSetFileTimes ops) filePath
                                      accessTime modificationTime
                 return ( errno)
          wrapOpen :: COpen
          wrapOpen pFilePath pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (flags :: CInt) <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pFuseFileInfo
                 let append    = (1024)   .&. flags == (1024)
                     noctty    = (256)   .&. flags == (256)
                     nonBlock  = (2048) .&. flags == (2048)
                     how | (2) .&. flags == (2) = ReadWrite
                         | (1) .&. flags == (1) = WriteOnly
                         | otherwise = ReadOnly
                     openFileFlags = OpenFileFlags { append = append
                                                   , exclusive = False
                                                   , noctty = noctty
                                                   , nonBlock = nonBlock
                                                   , trunc = False
                                                   }
                 result <- (fuseOpen ops) filePath how openFileFlags
                 case result of
                    Left (Errno errno) -> return ( errno)
                    Right cval         -> do
                        sptr <- newStablePtr cval
                        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) pFuseFileInfo $ castStablePtrToPtr sptr
                        return okErrno
          wrapRead :: CRead
          wrapRead pFilePath pBuf bufSiz off pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 cVal <- getFH pFuseFileInfo
                 eitherRead <- (fuseRead ops) filePath cVal bufSiz off
                 case eitherRead of
                   Left (Errno errno) -> return ( errno)
                   Right bytes  -> 
                     do let len = fromIntegral bufSiz `min` B.length bytes
                        bsToBuf pBuf bytes len
                        return (fromIntegral len)
          wrapWrite :: CWrite
          wrapWrite pFilePath pBuf bufSiz off pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 cVal <- getFH pFuseFileInfo
                 buf  <- B.packCStringLen (pBuf, fromIntegral bufSiz)
                 eitherBytes <- (fuseWrite ops) filePath cVal buf off
                 case eitherBytes of
                   Left  (Errno errno) -> return ( errno)
                   Right bytes         -> return (fromIntegral bytes)
          wrapStatFS :: CStatFS
          wrapStatFS pStr pStatFS = handle fuseHandler $
            do str <- peekCString pStr
               eitherStatFS <- (fuseGetFileSystemStats ops) str
               case eitherStatFS of
                 Left (Errno errno) -> return ( errno)
                 Right stat         ->
                   do ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) pStatFS
                          (fromIntegral (fsStatBlockSize stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pStatFS
                          (fromIntegral (fsStatBlockCount stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) pStatFS
                          (fromIntegral (fsStatBlocksFree stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) pStatFS
                          (fromIntegral (fsStatBlocksAvailable
                                             stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) pStatFS
                           (fromIntegral (fsStatFileCount stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) pStatFS
                          (fromIntegral (fsStatFilesFree stat) :: (Int32))
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) pStatFS
                          (fromIntegral (fsStatMaxNameLength stat) :: (Int32))
                      return 0
          wrapFlush :: CFlush
          wrapFlush pFilePath pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 cVal     <- getFH pFuseFileInfo
                 (Errno errno) <- (fuseFlush ops) filePath cVal
                 return ( errno)
          wrapRelease :: CRelease
          wrapRelease pFilePath pFuseFileInfo = E.finally (handle fuseHandler $
              do filePath <- peekCString pFilePath
                 cVal     <- getFH pFuseFileInfo
                 
                 (fuseRelease ops) filePath cVal
                 return 0) (delFH pFuseFileInfo)
          wrapFSync :: CFSync
          wrapFSync pFilePath isFullSync pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseSynchronizeFile ops)
                                      filePath (toEnum isFullSync)
                 return ( errno)
          wrapOpenDir :: COpenDir
          wrapOpenDir pFilePath pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 
                 (Errno errno) <- (fuseOpenDirectory ops) filePath
                 return ( errno)
          wrapReadDir :: CReadDir
          wrapReadDir pFilePath pBuf pFillDir off pFuseFileInfo =
            handle fuseHandler $ do
              filePath <- peekCString pFilePath
              let fillDir = mkFillDir pFillDir
              let filler :: (FilePath, FileStat) -> IO ()
                  filler (fileName, fileStat) =
                    withCString fileName $ \ pFileName ->
                      allocaBytes ((96)) $ \ pFileStat ->
                        do fileStatToCStat fileStat pFileStat
                           fillDir pBuf pFileName pFileStat 0
                           
                           
                           return ()
              eitherContents <- (fuseReadDirectory ops) filePath 
              case eitherContents of
                Left (Errno errno) -> return ( errno)
                Right contents     -> mapM filler contents >> return okErrno
          wrapReleaseDir :: CReleaseDir
          wrapReleaseDir pFilePath pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseReleaseDirectory ops) filePath
                 return ( errno)
          wrapFSyncDir :: CFSyncDir
          wrapFSyncDir pFilePath isFullSync pFuseFileInfo = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseSynchronizeDirectory ops)
                                      filePath (toEnum isFullSync)
                 return ( errno)
          wrapAccess :: CAccess
          wrapAccess pFilePath at = handle fuseHandler $
              do filePath <- peekCString pFilePath
                 (Errno errno) <- (fuseAccess ops) filePath (fromIntegral at)
                 return ( errno)
          wrapInit :: CInit
          wrapInit pFuseConnInfo =
            handle (\e -> defaultExceptionHandler e >> return nullPtr) $
              do fuseInit ops
                 return nullPtr
          wrapDestroy :: CDestroy
          wrapDestroy _ = handle (\e -> defaultExceptionHandler e >> return ()) $
              do fuseDestroy ops
defaultExceptionHandler :: (SomeException -> IO Errno)
defaultExceptionHandler e = hPutStrLn stderr (show e) >> return eFAULT
fuseParseCommandLine :: Ptr CFuseArgs -> IO (Maybe (Maybe String, Bool, Bool))
fuseParseCommandLine pArgs = 
    alloca (\pMountPt -> 
        alloca (\pMultiThreaded ->
            alloca (\pFG ->
                do poke pMultiThreaded 0
                   poke pFG 0
                   retval <- fuse_parse_cmdline pArgs pMountPt pMultiThreaded pFG
                   if retval == 0
                     then do cMountPt <- peek pMountPt
                             mountPt <- if cMountPt /= nullPtr
                                          then do a <- peekCString cMountPt
                                                  free cMountPt
                                                  return $ Just a
                                          else return $ Nothing
                             multiThreaded <- peek pMultiThreaded
                             foreground <- peek pFG
                             return $ Just (mountPt, multiThreaded == 1, foreground == 1)
                     else return Nothing)))
daemon f = forkProcess d >> exitImmediately ExitSuccess
  where d = IO.catch (do createSession
                         changeWorkingDirectory "/"
                         
                         withFile "/dev/null" WriteMode (\devNullOut ->
                           do hDuplicateTo devNullOut stdout
                              hDuplicateTo devNullOut stderr)
                         withFile "/dev/null" ReadMode (\devNullIn -> hDuplicateTo devNullIn stdin)
                         f
                         exitWith ExitSuccess)
                     (const exitFailure)
withSignalHandlers exitHandler f =
    do let sigHandler = Signals.CatchOnce exitHandler
       Signals.installHandler Signals.keyboardSignal sigHandler Nothing
       Signals.installHandler Signals.lostConnection sigHandler Nothing
       Signals.installHandler Signals.softwareTermination sigHandler Nothing
       Signals.installHandler Signals.openEndedPipe Signals.Ignore Nothing
       E.finally f
                 (do Signals.installHandler Signals.keyboardSignal Signals.Default Nothing
                     Signals.installHandler Signals.lostConnection Signals.Default Nothing
                     Signals.installHandler Signals.softwareTermination Signals.Default Nothing
                     Signals.installHandler Signals.openEndedPipe Signals.Default Nothing)
fuseMainReal foreground ops handler pArgs mountPt =
    withCString mountPt (\cMountPt ->
      do pFuseChan <- fuse_mount cMountPt pArgs
         if pFuseChan == nullPtr
           then exitFailure 
           else (withStructFuse pFuseChan pArgs ops handler (\pFuse ->
                  E.finally 
                     (if foreground 
                       then changeWorkingDirectory "/" >> (procMain pFuse)
                       else daemon (procMain pFuse))
                     (fuse_unmount cMountPt pFuseChan))))
    
    where procMain pFuse = do session <- fuse_get_session pFuse
                              
                              
                              
                              
                              
                              withSignalHandlers (fuse_session_exit session) $
                                 do retVal <- fuse_loop_mt pFuse
                                    if retVal == 1 
                                      then exitWith ExitSuccess
                                      else exitFailure
                                    return ()
fuseMain :: Exception e => FuseOperations fh -> (e -> IO Errno) -> IO ()
fuseMain ops handler = do
    
    
    
    
    prog <- getProgName
    args <- getArgs
    fuseRun prog args ops handler
fuseRun :: String -> [String] -> Exception e => FuseOperations fh -> (e -> IO Errno) -> IO ()
fuseRun prog args ops handler =
    IO.catch
       (withFuseArgs prog args (\pArgs ->
         do cmd <- fuseParseCommandLine pArgs
            case cmd of
              Nothing -> fail ""
              Just (Nothing, _, _) -> fail "Usage error: mount point required"
              Just (Just mountPt, _, foreground) -> fuseMainReal foreground ops handler pArgs mountPt))
       ((\errStr -> when (not $ null errStr) (putStrLn errStr) >> exitFailure) . IO.ioeGetErrorString)
unErrno :: Errno -> CInt
unErrno (Errno errno) = errno
okErrno :: CInt
okErrno = unErrno eOK
pokeCStringLen :: CStringLen -> String -> IO ()
pokeCStringLen (pBuf, bufSize) src =
    pokeArray pBuf $ take bufSize $ map castCharToCChar src
pokeCStringLen0 :: CStringLen -> String -> IO ()
pokeCStringLen0 (pBuf, bufSize) src =
    pokeArray0 0 pBuf $ take (bufSize  1) $ map castCharToCChar src
data CFuseArgs 
data CFuseChan 
foreign import ccall safe "fuse.h fuse_mount"
    fuse_mount :: CString -> Ptr CFuseArgs -> IO (Ptr CFuseChan)
foreign import ccall safe "fuse.h fuse_unmount"
    fuse_unmount :: CString -> Ptr CFuseChan -> IO ()
data CFuseSession 
foreign import ccall safe "fuse.h fuse_get_session"
    fuse_get_session :: Ptr CStructFuse -> IO (Ptr CFuseSession)
foreign import ccall safe "fuse.h fuse_session_exit"
    fuse_session_exit :: Ptr CFuseSession -> IO ()
foreign import ccall safe "fuse.h fuse_set_signal_handlers"
    fuse_set_signal_handlers :: Ptr CFuseSession -> IO Int
foreign import ccall safe "fuse.h fuse_remove_signal_handlers"
    fuse_remove_signal_handlers :: Ptr CFuseSession -> IO ()
foreign import ccall safe "fuse.h fuse_parse_cmdline"
    fuse_parse_cmdline :: Ptr CFuseArgs -> Ptr CString -> Ptr Int -> Ptr Int -> IO Int
data CStructFuse 
data CFuseOperations 
foreign import ccall safe "fuse.h fuse_new"
    fuse_new :: Ptr CFuseChan -> Ptr CFuseArgs -> Ptr CFuseOperations -> Int -> Ptr () -> IO (Ptr CStructFuse)
foreign import ccall safe "fuse.h fuse_destroy"
    fuse_destroy :: Ptr CStructFuse -> IO ()
foreign import ccall safe "fuse.h fuse_opt_free_args"
    fuse_opt_free_args :: Ptr CFuseArgs -> IO ()
foreign import ccall safe "fuse.h fuse_loop_mt"
    fuse_loop_mt :: Ptr CStructFuse -> IO Int
data CFuseContext
foreign import ccall safe "fuse.h fuse_get_context"
    fuse_get_context :: IO (Ptr CFuseContext)
data CFuseFileInfo 
data CFuseConnInfo 
data CStat 
type CGetAttr = CString -> Ptr CStat -> IO CInt
foreign import ccall safe "wrapper"
    mkGetAttr :: CGetAttr -> IO (FunPtr CGetAttr)
type CReadLink = CString -> CString -> CSize -> IO CInt
foreign import ccall safe "wrapper"
    mkReadLink :: CReadLink -> IO (FunPtr CReadLink)
type CMkNod = CString -> CMode -> CDev -> IO CInt
foreign import ccall safe "wrapper"
    mkMkNod :: CMkNod -> IO (FunPtr CMkNod)
type CMkDir = CString -> CMode -> IO CInt
foreign import ccall safe "wrapper"
    mkMkDir :: CMkDir -> IO (FunPtr CMkDir)
type CUnlink = CString -> IO CInt
foreign import ccall safe "wrapper"
    mkUnlink :: CUnlink -> IO (FunPtr CUnlink)
type CRmDir = CString -> IO CInt
foreign import ccall safe "wrapper"
    mkRmDir :: CRmDir -> IO (FunPtr CRmDir)
type CSymLink = CString -> CString -> IO CInt
foreign import ccall safe "wrapper"
    mkSymLink :: CSymLink -> IO (FunPtr CSymLink)
type CRename = CString -> CString -> IO CInt
foreign import ccall safe "wrapper"
    mkRename :: CRename -> IO (FunPtr CRename)
type CLink = CString -> CString -> IO CInt
foreign import ccall safe "wrapper"
    mkLink :: CLink -> IO (FunPtr CLink)
type CChMod = CString -> CMode -> IO CInt
foreign import ccall safe "wrapper"
    mkChMod :: CChMod -> IO (FunPtr CChMod)
type CChOwn = CString -> CUid -> CGid -> IO CInt
foreign import ccall safe "wrapper"
    mkChOwn :: CChOwn -> IO (FunPtr CChOwn)
type CTruncate = CString -> COff -> IO CInt
foreign import ccall safe "wrapper"
    mkTruncate :: CTruncate -> IO (FunPtr CTruncate)
data CUTimBuf 
type CUTime = CString -> Ptr CUTimBuf -> IO CInt
foreign import ccall safe "wrapper"
    mkUTime :: CUTime -> IO (FunPtr CUTime)
type COpen = CString -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkOpen :: COpen -> IO (FunPtr COpen)
type CRead = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkRead :: CRead -> IO (FunPtr CRead)
type CWrite = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkWrite :: CWrite -> IO (FunPtr CWrite)
data CStructStatFS 
type CStatFS = CString -> Ptr CStructStatFS -> IO CInt
foreign import ccall safe "wrapper"
    mkStatFS :: CStatFS -> IO (FunPtr CStatFS)
type CFlush = CString -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkFlush :: CFlush -> IO (FunPtr CFlush)
type CRelease = CString -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkRelease :: CRelease -> IO (FunPtr CRelease)
type CFSync = CString -> Int -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkFSync :: CFSync -> IO (FunPtr CFSync) 
type COpenDir = CString -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkOpenDir :: COpenDir -> IO (FunPtr COpenDir)
type CReadDir = CString -> Ptr CFillDirBuf -> FunPtr CFillDir -> COff
             -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkReadDir :: CReadDir -> IO (FunPtr CReadDir)
type CReleaseDir = CString -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkReleaseDir :: CReleaseDir -> IO (FunPtr CReleaseDir)
type CFSyncDir = CString -> Int -> Ptr CFuseFileInfo -> IO CInt
foreign import ccall safe "wrapper"
    mkFSyncDir :: CFSyncDir -> IO (FunPtr CFSyncDir)
type CAccess = CString -> CInt -> IO CInt
foreign import ccall safe "wrapper"
    mkAccess :: CAccess -> IO (FunPtr CAccess)
type CInit = Ptr CFuseConnInfo -> IO (Ptr CInt)
foreign import ccall safe "wrapper"
    mkInit :: CInit -> IO (FunPtr CInit)
type CDestroy = Ptr CInt -> IO ()
foreign import ccall safe "wrapper"
    mkDestroy :: CDestroy -> IO (FunPtr CDestroy)
bsToBuf :: Ptr a -> B.ByteString -> Int -> IO ()
bsToBuf dst bs len = do
  let l = fromIntegral $ min len $ B.length bs
  B.unsafeUseAsCString bs $ \src -> B.memcpy (castPtr dst) (castPtr src) l
  return ()
getFH pFuseFileInfo = do
  sptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) pFuseFileInfo
  cVal <- deRefStablePtr $ castPtrToStablePtr sptr
  return cVal
delFH pFuseFileInfo = do
  sptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) pFuseFileInfo
  freeStablePtr $ castPtrToStablePtr sptr
data CDirHandle 
type CDirFil = Ptr CDirHandle -> CString -> Int -> IO CInt 
foreign import ccall safe "dynamic"
    mkDirFil :: FunPtr CDirFil -> CDirFil
data CFillDirBuf 
type CFillDir = Ptr CFillDirBuf -> CString -> Ptr CStat -> COff -> IO CInt
foreign import ccall safe "dynamic"
    mkFillDir :: FunPtr CFillDir -> CFillDir
foreign import ccall safe "bzero"
    bzero :: Ptr a -> Int -> IO ()