halfs-2.0: Halfs/Inode.hs
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, BangPatterns #-}
module Halfs.Inode
(
InodeRef(..)
, blockAddrToInodeRef
, buildEmptyInodeEnc
, decLinkCount
, fileStat
, incLinkCount
, inodeKey
, inodeRefToBlockAddr
, isNilIR
, nilIR
, readStream
, writeStream
-- * for internal use only!
, atomicModifyInode
, atomicReadInode
, bsReplicate
, drefInode
, expandExts -- for use by fsck
, fileStat_lckd
, freeInode
, withLockedInode
, writeStream_lckd
-- * for testing: ought not be used by actual clients of this module!
, Inode(..)
, Ext(..)
, ExtRef(..)
, bsDrop
, bsTake
, computeMinimalInodeSize
, computeNumAddrs
, computeNumInodeAddrsM
, computeNumExtAddrsM
, computeSizes
, decodeExt
, decodeInode
, minimalExtSize
, minInodeBlocks
, minExtBlocks
, nilER
, safeToInt
, truncSentinel
)
where
import Control.Exception
import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Data.Char
import Data.List (genericDrop, genericLength, genericTake)
import Data.Serialize
import qualified Data.Serialize.Get as G
import Data.Word
import Halfs.BlockMap (BlockMap)
import qualified Halfs.BlockMap as BM
import Halfs.Classes
import Halfs.Errors
import Halfs.HalfsState
import Halfs.Protection
import Halfs.Monad
import Halfs.MonadUtils
import Halfs.Types
import Halfs.Utils
import System.Device.BlockDevice
-- import System.IO.Unsafe (unsafePerformIO)
dbug :: String -> a -> a
-- dbug = seq . unsafePerformIO . putStrLn
dbug _ = id
dbugM :: Monad m => String -> m ()
--dbugM s = dbug s $ return ()
dbugM _ = return ()
type HalfsM b r l m a = HalfsT HalfsError (Maybe (HalfsState b r l m)) m a
--------------------------------------------------------------------------------
-- Inode/Ext constructors, geometry calculation, and helpful constructors
type StreamIdx = (Word64, Word64, Word64)
-- | Obtain a 64 bit "key" for an inode; useful for building maps etc.
-- For now, this is the same as inodeRefToBlockAddr, but clients should
-- be using this function rather than inodeRefToBlockAddr in case the
-- underlying inode representation changes.
inodeKey :: InodeRef -> Word64
inodeKey = inodeRefToBlockAddr
-- | Convert a disk block address into an Inode reference.
blockAddrToInodeRef :: Word64 -> InodeRef
blockAddrToInodeRef = IR
-- | Convert an inode reference into a block address
inodeRefToBlockAddr :: InodeRef -> Word64
inodeRefToBlockAddr = unIR
-- | The nil Inode reference. With the current Word64 representation and the
-- block layout assumptions, block 0 is the superblock, and thus an invalid
-- Inode reference.
nilIR :: InodeRef
nilIR = IR 0
isNilIR :: InodeRef -> Bool
isNilIR = (==) nilIR
-- | The nil Ext reference. With the current Word64 representation and
-- the block layout assumptions, block 0 is the superblock, and thus an
-- invalid Ext reference.
nilER :: ExtRef
nilER = ER 0
isNilER :: ExtRef -> Bool
isNilER = (==) nilER
-- | The sentinel byte written to partial blocks when doing truncating writes
truncSentinel :: Word8
truncSentinel = 0xBA
-- | The sentinel byte written to the padded region at the end of Inodes/Exts
padSentinel :: Word8
padSentinel = 0xAD
-- We semi-arbitrarily state that an Inode must be capable of maintaining a
-- minimum of 35 block addresses in its embedded Ext while the Ext must be
-- capable of maintaining 57 block addresses. These values, together with
-- specific padding values for inodes and exts (4 and 0, respectively), give us
-- a minimum inode AND ext size of 512 bytes each (in the IO monad variant,
-- which uses the our Serialize instance for the UTCTime when writing the time
-- fields).
--
-- These can be adjusted as needed according to inode metadata sizes, but it's
-- very important that (computeMinimalInodeSize =<< getTime) and minimalExtSize yield
-- the same value!
-- | The size, in bytes, of the padding region at the end of Inodes
iPadSize :: Int
iPadSize = 4
-- | The size, in bytes, of the padding region at the end of Exts
cPadSize :: Int
cPadSize = 0
minInodeBlocks :: Word64
minInodeBlocks = 35
minExtBlocks :: Word64
minExtBlocks = 57
-- | The structure of an Inode. Pretty standard, except that we use the Ext
-- structure (the first of which is embedded in the inode) to hold block
-- references and use its ext field to allow multiple runs of block
-- addresses.
data Inode t = Inode
{ inoParent :: InodeRef -- ^ block addr of parent directory
-- inode: This is nilIR for the
-- root directory inode
, inoLastExt :: (ExtRef, Word64) -- ^ The last-accessed ER and its ext
-- idx. For the "faster end-of-stream
-- access" hack.
-- begin fstat metadata
, inoAddress :: InodeRef -- ^ block addr of this inode
, inoFileSize :: Word64 -- ^ in bytes
, inoAllocBlocks :: Word64 -- ^ number of blocks allocated to this inode
-- (includes its own allocated block, blocks
-- allocated for Exts, and and all blocks in
-- the ext chain itself)
, inoFileType :: FileType
, inoMode :: FileMode
, inoNumLinks :: Word64 -- ^ number of hardlinks to this inode
, inoCreateTime :: t -- ^ time of creation
, inoModifyTime :: t -- ^ time of last data modification
, inoAccessTime :: t -- ^ time of last data access
, inoChangeTime :: t -- ^ time of last change to inode data
, inoUser :: UserID -- ^ userid of inode's owner
, inoGroup :: GroupID -- ^ groupid of inode's owner
-- end fstat metadata
, inoExt :: Ext -- The "embedded" inode extension ("ext")
}
deriving (Show, Eq)
-- An "Inode extension" datatype
data Ext = Ext
{ address :: ExtRef -- ^ Address of this Ext (nilER for an
-- inode's embedded Ext)
, nextExt :: ExtRef -- ^ Next Ext in the chain; nilER terminates
, blockCount :: Word64
, blockAddrs :: [Word64] -- ^ references to blocks governed by this Ext
-- Fields below here are not persisted, and are populated via decodeExt
, numAddrs :: Word64 -- ^ Maximum number of blocks addressable by *this*
-- Ext. NB: Does not include blocks further down
-- the chain.
}
deriving (Show, Eq)
-- | Size of a minimal inode structure when serialized, in bytes. This will
-- vary based on the space required for type t when serialized. Note that
-- minimal inode structure always contains minInodeBlocks InodeRefs in
-- its blocks region.
--
-- You can check this value interactively in ghci by doing, e.g.
-- computeMinimalInodeSize =<< (getTime :: IO UTCTime)
computeMinimalInodeSize :: (Monad m, Ord t, Serialize t, Show t) =>
t -> m Word64
computeMinimalInodeSize t = do
return $ fromIntegral $ BS.length $ encode $
let e = emptyInode minInodeBlocks t RegularFile (FileMode [] [] [])
nilIR nilIR rootUser rootGroup
c = inoExt e
in e{ inoExt = c{ blockAddrs = replicate (safeToInt minInodeBlocks) 0 } }
-- | The size of a minimal Ext structure when serialized, in bytes.
minimalExtSize :: Monad m => m (Word64)
minimalExtSize = return $ fromIntegral $ BS.length $ encode $
(emptyExt minExtBlocks nilER){
blockAddrs = replicate (safeToInt minExtBlocks) 0
}
-- | Computes the number of block addresses storable by an inode/ext
computeNumAddrs :: Monad m =>
Word64 -- ^ block size, in bytes
-> Word64 -- ^ minimum number of blocks for inode/ext
-> Word64 -- ^ minimum inode/ext total size, in bytes
-> m Word64
computeNumAddrs blkSz minBlocks minSize = do
unless (minSize <= blkSz) $
fail "computeNumAddrs: Block size too small to accomodate minimal inode"
let
-- # bytes required for the blocks region of the minimal inode
padding = minBlocks * refSize
-- # bytes of the inode excluding the blocks region
notBlocksSize = minSize - padding
-- # bytes available for storing the blocks region
blkSz' = blkSz - notBlocksSize
unless (0 == blkSz' `mod` refSize) $
fail "computeNumAddrs: Inexplicably bad block size"
return $ blkSz' `div` refSize
computeNumInodeAddrsM :: (Serialize t, Timed t m, Show t) =>
Word64 -> m Word64
computeNumInodeAddrsM blkSz =
computeNumAddrs blkSz minInodeBlocks =<< computeMinimalInodeSize =<< getTime
computeNumExtAddrsM :: (Serialize t, Timed t m) =>
Word64 -> m Word64
computeNumExtAddrsM blkSz = do
minSize <- minimalExtSize
computeNumAddrs blkSz minExtBlocks minSize
computeSizes :: (Serialize t, Timed t m, Show t) =>
Word64
-> m ( Word64 -- #inode bytes
, Word64 -- #ext bytes
, Word64 -- #inode addrs
, Word64 -- #ext addrs
)
computeSizes blkSz = do
startExtAddrs <- computeNumInodeAddrsM blkSz
extAddrs <- computeNumExtAddrsM blkSz
return (startExtAddrs * blkSz, extAddrs * blkSz, startExtAddrs, extAddrs)
-- Builds and encodes an empty inode
buildEmptyInodeEnc :: (Serialize t, Timed t m, Show t) =>
BlockDevice m -- ^ The block device
-> FileType -- ^ This inode's filetype
-> FileMode -- ^ This inode's access mode
-> InodeRef -- ^ This inode's block address
-> InodeRef -- ^ Parent's block address
-> UserID
-> GroupID
-> m ByteString
buildEmptyInodeEnc bd ftype fmode me mommy usr grp =
liftM encode $ buildEmptyInode bd ftype fmode me mommy usr grp
buildEmptyInode :: (Serialize t, Timed t m, Show t) =>
BlockDevice m
-> FileType -- ^ This inode's filetype
-> FileMode -- ^ This inode's access mode
-> InodeRef -- ^ This inode's block address
-> InodeRef -- ^ Parent block's address
-> UserID -- ^ This inode's owner's userid
-> GroupID -- ^ This inode's owner's groupid
-> m (Inode t)
buildEmptyInode bd ftype fmode me mommy usr grp = do
now <- getTime
minSize <- computeMinimalInodeSize =<< return now
minimalExtSize >>= (`assert` return ()) . (==) minSize
nAddrs <- computeNumAddrs (bdBlockSize bd) minInodeBlocks minSize
return $ emptyInode nAddrs now ftype fmode me mommy usr grp
emptyInode :: (Ord t, Serialize t) =>
Word64 -- ^ number of block addresses
-> t -- ^ creation timestamp
-> FileType -- ^ inode's filetype
-> FileMode -- ^ inode's access mode
-> InodeRef -- ^ block addr for this inode
-> InodeRef -- ^ parent block address
-> UserID
-> GroupID
-> Inode t
emptyInode nAddrs now ftype fmode me mommy usr grp =
Inode
{ inoParent = mommy
, inoLastExt = (nilER, 0)
, inoAddress = me
, inoFileSize = 0
, inoAllocBlocks = 1
, inoFileType = ftype
, inoMode = fmode
, inoNumLinks = 1
, inoCreateTime = now
, inoModifyTime = now
, inoAccessTime = now
, inoChangeTime = now
, inoUser = usr
, inoGroup = grp
, inoExt = emptyExt nAddrs nilER
}
buildEmptyExt :: (Serialize t, Timed t m) =>
BlockDevice m -- ^ The block device
-> ExtRef -- ^ This ext's block address
-> m Ext
buildEmptyExt bd me = do
minSize <- minimalExtSize
nAddrs <- computeNumAddrs (bdBlockSize bd) minExtBlocks minSize
return $ emptyExt nAddrs me
emptyExt :: Word64 -- ^ number of block addresses
-> ExtRef -- ^ block addr for this ext
-> Ext
emptyExt nAddrs me =
Ext
{ address = me
, nextExt = nilER
, blockCount = 0
, blockAddrs = []
, numAddrs = nAddrs
}
--------------------------------------------------------------------------------
-- Inode stream functions
-- | Provides a stream over the bytes governed by a given Inode and its
-- extensions (exts). This function performs a write to update inode metadata
-- (e.g., access time).
readStream :: HalfsCapable b t r l m =>
InodeRef -- ^ Starting inode reference
-> Word64 -- ^ Starting stream (byte) offset
-> Maybe Word64 -- ^ Stream length (Nothing => read
-- until end of stream, including
-- entire last block)
-> HalfsM b r l m ByteString -- ^ Stream contents
readStream startIR start mlen = do
withLockedInode startIR $ do
-- ====================== Begin inode critical section ======================
dev <- hasks hsBlockDev
startInode <- drefInode startIR
let bs = bdBlockSize dev
readB c b = lift $ readBlock dev c b
fileSz = inoFileSize startInode
gsi = getStreamIdx (bdBlockSize dev) fileSz
if 0 == blockCount (inoExt startInode)
then return BS.empty
else do
dbug ("==== readStream begin ===") $ do
(sExtI, sBlkOff, sByteOff) <- gsi start
sExt <- findExt startInode sExtI
(eExtI, _, _) <- gsi $ case mlen of
Nothing -> fileSz - 1
Just len -> start + len - 1
dbug ("start = " ++ show start) $ do
dbug ("(sExtI, sBlkOff, sByteOff) = " ++ show (sExtI, sBlkOff, sByteOff)) $ do
dbug ("eExtI = " ++ show eExtI) $ do
rslt <- case mlen of
Just len | len == 0 -> return BS.empty
_ -> do
assert (maybe True (> 0) mlen) $ return ()
-- 'hdr' is the (possibly partial) first block
hdr <- bsDrop sByteOff `fmap` readB sExt sBlkOff
-- 'rest' is the list of block-sized bytestrings containing the
-- requested content from blocks in subsequent conts, accounting for
-- the (Maybe) maximum length requested.
rest <- do
let hdrLen = fromIntegral (BS.length hdr)
totalToRead = maybe (fileSz - start) id mlen
--
howManyBlks ext bsf blkOff =
let bc = blockCount ext - blkOff
in
maybe bc (\len -> min bc ((len - bsf) `divCeil` bs)) mlen
--
readExt (_, [], _) = error "The impossible happened"
readExt ((cExt, cExtI), blkOff:boffs, bytesSoFar)
| cExtI > eExtI =
assert (bytesSoFar >= totalToRead) $ return Nothing
| bytesSoFar >= totalToRead =
return Nothing
| otherwise = do
let remBlks = howManyBlks cExt bytesSoFar blkOff
range = if remBlks > 0
then [blkOff .. blkOff + remBlks - 1]
else []
theData <- BS.concat `fmap` mapM (readB cExt) range
assert (fromIntegral (BS.length theData) == remBlks * bs) $ return ()
let rslt c = return $ Just $
( theData -- accumulated by unfoldr
, ( (c, cExtI+1)
, boffs
, bytesSoFar + remBlks * bs
)
)
if isNilER (nextExt cExt)
then rslt (error "Ext DNE and expected termination!")
else rslt =<< drefExt (nextExt cExt)
-- ==> Bulk reading starts here <==
if (sBlkOff + 1 < blockCount sExt || sExtI < eExtI)
then unfoldrM readExt ((sExt, sExtI), (sBlkOff+1):repeat 0, hdrLen)
else return []
return $ bsTake (maybe (fileSz - start) id mlen) $
hdr `BS.append` BS.concat rest
now <- getTime
lift $ writeInode dev $
startInode { inoAccessTime = now, inoChangeTime = now }
dbug ("==== readStream end ===") $ return ()
return rslt
-- ======================= End inode critical section =======================
-- | Writes to the inode stream at the given starting inode and starting byte
-- offset, overwriting data and allocating new space on disk as needed. If the
-- write is a truncating write, all resources after the end of the written data
-- are freed. Whenever the data to be written exceeds the the end of the
-- stream, the trunc flag is ignored.
writeStream :: HalfsCapable b t r l m =>
InodeRef -- ^ Starting inode ref
-> Word64 -- ^ Starting stream (byte) offset
-> Bool -- ^ Truncating write?
-> ByteString -- ^ Data to write
-> HalfsM b r l m ()
writeStream _ _ False bytes | 0 == BS.length bytes = return ()
writeStream startIR start trunc bytes = do
withLockedInode startIR $ writeStream_lckd startIR start trunc bytes
writeStream_lckd :: HalfsCapable b t r l m =>
InodeRef -- ^ Starting inode ref
-> Word64 -- ^ Starting stream (byte) offset
-> Bool -- ^ Truncating write?
-> ByteString -- ^ Data to write
-> HalfsM b r l m ()
writeStream_lckd _ _ False bytes | 0 == BS.length bytes = return ()
writeStream_lckd startIR start trunc bytes = do
-- ====================== Begin inode critical section ======================
-- NB: This implementation currently 'flattens' Contig/Discontig block groups
-- from the BlockMap allocator (see allocFill and truncUnalloc below), which
-- will force us to treat them as Discontig when we unallocate, which is more
-- expensive. We may want to have the Exts hold onto these block groups
-- directly and split/merge them as needed to reduce the number of
-- unallocation actions required, but we leave this as a TODO for now.
startInode@Inode{ inoLastExt = lcInfo } <- drefInode startIR
dev <- hasks hsBlockDev
let bs = bdBlockSize dev
len = fromIntegral $ BS.length bytes
fileSz = inoFileSize startInode
newFileSz = if trunc then start + len else max (start + len) fileSz
fszRndBlk = (fileSz `divCeil` bs) * bs
availBlks c = numAddrs c - blockCount c
bytesToAlloc = if newFileSz > fszRndBlk then newFileSz - fszRndBlk else 0
blksToAlloc = bytesToAlloc `divCeil` bs
(_, _, _, apc) <- hasks hsSizes
sIdx@(sExtI, sBlkOff, sByteOff) <- getStreamIdx bs fileSz start
sExt <- findExt startInode sExtI
lastExt <- getLastExt Nothing sExt
-- TODO: Track a ptr to this? Traversing
-- the allocated region is yucky.
let extsToAlloc = (blksToAlloc - availBlks lastExt) `divCeil` apc
------------------------------------------------------------------------------
-- Debugging miscellany
dbug ("\nwriteStream: " ++ show (sExtI, sBlkOff, sByteOff)
++ " (start=" ++ show start ++ ")"
++ " len = " ++ show len ++ ", trunc = " ++ show trunc
++ ", fileSz/newFileSz = " ++ show fileSz ++ "/" ++ show newFileSz
++ ", toAlloc(exts/blks/bytes) = " ++ show extsToAlloc ++ "/"
++ show blksToAlloc ++ "/" ++ show bytesToAlloc) $ do
-- dbug ("inoLastExt startInode = " ++ show (lcInfo) ) $ return ()
-- dbug ("inoExt startInode = " ++ show (inoExt startInode)) $ return ()
-- dbug ("Exts on entry, from inode ext:") $ return ()
-- dumpExts (inoExt startInode)
------------------------------------------------------------------------------
-- Allocation:
-- Allocate if needed and obtain (1) the post-alloc start ext and (2)
-- possibly a dirty ext to write back into the inode (ie, when its
-- nextExt field is modified as a result of allocation -- all other
-- modified exts are written by allocFill, but the inode write is the last
-- thing we do, so we defer the update).
(sExt', minodeExt) <- do
if blksToAlloc == 0
then return (sExt, Nothing)
else do
lastExt' <- allocFill availBlks blksToAlloc extsToAlloc lastExt
let st = if address lastExt' == address sExt then lastExt' else sExt
-- Our starting location remains the same, but in case of an
-- update of the start ext, we can use lastExt' instead of
-- re-reading.
lci = snd lcInfo
st' <- if lci < sExtI
then getLastExt (Just $ sExtI - lci + 1) st
-- NB: We need to start ahead of st, but couldn't adjust
-- until after we allocated. This is to catch a corner case
-- where the "start" ext coming into writeStream_lckd
-- refers to a ext that hasn't been allocated yet.
else return st
return (st', if isEmbedded st then Just st else Nothing)
-- dbug ("sExt' = " ++ show sExt') $ return ()
-- dbug ("minodeExt = " ++ show minodeExt) $ return ()
-- dbug ("Exts immediately after alloc, from sExt'") $ return ()
-- dumpExts (sExt')
assert (sBlkOff < blockCount sExt') $ return ()
------------------------------------------------------------------------------
-- Truncation
-- Truncate if needed and obtain (1) the new start ext at which to start
-- writing data and (2) possibly a dirty ext to write back into the inode
(sExt'', numBlksFreed, minodeExt') <-
if trunc && bytesToAlloc == 0
then do
(ext, nbf) <- truncUnalloc start len (sExt', sExtI)
return ( ext
, nbf
, if isEmbedded ext
then case minodeExt of
Nothing -> Just ext
Just _ -> -- This "can't happen" ...
error $ "Internal: dirty inode ext from "
++ "both allocFill & truncUnalloc!?"
else Nothing
)
else return (sExt', 0, minodeExt)
assert (blksToAlloc + extsToAlloc == 0 || numBlksFreed == 0) $ return ()
------------------------------------------------------------------------------
-- Data streaming
(eExtI, _, _) <- decomp (bdBlockSize dev) (bytesToEnd start len)
eExt <- getLastExt (Just $ (eExtI - sExtI) + 1) sExt''
when (len > 0) $ writeInodeData (sIdx, sExt'') eExtI trunc bytes
--------------------------------------------------------------------------------
-- Inode metadata adjustments & persist
now <- getTime
lift $ writeInode dev $
startInode
{ inoLastExt = if eExtI == sExtI
then (address sExt'', sExtI)
else (address eExt, eExtI)
, inoFileSize = newFileSz
, inoAllocBlocks = inoAllocBlocks startInode
+ blksToAlloc
+ extsToAlloc
- numBlksFreed
, inoAccessTime = now
, inoModifyTime = now
, inoChangeTime = now
, inoExt = maybe (inoExt startInode) id minodeExt'
}
-- ======================= End inode critical section =======================
--------------------------------------------------------------------------------
-- Inode operations
incLinkCount :: HalfsCapable b t r l m =>
InodeRef -- ^ Source inode ref
-> HalfsM b r l m ()
incLinkCount inr =
atomicModifyInode inr $ \nd ->
return $ nd{ inoNumLinks = inoNumLinks nd + 1 }
decLinkCount :: HalfsCapable b t r l m =>
InodeRef -- ^ Source inode ref
-> HalfsM b r l m ()
decLinkCount inr =
atomicModifyInode inr $ \nd ->
return $ nd{ inoNumLinks = inoNumLinks nd - 1 }
-- | Atomically modifies an inode; always updates inoChangeTime, but
-- callers are responsible for other metadata modifications.
atomicModifyInode :: HalfsCapable b t r l m =>
InodeRef
-> (Inode t -> HalfsM b r l m (Inode t))
-> HalfsM b r l m ()
atomicModifyInode inr f =
withLockedInode inr $ do
dev <- hasks hsBlockDev
inode <- drefInode inr
now <- getTime
inode' <- setChangeTime now `fmap` f inode
lift $ writeInode dev inode'
atomicReadInode :: HalfsCapable b t r l m =>
InodeRef
-> (Inode t -> a)
-> HalfsM b r l m a
atomicReadInode inr f =
withLockedInode inr $ f `fmap` drefInode inr
fileStat :: HalfsCapable b t r l m =>
InodeRef
-> HalfsM b r l m (FileStat t)
fileStat inr =
withLockedInode inr $ fileStat_lckd inr
fileStat_lckd :: HalfsCapable b t r l m =>
InodeRef
-> HalfsM b r l m (FileStat t)
fileStat_lckd inr = do
inode <- drefInode inr
return $ FileStat
{ fsInode = inr
, fsType = inoFileType inode
, fsMode = inoMode inode
, fsNumLinks = inoNumLinks inode
, fsUID = inoUser inode
, fsGID = inoGroup inode
, fsSize = inoFileSize inode
, fsNumBlocks = inoAllocBlocks inode
, fsAccessTime = inoAccessTime inode
, fsModifyTime = inoModifyTime inode
, fsChangeTime = inoChangeTime inode
}
--------------------------------------------------------------------------------
-- Inode/Ext stream helper & utility functions
isEmbedded :: Ext -> Bool
isEmbedded = isNilER . address
freeInode :: HalfsCapable b t r l m =>
InodeRef -- ^ reference to the inode to remove
-> HalfsM b r l m ()
freeInode inr@(IR addr) =
withLockedInode inr $ do
bm <- hasks hsBlockMap
start <- inoExt `fmap` drefInode inr
freeBlocks bm (blockAddrs start)
_numFreed :: Word64 <- freeExts bm start
BM.unalloc1 bm addr
freeBlocks :: HalfsCapable b t r l m =>
BlockMap b r l -> [Word64] -> HalfsM b r l m ()
freeBlocks _ [] = return ()
freeBlocks bm addrs =
lift $ BM.unallocBlocks bm $ BM.Discontig $ map (`BM.Extent` 1) addrs
-- NB: Freeing all of the blocks this way (as unit extents) is ugly and
-- inefficient, but we need to be tracking BlockGroups (or reconstitute them
-- here by digging for contiguous address subsequences in addrs) before we can
-- do better.
-- | Frees all exts after the given ext, returning the number of blocks freed.
freeExts :: (HalfsCapable b t r l m, Num a) =>
BlockMap b r l -> Ext -> HalfsM b r l m a
freeExts bm Ext{ nextExt = cr }
| isNilER cr = return $ fromInteger 0
| otherwise = drefExt cr >>= extFoldM freeExt (fromInteger 0)
where
freeExt !acc c =
freeBlocks bm toFree >> return (acc + genericLength toFree)
where toFree = unER (address c) : blockAddrs c
withLockedInode :: HalfsCapable b t r l m =>
InodeRef -- ^ reference to inode to lock
-> HalfsM b r l m a -- ^ action to take while holding lock
-> HalfsM b r l m a
withLockedInode inr act =
-- Inode locking: We currently use a single reader/writer lock tracked by the
-- InodeRef -> (lock, ref count) map in HalfsState. Reference counting is used
-- to determine when it is safe to remove a lock from the map.
--
-- We use the map to track lock info so that we don't hold locks for lengthy
-- intervals when we have access requests for disparate inode refs.
hbracket before after (const act {- inode lock doesn't escape! -})
where
before = do
-- When the InodeRef is already in the map, atomically increment its
-- reference count and acquire; otherwise, create a new lock and acquire.
inodeLock <- do
lm <- hasks hsInodeLockMap
withLockedRscRef lm $ \mapRef -> do
-- begin inode lock map critical section
lockInfo <- lookupRM inr mapRef
case lockInfo of
Nothing -> do
l <- newLock
insertRM inr (l, 1) mapRef
return l
Just (l, r) -> do
insertRM inr (l, r + 1) mapRef
return l
-- end inode lock map critical section
lock inodeLock
return inodeLock
--
after inodeLock = do
-- Atomically decrement the reference count for the InodeRef and then
-- release the lock
lm <- hasks hsInodeLockMap
withLockedRscRef lm $ \mapRef -> do
-- begin inode lock map critical section
lockInfo <- lookupRM inr mapRef
case lockInfo of
Nothing -> fail "withLockedInode internal: No InodeRef in lock map"
Just (l, r) | r == 1 -> deleteRM inr mapRef
| otherwise -> insertRM inr (l, r - 1) mapRef
-- end inode lock map critical section
release inodeLock
-- | A wrapper around Data.Serialize.decode that populates transient fields. We
-- do this to avoid occupying valuable on-disk inode space where possible. Bare
-- applications of 'decode' should not occur when deserializing inodes!
decodeInode :: HalfsCapable b t r l m =>
ByteString
-> HalfsM b r l m (Inode t)
decodeInode bs = do
(_, _, numAddrs', _) <- hasks hsSizes
case decode bs of
Left s -> throwError $ HE_DecodeFail_Inode s
Right n -> do
return n{ inoExt = (inoExt n){ numAddrs = numAddrs' } }
-- | A wrapper around Data.Serialize.decode that populates transient fields. We
-- do this to avoid occupying valuable on-disk Ext space where possible. Bare
-- applications of 'decode' should not occur when deserializing Exts!
decodeExt :: HalfsCapable b t r l m =>
Word64
-> ByteString
-> HalfsM b r l m Ext
decodeExt blkSz bs = do
numAddrs' <- computeNumExtAddrsM blkSz
case decode bs of
Left s -> throwError $ HE_DecodeFail_Ext s
Right c -> return c{ numAddrs = numAddrs' }
-- | Obtain the ext with the given ext index in the ext chain.
-- Currently traverses Exts from either the inode's embedded ext or
-- from the (saved) ext from the last operation, whichever is
-- closest.
findExt :: HalfsCapable b t r l m =>
Inode t -> Word64 -> HalfsM b r l m Ext
findExt Inode{ inoLastExt = (ler, lci), inoExt = defExt } sci
| isNilER ler || lci > sci = getLastExt (Just $ sci + 1) defExt
| otherwise = getLastExt (Just $ sci - lci + 1) =<< drefExt ler
-- | Allocate the given number of Exts and blocks, and fill blocks into the
-- ext chain starting at the given ext. Persists dirty exts and yields a new
-- start ext to use.
allocFill :: HalfsCapable b t r l m =>
(Ext -> Word64) -- ^ Available blocks function
-> Word64 -- ^ Number of blocks to allocate
-> Word64 -- ^ Number of exts to allocate
-> Ext -- ^ Last allocated ext
-> HalfsM b r l m Ext -- ^ Updated last ext
allocFill _ 0 _ eExt = return eExt
allocFill avail blksToAlloc extsToAlloc eExt = do
dev <- hasks hsBlockDev
bm <- hasks hsBlockMap
newExts <- allocExts dev bm
blks <- allocBlocks bm
-- Fill nextExt fields to form the region that we'll fill with the newly
-- allocated blocks (i.e., starting at the end of the already-allocated region
-- from the start ext, but including the newly allocated exts as well).
let (_, region) = foldr (\c (er, !acc) ->
( address c
, c{ nextExt = er } : acc
)
)
(nilER, [])
(eExt : newExts)
-- "Spill" the allocated blocks into the empty region
let (blks', k) = foldl fillBlks (blks, id) region
dirtyExts@(eExt':_) = k []
fillBlks (remBlks, k') c =
let cnt = min (safeToInt $ avail c) (length remBlks)
c' = c { blockCount = blockCount c + fromIntegral cnt
, blockAddrs = blockAddrs c ++ take cnt remBlks
}
in
(drop cnt remBlks, k' . (c':))
assert (null blks') $ return ()
forM_ (dirtyExts) $ \c -> unless (isEmbedded c) $ lift $ writeExt dev c
return eExt'
where
allocBlocks bm = do
-- currently "flattens" BlockGroup; see comment in writeStream
mbg <- lift $ BM.allocBlocks bm blksToAlloc
case mbg of
Nothing -> throwError HE_AllocFailed
Just bg -> return $ BM.blkRangeBG bg
--
allocExts dev bm =
if 0 == extsToAlloc
then return []
else do
-- TODO: Unalloc partial allocs on HE_AllocFailed?
mexts <- fmap sequence $ replicateM (safeToInt extsToAlloc) $ do
mcr <- fmap ER `fmap` BM.alloc1 bm
case mcr of
Nothing -> return Nothing
Just cr -> Just `fmap` lift (buildEmptyExt dev cr)
maybe (throwError HE_AllocFailed) (return) mexts
-- | Truncates the stream at the given a stream index and length offset, and
-- unallocates all resources in the corresponding free region, yielding a new
-- Ext for the truncated chain.
truncUnalloc ::
HalfsCapable b t r l m =>
Word64 -- ^ Starting stream byte index
-> Word64 -- ^ Length from start at which to truncate
-> (Ext, Word64) -- ^ Start ext of chain to truncate, start ext idx
-> HalfsM b r l m (Ext, Word64)
-- ^ new start ext, number of blocks freed
truncUnalloc start len (stExt, sExtI) = do
dev <- hasks hsBlockDev
bm <- hasks hsBlockMap
(eExtI, eBlkOff, _) <- decomp (bdBlockSize dev) (bytesToEnd start len)
assert (eExtI >= sExtI) $ return ()
-- Get the (new) end of the ext chain. Retain all exts in [sExtI, eExtI].
eExt <- getLastExt (Just $ eExtI - sExtI + 1) stExt
let keepBlkCnt = if start + len == 0 then 0 else eBlkOff + 1
endExtRem = genericDrop keepBlkCnt (blockAddrs eExt)
freeBlocks bm endExtRem
numFreed <- (+ (genericLength endExtRem)) `fmap` freeExts bm eExt
-- Currently, only eExt is considered dirty; we do *not* do any writes to any
-- of the Exts that are detached from the chain & freed (we just toss them
-- out); this may have implications for fsck.
let dirtyExts@(firstDirty:_) =
[
-- eExt, adjusted to discard the freed blocks and clear the
-- nextExt field.
eExt { blockCount = keepBlkCnt
, blockAddrs = genericTake keepBlkCnt (blockAddrs eExt)
, nextExt = nilER
}
]
stExt' = if sExtI == eExtI then firstDirty else stExt
forM_ (dirtyExts) $ \c -> unless (isEmbedded c) $ lift $ writeExt dev c
return (stExt', numFreed)
-- | Write the given bytes to the already-allocated/truncated inode data stream
-- starting at the given start indices (ext/blk/byte offsets) and ending when
-- we have traversed up (and including) to the end ext index. Assumes the
-- inode lock is held.
writeInodeData :: HalfsCapable b t r l m =>
(StreamIdx, Ext)
-> Word64
-> Bool
-> ByteString
-> HalfsM b r l m ()
writeInodeData ((sExtI, sBlkOff, sByteOff), sExt) eExtI trunc bytes = do
dev <- hasks hsBlockDev
sBlk <- lift $ readBlock dev sExt sBlkOff
let bs = bdBlockSize dev
toWrite =
-- The first block-sized chunk to write is the region in the start block
-- prior to the start byte offset (header), followed by the first bytes
-- of the data. The trailer is nonempty and must be included when
-- BS.length bytes < bs. We adjust the input bytestring by this
-- first-block padding below.
let (sData, bytes') = bsSplitAt (bs - sByteOff) bytes
header = bsTake sByteOff sBlk
trailLen = sByteOff + fromIntegral (BS.length sData)
trailer = if trunc
then bsReplicate (bs - trailLen) truncSentinel
else bsDrop trailLen sBlk
fstBlk = header `BS.append` sData `BS.append` trailer
in assert (fromIntegral (BS.length fstBlk) == bs) $
fstBlk `BS.append` bytes'
-- The unfoldr seed is: current ext/idx, a block offset "supply", and the
-- data that remains to be written.
unfoldrM_ (fillExt dev) ((sExt, sExtI), sBlkOff : repeat 0, toWrite)
where
fillExt _ (_, [], _) = error "The impossible happened"
fillExt dev ((cExt, cExtI), blkOff:boffs, toWrite)
| cExtI > eExtI || BS.null toWrite = return Nothing
| otherwise = do
let blkAddrs = genericDrop blkOff (blockAddrs cExt)
split crs = let (cs, rems) = unzip crs in (cs, last rems)
gbc = lift . getBlockContents dev trunc
(chunks, remBytes) <- split `fmap` unfoldrM gbc (toWrite, blkAddrs)
assert (let lc = length chunks; lb = length blkAddrs
in lc == lb || (BS.length remBytes == 0 && lc < lb)) $ return ()
mapM_ (lift . uncurry (bdWriteBlock dev)) (blkAddrs `zip` chunks)
if isNilER (nextExt cExt)
then assert (BS.null remBytes) $ return Nothing
else do
nextExt' <- drefExt (nextExt cExt)
return $ Just $ ((), ((nextExt', cExtI+1), boffs, remBytes))
-- | Splits the input bytestring into block-sized chunks; may read from the
-- block device in order to preserve contents of blocks if needed.
getBlockContents ::
(Monad m, Functor m) =>
BlockDevice m
-- ^ The block device
-> Bool
-- ^ Truncating write? (Impacts partial block retention)
-> (ByteString, [Word64])
-- ^ Input bytestring, block addresses for each chunk (for retention)
-> m (Maybe ((ByteString, ByteString), (ByteString, [Word64])))
-- ^ When unfolding, the collected result type here of (ByteString,
-- ByteString) is (chunk, remaining data), in case the entire input bytestring
-- is not consumed. The seed value is (bytestring for all data, block
-- addresses for each chunk).
getBlockContents _ _ (s, _) | BS.null s = return Nothing
getBlockContents _ _ (_, []) = return Nothing
getBlockContents dev trunc (s, blkAddr:blkAddrs) = do
let (newBlkData, remBytes) = bsSplitAt bs s
bs = bdBlockSize dev
if BS.null remBytes
then do
-- Last block; retain the relevant portion of its data
trailer <-
if trunc
then return $ bsReplicate bs truncSentinel
else
bsDrop (BS.length newBlkData) `fmap` bdReadBlock dev blkAddr
let rslt = bsTake bs $ newBlkData `BS.append` trailer
return $ Just ((rslt, remBytes), (remBytes, blkAddrs))
else do
-- Full block; nothing to see here
return $ Just ((newBlkData, remBytes), (remBytes, blkAddrs))
-- | Reads the contents of the given exts's ith block
readBlock :: (Monad m) =>
BlockDevice m
-> Ext
-> Word64
-> m ByteString
readBlock dev c i = do
assert (i < blockCount c) $ return ()
bdReadBlock dev (blockAddrs c !! safeToInt i)
writeExt :: Monad m =>
BlockDevice m -> Ext -> m ()
writeExt dev c =
dbug (" ==> Writing ext: " ++ show c ) $
bdWriteBlock dev (unER $ address c) (encode c)
writeInode :: (Monad m, Ord t, Serialize t, Show t) =>
BlockDevice m -> Inode t -> m ()
writeInode dev n = bdWriteBlock dev (unIR $ inoAddress n) (encode n)
-- | Expands the given Ext into a Ext list containing itself followed by zero
-- or more Exts; can be bounded by a positive nonzero value to only retrieve
-- (up to) the given number of exts.
expandExts :: HalfsCapable b t r l m =>
Maybe Word64 -> Ext -> HalfsM b r l m [Ext]
expandExts (Just bnd) start@Ext{ nextExt = cr }
| bnd == 0 = throwError HE_InvalidExtIdx
| isNilER cr || bnd == 1 = return [start]
| otherwise = do
(start:) `fmap` (drefExt cr >>= expandExts (Just (bnd - 1)))
expandExts Nothing start@Ext{ nextExt = cr }
| isNilER cr = return [start]
| otherwise = do
(start:) `fmap` (drefExt cr >>= expandExts Nothing)
getLastExt :: HalfsCapable b t r l m =>
Maybe Word64 -> Ext -> HalfsM b r l m Ext
getLastExt mbnd c = last `fmap` expandExts mbnd c
extFoldM :: HalfsCapable b t r l m =>
(a -> Ext -> HalfsM b r l m a) -> a -> Ext -> HalfsM b r l m a
extFoldM f a c@Ext{ nextExt = cr }
| isNilER cr = f a c
| otherwise = f a c >>= \fac -> drefExt cr >>= extFoldM f fac
extMapM :: HalfsCapable b t r l m =>
(Ext -> HalfsM b r l m a) -> Ext -> HalfsM b r l m [a]
extMapM f c@Ext{ nextExt = cr }
| isNilER cr = liftM (:[]) (f c)
| otherwise = liftM2 (:) (f c) (drefExt cr >>= extMapM f)
drefExt :: HalfsCapable b t r l m =>
ExtRef -> HalfsM b r l m Ext
drefExt cr@(ER addr) | isNilER cr = throwError HE_InvalidExtIdx
| otherwise = do
dev <- hasks hsBlockDev
lift (bdReadBlock dev addr) >>= decodeExt (bdBlockSize dev)
drefInode :: HalfsCapable b t r l m =>
InodeRef -> HalfsM b r l m (Inode t)
drefInode (IR addr) = do
dev <- hasks hsBlockDev
lift (bdReadBlock dev addr) >>= decodeInode
setChangeTime :: (Ord t, Serialize t) => t -> Inode t -> Inode t
setChangeTime t nd = nd{ inoChangeTime = t }
-- | Decompose the given absolute byte offset into an inode's data stream into
-- Ext index (i.e., 0-based index into the ext chain), a block offset within
-- that Ext, and a byte offset within that block.
decomp :: (Serialize t, Timed t m, Monad m, Show t) =>
Word64 -- ^ Block size, in bytes
-> Word64 -- ^ Offset into the data stream
-> HalfsM b r l m StreamIdx
decomp blkSz streamOff = do
-- Note that the first Ext in a Ext chain always gets embedded in an Inode,
-- and thus has differing capacity than the rest of the Exts, which are of
-- uniform size.
(stExtBytes, extBytes, _, _) <- hasks hsSizes
let (extIdx, extByteIdx) =
if streamOff >= stExtBytes
then fmapFst (+1) $ (streamOff - stExtBytes) `divMod` extBytes
else (0, streamOff)
(blkOff, byteOff) = extByteIdx `divMod` blkSz
return (extIdx, blkOff, byteOff)
getStreamIdx :: HalfsCapable b t r l m =>
Word64 -- block size in bytse
-> Word64 -- file size in bytes
-> Word64 -- start byte index
-> HalfsM b r l m StreamIdx
getStreamIdx blkSz fileSz start = do
when (start > fileSz) $ throwError $ HE_InvalidStreamIndex start
decomp blkSz start
bytesToEnd :: Word64 -> Word64 -> Word64
bytesToEnd start len
| start + len == 0 = 0
| otherwise = max (start + len - 1) start
-- "Safe" (i.e., emits runtime assertions on overflow) versions of
-- BS.{take,drop,replicate}. We want the efficiency of these functions without
-- the danger of an unguarded fromIntegral on the Word64 types we use throughout
-- this module, as this could overflow for absurdly large device geometries. We
-- may need to revisit some implementation decisions should this occur (e.g.,
-- because many Prelude and Data.ByteString functions yield and take values of
-- type Int).
safeToInt :: Integral a => a -> Int
safeToInt n =
assert (toInteger n <= toInteger (maxBound :: Int)) $ fromIntegral n
makeSafeIntF :: Integral a => (Int -> b) -> a -> b
makeSafeIntF f n = f $ safeToInt n
-- | "Safe" version of Data.ByteString.take
bsTake :: Integral a => a -> ByteString -> ByteString
bsTake = makeSafeIntF BS.take
-- | "Safe" version of Data.ByteString.drop
bsDrop :: Integral a => a -> ByteString -> ByteString
bsDrop = makeSafeIntF BS.drop
-- | "Safe" version of Data.ByteString.replicate
bsReplicate :: Integral a => a -> Word8 -> ByteString
bsReplicate = makeSafeIntF BS.replicate
bsSplitAt :: Integral a => a -> ByteString -> (ByteString, ByteString)
bsSplitAt = makeSafeIntF BS.splitAt
--------------------------------------------------------------------------------
-- Magic numbers
magicStr :: String
magicStr = "This is a halfs Inode structure!"
magicBytes :: [Word8]
magicBytes = assert (length magicStr == 32) $
map (fromIntegral . ord) magicStr
magic1, magic2, magic3, magic4 :: ByteString
magic1 = BS.pack $ take 8 $ drop 0 magicBytes
magic2 = BS.pack $ take 8 $ drop 8 magicBytes
magic3 = BS.pack $ take 8 $ drop 16 magicBytes
magic4 = BS.pack $ take 8 $ drop 24 magicBytes
magicExtStr :: String
magicExtStr = "!!erutcurts tnoC sflah a si sihT"
magicExtBytes :: [Word8]
magicExtBytes = assert (length magicExtStr == 32) $
map (fromIntegral . ord) magicExtStr
cmagic1, cmagic2, cmagic3, cmagic4 :: ByteString
cmagic1 = BS.pack $ take 8 $ drop 0 magicExtBytes
cmagic2 = BS.pack $ take 8 $ drop 8 magicExtBytes
cmagic3 = BS.pack $ take 8 $ drop 16 magicExtBytes
cmagic4 = BS.pack $ take 8 $ drop 24 magicExtBytes
--------------------------------------------------------------------------------
-- Typeclass instances
instance (Show t, Eq t, Ord t, Serialize t) => Serialize (Inode t) where
put n = do
putByteString $ magic1
put $ inoParent n
put $ inoLastExt n
put $ inoAddress n
putWord64be $ inoFileSize n
putWord64be $ inoAllocBlocks n
put $ inoFileType n
put $ inoMode n
putByteString $ magic2
putWord64be $ inoNumLinks n
put $ inoCreateTime n
put $ inoModifyTime n
put $ inoAccessTime n
put $ inoChangeTime n
put $ inoUser n
put $ inoGroup n
putByteString $ magic3
put $ inoExt n
-- NB: For Exts that are inside inodes, the Serialize instance for Ext
-- relies on only 8 + iPadSize bytes beyond this point (the inode magic
-- number and some padding). If you change this, you'll need to update the
-- related calculations in Serialize Ext's get function!
putByteString magic4
replicateM_ iPadSize $ putWord8 padSentinel
get = do
checkMagic magic1
par <- get
lcr <- get
addr <- get
fsz <- getWord64be
blks <- getWord64be
ftype <- get
fmode <- get
checkMagic magic2
nlnks <- getWord64be
ctm <- get
mtm <- get
atm <- get
chtm <- get
unless (ctm <= mtm && ctm <= atm) $
fail "Inode: Incoherent modified / creation / access times."
usr <- get
grp <- get
checkMagic magic3
c <- get
checkMagic magic4
padding <- replicateM iPadSize $ getWord8
assert (all (== padSentinel) padding) $ return ()
return Inode
{ inoParent = par
, inoLastExt = lcr
, inoAddress = addr
, inoFileSize = fsz
, inoAllocBlocks = blks
, inoFileType = ftype
, inoMode = fmode
, inoNumLinks = nlnks
, inoCreateTime = ctm
, inoModifyTime = mtm
, inoAccessTime = atm
, inoChangeTime = chtm
, inoUser = usr
, inoGroup = grp
, inoExt = c
}
where
checkMagic x = do
magic <- getBytes 8
unless (magic == x) $ fail "Invalid Inode: magic number mismatch"
instance Serialize Ext where
put c = do
unless (numBlocks <= numAddrs') $
fail $ "Corrupted Ext structure put: too many blocks"
-- dbugM $ "Ext.put: numBlocks = " ++ show numBlocks
-- dbugM $ "Ext.put: blocks = " ++ show blocks
-- dbugM $ "Ext.put: fillBlocks = " ++ show fillBlocks
putByteString $ cmagic1
put $ address c
put $ nextExt c
putByteString $ cmagic2
putWord64be $ blockCount c
putByteString $ cmagic3
forM_ blocks put
replicateM_ fillBlocks $ put nilIR
putByteString cmagic4
replicateM_ cPadSize $ putWord8 padSentinel
where
blocks = blockAddrs c
numBlocks = length blocks
numAddrs' = safeToInt $ numAddrs c
fillBlocks = numAddrs' - numBlocks
get = do
checkMagic cmagic1
addr <- get
dbugM $ "decodeExt: addr = " ++ show addr
ext <- get
dbugM $ "decodeExt: ext = " ++ show ext
checkMagic cmagic2
blkCnt <- getWord64be
dbugM $ "decodeExt: blkCnt = " ++ show blkCnt
checkMagic cmagic3
-- Some calculations differ slightly based on whether or not this Ext is
-- embedded in an inode; in particular, the Inode writes a terminating magic
-- number after the end of the serialized Ext, so we must account for that
-- when calculating the number of blocks to read below.
let isEmbeddedExt = addr == nilER
dbugM $ "decodeExt: isEmbeddedExt = " ++ show isEmbeddedExt
numBlockBytes <- do
remb <- fmap fromIntegral G.remaining
dbugM $ "decodeExt: remb = " ++ show remb
dbugM $ "--"
let numTrailingBytes =
if isEmbeddedExt
then 8 + fromIntegral cPadSize + 8 + fromIntegral iPadSize
-- cmagic4, padding, inode's magic4, inode's padding <EOS>
else 8 + fromIntegral cPadSize
-- cmagic4, padding, <EOS>
dbugM $ "decodeExt: numTrailingBytes = " ++ show numTrailingBytes
return (remb - numTrailingBytes)
dbugM $ "decodeExt: numBlockBytes = " ++ show numBlockBytes
let (numBlocks, check) = numBlockBytes `divMod` refSize
dbugM $ "decodeExt: numBlocks = " ++ show numBlocks
-- dbugM $ "decodeExt: numBlockBytes = " ++ show numBlockBytes
-- dbugM $ "decodeExt: refSzie = " ++ show refSize
-- dbugM $ "decodeExt: check = " ++ show check
unless (check == 0) $ fail "Ext: Bad remaining byte count for block list."
unless (not isEmbeddedExt && numBlocks >= minExtBlocks ||
isEmbeddedExt && numBlocks >= minInodeBlocks) $
fail "Ext: Not enough space left for minimum number of blocks."
blks <- filter (/= 0) `fmap` replicateM (safeToInt numBlocks) get
checkMagic cmagic4
padding <- replicateM cPadSize $ getWord8
assert (all (== padSentinel) padding) $ return ()
let na = error $ "numAddrs has not been populated via Data.Serialize.get "
++ "for Ext; did you forget to use the "
++ "Inode.decodeExt wrapper?"
return Ext
{ address = addr
, nextExt = ext
, blockCount = blkCnt
, blockAddrs = blks
, numAddrs = na
}
where
checkMagic x = do
magic <- getBytes 8
unless (magic == x) $ fail "Invalid Ext: magic number mismatch"
--------------------------------------------------------------------------------
-- Debugging cruft
_dumpExts :: HalfsCapable b t r l m =>
Ext -> HalfsM b r l m ()
_dumpExts stExt = do
exts <- expandExts Nothing stExt
if null exts
then dbug ("=== No exts ===") $ return ()
else do
dbug ("=== Exts ===") $ return ()
mapM_ (\c -> dbug (" " ++ show c) $ return ()) exts
_allowNoUsesOf :: HalfsCapable b t r l m => HalfsM b r l m ()
_allowNoUsesOf = do
extMapM undefined undefined >> return ()