module Halfs.FSRoot (FSRoot(..), FileSystemStats(..),
addToInodeCache,
allocateInode, getFromInodeCache, emptyInodeCache,
fsRootUpdateInodeCache,
fsRootInode, fsRootAllInodeNums, fsStats,
fsRootBmInode, fsRootRootDirInode, fsRootImInode,
fsRootUpdateDirectoryCache, fsRootRmFromDirectoryCache,
Directory,
FSStatus(..), InodeCacheAddStyle(..),
BufferBlockCache, InodeNum, InodeCache)
where
import Halfs.TheBlockMap(TheBlockMap(..))
import Halfs.BufferBlockCache (BufferBlockCache)
import Data.Integral ( INInt )
import Halfs.Utils (bytesPerBlock,
rootInodeNum, blockMapInodeNum, rootDirInodeNum,
inodeMapInodeNum, FileType(File))
import System.RawDevice(RawDevice)
import Halfs.Inode (Inode(..), InodeMetadata (..), newInode,
newFSRootInode, newFSBlockMapInode,
newFSRootDirInode, newFSInodeMapInode)
import Halfs.TheInodeMap(TheInodeMap(..))
import Halfs.Directory(Directory(..), DirectoryCache, addDirectoryToCache,
rmDirectoryFromCache)
import Control.Exception(assert)
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Queue (queueLength)
import Data.Set(Set)
import qualified Data.Set as Set
type InodeNum = INInt
type InodeCache = (Map InodeNum Inode, Bool)
data FSRoot = FSRoot {device :: RawDevice
,bbCache :: BufferBlockCache
,blockMap :: TheBlockMap
,inodeCache :: InodeCache
,inodeMap :: TheInodeMap
,directoryCache :: DirectoryCache
,fsStatus :: FSStatus
}
data FSStatus = FsUnmounted | FsReadOnly | FsReadWrite deriving (Eq, Show)
data FileSystemStats = FileSystemStats
{ blockSize :: Integer
, blockCount :: Integer
, blocksFree :: Integer
, blocksAvailable :: Integer
, fileCount :: Integer
, filesFree :: Integer
, maxNameLength :: Integer
}
data InodeCacheAddStyle
= InodeCacheOverwrite
| InodeCacheKeep
| InodeCacheError
deriving Eq
instance Eq FSRoot where
(==) FSRoot{device=one} FSRoot{device=two}
= one == two
instance Ord FSRoot where
compare FSRoot{device=one} FSRoot{device=two}
= compare one two
addToInodeCache :: InodeCacheAddStyle
-> (InodeCache, InodeNum)
-> Inode
-> (InodeCache, InodeNum)
addToInodeCache style p@(c@(iCache, _), num) i =
case style of
InodeCacheOverwrite -> adder p i
_ -> case Map.lookup num iCache of
Nothing -> adder p i
Just _ -> ( c
, assert (style /= InodeCacheError) (num+1))
where
adder :: (InodeCache, InodeNum) -> Inode -> (InodeCache, InodeNum)
adder ((inCache, _), inodeNum) inode@Inode{metaData=md}
= ((Map.insert inodeNum inode{metaData=md{inode_num=inodeNum}} inCache, True)
,inodeNum + 1)
fsRootUpdateInodeCache :: FSRoot -> Inode -> FSRoot
fsRootUpdateInodeCache fsroot@FSRoot{inodeCache=(ic, _)}
inode@Inode{metaData=InodeMetadata{inode_num=inodeNum}}
= fsroot{inodeCache=(Map.insert inodeNum inode ic, True)}
getFromInodeCache :: InodeCache -> InodeNum -> Maybe Inode
getFromInodeCache (cache, _) n = Map.lookup n cache
emptyInodeCache :: InodeCache
emptyInodeCache = (Map.empty, True)
fsRootInode :: FSRoot -> Inode
fsRootInode FSRoot{inodeCache=c}
= case getFromInodeCache c rootInodeNum of
Nothing -> assert False newFSRootInode
Just a -> a
fsRootBmInode :: FSRoot -> Inode
fsRootBmInode FSRoot{inodeCache=c}
= case getFromInodeCache c blockMapInodeNum of
Nothing -> assert False newFSBlockMapInode
Just a -> a
fsRootRootDirInode :: FSRoot -> Inode
fsRootRootDirInode FSRoot{inodeCache=c}
= case getFromInodeCache c rootDirInodeNum of
Nothing -> assert False newFSRootDirInode
Just a -> a
fsRootImInode :: FSRoot -> Inode
fsRootImInode FSRoot{inodeCache=c}
= case getFromInodeCache c inodeMapInodeNum of
Nothing -> assert False newFSInodeMapInode
Just a -> a
allocateInode :: FSRoot
-> (INInt, FSRoot)
allocateInode fsRoot@FSRoot{inodeMap=inMap@TheInodeMap{freeInodes=[]
,imMaxNum=numInodes},
inodeCache=inCache
} =
let (newCache, newNumInodes)
= addToInodeCache InodeCacheOverwrite (inCache, numInodes) (newInode numInodes File)
in (numInodes, fsRoot{inodeCache=newCache
,inodeMap=inMap{imDirty=True,
imMaxNum=newNumInodes}})
allocateInode fs@FSRoot{inodeMap=im@TheInodeMap{freeInodes=(h:t)}}
= (h, fs{inodeMap=im{freeInodes=t, imDirty=True}})
fsRootUpdateDirectoryCache :: Directory -> FSRoot -> FSRoot
fsRootUpdateDirectoryCache dir fsroot@FSRoot{directoryCache=c}
= fsroot{directoryCache=addDirectoryToCache c dir}
fsRootRmFromDirectoryCache :: INInt
-> FSRoot
-> FSRoot
fsRootRmFromDirectoryCache dirInodeNum fsroot@FSRoot{directoryCache=c}
= fsroot{directoryCache=rmDirectoryFromCache c dirInodeNum}
fsRootAllInodeNums :: FSRoot -> Set INInt
fsRootAllInodeNums FSRoot{inodeMap=theInMap}
= let maxInode = (imMaxNum theInMap) 1
in (Set.fromList (0:[blockMapInodeNum .. maxInode]))
`Set.difference` (Set.fromList $ freeInodes theInMap)
fsStats :: FSRoot -> IO FileSystemStats
fsStats fsroot = do
let availBlocks = toInteger $ queueLength $ freeBlocks $ blockMap $ fsroot
return FileSystemStats{blockSize=toInteger bytesPerBlock
,blockCount=toInteger $ bmTotalSize $ blockMap fsroot
,blocksFree=availBlocks
,blocksAvailable=availBlocks
,fileCount=toInteger
$ Set.size $ fsRootAllInodeNums fsroot
,filesFree=0
,maxNameLength=255
}