68 lines
2.0 KiB
Haskell
68 lines
2.0 KiB
Haskell
-- |
|
|
-- Module : Crypto.Random.Entropy.Unix
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
-- Stability : experimental
|
|
-- Portability : Good
|
|
--
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
module Crypto.Random.Entropy.Unix
|
|
( DevRandom
|
|
, DevURandom
|
|
) where
|
|
|
|
import Foreign.Ptr
|
|
import Data.Word (Word8)
|
|
import Crypto.Random.Entropy.Source
|
|
import Control.Exception as E
|
|
|
|
import System.Posix.Types (Fd)
|
|
import System.Posix.IO
|
|
|
|
type H = Fd
|
|
type DeviceName = String
|
|
|
|
-- | Entropy device /dev/random on unix system
|
|
newtype DevRandom = DevRandom DeviceName
|
|
|
|
-- | Entropy device /dev/urandom on unix system
|
|
newtype DevURandom = DevURandom DeviceName
|
|
|
|
instance EntropySource DevRandom where
|
|
entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random"
|
|
entropyGather (DevRandom name) ptr n =
|
|
withDev name $ \h -> gatherDevEntropy h ptr n
|
|
entropyClose (DevRandom _) = return ()
|
|
|
|
instance EntropySource DevURandom where
|
|
entropyOpen = fmap DevURandom `fmap` testOpen "/dev/urandom"
|
|
entropyGather (DevURandom name) ptr n =
|
|
withDev name $ \h -> gatherDevEntropy h ptr n
|
|
entropyClose (DevURandom _) = return ()
|
|
|
|
testOpen :: DeviceName -> IO (Maybe DeviceName)
|
|
testOpen filepath = do
|
|
d <- openDev filepath
|
|
case d of
|
|
Nothing -> return Nothing
|
|
Just h -> closeDev h >> return (Just filepath)
|
|
|
|
openDev :: String -> IO (Maybe H)
|
|
openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags)
|
|
`E.catch` \(_ :: IOException) -> return Nothing
|
|
where fileFlags = defaultFileFlags { nonBlock = True }
|
|
|
|
withDev :: String -> (H -> IO a) -> IO a
|
|
withDev filepath f = openDev filepath >>= \h ->
|
|
case h of
|
|
Nothing -> error ("device " ++ filepath ++ " cannot be grabbed")
|
|
Just fd -> f fd >>= \r -> (closeDev fd >> return r)
|
|
|
|
closeDev :: H -> IO ()
|
|
closeDev h = closeFd h
|
|
|
|
gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int
|
|
gatherDevEntropy h ptr sz =
|
|
(fromIntegral `fmap` fdReadBuf h ptr (fromIntegral sz))
|
|
`E.catch` \(_ :: IOException) -> return 0
|