-- | Function to find the file offsets of primary partitions in raw disk
--    images. Currently only MBR partitions are supported. See 'B9.MBR'
module B9.PartitionTable
  ( getPartition,
  )
where

import qualified B9.MBR as MBR
import Data.Word (Word64)

getPartition :: Int -> FilePath -> IO (Word64, Word64, Word64)
getPartition :: Int -> FilePath -> IO (Word64, Word64, Word64)
getPartition Int
partitionIndex FilePath
diskImage =
  (Word64, Word64) -> (Word64, Word64, Word64)
forall a. Integral a => (a, a) -> (a, a, a)
blockSized ((Word64, Word64) -> (Word64, Word64, Word64))
-> IO (Word64, Word64) -> IO (Word64, Word64, Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> FilePath -> IO (Word64, Word64)
MBR.getPartition Int
partitionIndex FilePath
diskImage

blockSized :: (Integral a) => (a, a) -> (a, a, a)
blockSized :: (a, a) -> (a, a, a)
blockSized (a
s, a
l) = let bs :: a
bs = a -> a -> a -> a
forall p. Integral p => p -> p -> p -> p
gcd2 a
1 a
s a
l in (a
s a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
bs, a
l a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
bs, a
bs)
  where
    gcd2 :: p -> p -> p -> p
gcd2 p
n p
x p
y =
      let next :: p
next = p
2 p -> p -> p
forall a. Num a => a -> a -> a
* p
n
       in if p
x p -> p -> p
forall a. Integral a => a -> a -> a
`rem` p
next p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0 Bool -> Bool -> Bool
&& p
y p -> p -> p
forall a. Integral a => a -> a -> a
`rem` p
next p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0 then p -> p -> p -> p
gcd2 p
next p
x p
y else p
n