{-# LINE 1 "System/Linux/FileExtents.hsc" #-}
------------------------------------------------------------------------------
{-# LINE 2 "System/Linux/FileExtents.hsc" #-}
-- |
-- Module      : System.Linux.FileExtents
--
-- Stability   : provisional
-- Portability : non-portable (requires Linux)
--
-- This module can be used to retrieve information about how a
-- particular file is stored on disk (i.e. the file fragmentation).
-- It accomplishes that by directly calling the FIEMAP ioctl provided by
-- recent versions of the Linux kernel. This ioctl is specific to Linux
-- and therefore this module is not portable.
--
-- For more information about the FIEMAP ioctl see @filesystems/fiemap.txt@
-- in the kernel documentation.
--
------------------------------------------------------------------------------


module System.Linux.FileExtents
    ( -- * Extent flags
      -- |See @filesystems/fiemap.txt@ in the kernel documentation for a more
      -- detailed description of each of these flags.
      ExtentFlags
    , efLast
    , efUnknown
    , efDelalloc
    , efEncoded
    , efDataEncrypted
    , efNotAligned
    , efDataInline
    , efDataTail
    , efUnwritten
    , efMerged
    , efShared
    -- * Extents
    , Extent(..)
    -- * Request flags
    , ReqFlags(..)
    , defReqFlags
    -- * Getting extent information
    , 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


{-# LINE 58 "System/Linux/FileExtents.hsc" #-}

{-# LINE 59 "System/Linux/FileExtents.hsc" #-}

{-# LINE 60 "System/Linux/FileExtents.hsc" #-}

--------------------------------------------------------------------------------
-- extent flags

type ExtentFlags = Word32

-- |Last extent in file.
efLast          :: ExtentFlags
efLast          = 1
{-# LINE 69 "System/Linux/FileExtents.hsc" #-}

-- |Data location unknown.
efUnknown       :: ExtentFlags
efUnknown       = 2
{-# LINE 73 "System/Linux/FileExtents.hsc" #-}

-- |Location still pending.
efDelalloc      :: ExtentFlags
efDelalloc      = 4
{-# LINE 77 "System/Linux/FileExtents.hsc" #-}

-- |Data cannot be read while fs is unmounted.
efEncoded       :: ExtentFlags
efEncoded       = 8
{-# LINE 81 "System/Linux/FileExtents.hsc" #-}

-- |Data is encrypted by fs.
efDataEncrypted :: ExtentFlags
efDataEncrypted = 128
{-# LINE 85 "System/Linux/FileExtents.hsc" #-}

-- |Extent offsets may not be block aligned.
efNotAligned    :: ExtentFlags
efNotAligned    = 256
{-# LINE 89 "System/Linux/FileExtents.hsc" #-}

-- |Data mixed with metadata.
efDataInline    :: ExtentFlags
efDataInline    = 512
{-# LINE 93 "System/Linux/FileExtents.hsc" #-}

-- |Multiple files in block.
efDataTail      :: ExtentFlags
efDataTail      = 1024
{-# LINE 97 "System/Linux/FileExtents.hsc" #-}

-- |Space allocated, but no data (i.e. zero).
efUnwritten     :: ExtentFlags
efUnwritten     = 2048
{-# LINE 101 "System/Linux/FileExtents.hsc" #-}

-- |File does not natively support extents. Result merged for efficiency.
efMerged        :: ExtentFlags
efMerged        = 4096
{-# LINE 105 "System/Linux/FileExtents.hsc" #-}

-- |Space shared with other files.
efShared        :: ExtentFlags
efShared        = 8192
{-# LINE 109 "System/Linux/FileExtents.hsc" #-}

--------------------------------------------------------------------------------
-- extent type

-- |Description of a single extent. All offsets and lengths are in bytes.
data Extent = Extent
    { extLogical :: Word64    -- ^ Offset relative to the beginning of the file.
    , extPhysical :: Word64   -- ^ Offset relative to the beginning of the underlying block device.
    , extLength :: Word64     -- ^ The length of the extent.
    , extFlags :: ExtentFlags -- ^ Flags for this extent.
    }
  deriving (Show, Eq)

instance Storable Extent where
    sizeOf _ = (56)
{-# LINE 124 "System/Linux/FileExtents.hsc" #-}
    alignment _ = alignment (undefined :: Int)
    peek ptr = do
        extLogical_  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 127 "System/Linux/FileExtents.hsc" #-}
        extPhysical_ <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 128 "System/Linux/FileExtents.hsc" #-}
        extLength_   <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 129 "System/Linux/FileExtents.hsc" #-}
        extFlags_    <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 130 "System/Linux/FileExtents.hsc" #-}
        return (Extent extLogical_ extPhysical_ extLength_ extFlags_)
    poke ptr ext = do
        memset (castPtr ptr) 0 ((56))
{-# LINE 133 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (extLogical ext)
{-# LINE 134 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (extPhysical ext)
{-# LINE 135 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (extLength ext)
{-# LINE 136 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (extFlags ext)
{-# LINE 137 "System/Linux/FileExtents.hsc" #-}

--------------------------------------------------------------------------------
-- request flags

-- |Flags the modify the behavior of extent information requests.
data ReqFlags = ReqFlags
    { rfSync :: Bool  -- ^ Sync the file before requesting its extents.
    , rfXattr :: Bool -- ^ Retrieve the extents of the inode's extended attribute lookup tree, instead of its data tree.
    , rfCache :: Bool -- ^ Request caching of the extents (not supported by older kernels).
    }
  deriving (Show, Eq)

-- |Default values for the request flags. All options are disabled.
defReqFlags :: ReqFlags
defReqFlags = ReqFlags False False False

encodeFlags :: ReqFlags -> Word32
encodeFlags f =
    (if rfSync f then (1) else 0)
{-# LINE 156 "System/Linux/FileExtents.hsc" #-}
      .|.
    (if rfXattr f then (2) else 0)
{-# LINE 158 "System/Linux/FileExtents.hsc" #-}
      .|.
    (if rfCache f then (4) else 0)
{-# LINE 160 "System/Linux/FileExtents.hsc" #-}

--------------------------------------------------------------------------------
-- get extents

-- | Retrieve the list of all extents associated with the file
-- referenced by the file descriptor. Extents returned mirror those on disk
-- - that is, the logical offset of the first returned extent may start
-- before the requested range, and the last returned extent may end after
-- the end of the requested range.
--
-- Note: 'getExtentsFd' might call the FIEMAP ioctl multiple times in order to
-- retrieve all the extents of the file. This is necessary when the file
-- has too many fragments. If the file is modified in the meantime, the
-- returned list might be inconsistent.
getExtentsFd
    :: ReqFlags
    -> Fd
    -> Maybe (Word64, Word64) -- ^ The range (offset and length) within the file to look extents for. Use 'Nothing' for the entire file.
    -> IO [Extent]
getExtentsFd = getExtentsPathFd "getExtentsFd" Nothing

-- |Like 'getExtentsFd' except that it operates on file paths instead of
-- file descriptors.
getExtents :: ReqFlags -> FilePath -> Maybe (Word64, Word64) -> IO [Extent]
getExtents flags path range =
    bracket (openFd path ReadOnly Nothing 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 193 "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 198 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fiemap len
{-# LINE 199 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) fiemap flags'
{-# LINE 200 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) fiemap maxExtentCount
{-# LINE 201 "System/Linux/FileExtents.hsc" #-}
        ioctl_fiemap loc path fd fiemap
        mappedExtents <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) fiemap :: IO Word32
{-# LINE 203 "System/Linux/FileExtents.hsc" #-}
        let extentsPtr = fiemap `plusPtr` ((32))
{-# LINE 204 "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 217 "System/Linux/FileExtents.hsc" #-}
    allocSize = 16 * 1024

--------------------------------------------------------------------------------
-- get extent count

-- |Like 'getExtentsFd' except that it returns the number of extents
-- instead of a list.
getExtentCountFd :: ReqFlags -> Fd -> Maybe (Word64, Word64) -> IO Word32
getExtentCountFd = getExtentCountPathFd "getExtentCountFd" Nothing

-- |Like 'getExtents' except that it returns the number of extents
-- instead of a list.
getExtentCount :: ReqFlags -> FilePath -> Maybe (Word64, Word64) -> IO Word32
getExtentCount flags path range =
    bracket (openFd path ReadOnly Nothing 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 238 "System/Linux/FileExtents.hsc" #-}
        memset (castPtr fiemap) 0 ((32))
{-# LINE 239 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) fiemap start
{-# LINE 240 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) fiemap len
{-# LINE 241 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) fiemap flags'
{-# LINE 242 "System/Linux/FileExtents.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) fiemap (0 :: Word32)
{-# LINE 243 "System/Linux/FileExtents.hsc" #-}
        ioctl_fiemap loc path fd fiemap
        (\hsc_ptr -> peekByteOff hsc_ptr 20) fiemap
{-# LINE 245 "System/Linux/FileExtents.hsc" #-}
  where
    flags' = encodeFlags flags

--------------------------------------------------------------------------------
-- auxiliary stuff

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 258 "System/Linux/FileExtents.hsc" #-}
        Just path ->
            throwErrnoPathIfMinus1_ loc path $ ioctl fd (3223348747) buf
{-# LINE 260 "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