halfs-0.2: Halfs/FileHandle.hs
{-# LANGUAGE PatternSignatures #-}
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 {-# SOURCE #-} 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 {-# SOURCE #-} Halfs.Directory(Directory(..),
getDirectoryFromCache,
removeChild, getChildWithName)
-- Base
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)
-- ------------------------------------------------------------
-- * FileHandle stuff
-- ------------------------------------------------------------
data FileMode = ReadMode | WriteMode | AppendMode deriving (Eq, Show)
-- |This is _not_ an opaque type. Anyone can change the mode of
-- elements, reguardless of whether they're in the FSRead or FSWrite
-- monads. The mode here is _not_ enforcing. Maybe eventually will
-- be opaque. FIX.
data FileHandle
= FileHandle {fhInodeNum :: INInt
,fhSeekPos :: INLong
,fhMode :: FileMode
} deriving (Show, Eq) -- FIX: eq instance should probably be the inode number?
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
-- |A "smart" constructor for FileHandle. Does not truncate file in
-- write mode or anything like that.
fileHandle :: INInt -> FileMode -> FileHandle
fileHandle iNum f = fileHandle' iNum 0 f
-- |Another smart construcor.
fileHandle' :: INInt -> INLong -> FileMode -> FileHandle
fileHandle' iNum s f = FileHandle iNum s f
-- |open for write.
fhOpenWrite :: INInt -> FSWrite FileHandle
fhOpenWrite inodeNum = do
return $ FileHandle inodeNum 0 WriteMode
-- |Opens the file in write mode and frees all blocks in the file.
-- Reuses the inode.
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
-- |Close this handle. Does nothing for now.
fhCloseRead :: FileHandle -> FSRead ()
fhCloseRead _ = return ()
-- |Close this handle. Does nothing for now.
fhCloseWrite :: FileHandle -> FSWrite ()
fhCloseWrite _ = return ()
fhRewind :: FileHandle -> FileHandle
fhRewind fh = fh{fhSeekPos=0}
fhSeek :: FileHandle -> INLong -> FileHandle
fhSeek fh n = fh{fhSeekPos=n}
-- ------------------------------------------------------------
-- * Read
-- ------------------------------------------------------------
-- |Must not touch the block map in fhRead, since it may not be
-- well-formed yet.
fhRead :: FileHandle
-> BinHandle -- ^Buffer to read into
-> INInt -- ^Offset into above buffer
-> INInt -- ^How many to read
-> FSRead (FileHandle, INInt) -- ^Number actually read, nothing if eof
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 -- ^Buffer to read into
-> INInt -- ^Offset into above buffer
-> INInt -- ^How many to read
-> INInt -- Buffer size
-> INLong -- Size of file (from fhSize)
-> FSRead INInt -- ^Number actually read, nothing if eof
fhRead' fh@FileHandle{fhSeekPos=filePos} buffer offset len buffSize fileSize
-- First two cases handle bad length requests.
| offset + len > buffSize
= fhRead' fh buffer offset (buffSize - offset) buffSize fileSize
| filePos + (inIntToINLong len) > fileSize
-- safe conversion, since len is INInt
= 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
-- following fromIntegral'' is kinda safe, due to mod.
(fromIntegral'' (startPos `div` intToINLong bytesPerBlock))
(fromIntegral'' (startPos `mod` intToINLong bytesPerBlock))
len' buffer (offset + soFar))
(seekPositions filePos len)
return (sum sums) -- the amount actually read
-- |Read a number of bytes from the given file.
readBlock :: Inode -- The file to read from
-> BlockNumber -- Block number of the file to read
-> INInt -- Offset in the above block
-> INInt -- number of bytes to read
-> BinHandle -- Array to read the block into
-> INInt -- buffer offset; where to read this block into
-> FSRead INInt -- Number of bytes read
readBlock inode blockNum blockOffset numBytes buffer buffOffset
= do da <- getDiskAddrOfBlockRead inode blockNum
readPartOfBlock da blockOffset buffer buffOffset numBytes
-- ------------------------------------------------------------
-- * Write
-- ------------------------------------------------------------
fhWrite :: FileHandle
-> BinHandle -- ^Buffer to write from
-> INInt -- ^Offset into above buffer
-> INInt -- ^How many to write
-> FSWrite (FileHandle, INInt)
-- ^Number actually written, nothing if eof
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)
-- |Bumps the filesize.
oneWrite :: BinHandle
-> INInt -- Inode number
-> INInt -- buff offset
-> INInt -- bytes so far, inode
-> (INLong, INInt, INInt)
-> FSWrite INInt -- bytes so far
oneWrite buffer inodeNum buffOffset
bytesSoFar (startPos, len', soFar) = do
lastInode <- getInodeWrite inodeNum Nothing
let oldSize = num_bytes $ metaData lastInode
newLen
<- writeBlock
lastInode
-- following are kinda safe due to div & mod
(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
-- how much bigger is this file than it was before?
let (biggerBy::INLong)
= startPos + (inIntToINLong newLen)
- (assert (currSize == oldSize) currSize)
-- putStrLnWriteRead $ "would bump if > 0: " ++ (show biggerBy)
-- bump the size if we've gone off the end:
updateInodeCacheWrite (if biggerBy > 0
then inodeBumpSize newInodeB (currSize + biggerBy)
else newInodeB)
return $ bytesSoFar + newLen
-- |Write a number of bytes from the given file. Be sure to bump the
-- file size.
writeBlock :: Inode -- The file to write into
-> BlockNumber -- Block number of the file to write
-> INInt -- Offset in the above block
-> INInt -- number of bytes to write
-> BinHandle -- buffer to read from
-> INInt -- buffer offset; where to write this block into
-> FSWrite INInt -- Number of bytes written
writeBlock inInode blockNum blockOffset numBytes buffer buffOffset
= do da <- getDiskAddrOfBlockWrite inInode blockNum
num <- writePartOfBlock da blockOffset buffer buffOffset numBytes
return num
-- ------------------------------------------------------------
-- * Helpers (Rithmatic)
-- ------------------------------------------------------------
-- |Compute the start positions, lengths, and buffer offset for a read
-- call. This takes into account the size of the buffer.
seekPositions :: INLong -- ^Start position
-> INInt -- ^Length to read
-> [(INLong -- positions
,INInt -- sizes
,INInt)] -- total amount read at end of read
seekPositions startPos len = seekPositions' startPos len 0
seekPositions' :: INLong -- Start position
-> INInt -- Length to read
-> INInt -- amount read so far
-> [(INLong -- positions
,INInt -- sizes
,INInt)] -- total amount read at end of read
seekPositions' startPos len soFar =
let bytesPerBlock' = intToINLong bytesPerBlock
(thisBlockSize::Int) = fromIntegral'' $ -- safe due to 'mod'
if startPos < bytesPerBlock'
then bytesPerBlock' - startPos
else bytesPerBlock'
- (startPos `mod` bytesPerBlock')
in if len <= intToINInt thisBlockSize
then [(startPos,len, soFar)] -- base case
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
-- ------------------------------------------------------------
-- * Directory stuff
-- ------------------------------------------------------------
-- |Builds a brand-new, almost-empty directory.
newDirectory :: INInt -- ^inode number
-> Directory
newDirectory inodeNum =
-- not really open, so mode doesn't matter
let fhDirectory = fileHandle' inodeNum 0 ReadMode
in Directory fhDirectory (Map.fromList [(".", inodeNum)]) True
-- |This file will always be less than INInt, not INLong. FIX: Is this
-- true? If not, we'll have to read it in chunks.
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)
-- | Reads a directory from the given inode.
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
-- |fetch the inode out of the root directory
readRootDir :: FSRead Directory
readRootDir = do
fsroot <- unsafeReadGet
let inode = fsRootRootDirInode fsroot
readDirectory inode
-- |FIX: are we actually freeing the inode?
unlink :: Directory
-> String -- file to unlink
-> 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 --also takes care of dir cache.
else decLinksForInode
f inode
-- FIX: Should we not return dir?
let dir' = removeChild dir unlinkMe
modify (fsRootUpdateDirectoryCache dir')
return dir'
-- |Build a directory out of this FilePath.
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
-- |Higher level function for turning a path into an object. Uses
-- getInodeAtPath (mutually-recursive with getDirectoryAtPath) to get
-- this inode, and build something out of it. WARNING: the inode
-- returned may be an invalid inode. Caller is responsible for
-- initializing it if it's possibly invalid.
getSomethingAtPath :: (Inode -> FSRead a)
-> FilePath
-> FSRead a
getSomethingAtPath f path = do
inode <- getInodeAtPath path
f (assert (goodInodeMagic inode) inode)
-- |FIX: this is in the read monad, but it'll let you make a write
-- handle if you ask for one. The FileHandle type is not opaque so
-- that's OK! Should work for files or directories!
openFileAtPath :: FilePath
-> FileMode
-> FSRead FileHandle
openFileAtPath path fMode = do
Inode{metaData=InodeMetadata{inode_num=n}} <- getInodeAtPath path
return $ fileHandle n fMode
-- |Uses getDirectoryAtPath (mutually recursive) to traverse down a
-- directory hierarchy to get the contents of the parent of this
-- filepath and fetch the inode from there. WARNING: the inode
-- returned may be an invalid inode. Caller is responsible for
-- initializing it if it's possibly invalid.
getInodeAtPath :: FilePath
-> FSRead Inode
getInodeAtPath "" = error "getDirectoryAt: empty string"
getInodeAtPath "/" = readRootDir >>= fhInode . dirFile
getInodeAtPath ('.':'/':p) = getInodeAtPath ('/':p) -- FIX: this is a horrid hack
getInodeAtPath ('.':p) = getInodeAtPath ('/':p) -- FIX: remove when we have relative paths
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 -- FIX: will laziness hurt here?
return True)
(\e -> if isDoesNotExistError e
then return False
else throwError e)
-- ------------------------------------------------------------
-- * Files With Names
-- ------------------------------------------------------------
-- |Might fail if parent doesn't exist. FIX: talk to dylan about
-- special cases here handled in the java code.
-- openFileForWrite :: FSRoot -> FilePath -> IO (Maybe FileHandle)
-- openFileForWrite fsroot path = do
-- mInode <- getInodeAtPath fsroot path
-- case mInode of
-- Nothing ->
-- return $ Just $ FileHandle inode 0 WriteMode
-- ------------------------------------------------------------
-- * Tests
-- ------------------------------------------------------------
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, bs-10)
,(bs'*2, 10, 2*bs-10)]
~=? seekPositions 10 (bs * 2)
]]
-- a good quickecheck test would be to add up all the sizes and see if
-- they equal the length.
-- |For assertion checking
justSame :: (Eq a) => a -> (b, a) -> Bool
justSame r (_, numRead) = r == numRead