haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #20 from rblaze/devrandom

Browse Source 
Use non-blocking IO with /dev/random.
This commit is contained in:
Vincent Hanquez 2015-07-03 13:07:13 +02:00
commit 8f01f2ea64
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Crypto/Random/Entropy/Unix.hs
View File

@ -31,7 +31,7 @@ newtype DevURandom = DevURandom DeviceName
instance EntropySource DevRandom where instance EntropySource DevRandom where
entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random" entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random"
entropyGather (DevRandom name) ptr n = entropyGather (DevRandom name) ptr n =
withDev name $ \h -> gatherDevEntropy h ptr n withDev name $ \h -> gatherDevEntropyNonBlock h ptr n
entropyClose (DevRandom _) = return () entropyClose (DevRandom _) = return ()
instance EntropySource DevURandom where instance EntropySource DevURandom where
@ -67,3 +67,8 @@ gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int
gatherDevEntropy h ptr sz = gatherDevEntropy h ptr sz =
(fromIntegral `fmap` hGetBufSome h ptr (fromIntegral sz)) (fromIntegral `fmap` hGetBufSome h ptr (fromIntegral sz))
`E.catch` \(_ :: IOException) -> return 0 `E.catch` \(_ :: IOException) -> return 0
gatherDevEntropyNonBlock :: H -> Ptr Word8 -> Int -> IO Int
gatherDevEntropyNonBlock h ptr sz =
(fromIntegral `fmap` hGetBufNonBlocking h ptr (fromIntegral sz))
`E.catch` \(_ :: IOException) -> return 0