module Halfs.FileHandle (fhRead, fhSize, fhRewind, fileHandle, fileHandle',
fhCloseRead, fhCloseWrite, fhSeek, fhInode, fhOpenWrite,
fhOpenTruncate, fhWrite, getDirectoryAtPath,
allocateInodeWrite,
getSomethingAtPath, FileMode(..), FileHandle(..),
unitTests, readFileFromInode, newDirectory, unlink,
getInodeAtPath, openFileAtPath, doesPathExist)
where
import Halfs.Inode (Inode(..), InodeMetadata(..), inodeBumpSize,
goodInodeMagic, newInode, dupInode, updatePointers)
import Data.Integral ( INLong, INInt, fromIntegral'',
intToINInt, intToINLong, inIntToINLong)
import Halfs.Utils (BlockNumber, bytesPerBlock, FileType(..),
unimplemented, rootInodeMagicNum)
import Halfs.BasicIO (getDiskAddrOfBlockWrite,
readPartOfBlock, writePartOfBlock,
readDirectoryBin, getInodeRead, getInodeWrite,
freeInodeData, fsRootFreeInode)
import Binary (BinHandle)
import Halfs.BinaryMonad (openBinMemRW, sizeBinMemRW, resetBinRW)
import Halfs.Blocks(getDiskAddrOfBlockRead)
import Halfs.FSRoot (FSRoot(..), fsRootRootDirInode, fsRootUpdateInodeCache,
fsRootUpdateDirectoryCache, allocateInode)
import Halfs.TestFramework (Test, test, (~=?), (~:), UnitTests, hunitToUnitTest)
import qualified Halfs.FSState (get, put)
import Halfs.TheInodeMap(freeInode)
import Halfs.FSState (doesNotExistEx, FSWrite, FSRead,
modify, eofEx, decLinksForInode,
readToWrite, unsafeReadGet, unsafeModifyFSRead,
catchError, updateInodeCacheWrite)
import Halfs.TheBlockMap (freeBlock)
import Halfs.Directory(Directory(..),
getDirectoryFromCache,
removeChild, getChildWithName)
import qualified Data.Map as Map
import Data.Array(assocs)
import Data.List(sort)
import Control.Exception(assert)
import Control.Monad(foldM, unless, when)
import Control.Monad.Error(throwError)
import Halfs.CompatFilePath (splitFileName)
import System.IO.Error (isDoesNotExistError)
data FileMode = ReadMode | WriteMode | AppendMode deriving (Eq, Show)
data FileHandle
= FileHandle {fhInodeNum :: INInt
,fhSeekPos :: INLong
,fhMode :: FileMode
} deriving (Show, Eq)
fhSize :: FileHandle -> FSRead INLong
fhSize fh = do
inode <- fhInode fh
return $ num_bytes $ metaData inode
fhInode :: FileHandle -> FSRead Inode
fhInode FileHandle{fhInodeNum=n}
= getInodeRead n Nothing
fileHandle :: INInt -> FileMode -> FileHandle
fileHandle iNum f = fileHandle' iNum 0 f
fileHandle' :: INInt -> INLong -> FileMode -> FileHandle
fileHandle' iNum s f = FileHandle iNum s f
fhOpenWrite :: INInt -> FSWrite FileHandle
fhOpenWrite inodeNum = do
return $ FileHandle inodeNum 0 WriteMode
fhOpenTruncate :: INInt -> FSWrite FileHandle
fhOpenTruncate inodeNum0 = do
oldInode@
Inode{metaData=InodeMetadata{inode_num=inodeNum
,mode=theMode
,hard_links=oldHardLinks
,magic1=theMagic}} <- getInodeWrite inodeNum0 Nothing
let newI' = newInode inodeNum theMode
let newI = newI'{metaData=(metaData newI'){magic1 = theMagic
,hard_links=oldHardLinks}}
when (theMagic == rootInodeMagicNum) (error "overwriting root inode.")
modify (\fsroot -> fsRootUpdateInodeCache fsroot newI)
freeInodeData oldInode
return $ fileHandle inodeNum WriteMode
fhCloseRead :: FileHandle -> FSRead ()
fhCloseRead _ = return ()
fhCloseWrite :: FileHandle -> FSWrite ()
fhCloseWrite _ = return ()
fhRewind :: FileHandle -> FileHandle
fhRewind fh = fh{fhSeekPos=0}
fhSeek :: FileHandle -> INLong -> FileHandle
fhSeek fh n = fh{fhSeekPos=n}
fhRead :: FileHandle
-> BinHandle
-> INInt
-> INInt
-> FSRead (FileHandle, INInt)
fhRead inFh _buffer _offset _len = do
buffSize <- sizeBinMemRW _buffer
(newLen::INInt)
<- fhSize inFh >>= fhRead' inFh _buffer _offset _len (intToINInt buffSize)
return $ (inFh{fhSeekPos=(fhSeekPos inFh) + inIntToINLong newLen}, newLen)
where
fhRead' :: FileHandle
-> BinHandle
-> INInt
-> INInt
-> INInt
-> INLong
-> FSRead INInt
fhRead' fh@FileHandle{fhSeekPos=filePos} buffer offset len buffSize fileSize
| offset + len > buffSize
= fhRead' fh buffer offset (buffSize offset) buffSize fileSize
| filePos + (inIntToINLong len) > fileSize
= let (newLen::INInt) = fromIntegral'' $ fileSize filePos
in if newLen <= 0
then throwError $ eofEx ""
else fhSize fh >>= fhRead' fh buffer
(assert (newLen < len) offset)
newLen buffSize
| otherwise = do sums <- mapM (\ (startPos::INLong, len', soFar) -> do
inode <- fhInode fh
readBlock inode
(fromIntegral'' (startPos `div` intToINLong bytesPerBlock))
(fromIntegral'' (startPos `mod` intToINLong bytesPerBlock))
len' buffer (offset + soFar))
(seekPositions filePos len)
return (sum sums)
readBlock :: Inode
-> BlockNumber
-> INInt
-> INInt
-> BinHandle
-> INInt
-> FSRead INInt
readBlock inode blockNum blockOffset numBytes buffer buffOffset
= do da <- getDiskAddrOfBlockRead inode blockNum
readPartOfBlock da blockOffset buffer buffOffset numBytes
fhWrite :: FileHandle
-> BinHandle
-> INInt
-> INInt
-> FSWrite (FileHandle, INInt)
fhWrite (FileHandle{fhMode=ReadMode}) _ _ _ = throwError $ eofEx ""
fhWrite inFH@(FileHandle inodeNum filePos _) buffer buffOffset len = do
outLen
<- foldM (oneWrite buffer inodeNum buffOffset)
0
(seekPositions filePos len)
let fh' = inFH{fhSeekPos=filePos + inIntToINLong outLen}
return (fh', outLen)
oneWrite :: BinHandle
-> INInt
-> INInt
-> INInt
-> (INLong, INInt, INInt)
-> FSWrite INInt
oneWrite buffer inodeNum buffOffset
bytesSoFar (startPos, len', soFar) = do
lastInode <- getInodeWrite inodeNum Nothing
let oldSize = num_bytes $ metaData lastInode
newLen
<- writeBlock
lastInode
(fromIntegral'' (startPos `div` intToINLong bytesPerBlock))
(fromIntegral'' (startPos `mod` intToINLong bytesPerBlock))
len' buffer (buffOffset + soFar)
newInodeB <- getInodeWrite (inode_num $ metaData lastInode) Nothing
let currSize = num_bytes $ metaData newInodeB
let (biggerBy::INLong)
= startPos + (inIntToINLong newLen)
(assert (currSize == oldSize) currSize)
updateInodeCacheWrite (if biggerBy > 0
then inodeBumpSize newInodeB (currSize + biggerBy)
else newInodeB)
return $ bytesSoFar + newLen
writeBlock :: Inode
-> BlockNumber
-> INInt
-> INInt
-> BinHandle
-> INInt
-> FSWrite INInt
writeBlock inInode blockNum blockOffset numBytes buffer buffOffset
= do da <- getDiskAddrOfBlockWrite inInode blockNum
num <- writePartOfBlock da blockOffset buffer buffOffset numBytes
return num
seekPositions :: INLong
-> INInt
-> [(INLong
,INInt
,INInt)]
seekPositions startPos len = seekPositions' startPos len 0
seekPositions' :: INLong
-> INInt
-> INInt
-> [(INLong
,INInt
,INInt)]
seekPositions' startPos len soFar =
let bytesPerBlock' = intToINLong bytesPerBlock
(thisBlockSize::Int) = fromIntegral'' $
if startPos < bytesPerBlock'
then bytesPerBlock' startPos
else bytesPerBlock'
(startPos `mod` bytesPerBlock')
in if len <= intToINInt thisBlockSize
then [(startPos,len, soFar)]
else let newPos = startPos + (intToINLong thisBlockSize)
newLen = len (intToINInt thisBlockSize)
newSoFar = soFar + (intToINInt thisBlockSize)
in (startPos, intToINInt thisBlockSize, soFar)
:seekPositions' newPos newLen newSoFar
allocateInodeWrite :: FSWrite INInt
allocateInodeWrite = do fsr <- Halfs.FSState.get
let (a,b) = allocateInode fsr
Halfs.FSState.put b
return a
newDirectory :: INInt
-> Directory
newDirectory inodeNum =
let fhDirectory = fileHandle' inodeNum 0 ReadMode
in Directory fhDirectory (Map.fromList [(".", inodeNum)]) True
readFileFromInode :: (BinHandle -> FSRead a) -> Inode -> FSRead a
readFileFromInode f Inode{metaData=InodeMetadata{num_bytes=theSize
,inode_num=inodeNum}} = do
let theFileHandle = fileHandle inodeNum ReadMode
buffer <- openBinMemRW $ fromIntegral'' (assert (theSize > 0) theSize)
readOutput <- fhRead theFileHandle buffer 0 (fromIntegral'' theSize)
resetBinRW buffer
assert (justSame (fromIntegral'' theSize) readOutput) (f buffer)
readDirectory :: Inode
-> FSRead Directory
readDirectory inode@Inode{metaData=InodeMetadata{inode_num=inN}} = do
FSRoot{directoryCache=c} <- unsafeReadGet
case getDirectoryFromCache c inN of
Nothing -> do m <- readFileFromInode readDirectoryBin inode
let d = Directory (fileHandle inN WriteMode) m True
unsafeModifyFSRead (\fsroot
-> ((fsRootUpdateDirectoryCache d fsroot), ()))
return d
Just d -> return d
readRootDir :: FSRead Directory
readRootDir = do
fsroot <- unsafeReadGet
let inode = fsRootRootDirInode fsroot
readDirectory inode
unlink :: Directory
-> String
-> FSWrite Directory
unlink dir@(Directory _ contents _) unlinkMe
= case Map.lookup unlinkMe contents of
Nothing -> throwError $ doesNotExistEx unlinkMe
Just num -> do inode <- getInodeWrite num Nothing
let f = if (hard_links $ metaData inode) <= 1
then fsRootFreeInode
else decLinksForInode
f inode
let dir' = removeChild dir unlinkMe
modify (fsRootUpdateDirectoryCache dir')
return dir'
getDirectoryAtPath :: FilePath
-> FSRead Directory
getDirectoryAtPath path = do
getSomethingAtPath (\i@Inode{metaData=InodeMetadata{mode=inM}}
-> case assert (goodInodeMagic i) inM of
Dir -> readDirectory i
File -> throwError (userError
("file encountered where directory expected"))
SymLink -> unimplemented "Symlinks")
path
getSomethingAtPath :: (Inode -> FSRead a)
-> FilePath
-> FSRead a
getSomethingAtPath f path = do
inode <- getInodeAtPath path
f (assert (goodInodeMagic inode) inode)
openFileAtPath :: FilePath
-> FileMode
-> FSRead FileHandle
openFileAtPath path fMode = do
Inode{metaData=InodeMetadata{inode_num=n}} <- getInodeAtPath path
return $ fileHandle n fMode
getInodeAtPath :: FilePath
-> FSRead Inode
getInodeAtPath "" = error "getDirectoryAt: empty string"
getInodeAtPath "/" = readRootDir >>= fhInode . dirFile
getInodeAtPath ('.':'/':p) = getInodeAtPath ('/':p)
getInodeAtPath ('.':p) = getInodeAtPath ('/':p)
getInodeAtPath dirPath = do
unless (head dirPath == '/')
(error $ "FIX: non-absolute path encountered: " ++ (show dirPath))
let (parentDir, dirName) = splitFileName dirPath
d <- getDirectoryAtPath parentDir
case getChildWithName d dirName of
Nothing -> throwError (doesNotExistEx dirPath)
Just n -> getInodeRead n Nothing
doesPathExist :: FilePath -> FSRead Bool
doesPathExist path = do
catchError (do _ <- getInodeAtPath path
return True)
(\e -> if isDoesNotExistError e
then return False
else throwError e)
unitTests :: UnitTests
unitTests = hunitToUnitTest hunitTests
hunitTests :: [Test]
hunitTests
= let bs = (intToINInt bytesPerBlock)::INInt
bs' = (intToINLong bytesPerBlock)::INLong
in [test
["less than buffSize" ~: [(0,10, 0)] ~=? seekPositions 0 10
,"just at buffsize" ~: [(0, bs, 0)] ~=? seekPositions 0 bs
,"just over buffsize" ~: [(0, bs, 0), (bs', 1, bs)]
~=? seekPositions 0 (bs+1)
,"non-zero start point" ~: [(1, 10,0)] ~=? seekPositions 1 10
,"slop on both sides" ~: [(10, bs 10, 0)
,(bs', bs, bs10)
,(bs'*2, 10, 2*bs10)]
~=? seekPositions 10 (bs * 2)
]]
justSame :: (Eq a) => a -> (b, a) -> Bool
justSame r (_, numRead) = r == numRead