linux-file-extents 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+179/−40 lines, 4 filesdep +linux-file-extentsnew-component:exe:print-extents
Dependencies added: linux-file-extents
Files
- System/Linux/FileExtents.hsc +55/−38
- examples/print-extents.hs +31/−0
- include/fiemap.h +69/−0
- linux-file-extents.cabal +24/−2
System/Linux/FileExtents.hsc view
@@ -36,8 +36,8 @@ -- * Extents , Extent(..) -- * Request flags- , Flags(..)- , defaultFlags+ , ReqFlags(..)+ , defReqFlags -- * Getting extent information , getExtentsFd , getExtents@@ -56,7 +56,7 @@ #include <sys/ioctl.h> #include <linux/fs.h>-#include <linux/fiemap.h>+#include "fiemap.h" -------------------------------------------------------------------------------- -- extent flags@@ -138,23 +138,25 @@ -------------------------------------------------------------------------------- -- request flags --- |Request flags.-data Flags = Flags- { fSync :: Bool -- ^ Sync the file before requesting its extents.- , fXattr :: Bool -- ^ Retrieve the extents of the inode's extended attribute lookup tree, instead of its data tree.+-- |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. Both 'fSync' and 'fXattr' are set--- to False.-defaultFlags :: Flags-defaultFlags = Flags False False+-- |Default values for the request flags. All options are disabled.+defReqFlags :: ReqFlags+defReqFlags = ReqFlags False False False -encodeFlags :: Flags -> Word32+encodeFlags :: ReqFlags -> Word32 encodeFlags f =- (if fSync f then (#const FIEMAP_FLAG_SYNC) else 0)+ (if rfSync f then (#const FIEMAP_FLAG_SYNC) else 0) .|.- (if fXattr f then (#const FIEMAP_FLAG_XATTR) else 0)+ (if rfXattr f then (#const FIEMAP_FLAG_XATTR) else 0)+ .|.+ (if rfCache f then (#const FIEMAP_FLAG_CACHE) else 0) -------------------------------------------------------------------------------- -- get extents@@ -170,23 +172,33 @@ -- has too many fragments. If the file is modified in the meantime, the -- returned list might be inconsistent. getExtentsFd- :: Flags+ :: 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 flags (Fd fd) range =+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 (#size struct fiemap)- l <- getExtentsFd' start len fiemap+ l <- getExtentsPathFd' start len fiemap return (concat l) where- getExtentsFd' start len fiemap = do+ getExtentsPathFd' start len fiemap = do (#poke struct fiemap, fm_start ) fiemap start (#poke struct fiemap, fm_length ) fiemap len (#poke struct fiemap, fm_flags ) fiemap flags' (#poke struct fiemap, fm_extent_count) fiemap maxExtentCount- throwErrnoIfMinus1_ "getExtentsFd" $ ioctl fd (#const FS_IOC_FIEMAP) fiemap+ ioctl_fiemap loc path fd fiemap mappedExtents <- (#peek struct fiemap, fm_mapped_extents) fiemap :: IO Word32 let extentsPtr = fiemap `plusPtr` (#offset struct fiemap, fm_extents) extents <- peekArray (fromIntegral mappedExtents) extentsPtr@@ -196,7 +208,7 @@ , lExtEnd <- extLogical lExt + extLength lExt , bytesLeft <- start + len - lExtEnd , bytesLeft > 0 -> do- more <- getExtentsFd' lExtEnd bytesLeft fiemap+ more <- getExtentsPathFd' lExtEnd bytesLeft fiemap return (extents : more) _ -> return [extents] flags' = encodeFlags flags@@ -204,20 +216,23 @@ maxExtentCount = (fromIntegral allocSize - (#size struct fiemap)) `quot` (#size struct fiemap_extent); allocSize = 16 * 1024 --- |Like 'getExtentsFd' except that it operates on file paths instead of--- file descriptors.-getExtents :: Flags -> FilePath -> Maybe (Word64, Word64) -> IO [Extent]-getExtents flags path range = do- bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd $ \fd ->- getExtentsFd flags fd range- -------------------------------------------------------------------------------- -- get extent count -- |Like 'getExtentsFd' except that it returns the number of extents -- instead of a list.-getExtentCountFd :: Flags -> Fd -> Maybe (Word64, Word64) -> IO Word32-getExtentCountFd flags (Fd fd) range = do+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 (#size struct fiemap) $ \fiemap -> do memset (castPtr fiemap) 0 (#size struct fiemap)@@ -225,22 +240,24 @@ (#poke struct fiemap, fm_length ) fiemap len (#poke struct fiemap, fm_flags ) fiemap flags' (#poke struct fiemap, fm_extent_count) fiemap (0 :: Word32)- throwErrnoIfMinus1_ "getExtentCountFd" $ ioctl fd (#const FS_IOC_FIEMAP) fiemap+ ioctl_fiemap loc path fd fiemap #{peek struct fiemap, fm_mapped_extents} fiemap where flags' = encodeFlags flags --- |Like 'getExtents' except that it returns the number of extents--- instead of a list.-getExtentCount :: Flags -> FilePath -> Maybe (Word64, Word64) -> IO Word32-getExtentCount flags path range = do- bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd $ \fd ->- getExtentCountFd flags fd range- -------------------------------------------------------------------------------- -- auxiliary stuff -foreign import ccall unsafe ioctl :: CInt -> CULong -> Ptr a -> IO CInt+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 (#const FS_IOC_FIEMAP) buf+ Just path ->+ throwErrnoPathIfMinus1_ loc path $ ioctl fd (#const FS_IOC_FIEMAP) buf+{-# INLINE ioctl_fiemap #-} foreign import ccall unsafe "string.h memset" c_memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
+ examples/print-extents.hs view
@@ -0,0 +1,31 @@+import System.Linux.FileExtents+import System.Environment+import System.IO+import Control.Monad+import Control.Exception++main :: IO ()+main = do+ args <- getArgs+ case args of+ "-v" : paths ->+ forM_ paths $ handleIOExn . printExtents+ paths ->+ forM_ paths $ handleIOExn . printExtentCount++printExtents :: FilePath -> IO ()+printExtents path = do+ exts <- getExtents defReqFlags path Nothing+ putStrLn $ path ++ ":"+ forM_ exts $ \ext ->+ putStrLn $ " " ++ show ext+ putStrLn $ " " ++ show (length exts) ++ " extent(s)"++printExtentCount :: FilePath -> IO ()+printExtentCount path = do+ c <- getExtentCount defReqFlags path Nothing+ putStrLn $ show c ++ "\t" ++ path++handleIOExn :: IO () -> IO ()+handleIOExn =+ handle (\e -> hPrint stderr (e :: IOException))
+ include/fiemap.h view
@@ -0,0 +1,69 @@+/*+ * FS_IOC_FIEMAP ioctl infrastructure.+ *+ * Some portions copyright (C) 2007 Cluster File Systems, Inc+ *+ * Authors: Mark Fasheh <mfasheh@suse.com>+ * Kalpak Shah <kalpak.shah@sun.com>+ * Andreas Dilger <adilger@sun.com>+ */++#ifndef _LINUX_FIEMAP_H+#define _LINUX_FIEMAP_H++#include <linux/types.h>++struct fiemap_extent {+ __u64 fe_logical; /* logical offset in bytes for the start of+ * the extent from the beginning of the file */+ __u64 fe_physical; /* physical offset in bytes for the start+ * of the extent from the beginning of the disk */+ __u64 fe_length; /* length in bytes for this extent */+ __u64 fe_reserved64[2];+ __u32 fe_flags; /* FIEMAP_EXTENT_* flags for this extent */+ __u32 fe_reserved[3];+};++struct fiemap {+ __u64 fm_start; /* logical offset (inclusive) at+ * which to start mapping (in) */+ __u64 fm_length; /* logical length of mapping which+ * userspace wants (in) */+ __u32 fm_flags; /* FIEMAP_FLAG_* flags for request (in/out) */+ __u32 fm_mapped_extents;/* number of extents that were mapped (out) */+ __u32 fm_extent_count; /* size of fm_extents array (in) */+ __u32 fm_reserved;+ struct fiemap_extent fm_extents[0]; /* array of mapped extents (out) */+};++#define FIEMAP_MAX_OFFSET (~0ULL)++#define FIEMAP_FLAG_SYNC 0x00000001 /* sync file data before map */+#define FIEMAP_FLAG_XATTR 0x00000002 /* map extended attribute tree */+#define FIEMAP_FLAG_CACHE 0x00000004 /* request caching of the extents */++#define FIEMAP_FLAGS_COMPAT (FIEMAP_FLAG_SYNC | FIEMAP_FLAG_XATTR)++#define FIEMAP_EXTENT_LAST 0x00000001 /* Last extent in file. */+#define FIEMAP_EXTENT_UNKNOWN 0x00000002 /* Data location unknown. */+#define FIEMAP_EXTENT_DELALLOC 0x00000004 /* Location still pending.+ * Sets EXTENT_UNKNOWN. */+#define FIEMAP_EXTENT_ENCODED 0x00000008 /* Data can not be read+ * while fs is unmounted */+#define FIEMAP_EXTENT_DATA_ENCRYPTED 0x00000080 /* Data is encrypted by fs.+ * Sets EXTENT_NO_BYPASS. */+#define FIEMAP_EXTENT_NOT_ALIGNED 0x00000100 /* Extent offsets may not be+ * block aligned. */+#define FIEMAP_EXTENT_DATA_INLINE 0x00000200 /* Data mixed with metadata.+ * Sets EXTENT_NOT_ALIGNED.*/+#define FIEMAP_EXTENT_DATA_TAIL 0x00000400 /* Multiple files in block.+ * Sets EXTENT_NOT_ALIGNED.*/+#define FIEMAP_EXTENT_UNWRITTEN 0x00000800 /* Space allocated, but+ * no data (i.e. zero). */+#define FIEMAP_EXTENT_MERGED 0x00001000 /* File does not natively+ * support extents. Result+ * merged for efficiency. */+#define FIEMAP_EXTENT_SHARED 0x00002000 /* Space shared with other+ * files. */++#endif /* _LINUX_FIEMAP_H */
linux-file-extents.cabal view
@@ -1,9 +1,9 @@ name: linux-file-extents-version: 0.1.0.0+version: 0.2.0.0 synopsis: Retrieve file fragmentation information under Linux description: This package provides a simple wrapper around the Linux FIEMAP ioctl.- It can be used to retrieve a complete list of all the extents of any given+ It can be used to retrieve the list of all the extents of any given file, i.e. the area of the disk where the file is actually stored. This is similar to the @filefrag@ command line tool provided by the @e2fsprogs@ package.@@ -17,9 +17,31 @@ build-type: Simple cabal-version: >=1.10 +extra-source-files:+ include/fiemap.h++source-repository head+ type: git+ location: https://github.com/redneb/linux-file-extents.git++flag examples+ description: Build examples+ default: False+ library exposed-modules: System.Linux.FileExtents+ include-dirs: include build-depends: base >=4.6 && <5, unix >=2.6 build-tools: hsc2hs default-language: Haskell2010 ghc-options: -Wall++executable print-extents+ hs-source-dirs: examples+ main-is: print-extents.hs+ if !flag(examples)+ buildable: False+ else+ build-depends: base >=4.6 && <5, linux-file-extents+ default-language: Haskell2010+ ghc-options: -Wall