{-# OPTIONS_GHC -optc-DBTRFS_RAW_PATHS=1 #-}
{-# LINE 1 "System/Linux/Btrfs/ByteString.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LINE 17 "System/Linux/Btrfs/ByteString.hsc" #-}
#define FILEPATH RawFilePath
module System.Linux.Btrfs.ByteString
{-# DEPRECATED "This module is deprecated and will be removed in a\
future version of this library. Please leave a comment on\
https://github.com/redneb/hs-btrfs/issues/5 if you think that is\
should not be removed." #-}
{-# LINE 27 "System/Linux/Btrfs/ByteString.hsc" #-}
(
FileSize, ObjectType, ObjectId, InodeNum, SubvolId
, CompressionType, compressNone, compressZlib, compressLZO, compressZstd
, 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
, FSInfo
, fsiDeviceCount, fsiUuid, fsiNodeSize, fsiSectorSize, fsiCloneAlignment
, getFSInfoFd, getFSInfo
, getFSLabelFd, getFSLabel
, setFSLabelFd, setFSLabel
, 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, sync)
import System.Posix.Files
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
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
newtype CompressionType = CompressionType Word32
deriving Eq
instance Show CompressionType where
show t
| t == compressNone = "compressNone"
| t == compressZlib = "compressZlib"
| t == compressLZO = "compressLZO"
| t == compressZstd = "compressZstd"
| otherwise = error "unknown compression type"
compressNone, compressZlib, compressLZO, compressZstd :: CompressionType
compressNone = CompressionType (0)
{-# LINE 153 "System/Linux/Btrfs/ByteString.hsc" #-}
compressZlib = CompressionType (1)
{-# LINE 154 "System/Linux/Btrfs/ByteString.hsc" #-}
compressLZO = CompressionType (2)
{-# LINE 155 "System/Linux/Btrfs/ByteString.hsc" #-}
compressZstd = CompressionType (3)
{-# LINE 156 "System/Linux/Btrfs/ByteString.hsc" #-}
cloneFd :: Fd -> Fd -> IO ()
cloneFd srcFd dstFd =
throwErrnoIfMinus1_ "cloneFd" $
ioctl_fast dstFd (1074041865) srcFdP
{-# LINE 163 "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 defaultFileFlags {trunc = True, creat = Just mode}) closeFd $ \dstFd ->
cloneFd srcFd dstFd
cloneRangeFd :: Fd -> FileSize -> FileSize -> Fd -> FileSize -> IO ()
cloneRangeFd srcFd srcOff srcLen dstFd dstOff =
allocaBytesZero ((32)) $ \cra -> do
{-# LINE 193 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) cra (fromIntegral srcFd :: Int64)
{-# LINE 194 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) cra (srcOff :: Word64)
{-# LINE 195 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) cra (srcLen :: Word64)
{-# LINE 196 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) cra (dstOff :: Word64)
{-# LINE 197 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "cloneRangeFd" $
ioctl_fast dstFd (1075876877) cra
{-# LINE 199 "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 219 "System/Linux/Btrfs/ByteString.hsc" #-}
data SameExtentInfoIn = SameExtentInfoIn
Fd
FileSize
instance Storable SameExtentInfoIn where
sizeOf _ = ((32))
{-# LINE 225 "System/Linux/Btrfs/ByteString.hsc" #-}
alignment _ = alignment (undefined :: CInt)
poke ptr (SameExtentInfoIn dstFd dstOff) = do
memset ptr 0 ((32))
{-# LINE 228 "System/Linux/Btrfs/ByteString.hsc" #-}
let dstFd' = fromIntegral dstFd :: Int64
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr dstFd'
{-# LINE 230 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr dstOff
{-# LINE 231 "System/Linux/Btrfs/ByteString.hsc" #-}
peek _ = error "not implemented"
data SameExtentInfoOut = SameExtentInfoOut
Int32
FileSize
instance Storable SameExtentInfoOut where
sizeOf _ = ((32))
{-# LINE 239 "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 243 "System/Linux/Btrfs/ByteString.hsc" #-}
bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 244 "System/Linux/Btrfs/ByteString.hsc" #-}
return (SameExtentInfoOut status bytes)
{-# LINE 246 "System/Linux/Btrfs/ByteString.hsc" #-}
data CloneResult
= CRError IOError
| CRDataDiffers
| CRSuccess FileSize
deriving (Show, Eq)
cloneRangeIfSameFd :: Fd -> FileSize -> FileSize -> [(Fd, FileSize)] -> IO [CloneResult]
{-# LINE 262 "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 269 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) sa srcOff
{-# LINE 270 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) sa srcLen
{-# LINE 271 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) sa dstCount'
{-# LINE 272 "System/Linux/Btrfs/ByteString.hsc" #-}
let info = ((\hsc_ptr -> hsc_ptr `plusPtr` 24)) sa
{-# LINE 273 "System/Linux/Btrfs/ByteString.hsc" #-}
pokeArray info (map (uncurry SameExtentInfoIn) dsts)
throwErrnoIfMinus1_ "cloneRangeIfSameFd" $
ioctl srcFd (3222836278) sa
{-# LINE 276 "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 281 "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 290 "System/Linux/Btrfs/ByteString.hsc" #-}
dstCount * ((32))
{-# LINE 291 "System/Linux/Btrfs/ByteString.hsc" #-}
dstCount = length dsts
dstCount' = fromIntegral dstCount :: Word64
maxCount = fromIntegral (maxBound :: Word16)
{-# LINE 295 "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 338 "System/Linux/Btrfs/ByteString.hsc" #-}
allocaBytesZero ((4096)) $ \iva -> do
{-# LINE 339 "System/Linux/Btrfs/ByteString.hsc" #-}
let ivaName = ((\hsc_ptr -> hsc_ptr `plusPtr` 8)) iva
{-# LINE 340 "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 350 "System/Linux/Btrfs/ByteString.hsc" #-}
destroySubvol :: FILEPATH -> IO ()
destroySubvol path =
simpleSubvolOp "destroySubvol" path (1342215183)
{-# LINE 360 "System/Linux/Btrfs/ByteString.hsc" #-}
snapshotFd :: Fd -> FILEPATH -> Bool -> IO ()
snapshotFd srcFd dstPath readOnly =
withSplitPathOpenParent "snapshotFd" (4039) dstPath $ \(cName, l) dirFd ->
{-# LINE 364 "System/Linux/Btrfs/ByteString.hsc" #-}
allocaBytesZero ((4096)) $ \iva -> do
{-# LINE 365 "System/Linux/Btrfs/ByteString.hsc" #-}
let ivaName = ((\hsc_ptr -> hsc_ptr `plusPtr` 56)) iva
{-# LINE 366 "System/Linux/Btrfs/ByteString.hsc" #-}
copyBytes ivaName cName l
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) iva (fromIntegral srcFd :: Int64)
{-# LINE 368 "System/Linux/Btrfs/ByteString.hsc" #-}
when readOnly $
setFlags (((\hsc_ptr -> hsc_ptr `plusPtr` 16)) iva)
{-# LINE 370 "System/Linux/Btrfs/ByteString.hsc" #-}
((2) :: Word64)
{-# LINE 371 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "snapshotFd" $
ioctl dirFd (1342215191) iva
{-# LINE 373 "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 391 "System/Linux/Btrfs/ByteString.hsc" #-}
flags <- peek flagsPtr :: IO Word64
return (flags .&. (2) /= 0)
{-# LINE 393 "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 405 "System/Linux/Btrfs/ByteString.hsc" #-}
if readOnly then
setFlags flagsPtr ((2) :: Word64)
{-# LINE 407 "System/Linux/Btrfs/ByteString.hsc" #-}
else
clearFlags flagsPtr ((2) :: Word64)
{-# LINE 409 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "setSubvolReadOnlyFd" $
ioctl fd (1074304026) flagsPtr
{-# LINE 411 "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 423 "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 434 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (144)
{-# LINE 437 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (144)
{-# LINE 438 "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 461 "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 479 "System/Linux/Btrfs/ByteString.hsc" #-}
listSubvolsFd :: Fd -> IO [(SubvolId, SubvolId, InodeNum, FILEPATH)]
listSubvolsFd fd = do
let sk = defaultSearchKey
{ skTreeId = (1)
{-# LINE 484 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = (256)
{-# LINE 485 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxObjectId = (18446744073709551360)
{-# LINE 486 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinType = (144)
{-# LINE 487 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (144)
{-# LINE 488 "System/Linux/Btrfs/ByteString.hsc" #-}
}
treeSearchListFd fd sk unpack
where
unpack sh rr
| shType sh /= (144) =
{-# LINE 493 "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 525 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (156)
{-# LINE 528 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (156)
{-# LINE 529 "System/Linux/Btrfs/ByteString.hsc" #-}
}
treeSearchListFd fd sk unpack
where
unpack sh rr
| shType sh /= (156) =
{-# LINE 534 "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 555 "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 615 "System/Linux/Btrfs/ByteString.hsc" #-}
ioError $ mkIOError doesNotExistErrorType
"getSubvolInfoFd"
Nothing Nothing
| otherwise = do
let sk = defaultSearchKey
{ skTreeId = (1)
{-# LINE 621 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = subvolId
, skMaxObjectId = subvolId
, skMinType = (132)
{-# LINE 624 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (132)
{-# LINE 625 "System/Linux/Btrfs/ByteString.hsc" #-}
}
findFirstItemFd fd sk unpack
where
unpack sh ri = do
LE64 generation <- ((\hsc_ptr -> peekByteOff hsc_ptr 160)) ri
{-# LINE 630 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 lastSnapshot <- ((\hsc_ptr -> peekByteOff hsc_ptr 200)) ri
{-# LINE 631 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 208)) ri
{-# LINE 632 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 generationV2 <- ((\hsc_ptr -> peekByteOff hsc_ptr 239)) ri
{-# LINE 633 "System/Linux/Btrfs/ByteString.hsc" #-}
let nv2 = generationV2 < generation
uuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 247)) ri :: IO UUID
{-# LINE 635 "System/Linux/Btrfs/ByteString.hsc" #-}
pUuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 263)) ri :: IO UUID
{-# LINE 636 "System/Linux/Btrfs/ByteString.hsc" #-}
receivedUuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 279)) ri :: IO UUID
{-# LINE 637 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 cTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 295)) ri
{-# LINE 638 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 oTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 303)) ri
{-# LINE 639 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 sTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 311)) ri
{-# LINE 640 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 rTransId <- ((\hsc_ptr -> peekByteOff hsc_ptr 319)) ri
{-# LINE 641 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime cTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 327)) ri
{-# LINE 642 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime oTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 339)) ri
{-# LINE 643 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime sTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 351)) ri
{-# LINE 644 "System/Linux/Btrfs/ByteString.hsc" #-}
BtrfsTime rTime <- ((\hsc_ptr -> peekByteOff hsc_ptr 363)) ri
{-# LINE 645 "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 650 "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 676 "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 694 "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 710 "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 727 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinObjectId = (6)
{-# LINE 728 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxObjectId = (6)
{-# LINE 729 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMinType = (84)
{-# LINE 730 "System/Linux/Btrfs/ByteString.hsc" #-}
, skMaxType = (84)
{-# LINE 731 "System/Linux/Btrfs/ByteString.hsc" #-}
}
l <- treeSearchListFd fd sk $ \_ ptr -> do
LE16 nameLen <- ((\hsc_ptr -> peekByteOff hsc_ptr 27)) ptr
{-# LINE 734 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = ptr `plusPtr` ((30))
{-# LINE 735 "System/Linux/Btrfs/ByteString.hsc" #-}
name <- peekFilePathLen (cName, fromIntegral nameLen)
if name /= "default" then
return Nothing
else do
let location = ptr `plusPtr` ((0))
{-# LINE 740 "System/Linux/Btrfs/ByteString.hsc" #-}
LE64 objectId <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) location
{-# LINE 741 "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 759 "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" $
ioctl fd (1342215170) nullPtr
{-# LINE 776 "System/Linux/Btrfs/ByteString.hsc" #-}
defrag :: FILEPATH -> IO ()
defrag path = withFd path ReadWrite defragFd
data DefragRangeArgs = DefragRangeArgs
{ draStart :: FileSize
, draLength :: FileSize
, draExtentThreshold :: Word32
, draCompress :: CompressionType
, draFlush :: Bool
}
deriving (Show, Eq)
defaultDefragRangeArgs :: DefragRangeArgs
defaultDefragRangeArgs = DefragRangeArgs
{ draStart = 0
, draLength = maxBound
, draExtentThreshold = 0
, draCompress = compressNone
, draFlush = False
}
defragRangeFd :: Fd -> DefragRangeArgs -> IO ()
defragRangeFd fd DefragRangeArgs{..} =
allocaBytesZero ((48)) $ \args -> do
{-# LINE 813 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) args draStart
{-# LINE 814 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) args draLength
{-# LINE 815 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) args flags
{-# LINE 816 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) args draExtentThreshold
{-# LINE 817 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) args comp_type
{-# LINE 818 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "defragRangeFd" $
ioctl fd (1076925456) args
{-# LINE 820 "System/Linux/Btrfs/ByteString.hsc" #-}
where
flags :: Word64
flags = comp_flags .|. if draFlush then (2) else 0
{-# LINE 823 "System/Linux/Btrfs/ByteString.hsc" #-}
comp_flags
| draCompress == compressNone = 0
| otherwise = (1)
{-# LINE 826 "System/Linux/Btrfs/ByteString.hsc" #-}
CompressionType comp_type = draCompress
defragRange :: FILEPATH -> DefragRangeArgs -> IO ()
defragRange path args =
withFd path ReadWrite $ \fd ->
defragRangeFd fd args
data FSInfo = FSInfo
{ fsiDeviceCount :: Word64
, fsiUuid :: UUID
, fsiNodeSize :: FileSize
, fsiSectorSize :: FileSize
, fsiCloneAlignment :: FileSize
}
deriving (Show, Eq)
getFSInfoFd :: Fd -> IO FSInfo
getFSInfoFd fd =
allocaBytes ((1024)) $ \fsia -> do
{-# LINE 857 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "getFSInfoFd" $
ioctl_fast fd (2214630431) fsia
{-# LINE 859 "System/Linux/Btrfs/ByteString.hsc" #-}
nd <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) fsia :: IO Word64
{-# LINE 860 "System/Linux/Btrfs/ByteString.hsc" #-}
uuid <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) fsia :: IO UUID
{-# LINE 861 "System/Linux/Btrfs/ByteString.hsc" #-}
ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) fsia :: IO Word32
{-# LINE 862 "System/Linux/Btrfs/ByteString.hsc" #-}
ss <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) fsia :: IO Word32
{-# LINE 863 "System/Linux/Btrfs/ByteString.hsc" #-}
ca <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) fsia :: IO Word32
{-# LINE 864 "System/Linux/Btrfs/ByteString.hsc" #-}
return FSInfo
{ fsiDeviceCount = nd
, fsiUuid = uuid
, fsiNodeSize = fromIntegral ns
, fsiSectorSize = fromIntegral ss
, fsiCloneAlignment = fromIntegral ca
}
getFSInfo
:: FILEPATH
-> IO FSInfo
getFSInfo path =
withFd path ReadOnly getFSInfoFd
getFSLabelFd :: Fd -> IO FILEPATH
getFSLabelFd fd =
allocaBytesZero maxLabelSize $ \ptr -> do
throwErrnoIfMinus1_ "getFSLabelFd" $
ioctl_fast fd (2164298801) ptr
{-# LINE 888 "System/Linux/Btrfs/ByteString.hsc" #-}
peekFilePath ptr
getFSLabel
:: FILEPATH
-> IO FILEPATH
getFSLabel path =
withFd path ReadOnly getFSLabelFd
setFSLabelFd :: Fd -> FILEPATH -> IO ()
setFSLabelFd fd label =
withFilePathLen label $ \(ptr, len) ->
allocaBytesZero maxLabelSize $ \buf -> do
copyArray buf ptr (min len (maxLabelSize - 1))
throwErrnoIfMinus1_ "setFSLabelFd" $
ioctl fd (1090556978) buf
{-# LINE 906 "System/Linux/Btrfs/ByteString.hsc" #-}
setFSLabel
:: FILEPATH
-> FILEPATH
-> IO ()
setFSLabel path label =
withFd path ReadOnly $ \fd ->
setFSLabelFd fd label
maxLabelSize :: Int
maxLabelSize = (256)
{-# LINE 922 "System/Linux/Btrfs/ByteString.hsc" #-}
syncFd :: Fd -> IO ()
syncFd fd =
throwErrnoIfMinus1_ "syncFd" $
ioctl fd (37896) nullPtr
{-# LINE 929 "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 941 "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 952 "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 965 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) lia logical
{-# LINE 966 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) lia (fromIntegral inodesSize :: Word64)
{-# LINE 967 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) lia inodes
{-# LINE 968 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "resolveLogical" $ ioctl rootFd (3224933412) lia
{-# LINE 969 "System/Linux/Btrfs/ByteString.hsc" #-}
elemMissed <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) inodes :: IO Word32
{-# LINE 970 "System/Linux/Btrfs/ByteString.hsc" #-}
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) inodes :: IO Word32
{-# LINE 971 "System/Linux/Btrfs/ByteString.hsc" #-}
let val = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) inodes :: Ptr Word64
{-# LINE 972 "System/Linux/Btrfs/ByteString.hsc" #-}
vals <- peekArray (fromIntegral count) val
return (extractTriplets vals, fromIntegral elemMissed)
where
inodesSize = 64 * 1024 + ((16))
{-# LINE 976 "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 1001 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ipa inum
{-# LINE 1002 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ipa (fromIntegral fspathSize :: Word64)
{-# LINE 1003 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ipa fspath
{-# LINE 1004 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "resolveInode" $ ioctl subvolFd (3224933411) ipa
{-# LINE 1005 "System/Linux/Btrfs/ByteString.hsc" #-}
elemMissed <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) fspath :: IO Word32
{-# LINE 1006 "System/Linux/Btrfs/ByteString.hsc" #-}
count <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) fspath :: IO Word32
{-# LINE 1007 "System/Linux/Btrfs/ByteString.hsc" #-}
let val = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) fspath :: Ptr Word64
{-# LINE 1008 "System/Linux/Btrfs/ByteString.hsc" #-}
vals <- peekArray (fromIntegral count) val
paths <- mapM (peekFilePath . plusPtr val . fromIntegral) vals
return (paths, fromIntegral elemMissed)
where
fspathSize = 2 * 1024 + ((16))
{-# LINE 1013 "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 1032 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ila treeId
{-# LINE 1033 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ila inum
{-# LINE 1034 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "lookupInodeFd" $
ioctl_fast fd (3489698834) ila
{-# LINE 1036 "System/Linux/Btrfs/ByteString.hsc" #-}
treeId' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ila :: IO Word64
{-# LINE 1037 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) ila
{-# LINE 1038 "System/Linux/Btrfs/ByteString.hsc" #-}
name <- peekFilePath 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 1066 "System/Linux/Btrfs/ByteString.hsc" #-}
flags <- peek flagsPtr :: IO CUInt
return (flags .&. (8388608) /= 0)
{-# LINE 1068 "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 1081 "System/Linux/Btrfs/ByteString.hsc" #-}
if noCOW then
setFlags flagsPtr ((8388608) :: CUInt)
{-# LINE 1083 "System/Linux/Btrfs/ByteString.hsc" #-}
else
clearFlags flagsPtr ((8388608) :: CUInt)
{-# LINE 1085 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "setFileNoCOWFd" $
ioctl fd (1074292226) flagsPtr
{-# LINE 1087 "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 1137 "System/Linux/Btrfs/ByteString.hsc" #-}
let skPtr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) saPtr
{-# LINE 1138 "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 1146 "System/Linux/Btrfs/ByteString.hsc" #-}
throwErrnoIfMinus1_ "treeSearchFd" $
ioctl fd (3489698833) saPtr
{-# LINE 1148 "System/Linux/Btrfs/ByteString.hsc" #-}
itemsFound <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) skPtr :: IO Word32
{-# LINE 1149 "System/Linux/Btrfs/ByteString.hsc" #-}
when (itemsFound > 0) $ do
let shPtr = ((\hsc_ptr -> hsc_ptr `plusPtr` 104)) saPtr
{-# LINE 1151 "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 1156 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) skPtr (fromIntegral iType :: Word32)
{-# LINE 1157 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) skPtr offset
{-# LINE 1158 "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 1219 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (skMinObjectId sk)
{-# LINE 1220 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr (fromIntegral (skMinType sk) :: Word32)
{-# LINE 1221 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (skMinOffset sk)
{-# LINE 1222 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (skMaxObjectId sk)
{-# LINE 1223 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 60)) ptr (fromIntegral (skMaxType sk) :: Word32)
{-# LINE 1224 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (skMaxOffset sk)
{-# LINE 1225 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (skMinTransId sk)
{-# LINE 1226 "System/Linux/Btrfs/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr (skMaxTransId sk)
{-# LINE 1227 "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 1231 "System/Linux/Btrfs/ByteString.hsc" #-}
objectId <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) shPtr :: IO Word64
{-# LINE 1232 "System/Linux/Btrfs/ByteString.hsc" #-}
offset <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) shPtr :: IO Word64
{-# LINE 1233 "System/Linux/Btrfs/ByteString.hsc" #-}
iType <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) shPtr :: IO Word32
{-# LINE 1234 "System/Linux/Btrfs/ByteString.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) shPtr :: IO Word32
{-# LINE 1235 "System/Linux/Btrfs/ByteString.hsc" #-}
let itemPtr = shPtr `plusPtr` ((32))
{-# LINE 1236 "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 1241 "System/Linux/Btrfs/ByteString.hsc" #-}
LE16 nameLen <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) rrPtr
{-# LINE 1242 "System/Linux/Btrfs/ByteString.hsc" #-}
let cName = rrPtr `plusPtr` ((18))
{-# LINE 1243 "System/Linux/Btrfs/ByteString.hsc" #-}
name <- peekFilePathLen (cName, fromIntegral nameLen)
return (dirId, name)
withFd :: FILEPATH -> OpenMode -> (Fd -> IO r) -> IO r
withFd path openMode action =
bracket (openFd path openMode defaultFileFlags {nonBlock = True})
closeFd action
withSplitPathOpenParent :: String -> Int -> FILEPATH -> (CStringLen -> Fd -> IO r) -> IO r
withSplitPathOpenParent loc maxLen path action =
unsafeWithFilePathLen 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)
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)