module Data.VHD.Block
( Block
, Sector
, bitmapSizeOfBlock
, bitmapOfBlock
, withBlock
, readBlock
, writeBlock
, sectorLength
) where
import Foreign.Ptr
import Foreign.Storable
import Data.Word
import Data.Bits
import Data.VHD.Utils
import Data.VHD.Types
import Data.VHD.Bat
import Data.VHD.Bitmap
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B
import Control.Monad
import System.IO.MMap
data Block = Block BlockSize (Ptr Word8)
data Sector = Sector (Ptr Word8)
sectorLength :: Word32
sectorLength = 512
bitmapSizeOfBlock :: BlockSize -> Int
bitmapSizeOfBlock blockSize = fromIntegral ((nbSector `divRoundUp` 8) `roundUpToModulo` sectorLength)
where nbSector = blockSize `divRoundUp` sectorLength
bitmapOfBlock :: Block -> Bitmap
bitmapOfBlock (Block _ ptr) = Bitmap ptr
dataOfBlock :: Block -> Ptr Word8
dataOfBlock (Block bs ptr) = ptr `plusPtr` (bitmapSizeOfBlock bs)
withBlock :: FilePath -> BlockSize -> Word32 -> (Block -> IO a) -> IO a
withBlock file bs sectorOff f = mmapWithFilePtr file ReadWrite (Just offsetSize) $ \(ptr, sz) ->
f (Block bs $ castPtr ptr)
where
absoluteOffset = fromIntegral (fromIntegral sectorOff * sectorLength)
offsetSize = (absoluteOffset, fromIntegral bs + fromIntegral bitmapSize)
nbSector = (bs `divRoundUp` sectorLength)
bitmapSize = (nbSector `divRoundUp` 8) `roundUpToModulo` sectorLength
readBlock :: Block -> Int -> Int -> IO ByteString
readBlock block offsetStart offsetEnd = do
B.create length (\bsptr -> B.memcpy (castPtr bsptr) (dataPtr `plusPtr` offsetStart) (fromIntegral length))
where
length = offsetEnd offsetStart
bitmapPtr = bitmapOfBlock block
dataPtr = dataOfBlock block
sectorStart = fromIntegral offsetStart `div` sectorLength
sectorEnd = fromIntegral offsetEnd `div` sectorLength
writeBlock :: Block -> ByteString -> Int -> IO ()
writeBlock block content offset = do
bitmapSetRange bitmapPtr (fromIntegral sectorStart) (fromIntegral sectorEnd)
B.unsafeUseAsCString content (\bsptr -> B.memcpy (dataPtr `plusPtr` offset) (castPtr bsptr) (fromIntegral length))
where
length = B.length content
bitmapPtr = bitmapOfBlock block
dataPtr = dataOfBlock block
sectorStart = fromIntegral offset `div` sectorLength
sectorEnd = fromIntegral (offset + B.length content) `div` sectorLength