{-# OPTIONS_GHC -optc-DBTRFS_RAW_PATHS=1 #-}
{-# LINE 1 "System/Linux/Btrfs/ByteString.hsc" #-}
{-# LINE 2 "System/Linux/Btrfs/ByteString.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LINE 17 "System/Linux/Btrfs/ByteString.hsc" #-}
#define FILEPATH RawFilePath
module System.Linux.Btrfs.ByteString
{-# LINE 23 "System/Linux/Btrfs/ByteString.hsc" #-}
(
FileSize, ObjectType, ObjectId, InodeNum, SubvolId, CompressionType(..)
, cloneFd, clone, cloneNew
, cloneRangeFd, cloneRange
, CloneResult(..)
, cloneRangeIfSameFd, cloneRangeIfSame
, 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
, getDefaultSubvolFd, getDefaultSubvol
, setDefaultSubvolFd, setDefaultSubvol
, defragFd, defrag
, DefragRangeArgs(..), defaultDefragRangeArgs
, defragRangeFd, defragRange
, syncFd, sync
, startSyncFd, startSync
, waitSyncFd, waitSync
, resolveLogicalFd, resolveLogical
, resolveInodeFd, resolveInode
, lookupInodeFd, lookupInode
, getFileNoCOWFd, getFileNoCOW
, setFileNoCOWFd, setFileNoCOW
, 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 Prelude
import Foreign
import Foreign.C.Types
import Foreign.C.String (CStringLen)
import Foreign.C.Error
import System.Linux.Btrfs.FilePathLike
import Data.Word.Endian
import System.Linux.Btrfs.Time
import System.Linux.Btrfs.UUID
import System.Linux.Capabilities
{-# LINE 101 "System/Linux/Btrfs/ByteString.hsc" #-}
{-# LINE 102 "System/Linux/Btrfs/ByteString.hsc" #-}
{-# LINE 104 "System/Linux/Btrfs/ByteString.hsc" #-}
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
data CompressionType = Zlib | LZO
deriving (Show, Read, Eq, Enum, Bounded)
cloneFd :: Fd -> Fd -> IO ()
cloneFd srcFd dstFd =
throwErrnoIfMinus1_ "cloneFd" $
ioctl_fast dstFd (1074041865) srcFdP
{-# LINE 129 "System/Linux/Btrfs/ByteString.hsc" #-}
where
srcFdP = intPtrToPtr (fromIntegral srcFd)
clone
:: FILEPATH
-> FILEPATH
-> IO ()
clone srcPath dstPath =
withFd srcPath ReadOnly $ \srcFd ->
withFd dstPath WriteOnly $ \dstFd ->
cloneFd srcFd dstFd
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 ((32)) $ \cra -> do
{-# LINE 159 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) cra (fromIntegral srcFd :: Int64)
{-# LINE 160 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) cra (srcOff :: Word64)
{-# LINE 161 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) cra (srcLen :: Word64)
{-# LINE 162 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) cra (dstOff :: Word64)
{-# LINE 163 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "cloneRangeFd" $
ioctl_fast dstFd (1075876877) cra
{-# LINE 165 "System/Linux/Btrfs/ByteString.hsc" #-}
cloneRange
:: FILEPATH
-> FileSize
-> FileSize
-> FILEPATH
-> FileSize
-> IO ()
cloneRange srcPath srcOff srcLen dstPath dstOff =
withFd srcPath ReadOnly $ \srcFd ->
withFd dstPath WriteOnly $ \dstFd ->
cloneRangeFd srcFd srcOff srcLen dstFd dstOff
{-# LINE 184 "System/Linux/Btrfs/ByteString.hsc" #-}
data SameExtentInfoIn = SameExtentInfoIn
Fd
FileSize
instance Storable SameExtentInfoIn where
sizeOf _ = ((32))
{-# LINE 190 "System/Linux/Btrfs/ByteString.hsc" #-}
alignment _ = alignment (undefined :: CInt)
poke ptr (SameExtentInfoIn dstFd dstOff) = do
memset ptr 0 ((32))
{-# LINE 193 "System/Linux/Btrfs/ByteString.hsc" #-}
let dstFd' = fromIntegral dstFd :: Int64
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr dstFd'
{-# LINE 195 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr dstOff
{-# LINE 196 "System/Linux/Btrfs/ByteString.hsc" #-}
peek _ = error "not implemented"
data SameExtentInfoOut = SameExtentInfoOut
Int32
FileSize
instance Storable SameExtentInfoOut where
sizeOf _ = ((32))
{-# LINE 204 "System/Linux/Btrfs/ByteString.hsc" #-}
alignment _ = alignment (undefined :: CInt)
poke _ _ = error "not implemented"
peek ptr = do
status <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 208 "System/Linux/Btrfs/ByteString.hsc" #-}
bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 209 "System/Linux/Btrfs/ByteString.hsc" #-}
return (SameExtentInfoOut status bytes)
{-# LINE 211 "System/Linux/Btrfs/ByteString.hsc" #-}
data CloneResult
= CRError IOError
| CRDataDiffers
| CRSuccess FileSize
deriving (Show, Eq)
cloneRangeIfSameFd :: Fd -> FileSize -> FileSize -> [(Fd, FileSize)] -> IO [CloneResult]
{-# LINE 227 "System/Linux/Btrfs/ByteString.hsc" #-}
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 ((24))
{-# LINE 234 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) sa srcOff
{-# LINE 235 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) sa srcLen
{-# LINE 236 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) sa dstCount'
{-# LINE 237 "System/Linux/Btrfs/ByteString.hsc" #-}
let info = ((\hsc_ptr -> hsc_ptr `plusPtr` 24)) sa
{-# LINE 238 "System/Linux/Btrfs/ByteString.hsc" #-}
pokeArray info (map (uncurry SameExtentInfoIn) dsts)
throwErrnoIfMinus1_ "cloneRangeIfSameFd" $
ioctl srcFd (3222836278) sa
{-# LINE 241 "System/Linux/Btrfs/ByteString.hsc" #-}
res <- peekArray dstCount info
return $ flip map res $ \(SameExtentInfoOut status bytes) ->
if status == 0 then
CRSuccess bytes
else if status == (1) then
{-# LINE 246 "System/Linux/Btrfs/ByteString.hsc" #-}
CRDataDiffers
else if status <= 0 then
CRError $ errnoToIOError "cloneRangeIfSameFd"
(Errno $ fromIntegral $ -status)
Nothing Nothing
else
error $ "unknown status value (" ++ show status ++ ")"
where
saSize = ((24)) +
{-# LINE 255 "System/Linux/Btrfs/ByteString.hsc" #-}
dstCount * ((32))
{-# LINE 256 "System/Linux/Btrfs/ByteString.hsc" #-}
dstCount = length dsts
dstCount' = fromIntegral dstCount :: Word64
maxCount = fromIntegral (maxBound :: Word16)
{-# LINE 260 "System/Linux/Btrfs/ByteString.hsc" #-}
cloneRangeIfSame
:: FILEPATH
-> FileSize
-> FileSize
-> [(FILEPATH, FileSize)]
-> IO [CloneResult]
cloneRangeIfSame srcPath srcOff srcLen dstsP0 = do
isAdmin <- hasSysAdminCap
let openMode = if isAdmin then ReadOnly else WriteOnly
withFd srcPath ReadOnly $ \srcFd ->
loop srcFd openMode (reverse dstsP0) []
where
loop srcFd openMode ((dstPath, dstOff) : dstsP) dsts =
withFd dstPath openMode $ \fd ->
loop srcFd openMode dstsP ((fd, dstOff) : dsts)
loop srcFd _ [] dsts =
cloneRangeIfSameFd srcFd srcOff srcLen dsts
simpleSubvolOp :: String -> FILEPATH -> CULong -> IO ()
simpleSubvolOp loc path req =
withSplitPathOpenParent loc (4087) path $ \(cName, l) dirFd ->
{-# LINE 303 "System/Linux/Btrfs/ByteString.hsc" #-}
allocaBytesZero ((4096)) $ \iva -> do
{-# LINE 304 "System/Linux/Btrfs/ByteString.hsc" #-}
let ivaName = ((\hsc_ptr -> hsc_ptr `plusPtr` 8)) iva
{-# LINE 305 "System/Linux/Btrfs/ByteString.hsc" #-}
copyBytes ivaName cName l
throwErrnoIfMinus1_ loc $
ioctl dirFd req iva
createSubvol :: FILEPATH -> IO ()
createSubvol path =
simpleSubvolOp "createSubvol" path (1342215182)
{-# LINE 315 "System/Linux/Btrfs/ByteString.hsc" #-}
destroySubvol :: FILEPATH -> IO ()
destroySubvol path =
simpleSubvolOp "destroySubvol" path (1342215183)
{-# LINE 322 "System/Linux/Btrfs/ByteString.hsc" #-}
snapshotFd :: Fd -> FILEPATH -> Bool -> IO ()
snapshotFd srcFd dstPath readOnly =
withSplitPathOpenParent "snapshotFd" (4039) dstPath $ \(cName, l) dirFd ->
{-# LINE 326 "System/Linux/Btrfs/ByteString.hsc" #-}
allocaBytesZero ((4096)) $ \iva -> do
{-# LINE 327 "System/Linux/Btrfs/ByteString.hsc" #-}
let ivaName = ((\hsc_ptr -> hsc_ptr `plusPtr` 56)) iva
{-# LINE 328 "System/Linux/Btrfs/ByteString.hsc" #-}
copyBytes ivaName cName l
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) iva (fromIntegral srcFd :: Int64)
{-# LINE 330 "System/Linux/Btrfs/ByteString.hsc" #-}
when readOnly $
setFlags (((\hsc_ptr -> hsc_ptr `plusPtr` 16)) iva)
{-# LINE 332 "System/Linux/Btrfs/ByteString.hsc" #-}
((2) :: Word64)
{-# LINE 333 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "snapshotFd" $
ioctl dirFd (1342215191) iva
{-# LINE 335 "System/Linux/Btrfs/ByteString.hsc" #-}
snapshot
:: FILEPATH
-> FILEPATH
-> Bool
-> 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 (2148045849) flagsPtr
{-# LINE 353 "System/Linux/Btrfs/ByteString.hsc" #-}
flags <- peek flagsPtr :: IO Word64
return (flags .&. (2) /= 0)
{-# LINE 355 "System/Linux/Btrfs/ByteString.hsc" #-}
getSubvolReadOnly :: FILEPATH -> IO Bool
getSubvolReadOnly path = withFd path ReadOnly getSubvolReadOnlyFd
setSubvolReadOnlyFd :: Fd -> Bool -> IO ()
setSubvolReadOnlyFd fd readOnly =
alloca $ \flagsPtr -> do
throwErrnoIfMinus1_ "setSubvolReadOnlyFd" $
ioctl fd (2148045849) flagsPtr
{-# LINE 367 "System/Linux/Btrfs/ByteString.hsc" #-}
if readOnly then
setFlags flagsPtr ((2) :: Word64)
{-# LINE 369 "System/Linux/Btrfs/ByteString.hsc" #-}
else
clearFlags flagsPtr ((2) :: Word64)
{-# LINE 371 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "setSubvolReadOnlyFd" $
ioctl fd (1074304026) flagsPtr
{-# LINE 373 "System/Linux/Btrfs/ByteString.hsc" #-}
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 (256)
{-# LINE 385 "System/Linux/Btrfs/ByteString.hsc" #-}
return subvolId
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 = (1)
{-# LINE 396 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (144)
{-# LINE 399 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (144)
{-# LINE 400 "System/Linux/Btrfs/ByteString.hsc" #-}
}
findFirstItemFd fd sk $ \sh rr -> do
(dirId, name) <- peekRootRef rr
return (shOffset sh, dirId, name)
lookupSubvol
:: FILEPATH
-> SubvolId
-> 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 == (256) then
{-# LINE 423 "System/Linux/Btrfs/ByteString.hsc" #-}
return (parentPath </> name)
else do
(_, dirName) <- lookupInodeFd fd parentId dirId
return (parentPath </> dirName </> name)
resolveSubvol
:: FILEPATH
-> SubvolId
-> IO FILEPATH
resolveSubvol path subvolId =
withFd path ReadOnly $ \fd ->
resolveSubvolFd fd subvolId
rootSubvol :: SubvolId
rootSubvol = (5)
{-# LINE 441 "System/Linux/Btrfs/ByteString.hsc" #-}
listSubvolsFd :: Fd -> IO [(SubvolId, SubvolId, InodeNum, FILEPATH)]
listSubvolsFd fd = do
let sk = defaultSearchKey
{ skTreeId = (1)
{-# LINE 446 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = (256)
{-# LINE 447 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxObjectId = (18446744073709551360)
{-# LINE 448 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinType = (144)
{-# LINE 449 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (144)
{-# LINE 450 "System/Linux/Btrfs/ByteString.hsc" #-}
}
treeSearchListFd fd sk unpack
where
unpack sh rr
| shType sh /= (144) =
{-# LINE 455 "System/Linux/Btrfs/ByteString.hsc" #-}
return Nothing
| otherwise = do
(dirId, name) <- peekRootRef rr
return $ Just (shObjectId sh, shOffset sh, dirId, name)
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)
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 = (1)
{-# LINE 487 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (156)
{-# LINE 490 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (156)
{-# LINE 491 "System/Linux/Btrfs/ByteString.hsc" #-}
}
treeSearchListFd fd sk unpack
where
unpack sh rr
| shType sh /= (156) =
{-# LINE 496 "System/Linux/Btrfs/ByteString.hsc" #-}
return Nothing
| otherwise = do
(dirId, name) <- peekRootRef rr
return $ Just (shOffset sh, dirId, name)
childSubvols
:: FILEPATH
-> SubvolId
-> 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 == (256) then
{-# LINE 517 "System/Linux/Btrfs/ByteString.hsc" #-}
return (childId, name)
else do
(_, dirName) <- lookupInodeFd fd subvolId dirId
return (childId, dirName </> name)
childSubvolPaths
:: FILEPATH
-> SubvolId
-> IO [(SubvolId, FILEPATH)]
childSubvolPaths path subvolId =
withFd path ReadOnly $ \fd ->
childSubvolPathsFd fd subvolId
data SubvolInfo = SubvolInfo
{ siGeneration :: Word64
, siLastSnapshot :: Maybe Word64
, siParSnapGen :: Maybe Word64
, siReadOnly :: Bool
, siUuid :: Maybe UUID
, siPUuid :: Maybe UUID
, siReceivedUuid :: Maybe UUID
, siCTransId :: Maybe Word64
, siOTransId :: Maybe Word64
, siSTransId :: Maybe Word64
, siRTransId :: Maybe Word64
, siCTime :: Maybe UTCTime
, siOTime :: Maybe UTCTime
, siSTime :: Maybe UTCTime
, siRTime :: Maybe UTCTime
}
deriving (Show, Eq)
getSubvolInfoFd :: Fd -> SubvolId -> IO SubvolInfo
getSubvolInfoFd fd subvolId
| subvolId /= rootSubvol &&
(subvolId < (256) || subvolId > (18446744073709551360)) =
{-# LINE 577 "System/Linux/Btrfs/ByteString.hsc" #-}
ioError $ mkIOError doesNotExistErrorType
"getSubvolInfoFd"
Nothing Nothing
| otherwise = do
let sk = defaultSearchKey
{ skTreeId = (1)
{-# LINE 583 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (132)
{-# LINE 586 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (132)
{-# LINE 587 "System/Linux/Btrfs/ByteString.hsc" #-}
}
findFirstItemFd fd sk unpack
where
unpack sh ri = do
LE64 generation <- ((\hsc_ptr -> peekByteOff hsc_ptr 160)) ri
{-# LINE 592 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 lastSnapshot <- ((\hsc_ptr -> peekByteOff hsc_ptr 200)) ri
{-# LINE 593 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 208)) ri
{-# LINE 594 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 generationV2 <- ((\hsc_ptr -> peekByteOff hsc_ptr 239)) ri
{-# LINE 595 "System/Linux/Btrfs/ByteString.hsc" #-}
let nv2 = generationV2 < generation
uuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 247)) ri :: IO UUID
{-# LINE 597 "System/Linux/Btrfs/ByteString.hsc" #-}
pUuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 263)) ri :: IO UUID
{-# LINE 598 "System/Linux/Btrfs/ByteString.hsc" #-}
receivedUuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 279)) ri :: IO UUID
{-# LINE 599 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 cTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 295)) ri
{-# LINE 600 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 oTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 303)) ri
{-# LINE 601 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 sTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 311)) ri
{-# LINE 602 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 rTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 319)) ri
{-# LINE 603 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime cTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 327)) ri
{-# LINE 604 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime oTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 339)) ri
{-# LINE 605 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime sTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 351)) ri
{-# LINE 606 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime rTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 363)) ri
{-# LINE 607 "System/Linux/Btrfs/ByteString.hsc" #-}
return $ SubvolInfo
{ siGeneration = generation
, siLastSnapshot = nothingIf (lastSnapshot == 0) $ lastSnapshot
, siParSnapGen = nothingIf (shOffset sh == 0) $ shOffset sh
, siReadOnly = flags .&. (2) /= 0
{-# LINE 612 "System/Linux/Btrfs/ByteString.hsc" #-}
, 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
}
getSubvolInfo
:: FILEPATH
-> SubvolId
-> 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 = (9)
{-# LINE 638 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = hLE
, skMaxObjectId = hLE
, skMinType = typ
, skMaxType = typ
, skMinOffset = lLE
, skMaxOffset = lLE
}
findFirstItemFd fd sk $ \_ ptr ->
liftM fromLE64 $ peek ptr
where
lLE = invert64 lBE
hLE = invert64 hBE
getSubvolByUuidFd :: Fd -> UUID -> IO SubvolId
getSubvolByUuidFd =
searchByUuidFd (251)
{-# LINE 656 "System/Linux/Btrfs/ByteString.hsc" #-}
getSubvolByUuid
:: FILEPATH
-> UUID
-> IO SubvolId
getSubvolByUuid path uuid =
withFd path ReadOnly $ \fd ->
getSubvolByUuidFd fd uuid
getSubvolByReceivedUuidFd :: Fd -> UUID -> IO SubvolId
getSubvolByReceivedUuidFd =
searchByUuidFd (252)
{-# LINE 672 "System/Linux/Btrfs/ByteString.hsc" #-}
getSubvolByReceivedUuid
:: FILEPATH
-> UUID
-> IO SubvolId
getSubvolByReceivedUuid path uuid =
withFd path ReadOnly $ \fd ->
getSubvolByReceivedUuidFd fd uuid
getDefaultSubvolFd :: Fd -> IO SubvolId
getDefaultSubvolFd fd = do
let sk = defaultSearchKey
{ skTreeId = (1)
{-# LINE 689 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = (6)
{-# LINE 690 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxObjectId = (6)
{-# LINE 691 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinType = (84)
{-# LINE 692 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (84)
{-# LINE 693 "System/Linux/Btrfs/ByteString.hsc" #-}
}
l <- treeSearchListFd fd sk $ \_ ptr -> do
LE16 nameLen <- ((\hsc_ptr -> peekByteOff hsc_ptr 27)) ptr
{-# LINE 696 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = ptr `plusPtr` ((30))
{-# LINE 697 "System/Linux/Btrfs/ByteString.hsc" #-}
name <- peekCStringLen (cName, fromIntegral nameLen)
if name /= "default" then
return Nothing
else do
let location = ptr `plusPtr` ((0))
{-# LINE 702 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 objectId <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) location
{-# LINE 703 "System/Linux/Btrfs/ByteString.hsc" #-}
return (Just objectId)
case l of
[] -> ioError $ mkIOError doesNotExistErrorType "getDefaultSubvolFd" Nothing Nothing
(objectId : _) -> return objectId
getDefaultSubvol
:: FILEPATH
-> IO SubvolId
getDefaultSubvol path = withFd path ReadOnly getDefaultSubvolFd
setDefaultSubvolFd :: Fd -> ObjectId -> IO ()
setDefaultSubvolFd fd objectId = do
alloca $ \ptr -> do
poke ptr objectId
throwErrnoIfMinus1_ "setDefaultSubvolFd" $
ioctl fd (1074304019) ptr
{-# LINE 721 "System/Linux/Btrfs/ByteString.hsc" #-}
setDefaultSubvol
:: FILEPATH
-> SubvolId
-> IO ()
setDefaultSubvol path subvolId =
withFd path ReadOnly $ \fd -> setDefaultSubvolFd fd subvolId
defragFd :: Fd -> IO ()
defragFd fd =
throwErrnoIfMinus1_ "defragFd" $
withBlockSIGVTALRM $
ioctl fd (1342215170) nullPtr
{-# LINE 739 "System/Linux/Btrfs/ByteString.hsc" #-}
defrag :: FILEPATH -> IO ()
defrag path = withFd path ReadWrite defragFd
data DefragRangeArgs = DefragRangeArgs
{ draStart :: FileSize
, draLength :: FileSize
, draExtentThreshold :: Word32
, draCompress :: Maybe CompressionType
, draFlush :: Bool
}
deriving (Show, Eq)
defaultDefragRangeArgs :: DefragRangeArgs
defaultDefragRangeArgs = DefragRangeArgs
{ draStart = 0
, draLength = maxBound
, draExtentThreshold = 0
, draCompress = Nothing
, draFlush = False
}
defragRangeFd :: Fd -> DefragRangeArgs -> IO ()
defragRangeFd fd DefragRangeArgs{..} =
allocaBytesZero ((48)) $ \args -> do
{-# LINE 776 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) args draStart
{-# LINE 777 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) args draLength
{-# LINE 778 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) args flags
{-# LINE 779 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) args draExtentThreshold
{-# LINE 780 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) args comp_type
{-# LINE 781 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "defragRangeFd" $
withBlockSIGVTALRM $
ioctl fd (1076925456) args
{-# LINE 784 "System/Linux/Btrfs/ByteString.hsc" #-}
where
flags = comp_flags .|. if draFlush then (2) else 0
{-# LINE 786 "System/Linux/Btrfs/ByteString.hsc" #-}
comp_flags :: Word64
comp_type :: Word32
(comp_flags, comp_type) =
case draCompress of
Nothing -> (0, 0)
Just Zlib -> ((1), (1))
{-# LINE 792 "System/Linux/Btrfs/ByteString.hsc" #-}
Just LZO -> ((1), (2))
{-# LINE 793 "System/Linux/Btrfs/ByteString.hsc" #-}
defragRange :: FILEPATH -> DefragRangeArgs -> IO ()
defragRange path args =
withFd path ReadWrite $ \fd ->
defragRangeFd fd args
syncFd :: Fd -> IO ()
syncFd fd =
throwErrnoIfMinus1_ "syncFd" $
ioctl fd (37896) nullPtr
{-# LINE 808 "System/Linux/Btrfs/ByteString.hsc" #-}
sync :: FILEPATH -> IO ()
sync path = withFd path ReadOnly syncFd
startSyncFd :: Fd -> IO ()
startSyncFd fd =
throwErrnoIfMinus1_ "startSyncFd" $
ioctl_fast fd (2148045848) nullPtr
{-# LINE 820 "System/Linux/Btrfs/ByteString.hsc" #-}
startSync :: FILEPATH -> IO ()
startSync path = withFd path ReadOnly startSyncFd
waitSyncFd :: Fd -> IO ()
waitSyncFd fd =
throwErrnoIfMinus1_ "waitSyncFd" $
ioctl fd (1074304022) nullPtr
{-# LINE 831 "System/Linux/Btrfs/ByteString.hsc" #-}
waitSync :: FILEPATH -> IO ()
waitSync path = withFd path ReadOnly waitSyncFd
resolveLogicalFd :: Fd -> FileSize -> IO ([(InodeNum, FileSize, SubvolId)], Int)
resolveLogicalFd rootFd logical =
allocaBytes inodesSize $ \inodes ->
allocaBytesZero ((56)) $ \lia -> do
{-# LINE 844 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) lia logical
{-# LINE 845 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) lia (fromIntegral inodesSize :: Word64)
{-# LINE 846 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) lia inodes
{-# LINE 847 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "resolveLogical" $ ioctl rootFd (3224933412) lia
{-# LINE 848 "System/Linux/Btrfs/ByteString.hsc" #-}
elemMissed <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) inodes :: IO Word32
{-# LINE 849 "System/Linux/Btrfs/ByteString.hsc" #-}
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) inodes :: IO Word32
{-# LINE 850 "System/Linux/Btrfs/ByteString.hsc" #-}
let val = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) inodes :: Ptr Word64
{-# LINE 851 "System/Linux/Btrfs/ByteString.hsc" #-}
vals <- peekArray (fromIntegral count) val
return (extractTriplets vals, fromIntegral elemMissed)
where
inodesSize = 64 * 1024 + ((16))
{-# LINE 855 "System/Linux/Btrfs/ByteString.hsc" #-}
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"
resolveLogical
:: FILEPATH
-> FileSize
-> 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 ((56)) $ \ipa -> do
{-# LINE 880 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ipa inum
{-# LINE 881 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ipa (fromIntegral fspathSize :: Word64)
{-# LINE 882 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ipa fspath
{-# LINE 883 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "resolveInode" $ ioctl subvolFd (3224933411) ipa
{-# LINE 884 "System/Linux/Btrfs/ByteString.hsc" #-}
elemMissed <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) fspath :: IO Word32
{-# LINE 885 "System/Linux/Btrfs/ByteString.hsc" #-}
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) fspath :: IO Word32
{-# LINE 886 "System/Linux/Btrfs/ByteString.hsc" #-}
let val = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) fspath :: Ptr Word64
{-# LINE 887 "System/Linux/Btrfs/ByteString.hsc" #-}
vals <- peekArray (fromIntegral count) val
paths <- mapM (peekCString . plusPtr val . fromIntegral) vals
return (paths, fromIntegral elemMissed)
where
fspathSize = 2 * 1024 + ((16))
{-# LINE 892 "System/Linux/Btrfs/ByteString.hsc" #-}
resolveInode
:: FILEPATH
-> InodeNum
-> 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 ((4096)) $ \ila -> do
{-# LINE 911 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ila treeId
{-# LINE 912 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ila inum
{-# LINE 913 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "lookupInodeFd" $
ioctl_fast fd (3489698834) ila
{-# LINE 915 "System/Linux/Btrfs/ByteString.hsc" #-}
treeId' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ila :: IO Word64
{-# LINE 916 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) ila
{-# LINE 917 "System/Linux/Btrfs/ByteString.hsc" #-}
name <- peekCString cName
return (treeId', dropTrailingSlash name)
lookupInode
:: FILEPATH
-> SubvolId
-> InodeNum
-> 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 (2148034049) flagsPtr
{-# LINE 945 "System/Linux/Btrfs/ByteString.hsc" #-}
flags <- peek flagsPtr :: IO CUInt
return (flags .&. (8388608) /= 0)
{-# LINE 947 "System/Linux/Btrfs/ByteString.hsc" #-}
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 (2148034049) flagsPtr
{-# LINE 960 "System/Linux/Btrfs/ByteString.hsc" #-}
if noCOW then
setFlags flagsPtr ((8388608) :: CUInt)
{-# LINE 962 "System/Linux/Btrfs/ByteString.hsc" #-}
else
clearFlags flagsPtr ((8388608) :: CUInt)
{-# LINE 964 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "setFileNoCOWFd" $
ioctl fd (1074292226) flagsPtr
{-# LINE 966 "System/Linux/Btrfs/ByteString.hsc" #-}
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 ((4096)) $ \saPtr -> do
{-# LINE 1016 "System/Linux/Btrfs/ByteString.hsc" #-}
let skPtr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) saPtr
{-# LINE 1017 "System/Linux/Btrfs/ByteString.hsc" #-}
pokeSearchKey skPtr sk
loopSingleSearch saPtr skPtr maxItemCount0
where
loopSingleSearch saPtr skPtr maxItemCount
| maxItemCount <= 0 = return ()
| otherwise = do
let nrItems = fromIntegral (min 4096 maxItemCount) :: Word32
((\hsc_ptr -> pokeByteOff hsc_ptr 64)) skPtr nrItems
{-# LINE 1025 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "treeSearchFd" $
ioctl fd (3489698833) saPtr
{-# LINE 1027 "System/Linux/Btrfs/ByteString.hsc" #-}
itemsFound <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) skPtr :: IO Word32
{-# LINE 1028 "System/Linux/Btrfs/ByteString.hsc" #-}
when (itemsFound > 0) $ do
let shPtr = ((\hsc_ptr -> hsc_ptr `plusPtr` 104)) saPtr
{-# LINE 1030 "System/Linux/Btrfs/ByteString.hsc" #-}
lastSh <- loopItems shPtr itemsFound
case nextKey (shObjectId lastSh, shType lastSh, shOffset lastSh) of
Nothing -> return ()
Just (objectId, iType, offset) -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) skPtr objectId
{-# LINE 1035 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) skPtr (fromIntegral iType :: Word32)
{-# LINE 1036 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) skPtr offset
{-# LINE 1037 "System/Linux/Btrfs/ByteString.hsc" #-}
loopSingleSearch saPtr skPtr (maxItemCount - fromIntegral itemsFound)
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)
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
pokeSearchKey :: Ptr a -> SearchKey -> IO ()
pokeSearchKey ptr sk = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (skTreeId sk)
{-# LINE 1098 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (skMinObjectId sk)
{-# LINE 1099 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr (fromIntegral (skMinType sk) :: Word32)
{-# LINE 1100 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (skMinOffset sk)
{-# LINE 1101 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (skMaxObjectId sk)
{-# LINE 1102 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 60)) ptr (fromIntegral (skMaxType sk) :: Word32)
{-# LINE 1103 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (skMaxOffset sk)
{-# LINE 1104 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (skMinTransId sk)
{-# LINE 1105 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr (skMaxTransId sk)
{-# LINE 1106 "System/Linux/Btrfs/ByteString.hsc" #-}
peekSearchItem :: Ptr a -> IO (SearchHeader, Ptr i)
peekSearchItem shPtr = do
transId <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) shPtr :: IO Word64
{-# LINE 1110 "System/Linux/Btrfs/ByteString.hsc" #-}
objectId <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) shPtr :: IO Word64
{-# LINE 1111 "System/Linux/Btrfs/ByteString.hsc" #-}
offset <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) shPtr :: IO Word64
{-# LINE 1112 "System/Linux/Btrfs/ByteString.hsc" #-}
iType <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) shPtr :: IO Word32
{-# LINE 1113 "System/Linux/Btrfs/ByteString.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) shPtr :: IO Word32
{-# LINE 1114 "System/Linux/Btrfs/ByteString.hsc" #-}
let itemPtr = shPtr `plusPtr` ((32))
{-# LINE 1115 "System/Linux/Btrfs/ByteString.hsc" #-}
return (SearchHeader transId objectId offset (fromIntegral iType) len, itemPtr)
peekRootRef :: Ptr a -> IO (InodeNum, FILEPATH)
peekRootRef rrPtr = do
LE64 dirId <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) rrPtr
{-# LINE 1120 "System/Linux/Btrfs/ByteString.hsc" #-}
LE16 nameLen <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) rrPtr
{-# LINE 1121 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = rrPtr `plusPtr` ((18))
{-# LINE 1122 "System/Linux/Btrfs/ByteString.hsc" #-}
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)