[Haskell-cafe] How can I avoid buffered reads?

Leon Smith leon.p.smith at gmail.com
Thu Nov 29 11:26:03 CET 2012


Well,  I took Bardur's suggestion and avoided all the complexities of GHC's
IO stack and simply used System.Posix.IO and Foreign.    This appears to
work,  but for better or worse,   it is using blocking calls to the "read"
system call and is not integrated with GHC's IO manager.   This shouldn't
be an issue for my purposes,  but I suppose it's worth pointing out.

{-# LANGUAGE BangPatterns, ViewPatterns #-}

import           Control.Applicative
import           Data.Bits
import           Data.Word(Word64)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import           Data.ByteString.Internal (c2w)
import           Control.Exception
import           System.Posix.IO
import           Foreign
import qualified System.IO              as IO
import qualified Data.Binary.Get        as Get

showHex :: Word64 -> S.ByteString
showHex n = s
  where
    (!s,_) = S.unfoldrN 16 f n

    f n = Just (char (n `shiftR` 60), n `shiftL` 4)

    char (fromIntegral -> i)
      | i < 10    = (c2w '0' -  0) + i
      | otherwise = (c2w 'a' - 10) + i

twoRandomWord64s :: IO (Word64,Word64)
twoRandomWord64s = bracket openRd closeRd readRd
  where
    openRd = openFd "/dev/urandom" ReadOnly Nothing defaultFileFlags {
noctty = True }
    readRd = \fd -> allocaBytes 16 $ \ptr -> do
                fdReadAll fd ptr 16
                x <- peek (castPtr ptr)
                y <- peek (castPtr ptr `plusPtr` 8)
                return (x,y)
    closeRd = closeFd
    fdReadAll fd ptr n = do
      n' <- fdReadBuf fd ptr n
      if n /= n'
      then fdReadAll fd (ptr `plusPtr` n') (n - n')
      else return ()

main = do
   (x,y) <- twoRandomWord64s
   S.hPutStrLn IO.stdout (S.append (showHex x) (showHex y))


On Wed, Nov 28, 2012 at 6:05 PM, Leon Smith <leon.p.smith at gmail.com> wrote:

> If you have rdrand,  there is no need to build your own PRNG on top of
> rdrand.   RdRand already incorporates one so that it can produce random
> numbers as fast as they can be requested,  and this number is continuously
> re-seeded with the on-chip entropy source.
>
> It would be nice to have a little more information about /dev/urandom and
> how it varies by OS and hardware,   but on Linux and FreeBSD at least it's
> supposed to be a cryptographically secure RNG that incorporates a PRNG to
> produce numbers in case you exhaust the entropy pool.
>
> On Wed, Nov 28, 2012 at 5:00 PM, Vincent Hanquez <tab at snarc.org> wrote:
>
>> On 11/28/2012 09:31 PM, Leon Smith wrote:
>>
>>> Quite possibly,  entropy does seem to be a pretty lightweight
>>> dependency...
>>>
>>> Though doesn't recent kernels use rdrand to seed /dev/urandom if it's
>>> available?   So /dev/urandom is the most portable source of random numbers
>>> on unix systems,  though rdrand does have the advantage of avoiding system
>>> calls,  so it certainly would be preferable, especially if you need large
>>> numbers of random numbers.
>>>
>> There's no much information on this i think, but if you need large number
>> of random numbers you should build a PRNG yourself on top of the best
>> random seed you can get, and make sure you reseed your prng casually with
>> more entropy bytes. Also if
>> you don't have enough initial entropy, you should block.
>>
>> /dev/urandom is not the same thing on every unix system. leading to
>> various assumptions broken when varying the unixes. It also varies with the
>> hardware context: for example on an embedded or some virtualized platform,
>> giving you really terrible entropy.
>>
>> --
>> Vincent
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20121129/debb7484/attachment-0001.htm>


More information about the Haskell-Cafe mailing list