Hi,
I had a requirement to generate various kinds of I/O patterns on a
filesystem and subsequently verify this. The initial version of the
program below implements a random I/O pattern with multiple threads.
Even when the number of I/O is as small as 200 and 10 concurrent
theads, the amount of memory used is huge. When I run the program it
consumes close to 1to2GB memory. Moreover the rate at which it
generates the I/O is very low which is not good for testing a
filesystem. I have used System.POSIX.IO but I tried System.IO and did
not see much difference either. I would appreciate help in identifying
ways to improve this.
{-# OPTIONS -fglasgow-exts #-}
import System.Random
import Data.List
import Monad
import System.Posix.IO
import System.Posix.Types
import Data.Time.Clock
import System.Posix.Files
import Data.Maybe
import GHC.IO.Device (SeekMode(..))
import Control.Exception
import Data.Typeable
import System
import Control.Concurrent
--myrandomRlist :: (Num t, Random t) => t -> IO [t]
--myrandomRlist x = liftM (randomRs (0,x)) newStdGen
myrandomRlist :: (Num t, Random t) => t ->t -> StdGen -> [t]
myrandomRlist min max seed = randomRs (min,max) seed
data IoLoc = IoLoc {offset :: FileOffset, size::ByteCount, num::Int }
deriving (Show, Typeable)
instance Exception IoLoc
data Corrupt = Corrupt String IoLoc
deriving (Show, Typeable)
instance Exception Corrupt
data FileHdr = FileHdr {fileName::FilePath, seed::StdGen,
minIoSize::Int, maxIoSize::Int, ioCount::Int}
deriving (Show)
data FileIO = FileIO {fd::Fd, params::FileHdr, fileData::[IoLoc]}
genPattern :: FilePath -> IoLoc -> String
genPattern f l =
take (read $ show $size l) (cycle $ "(" ++ f ++ ")" ++ "[" ++
(show (offset l)) ++ ":" ++ (show (size l)) ++ (show (num l)) ++ "]")
doHdrRead :: Fd -> IO [Char]
doHdrRead fd = do
(str, count) <- fdRead fd 100
return (takeWhile (\x-> not (x == '\n')) str)
doGetHdr :: Fd -> IO FileHdr
doGetHdr fd = do
file <- doHdrRead fd
seed <- doHdrRead fd
minIoSize <- doHdrRead fd
maxIoSize <- doHdrRead fd
ioCount <- doHdrRead fd
return (FileHdr file (read seed) (read minIoSize) (read maxIoSize)
(read ioCount))
doHdrFromFile :: FilePath -> IO FileIO
doHdrFromFile name = do
fd <- openFd name ReadWrite (Just ownerModes) (OpenFileFlags
{append=False, exclusive=False, noctty=True, nonBlock=False,
trunc=False})
hdr <- doGetHdr fd
return (FileIO fd hdr [])
doHdrWrite :: Fd -> [Char] -> IO ByteCount
doHdrWrite fd str = do
fdWrite fd (take 100 (str ++ "\n" ++ (cycle ['\0'])))
doWriteHdr :: Fd -> FileHdr -> IO ByteCount
doWriteHdr fd hdr = do
doHdrWrite fd (show (fileName hdr))
doHdrWrite fd (show (seed hdr))
doHdrWrite fd (show (minIoSize hdr))
doHdrWrite fd (show (maxIoSize hdr))
doHdrWrite fd (show (ioCount hdr))
doWriteFile :: FilePath -> IO FileHdr
doWriteFile name = do
fd <- openFd name ReadWrite (Just ownerModes) (OpenFileFlags
{append=False, exclusive=False, noctty=True, nonBlock=False,
trunc=True})
seed <- newStdGen
hdr <- return (FileHdr name seed 4096 (2*8096) 200)
doWriteHdr fd hdr
return hdr
overLap (IoLoc off1' sz1' num1) (IoLoc off2' sz2' num2) =
((off1 > off2) && (off1 < off2 +sz2)) ||((off1+sz1 >off2)
&&(off1+sz1 < off2 +sz2))
where
off1 = read (show off1')
sz1 = read (show sz1')
off2 = read (show off2')
sz2 = read (show sz2')
genIoList1 :: [IoLoc] -> [Int] -> [Int] -> Int -> Int -> [IoLoc]
genIoList1 list offset size _ 0 =
list
genIoList1 list offset size 0 _ =
list
genIoList1 list (offset:os) (size:ss) count bound =
if isNothing $ find (overLap x) list
then genIoList1 ([x] ++ list) os ss (count - 1) (bound -1)
else genIoList1 list os ss count (bound -1)
where
x = IoLoc (read (show offset)) (read(show size)) count
-- offset = (read (show offset1))
-- size = (read(show size1))
genIoList :: FileHdr -> [IoLoc]
genIoList (FileHdr name seed min max count) =
genIoList1 [] (myrandomRlist 4000 1099511627776 seed)
(myrandomRlist min max seed) count (count*2)
doActualIo :: Fd -> IoLoc -> String -> IO ()
doActualIo fd (IoLoc off sz num) str = do
off <- fdSeek fd AbsoluteSeek off
fdWrite fd str
return ()
doVerifyIo :: Fd -> IoLoc -> String -> IO ()
doVerifyIo fd (IoLoc off sz num) str = do
off <- fdSeek fd AbsoluteSeek off
(filedata, count) <- fdRead fd sz
if str == filedata
then return ()
else throwIO (Corrupt ("Data corruption in #" ++ (take 200 str)
++ "#" ++ (take 200 filedata))(IoLoc off sz num))
mainWrite file = do
hdr <- doWriteFile file
hdrIO <- doHdrFromFile file
iolst <- return $ genIoList hdr
app <- return $ zip iolst (map (genPattern (fileName hdr)) iolst)
putStrLn (fileName hdr)
mapM (\(x,y)-> doActualIo (fd hdrIO) x y) app
mapM (\(x,y)-> doVerifyIo (fd hdrIO) x y) app
return hdr
mainVerify file = do
hdrIO <- doHdrFromFile file
hdr <- return (params hdrIO)
iolst <- return $ genIoList hdr
file <- return $ filter (\x->not ( x=='"')) (fileName hdr)
app <- return $ zip iolst (map (genPattern file) iolst)
putStrLn $ filter (\x->not ( x=='"')) (fileName hdr)
mapM (\(x,y)-> doVerifyIo (fd hdrIO) x y) app
return hdr
main = do
x <- getArgs
if (length x) == 3
then do
main1
else do
putStrLn "USAGE:\nfile-io write/verify <full-path file name>
<number of threads> \
\\n\n\
\Simple IO load generator with write verification. This utility is designed\n\
\to generate multi-threaded IO load which will write a pattern to the file. \n\
\When this is invoked with the same parameters with the verify option \n\
\the data written will be verified.\n\
\ "
main1 = do
[op, name, numProcs] <- getArgs
m <- newEmptyMVar
n <- return $read numProcs
case op of
"write" -> do mapM forkIO [(fillfile (name ++ (show i)) ) m|i<-[1..n]]
"verify" -> do mapM forkIO [(verifyfile (name ++ (show i)) ) m|i<-[1..n]]
x <- mapM takeMVar $ take (read numProcs) $ repeat m
putStrLn $ show $ and x
fillfile filename m = do
mainWrite filename
putMVar m True
verifyfile filename m = do
mainVerify filename
putMVar m True
