{-# LINE 1 "System/Linux/FileExtents.hsc" #-}
module System.Linux.FileExtents
(
ExtentFlags
, efLast
, efUnknown
, efDelalloc
, efEncoded
, efDataEncrypted
, efNotAligned
, efDataInline
, efDataTail
, efUnwritten
, efMerged
, efShared
, Extent(..)
, ReqFlags(..)
, defReqFlags
, getExtentsFd
, getExtents
, getExtentCountFd
, getExtentCount
) where
import Control.Monad
import Control.Exception
import Data.Maybe
import Foreign hiding (void)
import Foreign.C
import System.Posix.Types
import System.Posix.IO
type ExtentFlags = Word32
efLast :: ExtentFlags
efLast = 1
{-# LINE 69 "System/Linux/FileExtents.hsc" #-}
efUnknown :: ExtentFlags
efUnknown = 2
{-# LINE 73 "System/Linux/FileExtents.hsc" #-}
efDelalloc :: ExtentFlags
efDelalloc = 4
{-# LINE 77 "System/Linux/FileExtents.hsc" #-}
efEncoded :: ExtentFlags
efEncoded = 8
{-# LINE 81 "System/Linux/FileExtents.hsc" #-}
efDataEncrypted :: ExtentFlags
efDataEncrypted = 128
{-# LINE 85 "System/Linux/FileExtents.hsc" #-}
efNotAligned :: ExtentFlags
efNotAligned = 256
{-# LINE 89 "System/Linux/FileExtents.hsc" #-}
efDataInline :: ExtentFlags
efDataInline = 512
{-# LINE 93 "System/Linux/FileExtents.hsc" #-}
efDataTail :: ExtentFlags
efDataTail = 1024
{-# LINE 97 "System/Linux/FileExtents.hsc" #-}
efUnwritten :: ExtentFlags
efUnwritten = 2048
{-# LINE 101 "System/Linux/FileExtents.hsc" #-}
efMerged :: ExtentFlags
efMerged = 4096
{-# LINE 105 "System/Linux/FileExtents.hsc" #-}
efShared :: ExtentFlags
efShared = 8192
{-# LINE 109 "System/Linux/FileExtents.hsc" #-}
data Extent = Extent
{ extLogical :: Word64
, extPhysical :: Word64
, extLength :: Word64
, extFlags :: ExtentFlags
}
deriving (Show, Eq)
{-# LINE 125 "System/Linux/FileExtents.hsc" #-}
instance Storable Extent where
sizeOf _ = (56)
{-# LINE 128 "System/Linux/FileExtents.hsc" #-}
alignment _ = (8)
{-# LINE 129 "System/Linux/FileExtents.hsc" #-}
peek ptr = do
extLogical_ <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 131 "System/Linux/FileExtents.hsc" #-}
extPhysical_ <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 132 "System/Linux/FileExtents.hsc" #-}
extLength_ <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 133 "System/Linux/FileExtents.hsc" #-}
extFlags_ <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 134 "System/Linux/FileExtents.hsc" #-}
return (Extent extLogical_ extPhysical_ extLength_ extFlags_)
poke ptr ext = do
memset (castPtr ptr) 0 ((56))
{-# LINE 137 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (extLogical ext)
{-# LINE 138 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (extPhysical ext)
{-# LINE 139 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (extLength ext)
{-# LINE 140 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (extFlags ext)
{-# LINE 141 "System/Linux/FileExtents.hsc" #-}
data ReqFlags = ReqFlags
{ rfSync :: Bool
, rfXattr :: Bool
, rfCache :: Bool
}
deriving (Show, Eq)
defReqFlags :: ReqFlags
defReqFlags = ReqFlags False False False
encodeFlags :: ReqFlags -> Word32
encodeFlags f =
(if rfSync f then (1) else 0)
{-# LINE 160 "System/Linux/FileExtents.hsc" #-}
.|.
(if rfXattr f then (2) else 0)
{-# LINE 162 "System/Linux/FileExtents.hsc" #-}
.|.
(if rfCache f then (4) else 0)
{-# LINE 164 "System/Linux/FileExtents.hsc" #-}
getExtentsFd
:: ReqFlags
-> Fd
-> Maybe (Word64, Word64)
-> IO [Extent]
getExtentsFd = getExtentsPathFd "getExtentsFd" Nothing
getExtents :: ReqFlags -> FilePath -> Maybe (Word64, Word64) -> IO [Extent]
getExtents flags path range =
bracket (openFd path ReadOnly defaultFileFlags) closeFd $ \fd ->
getExtentsPathFd "getExtents" (Just path) flags fd range
getExtentsPathFd :: String -> Maybe FilePath -> ReqFlags -> Fd -> Maybe (Word64, Word64) -> IO [Extent]
getExtentsPathFd loc path flags fd range =
allocaBytes allocSize $ \fiemap -> do
let (start, len) = fromMaybe (0, maxBound) range
memset (castPtr fiemap) 0 ((32))
{-# LINE 197 "System/Linux/FileExtents.hsc" #-}
l <- getExtentsPathFd' start len fiemap
return (concat l)
where
getExtentsPathFd' start len fiemap = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) fiemap start
{-# LINE 202 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fiemap len
{-# LINE 203 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) fiemap flags'
{-# LINE 204 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) fiemap maxExtentCount
{-# LINE 205 "System/Linux/FileExtents.hsc" #-}
ioctl_fiemap loc path fd fiemap
mappedExtents <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) fiemap :: IO Word32
{-# LINE 207 "System/Linux/FileExtents.hsc" #-}
let extentsPtr = fiemap `plusPtr` ((32))
{-# LINE 208 "System/Linux/FileExtents.hsc" #-}
extents <- peekArray (fromIntegral mappedExtents) extentsPtr
case extents of
(_ : _) | mappedExtents == maxExtentCount
, lExt <- last extents
, lExtEnd <- extLogical lExt + extLength lExt
, bytesLeft <- start + len - lExtEnd
, bytesLeft > 0 -> do
more <- getExtentsPathFd' lExtEnd bytesLeft fiemap
return (extents : more)
_ -> return [extents]
flags' = encodeFlags flags
maxExtentCount :: Word32
maxExtentCount = (fromIntegral allocSize - ((32))) `quot` ((56));
{-# LINE 221 "System/Linux/FileExtents.hsc" #-}
allocSize = 16 * 1024
getExtentCountFd :: ReqFlags -> Fd -> Maybe (Word64, Word64) -> IO Word32
getExtentCountFd = getExtentCountPathFd "getExtentCountFd" Nothing
getExtentCount :: ReqFlags -> FilePath -> Maybe (Word64, Word64) -> IO Word32
getExtentCount flags path range =
bracket (openFd path ReadOnly defaultFileFlags) closeFd $ \fd ->
getExtentCountPathFd "getExtentCount" (Just path) flags fd range
getExtentCountPathFd :: String -> Maybe FilePath -> ReqFlags -> Fd -> Maybe (Word64, Word64) -> IO Word32
getExtentCountPathFd loc path flags fd range = do
let (start, len) = fromMaybe (0, maxBound) range
allocaBytes ((32)) $ \fiemap -> do
{-# LINE 242 "System/Linux/FileExtents.hsc" #-}
memset (castPtr fiemap) 0 ((32))
{-# LINE 243 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) fiemap start
{-# LINE 244 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fiemap len
{-# LINE 245 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) fiemap flags'
{-# LINE 246 "System/Linux/FileExtents.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) fiemap (0 :: Word32)
{-# LINE 247 "System/Linux/FileExtents.hsc" #-}
ioctl_fiemap loc path fd fiemap
(\hsc_ptr -> peekByteOff hsc_ptr 20) fiemap
{-# LINE 249 "System/Linux/FileExtents.hsc" #-}
where
flags' = encodeFlags flags
foreign import ccall unsafe ioctl :: Fd -> CULong -> Ptr a -> IO CInt
ioctl_fiemap :: String -> Maybe FilePath -> Fd -> Ptr a -> IO ()
ioctl_fiemap loc mPath fd buf =
case mPath of
Nothing ->
throwErrnoIfMinus1_ loc $ ioctl fd (3223348747) buf
{-# LINE 262 "System/Linux/FileExtents.hsc" #-}
Just path ->
throwErrnoPathIfMinus1_ loc path $ ioctl fd (3223348747) buf
{-# LINE 264 "System/Linux/FileExtents.hsc" #-}
{-# INLINE ioctl_fiemap #-}
foreign import ccall unsafe "string.h memset"
c_memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
memset :: Ptr a -> Word8 -> CSize -> IO ()
memset p b l = void $ c_memset p (fromIntegral b) l