btrfs 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+1082/−42 lines, 4 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Setup.hs +1/−39
- System/Linux/Btrfs/ByteString.hsc +1058/−0
- btrfs.cabal +5/−3
- make-bytestring.hs +18/−0
Setup.hs view
@@ -1,40 +1,2 @@ import Distribution.Simple-import Distribution.Simple.Setup-import Distribution.Simple.Utils-import Distribution.Simple.BuildPaths-import Distribution.Simple.LocalBuildInfo-import Distribution.PackageDescription-import Distribution.ModuleName (fromString)-import System.IO-import System.FilePath--main :: IO ()-main = defaultMainWithHooks simpleUserHooks- { confHook = customConf- , buildHook = customBuild- }--customConf gh cFlags = do- lbi <- confHook simpleUserHooks gh cFlags- -- modify the package description to add the auto-generated module- let desc = localPkgDescr lbi- Just lib = library desc- modName = fromString "System.Linux.Btrfs.ByteString"- lib' = lib {exposedModules = exposedModules lib ++ [modName]}- desc' = desc {library = Just lib'}- return lbi {localPkgDescr = desc'}--customBuild desc lbi hooks bFlags = do- let verbosity = fromFlag (buildVerbosity bFlags)-- -- create System/Linux/Btrfs/ByteString.hsc- let dir = autogenModulesDir lbi </> "System/Linux/Btrfs"- createDirectoryIfMissingVerbose verbosity True dir- withFile (dir </> "ByteString.hsc") WriteMode $ \oHdl -> do- hPutStrLn oHdl "#define BTRFS_RAW_PATHS 1"- withFile "System/Linux/Btrfs.hsc" ReadMode $ \iHdl -> do- _ <- hGetLine iHdl -- skip the first line- contents <- hGetContents iHdl- hPutStr oHdl contents-- buildHook simpleUserHooks desc lbi hooks bFlags+main = defaultMain
+ System/Linux/Btrfs/ByteString.hsc view
@@ -0,0 +1,1058 @@+#define BTRFS_RAW_PATHS 1+{- |+Module : System.Linux.Btrfs++Stability : provisional+Portability : non-portable (requires Linux)++Most functions in this module come in two flavors: one that operates on+file descriptors and another one that operates on file paths. The former+can be distinguished by the @Fd@ suffix in their names.+-}++{-# LANGUAGE CPP #-}++#if BTRFS_RAW_PATHS+##define FILEPATH RawFilePath+module System.Linux.Btrfs.ByteString+#else+##define FILEPATH FilePath+module System.Linux.Btrfs+#endif+ (+ -- * Basic types+ FileSize, ObjectType, ObjectId, InodeNum, SubvolId+ -- * File cloning+ , cloneFd, clone, cloneNew+ , cloneRangeFd, cloneRange+ , CloneResult(..)+ , cloneRangeIfSameFd, cloneRangeIfSame+ -- * Subvolumes and snapshots+ , createSubvol+ , destroySubvol+ , snapshotFd, snapshot+ , getSubvolReadOnlyFd, getSubvolReadOnly+ , setSubvolReadOnlyFd, setSubvolReadOnly+ , getSubvolFd, getSubvol+ , lookupSubvolFd, lookupSubvol+ , resolveSubvolFd, resolveSubvol+ , rootSubvol+ , listSubvolsFd, listSubvols+ , listSubvolPathsFd, listSubvolPaths+ , childSubvolsFd, childSubvols+ , childSubvolPathsFd, childSubvolPaths+ , SubvolInfo(..)+ , getSubvolInfoFd, getSubvolInfo+ , getSubvolByUuidFd, getSubvolByUuid+ , getSubvolByReceivedUuidFd, getSubvolByReceivedUuid+ -- * Defragging+ , defragFd, defrag+ -- * Sync+ , syncFd, sync+ , startSyncFd, startSync+ , waitSyncFd, waitSync+ -- * Inspect internal+ , resolveLogicalFd, resolveLogical+ , resolveInodeFd, resolveInode+ , lookupInodeFd, lookupInode+ -- * Miscellaneous+ , getFileNoCOWFd, getFileNoCOW+ , setFileNoCOWFd, setFileNoCOW+ -- * Tree search+ -- | Low-level API for tree search using the @BTRFS_IOC_TREE_SEARCH@+ -- @ioctl@.+ , SearchKey(..)+ , defaultSearchKey+ , SearchHeader(..)+ , treeSearchFd, treeSearch+ , treeSearchListFd, treeSearchList+ , findFirstItemFd, findFirstItem+ ) where++import System.Posix.Types+import System.Posix.IO hiding (openFd)+import System.Posix.Files+import System.Posix.Signals+import System.IO.Error+import Control.Exception+import Control.Monad+import Data.IORef+import Data.Time.Clock (UTCTime)+import Data.Monoid+import System.Linux.Btrfs.FilePathLike++import Foreign+import Foreign.C.Types+import Foreign.C.String (CStringLen)+import Foreign.C.Error++import Data.Word.Endian+import System.Linux.Btrfs.Time+import System.Linux.Btrfs.UUID++#include <linux/btrfs.h>+#define __IOCTL_+#include <btrfs/ctree.h>++#include <linux/fs.h>++foreign import ccall safe+ ioctl :: Fd -> CULong -> Ptr a -> IO CInt+foreign import ccall unsafe "ioctl"+ ioctl_fast :: Fd -> CULong -> Ptr a -> IO CInt++type FileSize = Word64++type ObjectType = Word8++type ObjectId = Word64++type InodeNum = ObjectId++type SubvolId = ObjectId++--------------------------------------------------------------------------------++cloneFd :: Fd -> Fd -> IO ()+cloneFd srcFd dstFd =+ throwErrnoIfMinus1_ "cloneFd" $+ ioctl_fast dstFd (#const BTRFS_IOC_CLONE) srcFdP+ where+ srcFdP = intPtrToPtr (fromIntegral srcFd)++-- | Clone an entire file to an existing file.+--+-- Note: calls the @BTRFS_IOC_CLONE@ @ioctl@.+clone+ :: FILEPATH -- ^ The source file.+ -> FILEPATH -- ^ The destination file.+ -> IO ()+clone srcPath dstPath =+ withFd srcPath ReadOnly $ \srcFd ->+ withFd dstPath WriteOnly $ \dstFd ->+ cloneFd srcFd dstFd++-- | Like 'clone' except that it will create or truncate the destination+-- file if necessary. This is similar to @cp --reflink=always@.+--+-- Note: calls the @BTRFS_IOC_CLONE@ @ioctl@.+cloneNew :: FILEPATH -> FILEPATH -> IO ()+cloneNew srcPath dstPath =+ withFd srcPath ReadOnly $ \srcFd -> do+ stat <- getFdStatus srcFd+ let mode = fileMode stat+ bracket (openFd dstPath WriteOnly (Just mode) defaultFileFlags {trunc = True}) closeFd $ \dstFd ->+ cloneFd srcFd dstFd++cloneRangeFd :: Fd -> FileSize -> FileSize -> Fd -> FileSize -> IO ()+cloneRangeFd srcFd srcOff srcLen dstFd dstOff =+ allocaBytesZero (#size struct btrfs_ioctl_clone_range_args) $ \cra -> do+ (#poke struct btrfs_ioctl_clone_range_args, src_fd ) cra (fromIntegral srcFd :: Int64)+ (#poke struct btrfs_ioctl_clone_range_args, src_offset ) cra (srcOff :: Word64)+ (#poke struct btrfs_ioctl_clone_range_args, src_length ) cra (srcLen :: Word64)+ (#poke struct btrfs_ioctl_clone_range_args, dest_offset) cra (dstOff :: Word64)+ throwErrnoIfMinus1_ "cloneRangeFd" $+ ioctl_fast dstFd (#const BTRFS_IOC_CLONE_RANGE) cra++-- | Clones a range of bytes from a file to another file. All ranges must+-- be block-aligned.+--+-- Note: calls the @BTRFS_IOC_CLONE_RANGE@ @ioctl@.+cloneRange+ :: FILEPATH -- ^ The source file.+ -> FileSize -- ^ The offset within the source file.+ -> FileSize -- ^ The length of the range. A length of 0 selects the range+ -- from the source offset to the end.+ -> FILEPATH -- ^ The destination file.+ -> FileSize -- ^ The offset within the destination file.+ -> IO ()+cloneRange srcPath srcOff srcLen dstPath dstOff =+ withFd srcPath ReadOnly $ \srcFd ->+ withFd dstPath WriteOnly $ \dstFd ->+ cloneRangeFd srcFd srcOff srcLen dstFd dstOff++#ifdef BTRFS_IOC_FILE_EXTENT_SAME+data SameExtentInfoIn = SameExtentInfoIn+ Fd -- file descriptor (stored as Int64)+ FileSize -- offset++instance Storable SameExtentInfoIn where+ sizeOf _ = (#size struct btrfs_ioctl_same_extent_info)+ alignment _ = alignment (undefined :: CInt)+ poke ptr (SameExtentInfoIn dstFd dstOff) = do+ memset ptr 0 (#size struct btrfs_ioctl_same_extent_info)+ let dstFd' = fromIntegral dstFd :: Int64+ (#poke struct btrfs_ioctl_same_extent_info, fd) ptr dstFd'+ (#poke struct btrfs_ioctl_same_extent_info, logical_offset) ptr dstOff+ peek _ = error "not implemented"++data SameExtentInfoOut = SameExtentInfoOut+ Int32 -- status+ FileSize -- bytes deduped++instance Storable SameExtentInfoOut where+ sizeOf _ = (#size struct btrfs_ioctl_same_extent_info)+ alignment _ = alignment (undefined :: CInt)+ poke _ _ = error "not implemented"+ peek ptr = do+ status <- (#peek struct btrfs_ioctl_same_extent_info, status ) ptr+ bytes <- (#peek struct btrfs_ioctl_same_extent_info, bytes_deduped) ptr+ return (SameExtentInfoOut status bytes)+#endif++-- | The result of a 'cloneRangeIfSame' operation.+data CloneResult+ = CRError IOError -- ^ Cloning failed because of an error.+ | CRDataDiffers -- ^ No cloning was performed because the contents+ -- of the source and the destination file differ.+ | CRSuccess FileSize -- ^ Cloning succeeded, the returned integer+ -- indicates the number of bytes that were+ -- deduped.+ deriving (Show, Eq)++cloneRangeIfSameFd :: Fd -> FileSize -> FileSize -> [(Fd, FileSize)] -> IO [CloneResult]+#ifndef BTRFS_IOC_FILE_EXTENT_SAME+cloneRangeIfSameFd _ _ _ _ =+ error "System.Linux.Btrfs.cloneRangeIfSameFd: not supported"+#else+cloneRangeIfSameFd srcFd srcOff srcLen dsts = do+ unless (dstCount <= maxCount) $+ ioError $ flip ioeSetErrorString ("too many destination files (more than " +++ show maxCount ++ ")")+ $ mkIOError illegalOperationErrorType "cloneRangeIfSameFd" Nothing Nothing+ allocaBytes saSize $ \sa -> do+ memset sa 0 (#size struct btrfs_ioctl_same_args)+ (#poke struct btrfs_ioctl_same_args, logical_offset) sa srcOff+ (#poke struct btrfs_ioctl_same_args, length ) sa srcLen+ (#poke struct btrfs_ioctl_same_args, dest_count ) sa dstCount'+ let info = (#ptr struct btrfs_ioctl_same_args, info) sa+ pokeArray info (map (uncurry SameExtentInfoIn) dsts)+ throwErrnoIfMinus1_ "cloneRangeIfSameFd" $+ ioctl srcFd (#const BTRFS_IOC_FILE_EXTENT_SAME) sa+ res <- peekArray dstCount info+ return $ flip map res $ \(SameExtentInfoOut status bytes) ->+ if status == 0 then+ CRSuccess bytes+ else if status == (#const BTRFS_SAME_DATA_DIFFERS) then+ CRDataDiffers+ else if status <= 0 then+ CRError $ errnoToIOError "cloneRangeIfSameFd"+ (Errno $ fromIntegral $ -status)+ Nothing Nothing+ else+ error $ "unknown status value (" ++ show status ++ ")"+ where+ saSize = (#size struct btrfs_ioctl_same_args) ++ dstCount * (#size struct btrfs_ioctl_same_extent_info)+ dstCount = length dsts+ dstCount' = fromIntegral dstCount :: Word64+ maxCount = fromIntegral (maxBound :: Word16)+#endif++-- | Similar to 'cloneRange' except that it performs the cloning only if+-- the data ranges contain identical data.+-- Additionally, it accepts multiple destination files. The same thing can+-- be accomplished with 'cloneRange' in conjunction with file locking but+-- this function uses in-kernel locking to guarantee that the deduplicated+-- data is identical at the time of the operation. On the other hand, this+-- function will not clone arbitrarily large ranges; the kernel has an upper+-- limit for the length and if cloning bigger ranges is desired then it+-- has to be called multiple times. Note that cloning may succeed for some+-- of the destination files and fail for others. Because of that, this+-- function returns a list of outcomes, one for each destination file, and+-- no exceptions will be raised for the failed files.+--+-- Note: calls the @BTRFS_IOC_FILE_EXTENT_SAME@ @ioctl@.+--+-- /Requires Linux 3.12 or later./+cloneRangeIfSame+ :: FILEPATH -- ^ The source file.+ -> FileSize -- ^ The offset within the source file.+ -> FileSize -- ^ The length of the range.+ -> [(FILEPATH, FileSize)] -- ^ The destination files and corresponding offsets.+ -> IO [CloneResult]+cloneRangeIfSame srcPath srcOff srcLen dstsP0 =+ withFd srcPath ReadOnly $ \srcFd ->+ loop srcFd (reverse dstsP0) []+ where+ loop srcFd ((dstPath, dstOff) : dstsP) dsts =+ withFd dstPath WriteOnly $ \fd ->+ loop srcFd dstsP ((fd, dstOff) : dsts)+ loop srcFd [] dsts =+ cloneRangeIfSameFd srcFd srcOff srcLen dsts++--------------------------------------------------------------------------------++simpleSubvolOp :: String -> FILEPATH -> CULong -> IO ()+simpleSubvolOp loc path req =+ withSplitPathOpenParent loc (#const BTRFS_PATH_NAME_MAX) path $ \(cName, l) dirFd ->+ allocaBytesZero (#size struct btrfs_ioctl_vol_args) $ \iva -> do+ let ivaName = (#ptr struct btrfs_ioctl_vol_args, name) iva+ copyBytes ivaName cName l+ throwErrnoIfMinus1_ loc $+ ioctl dirFd req iva++-- | Create an (initially) empty new subvolume.+--+-- Note: calls the @BTRFS_IOC_SUBVOL_CREATE@ @ioctl@.+createSubvol :: FILEPATH -> IO ()+createSubvol path =+ simpleSubvolOp "createSubvol" path (#const BTRFS_IOC_SUBVOL_CREATE)++-- | Destroy (delete) a subvolume.+--+-- Note: calls the @BTRFS_IOC_SNAP_DESTROY@ @ioctl@.+destroySubvol :: FILEPATH -> IO ()+destroySubvol path =+ simpleSubvolOp "destroySubvol" path (#const BTRFS_IOC_SNAP_DESTROY)++snapshotFd :: Fd -> FILEPATH -> Bool -> IO ()+snapshotFd srcFd dstPath readOnly =+ withSplitPathOpenParent "snapshotFd" (#const BTRFS_SUBVOL_NAME_MAX) dstPath $ \(cName, l) dirFd ->+ allocaBytesZero (#size struct btrfs_ioctl_vol_args_v2) $ \iva -> do+ let ivaName = (#ptr struct btrfs_ioctl_vol_args_v2, name) iva+ copyBytes ivaName cName l+ (#poke struct btrfs_ioctl_vol_args_v2, fd) iva (fromIntegral srcFd :: Int64)+ when readOnly $+ setFlags ((#ptr struct btrfs_ioctl_vol_args_v2, flags) iva)+ ((#const BTRFS_SUBVOL_RDONLY) :: Word64)+ throwErrnoIfMinus1_ "snapshotFd" $+ ioctl dirFd (#const BTRFS_IOC_SNAP_CREATE_V2) iva++-- | Create a snapshot of an existing subvolume.+--+-- Note: calls the @BTRFS_IOC_SNAP_CREATE_V2@ @ioctl@.+snapshot+ :: FILEPATH -- ^ The source subvolume.+ -> FILEPATH -- ^ The destination subvolume (must not exist).+ -> Bool -- ^ Make the subvolume read-only?+ -> IO ()+snapshot srcPath dstPath readOnly =+ withFd srcPath ReadOnly $ \srcFd ->+ snapshotFd srcFd dstPath readOnly++getSubvolReadOnlyFd :: Fd -> IO Bool+getSubvolReadOnlyFd fd =+ alloca $ \flagsPtr -> do+ throwErrnoIfMinus1_ "getSubvolReadOnlyFd" $+ ioctl fd (#const BTRFS_IOC_SUBVOL_GETFLAGS) flagsPtr+ flags <- peek flagsPtr :: IO Word64+ return (flags .&. (#const BTRFS_SUBVOL_RDONLY) /= 0)++-- | Is the subvolume read-only?+--+-- Note: calls the @BTRFS_IOC_SUBVOL_GETFLAGS@ @ioctl@.+getSubvolReadOnly :: FILEPATH -> IO Bool+getSubvolReadOnly path = withFd path ReadOnly getSubvolReadOnlyFd++setSubvolReadOnlyFd :: Fd -> Bool -> IO ()+setSubvolReadOnlyFd fd readOnly =+ alloca $ \flagsPtr -> do+ throwErrnoIfMinus1_ "setSubvolReadOnlyFd" $+ ioctl fd (#const BTRFS_IOC_SUBVOL_GETFLAGS) flagsPtr+ if readOnly then+ setFlags flagsPtr ((#const BTRFS_SUBVOL_RDONLY) :: Word64)+ else+ clearFlags flagsPtr ((#const BTRFS_SUBVOL_RDONLY) :: Word64)+ throwErrnoIfMinus1_ "setSubvolReadOnlyFd" $+ ioctl fd (#const BTRFS_IOC_SUBVOL_SETFLAGS) flagsPtr++-- | Make a subvolume read-only (or read-write).+--+-- Note: calls the @BTRFS_IOC_SUBVOL_GETFLAGS@ and+-- @BTRFS_IOC_SUBVOL_SETFLAGS@ @ioctl@s.+setSubvolReadOnly :: FILEPATH -> Bool -> IO ()+setSubvolReadOnly path readOnly =+ withFd path ReadOnly $ \fd -> setSubvolReadOnlyFd fd readOnly++getSubvolFd :: Fd -> IO SubvolId+getSubvolFd fd = do+ (subvolId, _) <- lookupInodeFd fd 0 (#const BTRFS_FIRST_FREE_OBJECTID)+ return subvolId++-- | Find the id of the subvolume where the given file resides. This is+-- merely a wrapper around 'lookupInode' provided for convenience.+getSubvol :: FILEPATH -> IO SubvolId+getSubvol path = withFd path ReadOnly getSubvolFd++lookupSubvolFd :: Fd -> SubvolId -> IO (SubvolId, InodeNum, FILEPATH)+lookupSubvolFd fd subvolId = do+ let sk = defaultSearchKey+ { skTreeId = (#const BTRFS_ROOT_TREE_OBJECTID)+ , skMinObjectId = subvolId+ , skMaxObjectId = subvolId+ , skMinType = (#const BTRFS_ROOT_BACKREF_KEY)+ , skMaxType = (#const BTRFS_ROOT_BACKREF_KEY)+ }+ findFirstItemFd fd sk $ \sh rr -> do+ (dirId, name) <- peekRootRef rr+ return (shOffset sh, dirId, name)++-- | Given the id of a subvolume, find the id of the parent subvolume, the+-- inode number of the directory containing it, and its name. This is+-- a wrapper around 'treeSearch'.+lookupSubvol+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> SubvolId -- ^ The id of the subvolume.+ -> IO (SubvolId, InodeNum, FILEPATH)+lookupSubvol path subvolId =+ withFd path ReadOnly $ \fd ->+ lookupSubvolFd fd subvolId++resolveSubvolFd :: Fd -> SubvolId -> IO FILEPATH+resolveSubvolFd fd subvolId+ | subvolId == rootSubvol = return mempty+ | otherwise = do+ (parentId, dirId, name) <- lookupSubvolFd fd subvolId+ parentPath <- resolveSubvolFd fd parentId+ if dirId == (#const BTRFS_FIRST_FREE_OBJECTID) then+ return (parentPath </> name)+ else do+ (_, dirName) <- lookupInodeFd fd parentId dirId+ return (parentPath </> dirName </> name)++-- | Given the id of a subvolume, find its path relative to the root of the+-- volume. This function calls 'lookupSubvol' recursively.+resolveSubvol+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> SubvolId -- ^ The id of the subvolume.+ -> IO FILEPATH+resolveSubvol path subvolId =+ withFd path ReadOnly $ \fd ->+ resolveSubvolFd fd subvolId++-- | The id the root subvolume.+rootSubvol :: SubvolId+rootSubvol = (#const BTRFS_FS_TREE_OBJECTID)++listSubvolsFd :: Fd -> IO [(SubvolId, SubvolId, InodeNum, FILEPATH)]+listSubvolsFd fd = do+ let sk = defaultSearchKey+ { skTreeId = (#const BTRFS_ROOT_TREE_OBJECTID)+ , skMinObjectId = (#const BTRFS_FIRST_FREE_OBJECTID)+ , skMaxObjectId = (#const BTRFS_LAST_FREE_OBJECTID)+ , skMinType = (#const BTRFS_ROOT_BACKREF_KEY)+ , skMaxType = (#const BTRFS_ROOT_BACKREF_KEY)+ }+ treeSearchListFd fd sk unpack+ where+ unpack sh rr+ | shType sh /= (#const BTRFS_ROOT_BACKREF_KEY) =+ return Nothing+ | otherwise = do+ (dirId, name) <- peekRootRef rr+ return $ Just (shObjectId sh, shOffset sh, dirId, name)++-- | Find all subvolumes of the given volume. For each subvolume found, it+-- returns: its id, the id of its parent subvolume, the inode number of the+-- directory containing it, and its name. This is a wrapper around+-- 'treeSearch'.+listSubvols :: FILEPATH -> IO [(SubvolId, SubvolId, InodeNum, FILEPATH)]+listSubvols path =+ withFd path ReadOnly listSubvolsFd++listSubvolPathsFd :: Fd -> IO [(SubvolId, SubvolId, FILEPATH)]+listSubvolPathsFd fd = do+ subvols <- listSubvolsFd fd+ forM subvols $ \(subvolId, parentId, _, _) -> do+ path <- resolveSubvolFd fd subvolId+ return (subvolId, parentId, path)++-- | Find all subvolumes of the given volume. For each subvolume found, it+-- returns: its id, the id of its parent subvolume, and its path relative+-- to the root of the volume. This is a wrapper around 'treeSearch' and+-- 'resolveSubvol'.+listSubvolPaths :: FILEPATH -> IO [(SubvolId, SubvolId, FILEPATH)]+listSubvolPaths path =+ withFd path ReadOnly listSubvolPathsFd++childSubvolsFd :: Fd -> SubvolId -> IO [(SubvolId, InodeNum, FILEPATH)]+childSubvolsFd fd subvolId = do+ let sk = defaultSearchKey+ { skTreeId = (#const BTRFS_ROOT_TREE_OBJECTID)+ , skMinObjectId = subvolId+ , skMaxObjectId = subvolId+ , skMinType = (#const BTRFS_ROOT_REF_KEY)+ , skMaxType = (#const BTRFS_ROOT_REF_KEY)+ }+ treeSearchListFd fd sk unpack+ where+ unpack sh rr+ | shType sh /= (#const BTRFS_ROOT_REF_KEY) =+ return Nothing+ | otherwise = do+ (dirId, name) <- peekRootRef rr+ return $ Just (shOffset sh, dirId, name)++-- | Find all child subvolumes of the given subvolume. For each child,+-- returns its id, the inode number of the directory containing it, and its+-- name. This is a wrapper around 'treeSearch'.+childSubvols+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> SubvolId -- ^ The id of the subvolume.+ -> IO [(SubvolId, InodeNum, FILEPATH)]+childSubvols path subvolId =+ withFd path ReadOnly $ \fd ->+ childSubvolsFd fd subvolId++childSubvolPathsFd :: Fd -> SubvolId -> IO [(SubvolId, FILEPATH)]+childSubvolPathsFd fd subvolId = do+ childs <- childSubvolsFd fd subvolId+ forM childs $ \(childId, dirId, name) ->+ if dirId == (#const BTRFS_FIRST_FREE_OBJECTID) then+ return (childId, name)+ else do+ (_, dirName) <- lookupInodeFd fd subvolId dirId+ return (childId, dirName </> name)++-- | Find all child subvolumes of the given subvolume. For each child,+-- returns its id and its path relative to the root of the parent.+-- This is a wrapper around 'treeSearch' and 'lookupInode'.+childSubvolPaths+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> SubvolId -- ^ The id of the subvolume.+ -> IO [(SubvolId, FILEPATH)]+childSubvolPaths path subvolId =+ withFd path ReadOnly $ \fd ->+ childSubvolPathsFd fd subvolId++-- | Information about a subvolume.+data SubvolInfo = SubvolInfo+ { siGeneration :: Word64+ -- ^ The generation when the subvolume was last modified.+ , siLastSnapshot :: Maybe Word64+ -- ^ The generation when the most recent snapshot of this subvolume was taken.+ , siParSnapGen :: Maybe Word64+ -- ^ The generation of the snapshot parent at the time when the snapshot+ -- was taken. Defined if only if this is a snapshot.+ , siReadOnly :: Bool+ -- ^ Is this a read-only subvolume?+ , siUuid :: Maybe UUID+ -- ^ The UUID of the subvolume.+ , siPUuid :: Maybe UUID+ -- ^ The UUID of the snapshot parent.+ , siReceivedUuid :: Maybe UUID+ -- ^ The UUID of the source subvolume that this subvolume was+ -- received from. This is always defined for received subvolumes.+ , siCTransId :: Maybe Word64+ -- ^ The generation when an inode was last modified.+ , siOTransId :: Maybe Word64+ -- ^ The generation when the subvolume was created.+ , siSTransId :: Maybe Word64+ -- ^ The generation of the source subvolume that this subvolume was+ -- received from. This is always defined for received subvolumes.+ , siRTransId :: Maybe Word64+ -- ^ The generation when the subvolume was received. This is always+ -- defined for received subvolumes.+ , siCTime :: Maybe UTCTime+ -- ^ The time when an inode was last modified.+ , siOTime :: Maybe UTCTime+ -- ^ The time when the subvolume was created.+ , siSTime :: Maybe UTCTime+ -- ^ The timestamp that corresponds to 'siSTransId'.+ , siRTime :: Maybe UTCTime+ -- ^ The time when the subvolume was received. This is always+ -- defined for received subvolumes.+ }+ deriving (Show, Eq)++getSubvolInfoFd :: Fd -> SubvolId -> IO SubvolInfo+getSubvolInfoFd fd subvolId+ | subvolId /= rootSubvol &&+ (subvolId < (#const BTRFS_FIRST_FREE_OBJECTID) || subvolId > (#const BTRFS_LAST_FREE_OBJECTID)) =+ ioError $ mkIOError doesNotExistErrorType+ "getSubvolInfoFd"+ Nothing Nothing+ | otherwise = do+ let sk = defaultSearchKey+ { skTreeId = (#const BTRFS_ROOT_TREE_OBJECTID)+ , skMinObjectId = subvolId+ , skMaxObjectId = subvolId+ , skMinType = (#const BTRFS_ROOT_ITEM_KEY)+ , skMaxType = (#const BTRFS_ROOT_ITEM_KEY)+ }+ findFirstItemFd fd sk unpack+ where+ unpack sh ri = do+ LE64 generation <- (#peek struct btrfs_root_item, generation) ri+ LE64 lastSnapshot <- (#peek struct btrfs_root_item, last_snapshot) ri+ LE64 flags <- (#peek struct btrfs_root_item, flags) ri+ LE64 generationV2 <- (#peek struct btrfs_root_item, generation_v2) ri+ let nv2 = generationV2 < generation -- not version 2+ uuid <- (#peek struct btrfs_root_item, uuid) ri :: IO UUID+ pUuid <- (#peek struct btrfs_root_item, parent_uuid) ri :: IO UUID+ receivedUuid <- (#peek struct btrfs_root_item, received_uuid) ri :: IO UUID+ LE64 cTransId <- (#peek struct btrfs_root_item, ctransid) ri+ LE64 oTransId <- (#peek struct btrfs_root_item, otransid) ri+ LE64 sTransId <- (#peek struct btrfs_root_item, stransid) ri+ LE64 rTransId <- (#peek struct btrfs_root_item, rtransid) ri+ BtrfsTime cTime <- (#peek struct btrfs_root_item, ctime) ri+ BtrfsTime oTime <- (#peek struct btrfs_root_item, otime) ri+ BtrfsTime sTime <- (#peek struct btrfs_root_item, stime) ri+ BtrfsTime rTime <- (#peek struct btrfs_root_item, rtime) ri+ return $ SubvolInfo+ { siGeneration = generation+ , siLastSnapshot = nothingIf (lastSnapshot == 0) $ lastSnapshot+ , siParSnapGen = nothingIf (shOffset sh == 0) $ shOffset sh+ , siReadOnly = flags .&. (#const BTRFS_SUBVOL_RDONLY) /= 0+ , siUuid = nothingIf nv2 uuid+ , siPUuid = nothingIf (nv2 || shOffset sh == 0) pUuid+ , siReceivedUuid = nothingIf (nv2 || sTransId == 0) receivedUuid+ , siCTransId = nothingIf nv2 cTransId+ , siOTransId = nothingIf (nv2 || oTransId == 0) oTransId+ , siSTransId = nothingIf (nv2 || sTransId == 0) sTransId+ , siRTransId = nothingIf (nv2 || rTransId == 0) rTransId+ , siCTime = nothingIf nv2 cTime+ , siOTime = nothingIf (nv2 || oTransId == 0) oTime+ , siSTime = nothingIf (nv2 || sTransId == 0) sTime+ , siRTime = nothingIf (nv2 || rTransId == 0) rTime+ }++-- | Retrieve information about a subvolume.+getSubvolInfo+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> SubvolId -- ^ The id of the subvolume.+ -> IO SubvolInfo+getSubvolInfo path subvolId =+ withFd path ReadOnly $ \fd ->+ getSubvolInfoFd fd subvolId++searchByUuidFd :: ObjectType -> Fd -> UUID -> IO SubvolId+searchByUuidFd typ fd (UUID hBE lBE) = do+ let sk = defaultSearchKey+ { skTreeId = (#const BTRFS_UUID_TREE_OBJECTID)+ , skMinObjectId = hLE+ , skMaxObjectId = hLE+ , skMinType = typ+ , skMaxType = typ+ , skMinOffset = lLE+ , skMaxOffset = lLE+ }+ findFirstItemFd fd sk $ \_ ptr ->+ liftM fromLE64 $ peek ptr+ where+ -- UUID is stored as two big-endian integers+ -- but in the UUID tree, little-endian integers are used+ lLE = invert64 lBE+ hLE = invert64 hBE++getSubvolByUuidFd :: Fd -> UUID -> IO SubvolId+getSubvolByUuidFd =+ searchByUuidFd (#const BTRFS_UUID_KEY_SUBVOL)++-- | Find the id of a subvolume, given its UUID.+--+-- /Requires Linux 3.12 or later./+getSubvolByUuid+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> UUID -- ^ The UUID of the subvolume.+ -> IO SubvolId+getSubvolByUuid path uuid =+ withFd path ReadOnly $ \fd ->+ getSubvolByUuidFd fd uuid++getSubvolByReceivedUuidFd :: Fd -> UUID -> IO SubvolId+getSubvolByReceivedUuidFd =+ searchByUuidFd (#const BTRFS_UUID_KEY_RECEIVED_SUBVOL)++-- | Find the id of a subvolume, given its 'siReceivedUuid'.+--+-- /Requires Linux 3.12 or later./+getSubvolByReceivedUuid+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> UUID -- ^ The 'siReceivedUuid' of the subvolume.+ -> IO SubvolId+getSubvolByReceivedUuid path uuid =+ withFd path ReadOnly $ \fd ->+ getSubvolByReceivedUuidFd fd uuid++--------------------------------------------------------------------------------++defragFd :: Fd -> IO ()+defragFd fd =+ throwErrnoIfMinus1_ "defragFd" $+ withBlockSIGVTALRM $ -- this is probably a bad idea+ ioctl fd (#const BTRFS_IOC_DEFRAG) nullPtr++-- | Defrag a single file.+--+-- Note: calls the @BTRFS_IOC_DEFRAG@ @ioctl@.+defrag :: FILEPATH -> IO ()+defrag path = withFd path ReadWrite defragFd++--------------------------------------------------------------------------------++syncFd :: Fd -> IO ()+syncFd fd =+ throwErrnoIfMinus1_ "syncFd" $+ ioctl fd (#const BTRFS_IOC_SYNC) nullPtr++-- | Sync the file system identified by the supplied path.+-- The 'FilePath' can refer to any file in the file system.+--+-- Note: calls the @BTRFS_IOC_SYNC@ @ioctl@.+sync :: FILEPATH -> IO ()+sync path = withFd path ReadOnly syncFd++startSyncFd :: Fd -> IO ()+startSyncFd fd =+ throwErrnoIfMinus1_ "startSyncFd" $+ ioctl_fast fd (#const BTRFS_IOC_START_SYNC) nullPtr++-- | Initiate a sync for the file system identified by the supplied path.+--+-- Note: calls the @BTRFS_IOC_START_SYNC@ @ioctl@.+startSync :: FILEPATH -> IO ()+startSync path = withFd path ReadOnly startSyncFd++waitSyncFd :: Fd -> IO ()+waitSyncFd fd =+ throwErrnoIfMinus1_ "waitSyncFd" $+ ioctl fd (#const BTRFS_IOC_WAIT_SYNC) nullPtr++-- | Wait until the sync operation completes.+--+-- Note: calls the @BTRFS_IOC_WAIT_SYNC@ @ioctl@.+waitSync :: FILEPATH -> IO ()+waitSync path = withFd path ReadOnly waitSyncFd++--------------------------------------------------------------------------------++resolveLogicalFd :: Fd -> FileSize -> IO ([(InodeNum, FileSize, SubvolId)], Int)+resolveLogicalFd rootFd logical =+ allocaBytes inodesSize $ \inodes ->+ allocaBytesZero (#size struct btrfs_ioctl_logical_ino_args) $ \lia -> do+ (#poke struct btrfs_ioctl_logical_ino_args, logical) lia logical+ (#poke struct btrfs_ioctl_logical_ino_args, size ) lia (fromIntegral inodesSize :: Word64)+ (#poke struct btrfs_ioctl_logical_ino_args, inodes ) lia inodes+ throwErrnoIfMinus1_ "resolveLogical" $ ioctl rootFd (#const BTRFS_IOC_LOGICAL_INO) lia+ elemMissed <- (#peek struct btrfs_data_container, elem_missed) inodes :: IO Word32+ count <- (#peek struct btrfs_data_container, elem_cnt ) inodes :: IO Word32+ let val = (#ptr struct btrfs_data_container, val) inodes :: Ptr Word64+ vals <- peekArray (fromIntegral count) val+ return (extractTriplets vals, fromIntegral elemMissed)+ where+ inodesSize = 64 * 1024 + (#size struct btrfs_data_container)+ extractTriplets (x1 : x2 : x3 : xs) = (x1, x2, x3) : extractTriplets xs+ extractTriplets [] = []+ extractTriplets _ = error "extractTriplets: The length of the list must be a multiple of 3"++-- | Given a physical offset, look for any inodes that this byte belongs+-- to. For each inode, it returns the inode number, the logical offset+-- (i.e. the offset within the inode), and the subvolume id. If a large+-- number of inodes is found, then not all of them will be returned by this+-- function. This is due to a current limitation in the kernel. The integer+-- returned along with list of inodes indicates the number of inodes found+-- but not included in the list.+--+-- Note: calls the @BTRFS_IOC_LOGICAL_INO@ @ioctl@.+resolveLogical+ :: FILEPATH -- ^ The mount point of the volume (or any file in that volume).+ -> FileSize -- ^ The physical byte offset in the underlying block device.+ -> IO ([(InodeNum, FileSize, SubvolId)], Int)+resolveLogical rootPath logical =+ withFd rootPath ReadOnly $ \fd ->+ resolveLogicalFd fd logical++resolveInodeFd :: Fd -> InodeNum -> IO ([FILEPATH], Int)+resolveInodeFd subvolFd inum =+ allocaBytes fspathSize $ \fspath ->+ allocaBytesZero (#size struct btrfs_ioctl_ino_path_args) $ \ipa -> do+ (#poke struct btrfs_ioctl_ino_path_args, inum ) ipa inum+ (#poke struct btrfs_ioctl_ino_path_args, size ) ipa (fromIntegral fspathSize :: Word64)+ (#poke struct btrfs_ioctl_ino_path_args, fspath) ipa fspath+ throwErrnoIfMinus1_ "resolveInode" $ ioctl subvolFd (#const BTRFS_IOC_INO_PATHS) ipa+ elemMissed <- (#peek struct btrfs_data_container, elem_missed) fspath :: IO Word32+ count <- (#peek struct btrfs_data_container, elem_cnt ) fspath :: IO Word32+ let val = (#ptr struct btrfs_data_container, val) fspath :: Ptr Word64+ vals <- peekArray (fromIntegral count) val+ paths <- mapM (peekCString . plusPtr val . fromIntegral) vals+ return (paths, fromIntegral elemMissed)+ where+ fspathSize = 2 * 1024 + (#size struct btrfs_data_container)++-- | Find the file path(s) given an inode number. Returns a list of file paths+-- and an integer indicating the number of path found but not included in+-- the resulting list. This is because of a limitation in the kernel (it+-- will not return an arbitrarily large list). The paths returned are+-- relative to the root of the subvolume.+--+-- Note: calls the @BTRFS_IOC_INO_PATHS@ @ioctl@.+resolveInode+ :: FILEPATH -- ^ The path to the subvolume (or any file in that subvolume).+ -> InodeNum -- ^ The inode number.+ -> IO ([FILEPATH], Int)+resolveInode subvolPath inum =+ withFd subvolPath ReadOnly $ \subvolFd ->+ resolveInodeFd subvolFd inum++lookupInodeFd :: Fd -> SubvolId -> InodeNum -> IO (SubvolId, FILEPATH)+lookupInodeFd fd treeId inum =+ allocaBytesZero (#size struct btrfs_ioctl_ino_lookup_args) $ \ila -> do+ (#poke struct btrfs_ioctl_ino_lookup_args, treeid ) ila treeId+ (#poke struct btrfs_ioctl_ino_lookup_args, objectid) ila inum+ throwErrnoIfMinus1_ "lookupInodeFd" $+ ioctl_fast fd (#const BTRFS_IOC_INO_LOOKUP) ila+ treeId' <- (#peek struct btrfs_ioctl_ino_lookup_args, treeid) ila :: IO Word64+ let cName = (#ptr struct btrfs_ioctl_ino_lookup_args, name) ila+ name <- peekCString cName+ return (treeId', dropTrailingSlash name)++-- | Find the path of a file given its inode number and the id of the+-- subvolume. If multiple files share the same inode number, only one of+-- them is returned. The id of the subvolume is also returned. This is+-- useful when 0 is given for the 'SubvolId' argument (also see+-- 'getSubvol' for this case).+--+-- Note: calls the @BTRFS_IOC_INO_LOOKUP@ @ioctl@.+lookupInode+ :: FILEPATH -- ^ The path to any file in the volume. The subvolume where+ -- this file resides is ignored unless no 'SubvolId' is+ -- provided (see below).+ -> SubvolId -- ^ The id of the subvolume. Can be 0. In that case, the+ -- subvolume of the 'FilePath' is used (see above).+ -> InodeNum -- ^ The inode number.+ -> IO (SubvolId, FILEPATH)+lookupInode path treeId inum =+ withFd path ReadOnly $ \fd -> lookupInodeFd fd treeId inum++--------------------------------------------------------------------------------++getFileNoCOWFd :: Fd -> IO Bool+getFileNoCOWFd fd =+ alloca $ \flagsPtr -> do+ throwErrnoIfMinus1_ "getFileNoCOWFd" $+ ioctl fd (#const FS_IOC_GETFLAGS) flagsPtr+ flags <- peek flagsPtr :: IO CUInt+ return (flags .&. (#const FS_NOCOW_FL) /= 0)++-- | Determine whether the NOCOW flag is enabled for the specified file.+--+-- Note: calls the @FS_IOC_GETFLAGS@ @ioctl@.+getFileNoCOW :: FILEPATH -> IO Bool+getFileNoCOW path =+ withFd path ReadOnly getFileNoCOWFd++setFileNoCOWFd :: Fd -> Bool -> IO ()+setFileNoCOWFd fd noCOW = do+ alloca $ \flagsPtr -> do+ throwErrnoIfMinus1_ "setFileNoCOWFd" $+ ioctl fd (#const FS_IOC_GETFLAGS) flagsPtr+ if noCOW then+ setFlags flagsPtr ((#const FS_NOCOW_FL) :: CUInt)+ else+ clearFlags flagsPtr ((#const FS_NOCOW_FL) :: CUInt)+ throwErrnoIfMinus1_ "setFileNoCOWFd" $+ ioctl fd (#const FS_IOC_SETFLAGS) flagsPtr++-- | Set or clear the NOCOW flag for the specified file. If the file is not+-- empty, this has no effect and no error will be reported.+--+-- Note: calls the @FS_IOC_GETFLAGS@ and @FS_IOC_GETFLAGS@ @ioctl@s.+setFileNoCOW :: FILEPATH -> Bool -> IO ()+setFileNoCOW path noCOW = do+ withFd path ReadOnly $ \fd ->+ setFileNoCOWFd fd noCOW++--------------------------------------------------------------------------------++data SearchKey = SearchKey+ { skTreeId :: ObjectId+ , skMinObjectId :: ObjectId+ , skMinType :: ObjectType+ , skMinOffset :: Word64+ , skMaxObjectId :: ObjectId+ , skMaxType :: ObjectType+ , skMaxOffset :: Word64+ , skMinTransId :: Word64+ , skMaxTransId :: Word64+ }+ deriving (Show, Eq)++defaultSearchKey :: SearchKey+defaultSearchKey = SearchKey+ { skTreeId = 0+ , skMinObjectId = minBound+ , skMinType = minBound+ , skMinOffset = minBound+ , skMaxObjectId = maxBound+ , skMaxType = maxBound+ , skMaxOffset = maxBound+ , skMinTransId = minBound+ , skMaxTransId = maxBound+ }++data SearchHeader = SearchHeader+ { shTransId :: Word64+ , shObjectId :: ObjectId+ , shOffset :: Word64+ , shType :: ObjectType+ , shLen :: Word32+ }+ deriving (Show, Eq)++treeSearchFd :: Fd -> SearchKey -> Int -> (SearchHeader -> Ptr i -> IO ()) -> IO ()+treeSearchFd fd sk maxItemCount0 callback =+ allocaBytesZero (#size struct btrfs_ioctl_search_args) $ \saPtr -> do+ let skPtr = (#ptr struct btrfs_ioctl_search_args, key) saPtr+ pokeSearchKey skPtr sk+ loopSingleSearch saPtr skPtr maxItemCount0+ where+ loopSingleSearch saPtr skPtr maxItemCount+ | maxItemCount <= 0 = return ()+ | otherwise = do+ let nrItems = fromIntegral (min 4096 maxItemCount) :: Word32+ (#poke struct btrfs_ioctl_search_key, nr_items) skPtr nrItems+ throwErrnoIfMinus1_ "treeSearchFd" $+ ioctl fd (#const BTRFS_IOC_TREE_SEARCH) saPtr+ itemsFound <- (#peek struct btrfs_ioctl_search_key, nr_items) skPtr :: IO Word32+ when (itemsFound > 0) $ do+ let shPtr = (#ptr struct btrfs_ioctl_search_args, buf) saPtr+ lastSh <- loopItems shPtr itemsFound+ case nextKey (shObjectId lastSh, shType lastSh, shOffset lastSh) of+ Nothing -> return ()+ Just (objectId, iType, offset) -> do+ (#poke struct btrfs_ioctl_search_key, min_objectid) skPtr objectId+ (#poke struct btrfs_ioctl_search_key, min_type ) skPtr (fromIntegral iType :: Word32)+ (#poke struct btrfs_ioctl_search_key, min_offset ) skPtr offset+ loopSingleSearch saPtr skPtr (maxItemCount - fromIntegral itemsFound)+ -- itemsFound must be at least 1+ loopItems shPtr itemsFound = do+ (sh, itemPtr) <- peekSearchItem shPtr+ callback sh itemPtr+ if itemsFound <= 1 then+ return sh+ else do+ let shPtr' = itemPtr `plusPtr` fromIntegral (shLen sh)+ loopItems shPtr' (itemsFound - 1)+ -- items are index by keys which are (objectId, iType, offset)+ -- they are returned in lexicographical order wrt the keys+ nextKey (objectId, iType, offset)+ | offset < maxBound = Just (objectId, iType, offset + 1)+ | iType < skMaxType sk = Just (objectId, iType + 1, skMinOffset sk)+ | objectId < skMaxObjectId sk = Just (objectId + 1, skMinType sk, skMinOffset sk)+ | otherwise = Nothing++treeSearch :: FILEPATH -> SearchKey -> Int -> (SearchHeader -> Ptr i -> IO ()) -> IO ()+treeSearch path sk maxItemCount callback =+ withFd path ReadOnly $ \fd ->+ treeSearchFd fd sk maxItemCount callback++treeSearchListFd :: Fd -> SearchKey -> (SearchHeader -> Ptr i -> IO (Maybe a)) -> IO [a]+treeSearchListFd fd sk unpack = do+ res <- newIORef []+ treeSearchFd fd sk maxBound $ \sh itemPtr -> do+ r <- unpack sh itemPtr+ case r of+ Nothing -> return ()+ Just x -> modifyIORef' res (x :)+ liftM reverse $ readIORef res++treeSearchList :: FILEPATH -> SearchKey -> (SearchHeader -> Ptr i -> IO (Maybe a)) -> IO [a]+treeSearchList path sk unpack =+ withFd path ReadOnly $ \fd ->+ treeSearchListFd fd sk unpack++findFirstItemFd :: Fd -> SearchKey -> (SearchHeader -> Ptr i -> IO a) -> IO a+findFirstItemFd fd sk unpack = do+ res <- newIORef Nothing+ treeSearchFd fd sk 1 $ \sh ptr -> do+ r <- unpack sh ptr+ modifyIORef' res (`mplus` Just r)+ resV <- readIORef res+ case resV of+ Just x -> return x+ Nothing ->+ ioError $ mkIOError doesNotExistErrorType+ "findFirstItemFd"+ Nothing Nothing++findFirstItem :: FILEPATH -> SearchKey -> (SearchHeader -> Ptr i -> IO a) -> IO a+findFirstItem path sk unpack =+ withFd path ReadOnly $ \fd ->+ findFirstItemFd fd sk unpack++-- does not initialize nr_items+pokeSearchKey :: Ptr a -> SearchKey -> IO ()+pokeSearchKey ptr sk = do+ (#poke struct btrfs_ioctl_search_key, tree_id ) ptr (skTreeId sk)+ (#poke struct btrfs_ioctl_search_key, min_objectid) ptr (skMinObjectId sk)+ (#poke struct btrfs_ioctl_search_key, min_type ) ptr (fromIntegral (skMinType sk) :: Word32)+ (#poke struct btrfs_ioctl_search_key, min_offset ) ptr (skMinOffset sk)+ (#poke struct btrfs_ioctl_search_key, max_objectid) ptr (skMaxObjectId sk)+ (#poke struct btrfs_ioctl_search_key, max_type ) ptr (fromIntegral (skMaxType sk) :: Word32)+ (#poke struct btrfs_ioctl_search_key, max_offset ) ptr (skMaxOffset sk)+ (#poke struct btrfs_ioctl_search_key, min_transid ) ptr (skMinTransId sk)+ (#poke struct btrfs_ioctl_search_key, max_transid ) ptr (skMaxTransId sk)++peekSearchItem :: Ptr a -> IO (SearchHeader, Ptr i)+peekSearchItem shPtr = do+ transId <- (#peek struct btrfs_ioctl_search_header, transid ) shPtr :: IO Word64+ objectId <- (#peek struct btrfs_ioctl_search_header, objectid) shPtr :: IO Word64+ offset <- (#peek struct btrfs_ioctl_search_header, offset ) shPtr :: IO Word64+ iType <- (#peek struct btrfs_ioctl_search_header, type ) shPtr :: IO Word32+ len <- (#peek struct btrfs_ioctl_search_header, len ) shPtr :: IO Word32+ let itemPtr = shPtr `plusPtr` (#size struct btrfs_ioctl_search_header)+ return (SearchHeader transId objectId offset (fromIntegral iType) len, itemPtr)++peekRootRef :: Ptr a -> IO (InodeNum, FILEPATH)+peekRootRef rrPtr = do+ LE64 dirId <- (#peek struct btrfs_root_ref, dirid ) rrPtr+ LE16 nameLen <- (#peek struct btrfs_root_ref, name_len) rrPtr+ let cName = rrPtr `plusPtr` (#size struct btrfs_root_ref)+ name <- peekCStringLen (cName, fromIntegral nameLen)+ return (dirId, name)++--------------------------------------------------------------------------------++withFd :: FILEPATH -> OpenMode -> (Fd -> IO r) -> IO r+withFd path openMode action =+ bracket (openFd path openMode Nothing defaultFileFlags {nonBlock = True})+ closeFd action++withSplitPathOpenParent :: String -> Int -> FILEPATH -> (CStringLen -> Fd -> IO r) -> IO r+withSplitPathOpenParent loc maxLen path action =+ unsafeWithCStringLen name $ \cName @ (_, l) -> do+ unless (l <= maxLen) $+ ioError $ flip ioeSetErrorString "the subvolume name is too long"+ $ mkIOError illegalOperationErrorType loc Nothing (Just (asString name))+ withFd dir ReadOnly $ action cName+ where+ (dir, name) = splitFileName (dropTrailingSlash path)++withBlockSIGVTALRM :: IO a -> IO a+withBlockSIGVTALRM =+ bracket_ (blockSignals s) (unblockSignals s)+ where+ s = addSignal sigVTALRM emptySignalSet++nothingIf :: Bool -> a -> Maybe a+nothingIf f v = if f then Nothing else Just v+{-# INLINE nothingIf #-}++modifyPtr :: Storable a => Ptr a -> (a -> a) -> IO ()+modifyPtr ptr f = do+ peek ptr >>= (poke ptr . f)++setFlags :: (Storable a, Bits a) => Ptr a -> a -> IO ()+setFlags ptr flags =+ modifyPtr ptr (.|. flags)++clearFlags :: (Storable a, Bits a) => Ptr a -> a -> IO ()+clearFlags ptr flags =+ modifyPtr ptr (.&. complement flags)++allocaBytesZero :: Int -> (Ptr a -> IO b) -> IO b+allocaBytesZero size action =+ allocaBytes size $ \ptr -> do+ memset ptr 0 size+ action ptr++memset :: Ptr a -> Word8 -> Int -> IO ()+memset p b l = do+ _ <- c_memset p (fromIntegral b) (fromIntegral l)+ return ()+{-# INLINE memset #-}++foreign import ccall unsafe "string.h memset"+ c_memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
btrfs.cabal view
@@ -1,5 +1,5 @@ name: btrfs-version: 0.1.0.0+version: 0.1.0.1 synopsis: Bindings to the btrfs API description: This package provides low-level bindings to the btrfs API (i.e. the@@ -19,7 +19,7 @@ author: Marios Titas <rednebΑΤgmxDΟΤcom> maintainer: Marios Titas <rednebΑΤgmxDΟΤcom> category: System, Filesystem-build-type: Custom+build-type: Simple cabal-version: >=1.10 extra-source-files:@@ -31,6 +31,7 @@ include/btrfs/list.h include/btrfs/radix-tree.h include/btrfs/rbtree.h+ make-bytestring.hs source-repository head type: git@@ -41,7 +42,8 @@ default: False library- exposed-modules: System.Linux.Btrfs, System.Linux.Btrfs.UUID+ exposed-modules: System.Linux.Btrfs, System.Linux.Btrfs.ByteString,+ System.Linux.Btrfs.UUID other-modules: Data.Word.Endian, System.Linux.Btrfs.Time, System.Linux.Btrfs.FilePathLike build-depends: base >=4.6 && <5, unix >=2.6,
+ make-bytestring.hs view
@@ -0,0 +1,18 @@+#!/usr/bin/runhaskell++import System.Directory+import System.IO+import Control.Monad++main :: IO ()+main = do+ doesFileExist "btrfs.cabal" >>= \f ->+ unless f $ fail "could not find btrfs.cabal"++ -- create System/Linux/Btrfs/ByteString.hsc+ withFile "System/Linux/Btrfs/ByteString.hsc" WriteMode $ \oHdl -> do+ hPutStrLn oHdl "#define BTRFS_RAW_PATHS 1"+ withFile "System/Linux/Btrfs.hsc" ReadMode $ \iHdl -> do+ _ <- hGetLine iHdl -- skip the first line+ contents <- hGetContents iHdl+ hPutStr oHdl contents