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