HFuse 0.1 → 0.2.1
raw patch · 9 files changed
+960/−1082 lines, 9 filesdep +bytestringnew-uploader
Dependencies added: bytestring
Files
- HFuse.cabal +20/−30
- LICENSE +10/−13
- README +0/−6
- System/Fuse.hsc +916/−0
- System/Posix/HFuse.hsc +0/−866
- System/Posix/HelloFS.hs +0/−89
- System/Posix/LiveFS.hs +0/−78
- fuse_wrappers.c +11/−0
- fuse_wrappers.h +3/−0
HFuse.cabal view
@@ -1,39 +1,29 @@ Name: HFuse-Version: 0.1+Version: 0.2.1 License: BSD3-License-File: LICENSE-Author: Jérémy Bobbio-Maintainer: Jérémy Bobbio <jeremy.bobbio@etu.upmc.fr>-Synopsis: HFuse is a binding for the Linux FUSE library-Description: HFuse is a binding to the Linux C library, FUSE ('Filesystems in Userspace');- FUSE allows you to construct interesting filesystems which can be used in many ways,- such as a filesystem in which the files are Wikipedia files, or SSHFS where one mounts remote- directories over SSH, or FlickrFS which represents your Flickr account as directories and files.-Homepage: http://darcs.haskell.org/hfuse+License-File: LICENSE+Author: Jeremy Bobbio+Maintainer: Taru Karttunen <taruti@taruti.net>+Synopsis: HFuse is a binding for the Linux FUSE library.+Homepage: http://code.haskell.org/hfuse Category: System Stability: Experimental- Cabal-Version: >= 1.2 Build-Type: Simple --- Examples-Extra-Source-Files: System/Posix/HelloFS.hs, System/Posix/LiveFS.hs-Data-Files: README- Library- exposed-Modules: System.Posix.HFuse-- -- FIX: Remove this:- Includes: sys/statfs.h, dirent.h, fuse.h, fcntl.h- Include-Dirs: /usr/include, /usr/local/include- Extra-Libraries: fuse- Extra-Lib-Dirs: /usr/local/lib-- Build-Depends: base, unix- Extensions: ForeignFunctionInterface, PatternSignatures, EmptyDataDecls- Ghc-Options: -threaded -O2 -Wall -optl-Wl,-s- Ghc-Prof-Options: -prof -auto-all+ Build-Depends: base, unix, bytestring+ exposed-Modules: System.Fuse+ Extensions: ForeignFunctionInterface PatternSignatures EmptyDataDecls+ Includes: sys/statfs.h, dirent.h, fuse.h, fcntl.h+ Include-Dirs: /usr/include, /usr/local/include, .+ Extra-Libraries: fuse+ Extra-Lib-Dirs: /usr/local/lib+ Includes: fuse_wrappers.h+ Install-Includes: fuse_wrappers.h+ C-Sources: fuse_wrappers.c+ CC-Options: -D_FILE_OFFSET_BITS=64+ if os(darwin) {+ CC-Options: "-DMACFUSE"+ } - -- When compiling for a 64-bit architecture, we need special flags for hsc2hs- if arch(x86_64)- cc-options: -D_FILE_OFFSET_BITS=64
LICENSE view
@@ -4,26 +4,23 @@ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:- 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.- 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors+3. Neither the name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
− README
@@ -1,6 +0,0 @@-HelloFS seems to work with:-* Linux 2.4.26-* The Glorious Glasgow Haskell Compilation System, version 6.2.2-* fuse-2.3--BindFS (?) is known to have a deadlock problem.
+ System/Fuse.hsc view
@@ -0,0 +1,916 @@+-----------------------------------------------------------------------------+-- |+-- Module : System.Fuse+-- Copyright : (c) Jérémy Bobbio+-- License : BSD-style+-- +-- Maintainer : jeremy.bobbio@etu.upmc.fr+-- Stability : experimental+-- Portability : GHC 6.4+--+-- A binding for the FUSE (Filesystem in USErspace) library+-- (<http://fuse.sourceforge.net/>), which allows filesystems to be implemented+-- as userspace processes.+--+-- The binding tries to follow as much as possible current Haskell POSIX+-- interface in "System.Posix.Files" and "System.Posix.Directory".+--+-- FUSE uses POSIX threads, so any Haskell application using this library must+-- be linked against a threaded runtime system (eg. using the @threaded@ GHC+-- option).+--+-----------------------------------------------------------------------------+module System.Fuse+ ( -- * Using FUSE++ -- $intro++ module Foreign.C.Error+ , FuseOperations(..)+ , defaultFuseOps+ , fuseMain -- :: FuseOperations -> (Exception -> IO Errno) -> IO ()+ , defaultExceptionHandler -- :: Exception -> IO Errno+ -- * Operations datatypes+ , FileStat(..)+ , EntryType(..)+ , FileSystemStats(..)+ , SyncType(..)+ -- * FUSE Context+ , getFuseContext -- :: IO FuseContext+ , FuseContext(fuseCtxUserID, fuseCtxGroupID, fuseCtxProcessID)+ -- * File modes+ , entryTypeToFileMode -- :: EntryType -> FileMode+ , OpenMode(..)+ , OpenFileFlags(..)+ , intersectFileModes -- :: FileMode+ , unionFileModes -- :: FileMode+ ) where++import Prelude hiding ( Read )++import Control.Exception as E( Exception, handle, finally )+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 )+import System.Posix.Types+import System.Posix.Files ( accessModes, intersectFileModes, unionFileModes )+import System.Posix.IO ( OpenMode(..), OpenFileFlags(..) )++-- TODO: FileMode -> Permissions+-- TODO: Arguments !+-- TODO: implement binding to fuse_invalidate+-- TODO: bind fuse_*xattr++#define FUSE_USE_VERSION 26++#ifdef MACFUSE+#include <sys/mount.h>+#else+#include <sys/statfs.h>+#endif++#include <dirent.h>+#include <fuse.h>+#include <fcntl.h>++#include "fuse_wrappers.h"++{- $intro+'FuseOperations' contains a field for each filesystem operations that can be called+by FUSE. Think like if you were implementing a file system inside the Linux kernel.++Each actions must return a POSIX error code, also called 'Errno' reflecting+operation result. For actions not using 'Either', you should return 'eOK' in case+of success.++Read and writes are done with Haskell 'ByteString' type.++-}++{- All operations should return the negated error value (-errno) on+ error.+-}++{- | Used by 'fuseGetFileStat'. Corresponds to @struct stat@ from @stat.h@;+ @st_dev@, @st_ino@ and @st_blksize@ are omitted, since (from the libfuse+ documentation): \"the @st_dev@ and @st_blksize@ fields are ignored. The+ @st_ino@ field is ignored except if the use_ino mount option is given.\"++ /TODO: at some point the inode field will probably be needed./+-}+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++{- FIXME: I don't know how to determine the alignment of struct stat without+ - making unportable assumptions about the order of elements within it. Hence,+ - FileStat is not an instance of Storable. But it should be, rather than this+ - next function existing!+ -}++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) :: (#type blkcnt_t))+ (#poke struct stat, st_mode) pStat mode+ (#poke struct stat, st_nlink) pStat (statLinkCount stat)+ (#poke struct stat, st_uid) pStat (statFileOwner stat)+ (#poke struct stat, st_gid) pStat (statFileGroup stat)+ (#poke struct stat, st_rdev) pStat (statSpecialDeviceID stat)+ (#poke struct stat, st_size) pStat (statFileSize stat)+ (#poke struct stat, st_blocks) pStat block_count+ (#poke struct stat, st_atime) pStat (statAccessTime stat)+ (#poke struct stat, st_mtime) pStat (statModificationTime stat)+ (#poke struct stat, st_ctime) pStat (statStatusChangeTime stat)+++-- | The Unix type of a node in the filesystem.+data EntryType+ = Unknown -- ^ Unknown entry type+ | NamedPipe+ | CharacterSpecial+ | Directory+ | BlockSpecial+ | RegularFile+ | SymbolicLink+ | Socket+ deriving(Show)++entryTypeToDT :: EntryType -> Int+entryTypeToDT Unknown = (#const DT_UNKNOWN)+entryTypeToDT NamedPipe = (#const DT_FIFO)+entryTypeToDT CharacterSpecial = (#const DT_CHR)+entryTypeToDT Directory = (#const DT_DIR)+entryTypeToDT BlockSpecial = (#const DT_BLK)+entryTypeToDT RegularFile = (#const DT_REG)+entryTypeToDT SymbolicLink = (#const DT_LNK)+entryTypeToDT Socket = (#const DT_SOCK)++fileTypeModes :: FileMode+fileTypeModes = (#const S_IFMT)++blockSpecialMode :: FileMode+blockSpecialMode = (#const S_IFBLK)++characterSpecialMode :: FileMode+characterSpecialMode = (#const S_IFCHR)++namedPipeMode :: FileMode+namedPipeMode = (#const S_IFIFO)++regularFileMode :: FileMode+regularFileMode = (#const S_IFREG)++directoryMode :: FileMode+directoryMode = (#const S_IFDIR)++symbolicLinkMode :: FileMode+symbolicLinkMode = (#const S_IFLNK)++socketMode :: FileMode+socketMode = (#const S_IFSOCK)++-- | 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++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 .&. (#const S_IFMT)++{-+ There is no create() operation, mknod() will be called for+ creation of all non directory, non symlink nodes.+-}++-- | Type used by the 'fuseGetFileSystemStats'.+data FileSystemStats = FileSystemStats+ { fsStatBlockSize :: Integer+ -- ^ Optimal transfer block size. FUSE default is 512.+ , fsStatBlockCount :: Integer+ -- ^ Total data blocks in file system.+ , fsStatBlocksFree :: Integer+ -- ^ Free blocks in file system.+ , fsStatBlocksAvailable :: Integer+ -- ^ Free blocks available to non-superusers.+ , fsStatFileCount :: Integer+ -- ^ Total file nodes in file system.+ , fsStatFilesFree :: Integer+ -- ^ Free file nodes in file system.+ , fsStatMaxNameLength :: Integer+ -- ^ Maximum length of filenames. FUSE default is 255.+ }+++-- | Used by 'fuseSynchronizeFile' and 'fuseSynchronizeDirectory'.+data SyncType+ = FullSync+ -- ^ Synchronize all in-core parts of a file to disk: file content and+ -- metadata.+ | DataSync+ -- ^ Synchronize only the file content.+ deriving (Eq, Enum)+++-- | Returned by 'getFuseContext'.+data FuseContext = FuseContext+ { fuseCtxUserID :: UserID+ , fuseCtxGroupID :: GroupID+ , fuseCtxProcessID :: ProcessID+ }++-- | Returns the context of the program doing the current FUSE call.+getFuseContext :: IO FuseContext+getFuseContext =+ do pCtx <- fuse_get_context+ userID <- (#peek struct fuse_context, uid) pCtx+ groupID <- (#peek struct fuse_context, gid) pCtx+ processID <- (#peek struct fuse_context, pid) pCtx+ return $ FuseContext { fuseCtxUserID = userID+ , fuseCtxGroupID = groupID+ , fuseCtxProcessID = processID+ }++-- | This record, given to 'fuseMain', binds each required file system+-- operations.+--+-- Each field is named against 'System.Posix' names. Matching Linux system+-- calls are also given as a reference.+--+-- @fh@ is the file handle type returned by 'fuseOpen' and subsequently passed+-- to all other file operations.+data FuseOperations fh = FuseOperations+ { -- | Implements 'System.Posix.Files.getSymbolicLinkStatus' operation+ -- (POSIX @lstat(2)@).+ fuseGetFileStat :: FilePath -> IO (Either Errno FileStat),++ -- | Implements 'System.Posix.Files.readSymbolicLink' operation (POSIX+ -- @readlink(2)@). The returned 'FilePath' might be truncated+ -- depending on caller buffer size.+ fuseReadSymbolicLink :: FilePath -> IO (Either Errno FilePath),++ -- | Implements 'System.Posix.Files.createDevice' (POSIX @mknod(2)@).+ -- This function will also be called for regular file creation.+ fuseCreateDevice :: FilePath -> EntryType -> FileMode+ -> DeviceID -> IO Errno,++ -- | Implements 'System.Posix.Directory.createDirectory' (POSIX+ -- @mkdir(2)@).+ fuseCreateDirectory :: FilePath -> FileMode -> IO Errno,++ -- | Implements 'System.Posix.Files.removeLink' (POSIX @unlink(2)@).+ fuseRemoveLink :: FilePath -> IO Errno,++ -- | Implements 'System.Posix.Directory.removeDirectory' (POSIX+ -- @rmdir(2)@).+ fuseRemoveDirectory :: FilePath -> IO Errno,++ -- | Implements 'System.Posix.Files.createSymbolicLink' (POSIX+ -- @symlink(2)@).+ fuseCreateSymbolicLink :: FilePath -> FilePath -> IO Errno,++ -- | Implements 'System.Posix.Files.rename' (POSIX @rename(2)@).+ fuseRename :: FilePath -> FilePath -> IO Errno,++ -- | Implements 'System.Posix.Files.createLink' (POSIX @link(2)@).+ fuseCreateLink :: FilePath -> FilePath -> IO Errno,++ -- | Implements 'System.Posix.Files.setFileMode' (POSIX @chmod(2)@).+ fuseSetFileMode :: FilePath -> FileMode -> IO Errno,++ -- | Implements 'System.Posix.Files.setOwnerAndGroup' (POSIX+ -- @chown(2)@).+ fuseSetOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO Errno,++ -- | Implements 'System.Posix.Files.setFileSize' (POSIX @truncate(2)@).+ fuseSetFileSize :: FilePath -> FileOffset -> IO Errno,++ -- | Implements 'System.Posix.Files.setFileTimes'+ -- (POSIX @utime(2)@).+ fuseSetFileTimes :: FilePath -> EpochTime -> EpochTime -> 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'.+ --+ -- No creation, exclusive access or truncating flags will be passed.+ -- This should check that the operation is permitted for the given+ -- flags.+ fuseOpen :: FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno fh),++ -- | Implements Unix98 @pread(2)@. It differs from+ -- 'System.Posix.Files.fdRead' by the explicit 'FileOffset' argument.+ -- The @fuse.h@ documentation stipulates that this \"should return+ -- exactly the number of bytes requested except on EOF or error,+ -- otherwise the rest of the data will be substituted with zeroes.\"+ fuseRead :: 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.+ fuseWrite :: FilePath -> fh -> B.ByteString -> FileOffset+ -> IO (Either Errno ByteCount),++ -- | Implements @statfs(2)@.+ fuseGetFileSystemStats :: 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 :: 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 :: FilePath -> fh -> IO (),++ -- | Implements @fsync(2)@.+ fuseSynchronizeFile :: FilePath -> SyncType -> IO Errno,++ -- | Implements @opendir(3)@. This method should check if the open+ -- operation is permitted for this directory.+ fuseOpenDirectory :: FilePath -> IO Errno,++ -- | 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@).+ fuseReadDirectory :: FilePath -> IO (Either Errno [(FilePath, FileStat)]),++ -- | Implements @closedir(3)@.+ fuseReleaseDirectory :: FilePath -> IO Errno,++ -- | Synchronize the directory's contents; analogous to+ -- 'fuseSynchronizeFile'.+ fuseSynchronizeDirectory :: FilePath -> SyncType -> IO Errno,++ -- | Check file access permissions; this will be called for the+ -- access() system call. 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+ fuseAccess :: FilePath -> Int -> IO Errno, -- FIXME present a nicer type to Haskell++ -- | Initializes the filesystem. This is called before all other+ -- operations.+ fuseInit :: IO (),++ -- | Called on filesystem exit to allow cleanup.+ fuseDestroy :: IO ()+ }++-- | Empty \/ default versions of the FUSE operations.+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 ()+ }+++-- | 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'.+-- +-- This function does the following:+--+-- * parses command line options (@-d@, @-s@ and @-h@) ;+--+-- * passes all options after @--@ to the fusermount program ;+--+-- * mounts the filesystem by calling @fusermount@ ;+--+-- * installs signal handlers for 'System.Posix.Signals.keyboardSignal',+-- 'System.Posix.Signals.lostConnection',+-- 'System.Posix.Signals.softwareTermination' and+-- 'System.Posix.Signals.openEndedPipe' ;+--+-- * registers an exit handler to unmount the filesystem on program exit ;+--+-- * registers the operations ;+--+-- * calls FUSE event loop.+fuseMain :: FuseOperations fh -> (Exception -> IO Errno) -> IO ()+fuseMain ops handler =+ allocaBytes (#size struct fuse_operations) $ \ pOps -> do+ mkGetAttr wrapGetAttr >>= (#poke struct fuse_operations, getattr) pOps+ mkReadLink wrapReadLink >>= (#poke struct fuse_operations, readlink) pOps + -- getdir is deprecated and thus unsupported+ (#poke struct fuse_operations, getdir) pOps nullPtr+ mkMkNod wrapMkNod >>= (#poke struct fuse_operations, mknod) pOps + mkMkDir wrapMkDir >>= (#poke struct fuse_operations, mkdir) pOps + mkUnlink wrapUnlink >>= (#poke struct fuse_operations, unlink) pOps + mkRmDir wrapRmDir >>= (#poke struct fuse_operations, rmdir) pOps + mkSymLink wrapSymLink >>= (#poke struct fuse_operations, symlink) pOps + mkRename wrapRename >>= (#poke struct fuse_operations, rename) pOps + mkLink wrapLink >>= (#poke struct fuse_operations, link) pOps + mkChMod wrapChMod >>= (#poke struct fuse_operations, chmod) pOps + mkChOwn wrapChOwn >>= (#poke struct fuse_operations, chown) pOps + mkTruncate wrapTruncate >>= (#poke struct fuse_operations, truncate) pOps + -- TODO: Deprecated, use utimens() instead.+ mkUTime wrapUTime >>= (#poke struct fuse_operations, utime) pOps + mkOpen wrapOpen >>= (#poke struct fuse_operations, open) pOps + mkRead wrapRead >>= (#poke struct fuse_operations, read) pOps + mkWrite wrapWrite >>= (#poke struct fuse_operations, write) pOps + mkStatFS wrapStatFS >>= (#poke struct fuse_operations, statfs) pOps+ mkFlush wrapFlush >>= (#poke struct fuse_operations, flush) pOps+ mkRelease wrapRelease >>= (#poke struct fuse_operations, release) pOps + mkFSync wrapFSync >>= (#poke struct fuse_operations, fsync) pOps+ -- TODO: Implement these+ (#poke struct fuse_operations, setxattr) pOps nullPtr+ (#poke struct fuse_operations, getxattr) pOps nullPtr+ (#poke struct fuse_operations, listxattr) pOps nullPtr+ (#poke struct fuse_operations, removexattr) pOps nullPtr+ mkOpenDir wrapOpenDir >>= (#poke struct fuse_operations, opendir) pOps+ mkReadDir wrapReadDir >>= (#poke struct fuse_operations, readdir) pOps+ mkReleaseDir wrapReleaseDir >>= (#poke struct fuse_operations, releasedir) pOps+ mkFSyncDir wrapFSyncDir >>= (#poke struct fuse_operations, fsyncdir) pOps+ mkAccess wrapAccess >>= (#poke struct fuse_operations, access) pOps+ mkInit wrapInit >>= (#poke struct fuse_operations, init) pOps+ mkDestroy wrapDestroy >>= (#poke struct fuse_operations, destroy) pOps+ prog <- getProgName+ args <- getArgs+ let allArgs = (prog:args)+ argc = length allArgs+ withMany withCString allArgs $ \ pAddrs ->+ withArray pAddrs $ \ pArgv ->+ do fuse_main_wrapper argc pArgv pOps+ where fuseHandler :: Exception -> 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 ->+ -- This will truncate target if it's longer than the buffer+ -- can hold, which is correct according to fuse.h+ 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 <- (#peek struct utimbuf, actime) pUTimBuf+ modificationTime <- (#peek struct utimbuf, modtime) pUTimBuf+ (Errno errno) <- (fuseSetFileTimes ops) filePath+ accessTime modificationTime+ return (- errno)+ wrapOpen :: COpen+ wrapOpen pFilePath pFuseFileInfo = handle fuseHandler $+ do filePath <- peekCString pFilePath+ (flags :: CInt) <- (#peek struct fuse_file_info, flags) pFuseFileInfo+ let append = (#const O_APPEND) .&. flags == (#const O_APPEND)+ noctty = (#const O_NOCTTY) .&. flags == (#const O_NOCTTY)+ nonBlock = (#const O_NONBLOCK) .&. flags == (#const O_NONBLOCK)+ how | (#const O_RDWR) .&. flags == (#const O_RDWR) = ReadWrite+ | (#const O_WRONLY) .&. flags == (#const O_WRONLY) = 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+ (#poke struct fuse_file_info, fh) 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 (#poke struct statfs, f_bsize) pStatFS+ (fromIntegral (fsStatBlockSize stat) :: (#type long))+ (#poke struct statfs, f_blocks) pStatFS+ (fromIntegral (fsStatBlockCount stat) :: (#type long))+ (#poke struct statfs, f_bfree) pStatFS+ (fromIntegral (fsStatBlocksFree stat) :: (#type long))+ (#poke struct statfs, f_bavail) pStatFS+ (fromIntegral (fsStatBlocksAvailable+ stat) :: (#type long))+ (#poke struct statfs, f_files) pStatFS+ (fromIntegral (fsStatFileCount stat) :: (#type long))+ (#poke struct statfs, f_ffree) pStatFS+ (fromIntegral (fsStatFilesFree stat) :: (#type long))+#ifndef MACFUSE+-- OSX doesn't support 'max name length'+ (#poke struct statfs, f_namelen) pStatFS+ (fromIntegral (fsStatMaxNameLength stat) :: (#type long))+#endif+ 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+ -- TODO: deal with these flags?+-- flags <- (#peek struct fuse_file_info, flags) 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+ -- XXX: Should we pass flags from pFuseFileInfo?+ (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 (#size struct stat) $ \ pFileStat ->+ do fileStatToCStat fileStat pFileStat+ fillDir pBuf pFileName pFileStat 0+ -- Ignoring return value of pFillDir, namely 1 if+ -- pBuff is full.+ return ()+ eitherContents <- (fuseReadDirectory ops) filePath -- XXX fileinfo+ 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 -> hPutStrLn stderr (show e) >> return nullPtr) $+ do fuseInit ops+ return nullPtr+ wrapDestroy :: CDestroy+ wrapDestroy _ = handle (\e -> hPutStrLn stderr (show e)) $+ do fuseDestroy ops++-- | Default exception handler.+-- Print the exception on error output and returns 'eFAULT'.+defaultExceptionHandler :: (Exception -> IO Errno)+defaultExceptionHandler e = hPutStrLn stderr (show e) >> return eFAULT+++-----------------------------------------------------------------------------+-- Miscellaneous utilities++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++-----------------------------------------------------------------------------+-- C land++---+-- exported C called from Haskell+--- ++data CFuseOperations+foreign import ccall threadsafe "fuse_wrappers.h fuse_main_wrapper"+ fuse_main_wrapper :: Int -> Ptr CString -> Ptr CFuseOperations -> IO ()++data StructFuse+foreign import ccall threadsafe "fuse.h fuse_get_context"+ fuse_get_context :: IO (Ptr StructFuse)++---+-- dynamic Haskell called from C+---++data CFuseFileInfo -- struct fuse_file_info+data CFuseConnInfo -- struct fuse_conn_info++data CStat -- struct stat+type CGetAttr = CString -> Ptr CStat -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkGetAttr :: CGetAttr -> IO (FunPtr CGetAttr)++type CReadLink = CString -> CString -> CSize -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkReadLink :: CReadLink -> IO (FunPtr CReadLink)++type CMkNod = CString -> CMode -> CDev -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkMkNod :: CMkNod -> IO (FunPtr CMkNod)++type CMkDir = CString -> CMode -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkMkDir :: CMkDir -> IO (FunPtr CMkDir)++type CUnlink = CString -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkUnlink :: CUnlink -> IO (FunPtr CUnlink)++type CRmDir = CString -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkRmDir :: CRmDir -> IO (FunPtr CRmDir)++type CSymLink = CString -> CString -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkSymLink :: CSymLink -> IO (FunPtr CSymLink)++type CRename = CString -> CString -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkRename :: CRename -> IO (FunPtr CRename)++type CLink = CString -> CString -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkLink :: CLink -> IO (FunPtr CLink)++type CChMod = CString -> CMode -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkChMod :: CChMod -> IO (FunPtr CChMod)++type CChOwn = CString -> CUid -> CGid -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkChOwn :: CChOwn -> IO (FunPtr CChOwn)++type CTruncate = CString -> COff -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkTruncate :: CTruncate -> IO (FunPtr CTruncate)++data CUTimBuf -- struct utimbuf+type CUTime = CString -> Ptr CUTimBuf -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkUTime :: CUTime -> IO (FunPtr CUTime)++type COpen = CString -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkOpen :: COpen -> IO (FunPtr COpen)++type CRead = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkRead :: CRead -> IO (FunPtr CRead)++type CWrite = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkWrite :: CWrite -> IO (FunPtr CWrite)++data CStructStatFS -- struct fuse_stat_fs+type CStatFS = CString -> Ptr CStructStatFS -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkStatFS :: CStatFS -> IO (FunPtr CStatFS)++type CFlush = CString -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkFlush :: CFlush -> IO (FunPtr CFlush)++type CRelease = CString -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkRelease :: CRelease -> IO (FunPtr CRelease)++type CFSync = CString -> Int -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkFSync :: CFSync -> IO (FunPtr CFSync) ++-- XXX add *xattr bindings++type COpenDir = CString -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkOpenDir :: COpenDir -> IO (FunPtr COpenDir)++type CReadDir = CString -> Ptr CFillDirBuf -> FunPtr CFillDir -> COff+ -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkReadDir :: CReadDir -> IO (FunPtr CReadDir)++type CReleaseDir = CString -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkReleaseDir :: CReleaseDir -> IO (FunPtr CReleaseDir)++type CFSyncDir = CString -> Int -> Ptr CFuseFileInfo -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkFSyncDir :: CFSyncDir -> IO (FunPtr CFSyncDir)++type CAccess = CString -> CInt -> IO CInt+foreign import ccall threadsafe "wrapper"+ mkAccess :: CAccess -> IO (FunPtr CAccess)++-- CInt because anything would be fine as we don't use them+type CInit = Ptr CFuseConnInfo -> IO (Ptr CInt)+foreign import ccall threadsafe "wrapper"+ mkInit :: CInit -> IO (FunPtr CInit)++type CDestroy = Ptr CInt -> IO ()+foreign import ccall threadsafe "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 ()++-- Get filehandle+getFH pFuseFileInfo = do+ sptr <- (#peek struct fuse_file_info, fh) pFuseFileInfo+ cVal <- deRefStablePtr $ castPtrToStablePtr sptr+ return cVal++delFH pFuseFileInfo = do+ sptr <- (#peek struct fuse_file_info, fh) pFuseFileInfo+ freeStablePtr $ castPtrToStablePtr sptr+++---+-- dynamic C called from Haskell+---++data CDirHandle -- fuse_dirh_t+type CDirFil = Ptr CDirHandle -> CString -> Int -> IO CInt -- fuse_dirfil_t+foreign import ccall threadsafe "dynamic"+ mkDirFil :: FunPtr CDirFil -> CDirFil++data CFillDirBuf -- void+type CFillDir = Ptr CFillDirBuf -> CString -> Ptr CStat -> COff -> IO CInt+foreign import ccall threadsafe "dynamic"+ mkFillDir :: FunPtr CFillDir -> CFillDir
− System/Posix/HFuse.hsc
@@ -1,866 +0,0 @@--------------------------------------------------------------------------------- |--- Module : System.Posix.HFuse--- Copyright : (c) Jérémy Bobbio--- License : BSD-style------ Maintainer : jeremy.bobbio@etu.upmc.fr--- Stability : experimental--- Portability : GHC 6.8------ HFuse is a binding for the FUSE (Filesystem in USErspace) library.------ See <http://fuse.sourceforge.net/>------ This library allow new filesystem implementation as simple user-land--- programs.------ The binding tries to follow as much as possible current Haskell POSIX--- interface in "System.Posix.Files" and "System.Posix.Directory".------ FUSE uses POSIX thread, thus Haskell implementation needs to be linked--- against a threaded runtime system (eg. using the @threaded@ GHC option).----------------------------------------------------------------------------------module System.Posix.HFuse- ( -- * Using FUSE-- -- $intro-- module Foreign.C.Error- , FuseOperations(..)- , defaultFuseOps- , fuseMain -- :: FuseOperations -> (Exception -> IO Errno) -> IO ()- , defaultExceptionHandler -- :: Exception -> IO Errno- -- * Operations datatypes- , FileStat(..)- , EntryType(..)- , FileSystemStats(..)- , SyncType(..)- -- * FUSE Context- , getFuseContext -- :: IO FuseContext- , FuseContext(fuseCtxUserID, fuseCtxGroupID, fuseCtxProcessID)- -- * File modes- , entryTypeToFileMode -- :: EntryType -> FileMode- , OpenMode(..)- , OpenFileFlags(..)- , intersectFileModes -- :: FileMode- , unionFileModes -- :: FileMode- ) where--import Prelude hiding ( Read )--import Control.Exception ( Exception, handle )-import Foreign-import Foreign.C-import Foreign.C.Error-import Foreign.Marshal-import System.Environment ( getProgName, getArgs )-import System.IO ( hPutStrLn, stderr )-import System.Posix.Types-import System.Posix.Files ( accessModes, intersectFileModes, unionFileModes )-import System.Posix.IO ( OpenMode(..), OpenFileFlags(..) )---- TODO: FileMode -> Permissions--- TODO: Arguments !--- TODO: implement binding to fuse_invalidate--- TODO: bind fuse_*xattr--#define FUSE_USE_VERSION 22--#include <sys/statfs.h>-#include <dirent.h>-#include <fuse.h>-#include <fcntl.h>--{- $intro-'FuseOperations' contains a field for each filesystem operations that can be called-by FUSE. Think like if you were implementing a file system inside the Linux kernel.--Each actions must return a POSIX error code, also called 'Errno' reflecting-operation relult. For actions not using 'Either', you should return 'eOK' in case-of success.--Read and writes are done with Haskell 'String' type. Even if this representation-is known to have drawbacks, the binding try to be coherent with current-Haskell libraries.---}--{- All operations should return the negated error value (-errno) on- error.--}---- | Used by 'fuseGetFileStat'.-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- }--{- getattr() doesn't need to fill in the following fields:- st_ino- st_dev- st_blksize--}--{- readlink() should fill the buffer with a null terminated string. The- buffer size argument includes the space for the terminating null- character. If the linkname is too long to fit in the buffer, it should- be truncated. The return value should be 0 for success.--}---- | Used by 'fuseGetDirectoryContents' implementation to specify the type of--- a directory entry.-data EntryType- = Unknown -- ^ Unknown entry type- | NamedPipe- | CharacterSpecial- | Directory- | BlockSpecial- | RegularFile- | SymbolicLink- | Socket--entryTypeToDT :: EntryType -> Int-entryTypeToDT Unknown = (#const DT_UNKNOWN)-entryTypeToDT NamedPipe = (#const DT_FIFO)-entryTypeToDT CharacterSpecial = (#const DT_CHR)-entryTypeToDT Directory = (#const DT_DIR)-entryTypeToDT BlockSpecial = (#const DT_BLK)-entryTypeToDT RegularFile = (#const DT_REG)-entryTypeToDT SymbolicLink = (#const DT_LNK)-entryTypeToDT Socket = (#const DT_SOCK)--fileTypeModes :: FileMode-fileTypeModes = (#const S_IFMT)--blockSpecialMode :: FileMode-blockSpecialMode = (#const S_IFBLK)--characterSpecialMode :: FileMode-characterSpecialMode = (#const S_IFCHR)--namedPipeMode :: FileMode-namedPipeMode = (#const S_IFIFO)--regularFileMode :: FileMode-regularFileMode = (#const S_IFREG)--directoryMode :: FileMode-directoryMode = (#const S_IFDIR)--symbolicLinkMode :: FileMode-symbolicLinkMode = (#const S_IFLNK)--socketMode :: FileMode-socketMode = (#const S_IFSOCK)---- | 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--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 .&. (#const S_IFMT)--{- getdir() is the opendir(), readdir(), ..., closedir() sequence- in one call. For each directory entry the filldir parameter should- be called.--}---{-- There is no create() operation, mknod() will be called for- creation of all non directory, non symlink nodes.--}--{- open() should not return a filehandle, but 0 on success. No- creation, or trunctation flags (O_CREAT, O_EXCL, O_TRUNC) will be- passed to open(). Open should only check if the operation is- permitted for the given flags.--}--{- read(), write() are not passed a filehandle, but rather a- pathname. The offset of the read and write is passed as the last- argument, like the pread() and pwrite() system calls. (NOTE:- read() should always return the number of bytes requested, except- at end of file)-- TODO: String type was used to mimic System.Posix.IO but it should change- after inclusion of better I/O system in Haskell libraries.--}--- | Type used by the 'fuseGetFileSystemStats'.-data FileSystemStats = FileSystemStats- { fsStatBlockSize :: Integer- -- ^ Optimal transfer block size. FUSE default is 512.- , fsStatBlockCount :: Integer- -- ^ Total data blocks in file system.- , fsStatBlocksFree :: Integer- -- ^ Free blocks in file system.- , fsStatBlocksAvailable :: Integer- -- ^ Free blocks available to non-superusers.- , fsStatFileCount :: Integer- -- ^ Total file nodes in file system.- , fsStatFilesFree :: Integer- -- ^ Free file nodes in file system.- , fsStatMaxNameLength :: Integer- -- ^ Maximum length of filenames. FUSE default is 255.- }---{- release() is called when an open file has:- 1) all file descriptors closed- 2)-all memory mappings unmapped- This call need only be implemented if this information is required,- otherwise set this function to NULL.-- TODO: Find out what these "flags" are (Int here).--}---- | Used by 'fuseSynchronizeFile'.-data SyncType- = FullSync- -- ^ Synchronize all in-core parts of a file to disk: file content and- -- metadata.- | DataSync- -- ^ Synchronize only the file content.- deriving (Eq, Enum)-{- fsync() has a boolean 'datasync' parameter which if TRUE then do- an fdatasync() operation.--}----- | Returned by 'getFuseContext'.-data FuseContext = FuseContext- { fuseCtxUserID :: UserID- , fuseCtxGroupID :: GroupID- , fuseCtxProcessID :: ProcessID- }---- | Returns the context of the program doing the current FUSE call.-getFuseContext :: IO FuseContext-getFuseContext =- do pCtx <- fuse_get_context- userID <- (#peek struct fuse_context, uid) pCtx- groupID <- (#peek struct fuse_context, gid) pCtx- processID <- (#peek struct fuse_context, pid) pCtx- return $ FuseContext { fuseCtxUserID = userID- , fuseCtxGroupID = groupID- , fuseCtxProcessID = processID- }---- | This record, given to 'fuseMain', binds each required file system operations.------ Each field is named against 'System.Posix' names. Matching Linux system calls--- are also given as a reference.------ * 'fuseGetFileStat' implements--- 'System.Posix.Files.getSymbolicLinkStatus' operation (POSIX @lstat(2)@).------ * 'fuseReadSymbolicLink' implements--- 'System.Posix.Files.readSymbolicLink' operation (POSIX @readlink(2)@).--- The returned 'FilePath' might be truncated depending on caller--- buffer size.------ * 'fuseGetDirectoryContents' implements--- 'System.Directory.getDirectoryContents' (POSIX @readddir(2)@).------ * 'fuseCreateDevice' implements 'System.Posix.Files.createDevice'--- (POSIX @mknod(2)@).--- This function will also be called for regular file creation.------ * 'fuseCreateDirectory' implements 'System.Posix.Directory.createDirectory'--- (POSIX @mkdir(2)@).------ * 'fuseRemoveLink' implements 'System.Posix.Files.removeLink'--- (POSIX @unlink(2)@).------ * 'fuseRemoveDirectory' implements 'System.Posix.Directory.removeDirectory'--- (POSIX @rmdir(2)@).------ * 'fuseCreateSymbolicLink' implements--- 'System.Posix.Files.createSymbolicLink' (POSIX @symlink(2)@).------ * 'fuseRename' implements 'System.Posix.Files.rename' (POSIX @rename(2)@).------ * 'fuseCreateLink' implements 'System.Posix.Files.createLink'--- (POSIX @link(2)@).------ * 'fuseSetFileMode' implements 'System.Posix.Files.setFileMode'--- (POSIX @chmod(2)@).------ * 'fuseSetOwnerAndGroup' implements 'System.Posix.Files.setOwnerAndGroup'--- (POSIX @chown(2)@).------ * 'fuseSetFileSize' implements 'System.Posix.Files.setFileSize'--- (POSIX @truncate(2)@).------ * 'fuseSetFileTimes' implements 'System.Posix.Files.setFileTimes'--- (POSIX @utime(2)@).------ * 'fuseOpen' implements 'System.Posix.Files.openFd'--- (POSIX @open(2)@), but this does not actually returns a file handle--- but 'eOK' if the operation is permitted with the given flags.--- No creation, exclusive access or truncating flags will be passed.------ * 'fuseRead' implements Unix98 @pread(2)@. It differs--- from 'System.Posix.Files.fdRead' by the explicit 'FileOffset' argument.------ * 'fuseWrite' implements Unix98 @pwrite(2)@. It differs--- from 'System.Posix.Files.fdWrite' by the explicit 'FileOffset' argument.------ * 'fuseGetFileSystemStats' implements @statfs(2)@.------ * 'fuseFlush' is 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.------ * 'fuseRelease' is 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.------ * 'fuseSynchronizeFile' implements @fsync(2)@.----data FuseOperations = FuseOperations- { fuseGetFileStat :: FilePath -> IO (Either Errno FileStat)- , fuseReadSymbolicLink :: FilePath -> IO (Either Errno FilePath)- , fuseGetDirectoryContents :: FilePath- -> IO (Either Errno [(FilePath, EntryType)])- , 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 Errno- , fuseRead :: FilePath -> ByteCount -> FileOffset- -> IO (Either Errno (String, ByteCount))- , fuseWrite :: FilePath -> String -> FileOffset- -> IO (Either Errno ByteCount)- , fuseGetFileSystemStats :: String -> IO (Either Errno FileSystemStats)- , fuseFlush :: FilePath -> IO Errno- , fuseRelease :: FilePath -> Int -> IO ()- , fuseSynchronizeFile :: FilePath -> SyncType -> IO Errno- , fuseOpenDirectory :: FilePath -> IO Errno- , fuseReleaseDirectory :: FilePath -> IO Errno- , fuseSynchronizeDirectory :: FilePath -> SyncType -> IO Errno- , fuseInit :: IO ()- , fuseDestroy :: IO ()- }---- |Empty / default versions of the FUSE operations.-defaultFuseOps :: FuseOperations-defaultFuseOps =- FuseOperations { fuseGetFileStat = \_ -> return (Left eNOSYS)- , fuseReadSymbolicLink = \_ -> return (Left eNOSYS)- , fuseGetDirectoryContents = \_ -> 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 eNOSYS- , fuseRead = \_ _ _ -> return (Left eNOSYS)- , fuseWrite = \_ _ _ -> return (Left eNOSYS)- , fuseGetFileSystemStats = \_ -> return (Left eNOSYS)- , fuseFlush = \_ -> return eOK- , fuseRelease = \_ _ -> return ()- , fuseSynchronizeFile = \_ _ -> return eNOSYS- , fuseOpenDirectory = \_ -> return eNOSYS- , fuseReleaseDirectory = \_ -> return eNOSYS- , fuseSynchronizeDirectory = \_ _ -> return eNOSYS- , fuseInit = return ()- , fuseDestroy = return ()- }----- | 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'.------ This function does the following:------ * parses command line options (@-d@, @-s@ and @-h@) ;------ * passes all options after @--@ to the fusermount program ;------ * mounts the filesystem by calling @fusermount@ ;------ * installs signal handlers for 'System.Posix.Signals.keyboardSignal',--- 'System.Posix.Signals.lostConnection',--- 'System.Posix.Signals.softwareTermination' and--- 'System.Posix.Signals.openEndedPipe' ;------ * registers an exit handler to unmount the filesystem on program exit ;------ * registers the operations ;------ * calls FUSE event loop.-fuseMain :: FuseOperations -> (Exception -> IO Errno) -> IO ()-fuseMain ops handler =- allocaBytes (#size struct fuse_operations) $ \ pOps -> do- mkGetAttr wrapGetAttr >>= (#poke struct fuse_operations, getattr) pOps- mkReadLink wrapReadLink >>= (#poke struct fuse_operations, readlink) pOps- -- FIXME: getdir is deprecated- mkGetDir wrapGetDir >>= (#poke struct fuse_operations, getdir) pOps- mkMkNod wrapMkNod >>= (#poke struct fuse_operations, mknod) pOps- mkMkDir wrapMkDir >>= (#poke struct fuse_operations, mkdir) pOps- mkUnlink wrapUnlink >>= (#poke struct fuse_operations, unlink) pOps- mkRmDir wrapRmDir >>= (#poke struct fuse_operations, rmdir) pOps- mkSymLink wrapSymLink >>= (#poke struct fuse_operations, symlink) pOps- mkRename wrapRename >>= (#poke struct fuse_operations, rename) pOps- mkLink wrapLink >>= (#poke struct fuse_operations, link) pOps- mkChMod wrapChMod >>= (#poke struct fuse_operations, chmod) pOps- mkChOwn wrapChOwn >>= (#poke struct fuse_operations, chown) pOps- mkTruncate wrapTruncate >>= (#poke struct fuse_operations, truncate) pOps- mkUTime wrapUTime >>= (#poke struct fuse_operations, utime) pOps- mkOpen wrapOpen >>= (#poke struct fuse_operations, open) pOps- mkRead wrapRead >>= (#poke struct fuse_operations, read) pOps- mkWrite wrapWrite >>= (#poke struct fuse_operations, write) pOps- mkStatFS wrapStatFS >>= (#poke struct fuse_operations, statfs) pOps- mkFlush wrapFlush >>= (#poke struct fuse_operations, flush) pOps- mkRelease wrapRelease >>= (#poke struct fuse_operations, release) pOps- mkFSync wrapFSync >>= (#poke struct fuse_operations, fsync) pOps- -- TODO: Implement these- (#poke struct fuse_operations, setxattr) pOps nullPtr- (#poke struct fuse_operations, getxattr) pOps nullPtr- (#poke struct fuse_operations, listxattr) pOps nullPtr- (#poke struct fuse_operations, removexattr) pOps nullPtr- mkOpenDir wrapOpenDir >>= (#poke struct fuse_operations, opendir) pOps- -- TODO: Implement mkReadDir- -- mkReadDir wrapReadDir >>= (#poke struct fuse_operations, readdir) pOps- (#poke struct fuse_operations, readdir) pOps nullPtr- mkReleaseDir wrapReleaseDir >>= (#poke struct fuse_operations, releasedir) pOps- mkFSyncDir wrapFSyncDir >>= (#poke struct fuse_operations, fsyncdir) pOps- mkInit wrapInit >>= (#poke struct fuse_operations, init) pOps- mkDestroy wrapDestroy >>= (#poke struct fuse_operations, destroy) pOps- prog <- getProgName- args <- getArgs- let allArgs = (prog:args)- argc = length allArgs- withMany withCString allArgs $ \ pAddrs ->- withArray pAddrs $ \ pArgv ->- do fuse_main_real argc pArgv pOps (#size struct fuse_operations)- where fuseHandler :: Exception -> 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 (#poke struct stat, st_mode) pStat- (entryTypeToFileMode (statEntryType stat)- `unionFileModes`- (statFileMode stat `intersectFileModes` accessModes))- (#poke struct stat, st_nlink) pStat (statLinkCount stat)- (#poke struct stat, st_uid) pStat (statFileOwner stat)- (#poke struct stat, st_gid) pStat (statFileGroup stat)- (#poke struct stat, st_rdev) pStat- (statSpecialDeviceID stat)- (#poke struct stat, st_size) pStat (statFileSize stat)- (#poke struct stat, st_blocks) pStat- (fromIntegral (statBlocks stat) :: (#type blkcnt_t))- (#poke struct stat, st_atime) pStat (statAccessTime stat)- (#poke struct stat, st_mtime) pStat- (statModificationTime stat)- (#poke struct stat, st_ctime) pStat- (statStatusChangeTime stat)- 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- wrapGetDir :: CGetDir- wrapGetDir pFilePath pDirHandle pDirFil = handle fuseHandler $- do filePath <- peekCString pFilePath- let filler (entryFilePath, entryType) =- withCString entryFilePath $ \ pEntryFilePath ->- (mkDirFil pDirFil) pDirHandle pEntryFilePath- (entryTypeToDT entryType) >>= return . Errno- eitherContents <- (fuseGetDirectoryContents ops) filePath- case eitherContents of- Left (Errno errno) -> return (- errno)- Right contents ->- do mapM_ filler contents- 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 <- (#peek struct utimbuf, actime) pUTimBuf- modificationTime <- (#peek struct utimbuf, modtime) pUTimBuf- (Errno errno) <- (fuseSetFileTimes ops) filePath- accessTime modificationTime- return (- errno)- wrapOpen :: COpen- wrapOpen pFilePath pFuseFileInfo = handle fuseHandler $- do filePath <- peekCString pFilePath- (flags :: CInt) <- (#peek struct fuse_file_info, flags) pFuseFileInfo- let append = (#const O_APPEND) .&. flags == (#const O_APPEND)- noctty = (#const O_NOCTTY) .&. flags == (#const O_NOCTTY)- nonBlock = (#const O_NONBLOCK) .&. flags == (#const O_NONBLOCK)- how | (#const O_RDWR) .&. flags == (#const O_RDWR) = ReadWrite- | (#const O_WRONLY) .&. flags == (#const O_WRONLY) = WriteOnly- | otherwise = ReadOnly- openFileFlags = OpenFileFlags { append = append- , exclusive = False- , noctty = noctty- , nonBlock = nonBlock- , trunc = False- }- (Errno errno) <- (fuseOpen ops) filePath how openFileFlags- return (- errno)- wrapRead :: CRead- wrapRead pFilePath pBuf bufSiz off pFuseFileInfo = handle fuseHandler $- do filePath <- peekCString pFilePath- eitherRead <- (fuseRead ops) filePath bufSiz off- case eitherRead of- Left (Errno errno) -> return (- errno)- Right (bytes, byteCount) ->- do pokeCStringLen (pBuf, fromIntegral byteCount) bytes- return (fromIntegral byteCount)- wrapWrite :: CWrite- wrapWrite pFilePath pBuf bufSiz off pFuseFileInfo = handle fuseHandler $- do filePath <- peekCString pFilePath- buf <- peekCStringLen (pBuf, fromIntegral bufSiz)- eitherBytes <- (fuseWrite ops) filePath 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 (#poke struct statfs, f_bsize) pStatFS- (fromIntegral (fsStatBlockSize stat) :: (#type long))- (#poke struct statfs, f_blocks) pStatFS- (fromIntegral (fsStatBlockCount stat) :: (#type long))- (#poke struct statfs, f_bfree) pStatFS- (fromIntegral (fsStatBlocksFree stat) :: (#type long))- (#poke struct statfs, f_bavail) pStatFS- (fromIntegral (fsStatBlocksAvailable- stat) :: (#type long))- (#poke struct statfs, f_files) pStatFS- (fromIntegral (fsStatFileCount stat) :: (#type long))- (#poke struct statfs, f_ffree) pStatFS- (fromIntegral (fsStatFilesFree stat) :: (#type long))- (#poke struct statfs, f_namelen) pStatFS- (fromIntegral (fsStatMaxNameLength stat) :: (#type long))- return 0- wrapFlush :: CFlush- wrapFlush pFilePath pFuseFileInfo = handle fuseHandler $- do filePath <- peekCString pFilePath- (Errno errno) <- (fuseFlush ops) filePath- return (- errno)- wrapRelease :: CRelease- wrapRelease pFilePath pFuseFileInfo = handle fuseHandler $- do filePath <- peekCString pFilePath- flags <- (#peek struct fuse_file_info, flags) pFuseFileInfo- (fuseRelease ops) filePath flags- return 0- 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- -- XXX: Should we pass flags from pFuseFileInfo?- (Errno errno) <- (fuseOpenDirectory ops) filePath- return (- errno)- -- TODO: wrapReadDir- 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)- wrapInit :: CInit- wrapInit = handle (\e -> hPutStrLn stderr (show e) >> return nullPtr) $- do fuseInit ops- return nullPtr- wrapDestroy :: CDestroy- wrapDestroy _ = handle (\e -> hPutStrLn stderr (show e)) $- do fuseDestroy ops---- | Default exception handler.--- Print the exception on error output and returns 'eFAULT'.-defaultExceptionHandler :: (Exception -> IO Errno)-defaultExceptionHandler e = hPutStrLn stderr (show e) >> return eFAULT----------------------------------------------------------------------------------- Miscelaneous utilities--unErrno :: Errno -> CInt-unErrno (Errno errno) = errno--okErrno :: CInt-okErrno = 0--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---------------------------------------------------------------------------------- C land-------- exported C called from Haskell------data CFuseOperations-foreign import ccall threadsafe "fuse.h fuse_main_real"- fuse_main_real :: Int -> Ptr CString -> Ptr CFuseOperations -> CSize -> IO ()--data StructFuse-foreign import ccall threadsafe "fuse.h fuse_get_context"- fuse_get_context :: IO (Ptr StructFuse)-------- dynamic Haskell called from C------data CFuseFileInfo -- struct fuse_file_info--data CStat -- struct stat-type CGetAttr = CString -> Ptr CStat -> IO CInt-foreign import ccall threadsafe "wrapper"- mkGetAttr :: CGetAttr -> IO (FunPtr CGetAttr)--type CReadLink = CString -> CString -> CSize -> IO CInt-foreign import ccall threadsafe "wrapper"- mkReadLink :: CReadLink -> IO (FunPtr CReadLink)--type CGetDir = CString -> Ptr CDirHandle -> FunPtr CDirFil -> IO CInt-foreign import ccall threadsafe "wrapper"- mkGetDir :: CGetDir -> IO (FunPtr CGetDir)--type CMkNod = CString -> CMode -> CDev -> IO CInt-foreign import ccall threadsafe "wrapper"- mkMkNod :: CMkNod -> IO (FunPtr CMkNod)--type CMkDir = CString -> CMode -> IO CInt-foreign import ccall threadsafe "wrapper"- mkMkDir :: CMkDir -> IO (FunPtr CMkDir)--type CUnlink = CString -> IO CInt-foreign import ccall threadsafe "wrapper"- mkUnlink :: CUnlink -> IO (FunPtr CUnlink)--type CRmDir = CString -> IO CInt-foreign import ccall threadsafe "wrapper"- mkRmDir :: CRmDir -> IO (FunPtr CRmDir)--type CSymLink = CString -> CString -> IO CInt-foreign import ccall threadsafe "wrapper"- mkSymLink :: CSymLink -> IO (FunPtr CSymLink)--type CRename = CString -> CString -> IO CInt-foreign import ccall threadsafe "wrapper"- mkRename :: CRename -> IO (FunPtr CRename)--type CLink = CString -> CString -> IO CInt-foreign import ccall threadsafe "wrapper"- mkLink :: CLink -> IO (FunPtr CLink)--type CChMod = CString -> CMode -> IO CInt-foreign import ccall threadsafe "wrapper"- mkChMod :: CChMod -> IO (FunPtr CChMod)--type CChOwn = CString -> CUid -> CGid -> IO CInt-foreign import ccall threadsafe "wrapper"- mkChOwn :: CChOwn -> IO (FunPtr CChOwn)--type CTruncate = CString -> COff -> IO CInt-foreign import ccall threadsafe "wrapper"- mkTruncate :: CTruncate -> IO (FunPtr CTruncate)--data CUTimBuf -- struct utimbuf-type CUTime = CString -> Ptr CUTimBuf -> IO CInt-foreign import ccall threadsafe "wrapper"- mkUTime :: CUTime -> IO (FunPtr CUTime)--type COpen = CString -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkOpen :: COpen -> IO (FunPtr COpen)--type CRead = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkRead :: CRead -> IO (FunPtr CRead)--type CWrite = CString -> CString -> CSize -> COff -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkWrite :: CWrite -> IO (FunPtr CWrite)--data CStructStatFS -- struct fuse_stat_fs-type CStatFS = CString -> Ptr CStructStatFS -> IO CInt-foreign import ccall threadsafe "wrapper"- mkStatFS :: CStatFS -> IO (FunPtr CStatFS)--type CFlush = CString -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkFlush :: CFlush -> IO (FunPtr CFlush)--type CRelease = CString -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkRelease :: CRelease -> IO (FunPtr CRelease)--type CFSync = CString -> Int -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkFSync :: CFSync -> IO (FunPtr CFSync)---- XXX add *xattr bindings--type COpenDir = CString -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkOpenDir :: COpenDir -> IO (FunPtr COpenDir)--type CReadDir = CString -> Ptr CFillDirBuf -> Ptr CFillDir -> COff -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkReadDir :: CReadDir -> IO (FunPtr CReadDir)--type CReleaseDir = CString -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkReleaseDir :: CReleaseDir -> IO (FunPtr CReleaseDir)--type CFSyncDir = CString -> Int -> Ptr CFuseFileInfo -> IO CInt-foreign import ccall threadsafe "wrapper"- mkFSyncDir :: CFSyncDir -> IO (FunPtr CFSyncDir)---- CInt because anything would be fine as we don't use them-type CInit = IO (Ptr CInt)-foreign import ccall threadsafe "wrapper"- mkInit :: CInit -> IO (FunPtr CInit)--type CDestroy = Ptr CInt -> IO ()-foreign import ccall threadsafe "wrapper"- mkDestroy :: CDestroy -> IO (FunPtr CDestroy)-------- dynamic C called from Haskell------data CDirHandle -- fuse_dirh_t-type CDirFil = Ptr CDirHandle -> CString -> Int -> IO CInt -- fuse_dirfil_t-foreign import ccall threadsafe "dynamic"- mkDirFil :: FunPtr CDirFil -> CDirFil--data CFillDirBuf -- void-type CFillDir = Ptr CFillDirBuf -> CString -> Ptr CStat -> COff -> IO CInt-foreign import ccall threadsafe "dynamic"- mkFillDir :: FunPtr CFillDir -> CFillDir
− System/Posix/HelloFS.hs
@@ -1,89 +0,0 @@-module Main where---- import Foreign.C.Error-import System.Posix.Types-import System.Posix.Files--- import System.Posix.IO--import System.Posix.HFuse--main :: IO ()-main = fuseMain helloFSOps defaultExceptionHandler--helloFSOps :: FuseOperations-helloFSOps = defaultFuseOps { fuseGetFileStat = helloGetFileStat- , fuseGetDirectoryContents = helloGetDirectoryContents- , fuseOpen = helloOpen- , fuseRead = helloRead- }-helloString :: String-helloString = "Hello World, HFuse!\n"--helloPath :: FilePath-helloPath = "/hello"--helloGetFileStat :: FilePath -> IO (Either Errno FileStat)-helloGetFileStat "/" = do- ctx <- getFuseContext- return $ Right $ FileStat { statEntryType = Directory- , statFileMode = foldr1 unionFileModes- [ ownerReadMode- , ownerExecuteMode- , groupReadMode- , groupExecuteMode- , otherReadMode- , otherExecuteMode- ]- , statLinkCount = 2- , statFileOwner = fuseCtxUserID ctx- , statFileGroup = fuseCtxGroupID ctx- , statSpecialDeviceID = 0- , statFileSize = 4096- , statBlocks = 1- , statAccessTime = 0- , statModificationTime = 0- , statStatusChangeTime = 0- }-helloGetFileStat path | path == helloPath = do- ctx <- getFuseContext- return $ Right $ FileStat { statEntryType = RegularFile- , statFileMode = foldr1 unionFileModes- [ ownerReadMode- , groupReadMode- , otherReadMode- ]- , statLinkCount = 1- , statFileOwner = fuseCtxUserID ctx- , statFileGroup = fuseCtxGroupID ctx- , statSpecialDeviceID = 0- , statFileSize = fromIntegral $ length helloString- , statBlocks = 1- , statAccessTime = 0- , statModificationTime = 0- , statStatusChangeTime = 0- }-helloGetFileStat _ =- return $ Left eNOENT--helloGetDirectoryContents :: FilePath -> IO (Either Errno [(FilePath, EntryType)])-helloGetDirectoryContents "/" =- return $ Right [ (".", Directory)- , ("..", Directory)- , (tail helloPath, RegularFile) ]-helloGetDirectoryContents _ = return (Left (eNOENT))--helloOpen :: FilePath -> OpenMode -> OpenFileFlags -> IO Errno-helloOpen path mode _- | path == helloPath = case mode of- ReadOnly -> return eOK- _ -> return eACCES- | otherwise = return eNOENT---helloRead :: FilePath -> ByteCount -> FileOffset- -> IO (Either Errno (String, ByteCount))-helloRead path byteCount _- | path == helloPath =- let count = max (length helloString) (fromIntegral byteCount)- in return $ Right (take count helloString, fromIntegral count)- | otherwise = return $ Left eNOENT
− System/Posix/LiveFS.hs
@@ -1,78 +0,0 @@--- Currently broken experiment-module Main where--import Control.Concurrent.MVar--import System.Posix.HFuse--type FileName = String--type Permissions = (FileMode, UserID, GroupID)--type FSMap = FiniteMap FilePath FSObject--data FSObject- = FSRegularFile Permissions String- | FSDirectory Permissions [(FileName, FSObject)]--fsObjectPersmissions :: FSObject -> Persmissions-fsObjectPersmissions (FSRegularFile perms _) = perms-fsObjectPersmissions (FSDirectory perms _) = perms--main :: IO ()-main =- do mvRoot <- newMVar $ Directory []- let liveFSOps :: FuseOperations- liveFSOps =- FuseOperations { fuseGetFileStat = liveGetFileStat- , fuseReadSymbolicLink = liveReadSymbolicLink- , fuseGetDirectoryContents = liveGetDirectoryContents- , fuseCreateDevice = liveCreateDevice- , fuseCreateDirectory = liveCreateDirectory- , fuseRemoveLink = liveRemoveLink- , fuseRemoveDirectory = liveRemoveDirectory- , fuseCreateSymbolicLink = liveCreateSymbolicLink- , fuseRename = liveRename- , fuseCreateLink = liveCreateLink- , fuseSetFileMode = liveSetFileMode- , fuseSetOwnerAndGroup = liveSetOwnerAndGroup- , fuseSetFileSize = liveSetFileSize- , fuseSetFileTimes = liveSetFileTimes- , fuseOpen = liveOpen- , fuseRead = liveRead- , fuseWrite = liveWrite- , fuseGetFileSystemStats = liveGetFileSystemStats- , fuseFlush = liveFlush- , fuseRelease = liveRelease- , fuseSynchronizeFile = liveSynchronizeFile- }- withPath :: FilePath -> (Maybe FSObject -> a) -> IO a- withPath path f =- withMVar mvRoot $ \ root ->- f (foldl digPath root (paths path))- digPath :: Maybe FSObject -> FileName -> Maybe FSObject- digPath (Just (Directory entries)) name = lookup name entries- digPath _ _ = Nothing- liveGetFileStat :: FilePath -> IO (Either Errno FileStat)- liveGetFileStat path =- withPath path $ \ mbObj -> case mbObj of- Nothing -> return (Left eNOENT)- Just obj -> let entryType = case obj of FSRegularFile _ -> RegularFile- Directory _ -> Directory- (mode, owner, group) = fsObjectPermissions obj- size = undefined- in return $ Right $ FileStat- { statEntryType = entryType- , statFileMode = mode- , statLinkCount = 1- , statFileOwner = owner- , statFileGroup = group- , statSpecialDeviceID = 0- , statFileSize = undefined }- fuseMain liveFSOps (\e -> print e >> defaultExceptionHandler e)--paths :: FilePath -> [FileName]-paths s = case dropWhile (== '/') s of- "" -> []- s' -> w : words s''- where (w, s'') = break (== '/') s'
+ fuse_wrappers.c view
@@ -0,0 +1,11 @@+#define FUSE_USE_VERSION 26++#include "fuse_wrappers.h"++int+fuse_main_wrapper (int argc,+ char *argv[],+ const struct fuse_operations *op)+{+ return (fuse_main (argc, argv, op, NULL));+}
+ fuse_wrappers.h view
@@ -0,0 +1,3 @@+#include <fuse.h>++int fuse_main_wrapper (int argc, char *argv[], const struct fuse_operations *op);