----------------------------------------------------------------------------- -- | -- Module : Halfs.Inode -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : GHC -- -- Explanation: Represents inodes in the system. -- -- The root inode is a file containing all of the inodes in the -- system. This file never shrinks. module Halfs.Inode (Inode(..), InodeBlock, InodeMetadata(..) ,newFSRootInode, newFSBlockMapInode, newFSRootDirInode ,newFSInodeMapInode, dupInode ,rootInodeDiskAddr, firstFreeInodeDiskAddr ,getPointerAt, updatePointers, isRootDirInode ,goodInodeMagic, inodeBumpSize, newInode, inodeAddLink) where import Binary(Binary(..), Bin(..),tellBin,seekBin) import Halfs.Utils hiding (bytesPerBlock) import qualified Halfs.Utils (bytesPerBlock) import Data.Integral import Data.Array(listArray, (!), (//), elems) import Control.Exception(assert) bytesPerBlock :: INLong bytesPerBlock = intToINLong Halfs.Utils.bytesPerBlock data Inode = Inode { metaData :: InodeMetadata ,blockPtrs :: INPointers -- 16 pointers @ 32 bits each } deriving (Show, Eq) -- |Must be length 16 type InodeBlock = [Inode] updatePointers :: Inode -> [(Int, INInt)] -> Inode updatePointers inode@Inode{blockPtrs=ptrs} updatedPtrs = inode{blockPtrs=ptrs // (assert ((length (filter (\(x,_) -> x >= blockPointersPerInode) updatedPtrs)) == 0) updatedPtrs)} -- |Copy the important bits of this inode, bit not all of them; , -- leave the inode number alone, but copy everthing else. dupInode :: Inode -- ^Source inode -> Inode -- ^Copy to here -> Inode -- ^Resulting inode dupInode fromI@Inode{metaData=fromMD} _toI@Inode{metaData=toMD} = fromI{metaData=fromMD{magic1 =magic1 toMD ,inode_num=inode_num toMD } } newFSRootInode :: Inode newFSRootInode = let tempInode1 = newInode rootInodeNum File tempInode = tempInode1{metaData=(metaData tempInode1) {magic1=rootInodeMagicNum}} in inodeBumpSize (updatePointers tempInode [(0, rootInodeDiskAddr), (1, rootInodeDiskAddr + 1)]) (bytesPerBlock * 2) -- See notes about the block map in TheBlockMap.hs. Block map -- filesize never changes. newFSBlockMapInode :: Inode newFSBlockMapInode = inodeBumpSize (updatePointers (newInode blockMapInodeNum File) [(0,blockMapInodeDiskAddr)]) bytesPerBlock newFSInodeMapInode :: Inode newFSInodeMapInode = inodeBumpSize (updatePointers (newInode inodeMapInodeNum File) [(0, inodeMapInodeDiskAddr)]) bytesPerBlock newFSRootDirInode :: Inode newFSRootDirInode = inodeBumpSize (updatePointers (newInode rootDirInodeNum Dir) [(0, rootDirInodeDiskAddr)]) bytesPerBlock goodInodeMagic :: Inode -> Bool goodInodeMagic Inode{metaData=InodeMetadata{magic1=magicNum ,inode_num=num}} = if num == rootInodeNum then magicNum == rootInodeMagicNum else magicNum == otherInodeMagicNum -- |Is this the rootDir inode? isRootDirInode :: Inode -> Bool isRootDirInode Inode{metaData=InodeMetadata{inode_num=inodeNum}} = inodeNum == rootDirInodeNum -- |Create a new inode based on this inode number newInode :: INInt -> FileType -> Inode newInode num filetype = let inodeMD = InodeMetadata otherInodeMagicNum 0 0 0 filetype num -- inode number 0 0 0 0 -- so far unused 1 -- level in Inode inodeMD (listArray (0, blockPointersPerInode - 1) (replicate blockPointersPerInode 0)) -- |Increase the size of this inode, cannot decrease it! inodeBumpSize :: Inode -> INLong -- ^size in bytes -> Inode inodeBumpSize inode@(Inode md _) newSize = inode{metaData=md{num_bytes=max (num_bytes md) newSize}} inodeAddLink :: Inode -> Inode inodeAddLink i@Inode{metaData=md@InodeMetadata{hard_links=hl}} = i{metaData=md{hard_links=hl+1}} -- |Get the block pointer from this inode array. getPointerAt :: Inode -> BlockNumber -> INInt getPointerAt inode blockNumber = (blockPtrs inode) ! (assert (blockNumber < intToINInt blockPointersPerInode && blockNumber >= 0) (inIntToInt blockNumber)) rootInodeDiskAddr :: INInt rootInodeDiskAddr = 0 firstFreeInodeDiskAddr :: INInt firstFreeInodeDiskAddr = rootDirInodeDiskAddr + 1 -- For internal use only; they may change after newfs. blockMapInodeDiskAddr :: INInt blockMapInodeDiskAddr = 2 inodeMapInodeDiskAddr :: INInt inodeMapInodeDiskAddr = 3 rootDirInodeDiskAddr :: INInt rootDirInodeDiskAddr = 4 -- ------------------------------------------------------------ -- * INodeMetaData -- ------------------------------------------------------------ data InodeMetadata = InodeMetadata { magic1 :: INInt ,num_bytes :: INLong ,uid :: INInt ,gid :: INInt ,mode :: FileType -- ^ file or dir ,inode_num :: INInt ,flags :: INInt ,hard_links :: INInt -- ^persistent references ,create_time :: INLong ,last_modified_time :: INLong ,level :: INInt -- sum to here: 56 bytes } deriving Eq instance Show InodeMetadata where show i = "\n-----\n" ++ printField x "magic1" magic1 ++ printField s' "num_bytes" num_bytes ++ printField s "uid" uid ++ printField s "gid" gid ++ printField show "mode" mode ++ printField s "inode_num" inode_num ++ printField s "flags" flags ++ printField s "hard_links" hard_links ++ printField s' "create_time" create_time ++ printField s' "last_modified_time" last_modified_time ++ printField s "level" level ++ "-----\n" where x = myShowHex s = show s' = show printField :: (Show a) => (a -> String) -> String -- ^label -> (InodeMetadata -> a) -> String printField shower lab f = lab ++ ": " ++ (shower $ f i) ++ "\n" -- ------------------------------------------------------------ -- * Binary representation of the Inodes -- ------------------------------------------------------------ instance Binary Inode where put_ h inode = do (BinPtr start) <- tellBin h put_ h (metaData inode) sequence_ [ put_ h ptr | ptr <- elems $ blockPtrs inode] seekBin h (BinPtr (start + bytesPerInode)) return () get h = do (BinPtr start) <- tellBin h meta <- get h ptrs <- sequence [ get h | _ <- take 16 [1..blockPointersPerInode] ] seekBin h (BinPtr (start + bytesPerInode)) return $ Inode { metaData = meta , blockPtrs = listArray (0, blockPointersPerInode - 1) $ ptrs } instance Binary InodeMetadata where put_ h a = do put_ h (magic1 a) put_ h (num_bytes a) put_ h (uid a) put_ h (gid a) put_ h (mode a) put_ h (inode_num a) put_ h (flags a) put_ h (hard_links a) put_ h (create_time a) put_ h (last_modified_time a) put_ h (level a) -- add assert about size return () get h = do magic1' <- get h num_bytes' <- get h uid' <- get h gid' <- get h mode' <- get h inode_num' <- get h flags' <- get h hard_links' <- get h create_time' <- get h last_modified' <- get h level' <- get h -- add assert about size return $ InodeMetadata magic1' num_bytes' uid' gid' mode' inode_num' flags' hard_links' create_time' last_modified' level'