diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Marios Titas + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Marios Titas nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Linux/FileExtents.hsc b/System/Linux/FileExtents.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/FileExtents.hsc @@ -0,0 +1,249 @@ +------------------------------------------------------------------------------ +-- | +-- 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 + , Flags(..) + , defaultFlags + -- * 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 + +#include +#include +#include + +-------------------------------------------------------------------------------- +-- extent flags + +type ExtentFlags = Word32 + +-- |Last extent in file. +efLast :: ExtentFlags +efLast = #const FIEMAP_EXTENT_LAST + +-- |Data location unknown. +efUnknown :: ExtentFlags +efUnknown = #const FIEMAP_EXTENT_UNKNOWN + +-- |Location still pending. +efDelalloc :: ExtentFlags +efDelalloc = #const FIEMAP_EXTENT_DELALLOC + +-- |Data cannot be read while fs is unmounted. +efEncoded :: ExtentFlags +efEncoded = #const FIEMAP_EXTENT_ENCODED + +-- |Data is encrypted by fs. +efDataEncrypted :: ExtentFlags +efDataEncrypted = #const FIEMAP_EXTENT_DATA_ENCRYPTED + +-- |Extent offsets may not be block aligned. +efNotAligned :: ExtentFlags +efNotAligned = #const FIEMAP_EXTENT_NOT_ALIGNED + +-- |Data mixed with metadata. +efDataInline :: ExtentFlags +efDataInline = #const FIEMAP_EXTENT_DATA_INLINE + +-- |Multiple files in block. +efDataTail :: ExtentFlags +efDataTail = #const FIEMAP_EXTENT_DATA_TAIL + +-- |Space allocated, but no data (i.e. zero). +efUnwritten :: ExtentFlags +efUnwritten = #const FIEMAP_EXTENT_UNWRITTEN + +-- |File does not natively support extents. Result merged for efficiency. +efMerged :: ExtentFlags +efMerged = #const FIEMAP_EXTENT_MERGED + +-- |Space shared with other files. +efShared :: ExtentFlags +efShared = #const FIEMAP_EXTENT_SHARED + +-------------------------------------------------------------------------------- +-- 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 _ = #size struct fiemap_extent + alignment _ = alignment (undefined :: Int) + peek ptr = do + extLogical_ <- (#peek struct fiemap_extent, fe_logical ) ptr + extPhysical_ <- (#peek struct fiemap_extent, fe_physical) ptr + extLength_ <- (#peek struct fiemap_extent, fe_length ) ptr + extFlags_ <- (#peek struct fiemap_extent, fe_flags ) ptr + return (Extent extLogical_ extPhysical_ extLength_ extFlags_) + poke ptr ext = do + memset (castPtr ptr) 0 (#size struct fiemap_extent) + (#poke struct fiemap_extent, fe_logical ) ptr (extLogical ext) + (#poke struct fiemap_extent, fe_physical) ptr (extPhysical ext) + (#poke struct fiemap_extent, fe_length ) ptr (extLength ext) + (#poke struct fiemap_extent, fe_flags ) ptr (extFlags ext) + +-------------------------------------------------------------------------------- +-- 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. + } + deriving (Show, Eq) + +-- |Default values for the request flags. Both 'fSync' and 'fXattr' are set +-- to False. +defaultFlags :: Flags +defaultFlags = Flags False False + +encodeFlags :: Flags -> Word32 +encodeFlags f = + (if fSync f then (#const FIEMAP_FLAG_SYNC) else 0) + .|. + (if fXattr f then (#const FIEMAP_FLAG_XATTR) else 0) + +-------------------------------------------------------------------------------- +-- 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 + :: Flags + -> 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 = + allocaBytes allocSize $ \fiemap -> do + let (start, len) = fromMaybe (0, maxBound) range + memset (castPtr fiemap) 0 (#size struct fiemap) + l <- getExtentsFd' start len fiemap + return (concat l) + where + getExtentsFd' 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 + mappedExtents <- (#peek struct fiemap, fm_mapped_extents) fiemap :: IO Word32 + let extentsPtr = fiemap `plusPtr` (#offset struct fiemap, fm_extents) + 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 <- getExtentsFd' lExtEnd bytesLeft fiemap + return (extents : more) + _ -> return [extents] + flags' = encodeFlags flags + maxExtentCount :: Word32 + 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 + let (start, len) = fromMaybe (0, maxBound) range + allocaBytes (#size struct fiemap) $ \fiemap -> do + memset (castPtr fiemap) 0 (#size struct fiemap) + (#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 (0 :: Word32) + throwErrnoIfMinus1_ "getExtentCountFd" $ ioctl fd (#const FS_IOC_FIEMAP) 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 "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 diff --git a/linux-file-extents.cabal b/linux-file-extents.cabal new file mode 100644 --- /dev/null +++ b/linux-file-extents.cabal @@ -0,0 +1,25 @@ +name: linux-file-extents +version: 0.1.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 + 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. +homepage: https://github.com/redneb/linux-file-extents +bug-reports: https://github.com/redneb/linux-file-extents/issues +license: BSD3 +license-file: LICENSE +author: Marios Titas +maintainer: Marios Titas +category: System, Filesystem, FFI +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: System.Linux.FileExtents + build-depends: base >=4.6 && <5, unix >=2.6 + build-tools: hsc2hs + default-language: Haskell2010 + ghc-options: -Wall