Have I re-invented the wheel yet again? I have a module the following simple functions, that I have been using for some time: -- Read data from the system random device. -- Return Nothing if there is currently not -- enough entropy in the system random device. devRandom :: Storable a => IO (Maybe a) -- Read data from the system random device. -- If necessary, wait until there is -- enough entropy in the system random device. devRandomWait :: Storable a => IO a -- Read data from the system random device. -- If there is currently not enough entropy -- in the system random device, use a lower -- quality source of randomness instead. devURandom :: Storable a => IO a These are currently implemented only for platforms that have a /dev/random and /dev/urandom device, i.e., Unix-like. I know how to implement the third function - devURandom - on Windows, but I don't currently have a Windows box on which I can compile Haskell. I don't know how to implement the other two functions on Windows. This seems like something that is important to be in the standard library, or at least publicly accessible. Is it out there already and I am just missing it? If not, what is the best way to make this available? Is there someone who would like to do the Windows part? -Yitz
It's short, so I'll post it here. Any comments? Thanks, -Yitz module DevRandom where import System.IO import System.IO.Error import Foreign.Marshal.Alloc import Foreign.Storable import Foreign.Ptr data BlockingMode = Blocking | NonBlocking deriving (Eq, Show) -- Read data from the system random device. -- Return Nothing if there is currently not -- enough entropy in the system random device. devRandom :: Storable a => IO (Maybe a) devRandom = readDev "/dev/random" NonBlocking -- Read data from the system random device. -- If necessary, wait until there is -- enough entropy in the system random device. devRandomWait :: Storable a => IO a devRandomWait = readDev dev Blocking >>= maybe (devRandomError dev) return where dev = "/dev/random" -- Read data from the system random device. -- If there is currently not enough entropy -- in the system random device, use a lower -- quality source of randomness instead. devURandom :: Storable a => IO a devURandom = readDev dev NonBlocking >>= maybe (devRandomError dev) return where dev = "/dev/urandom" readDev :: Storable a => FilePath -> BlockingMode -> IO (Maybe a) readDev dev mode = do h <- openFile dev ReadMode hSetBuffering h NoBuffering alloca $ getMaybe h undefined where getMaybe :: Storable a => Handle -> a -> Ptr a -> IO (Maybe a) getMaybe h undef ptr = do let size = sizeOf undef n <- case mode of Blocking -> hGetBuf h ptr size NonBlocking -> hGetBufNonBlocking h ptr size if n < size then return Nothing else peek ptr >>= return . Just devRandomError :: FilePath -> IO a devRandomError p = ioError $ mkIOError illegalOperationErrorType "Unable to read from the system random device" Nothing (Just p)
Yitzchak Gale wrote:
It's short, so I'll post it here. Any comments?
readDev :: Storable a => FilePath -> BlockingMode -> IO (Maybe a) readDev dev mode = do h <- openFile dev ReadMode hSetBuffering h NoBuffering alloca $ getMaybe h undefined where getMaybe :: Storable a => Handle -> a -> Ptr a -> IO (Maybe a) getMaybe h undef ptr = do let size = sizeOf undef n <- case mode of Blocking -> hGetBuf h ptr size NonBlocking -> hGetBufNonBlocking h ptr size if n < size then return Nothing else peek ptr >>= return . Just
This re-opens the device every time we need it. How about opening once, when it's first needed? hDevRandom :: Handle {-# NOINLINE hDevRandom #-} hDevRandom = unsafePerformIO $ openFile "/dev/random" ReadMode hDevURandom :: Handle {-# NOINLINE hDevURandom #-} hDevURandom = unsafePerformIO $ openFile "/dev/urandom" ReadMode
Bryan Donlan wrote:
This re-opens the device every time we need it. How about opening once, when it's first needed?
Good idea.
hDevRandom :: Handle {-# NOINLINE hDevRandom #-} hDevRandom = unsafePerformIO $ openFile "/dev/random" ReadMode
hDevURandom :: Handle {-# NOINLINE hDevURandom #-} hDevURandom = unsafePerformIO $ openFile "/dev/urandom" ReadMode
The NOINLINE guarantees that openFile is called only once. But does it guarantee that openFile is NOT called if we do not need it? We could check what the compilers actually do, but I am not sure we have a guarantee here. Perhaps we should do something like data Dev = Dev String (IORef (Maybe Handle)) getDevHandle :: Dev -> IO Handle getDevHandle (Dev path ref) = readIORef ref >>= maybe openDev return where openDev = do h <- openFile path ReadMode writeIORef ref h return h hDevRandom :: Dev {-# NOINLINE hDevRandom #-} hDevRandom = Dev "/dev/random" $ unsafePerformIO $ newIORef Nothing hDevURandom :: Dev {-# NOINLINE hDevURandom #-} hDevURandom = Dev "/dev/urandom" $ unsafePerformIO $ newIORef Nothing -Yitz
Yitzchak Gale wrote:
Bryan Donlan wrote:
This re-opens the device every time we need it. How about opening once, when it's first needed?
Good idea.
hDevRandom :: Handle {-# NOINLINE hDevRandom #-} hDevRandom = unsafePerformIO $ openFile "/dev/random" ReadMode
hDevURandom :: Handle {-# NOINLINE hDevURandom #-} hDevURandom = unsafePerformIO $ openFile "/dev/urandom" ReadMode
The NOINLINE guarantees that openFile is called only once. But does it guarantee that openFile is NOT called if we do not need it? We could check what the compilers actually do, but I am not sure we have a guarantee here.
There's commentary in GHC/Conc.lhs that this is the case: {-# NOINLINE pendingEvents #-} {-# NOINLINE pendingDelays #-} (pendingEvents,pendingDelays) = unsafePerformIO $ do startIOManagerThread reqs <- newIORef [] dels <- newIORef [] return (reqs, dels) -- the first time we schedule an IO request, the service thread -- will be created (cool, huh?) I don't know if this is a documented guarentee however.
Bryan Donlan wrote:
{-# NOINLINE hDevRandom #-} hDevRandom = unsafePerformIO $ openFile "/dev/random" ReadMode
I wrote:
The NOINLINE guarantees that openFile is called only once. But does it guarantee that openFile is NOT called if we do not need it? We could check what the compilers actually do, but I am not sure we have a guarantee here.
There's commentary in GHC/Conc.lhs that this is the case: {-# NOINLINE pendingEvents #-} {-# NOINLINE pendingDelays #-} (pendingEvents,pendingDelays) = unsafePerformIO $ do startIOManagerThread reqs <- newIORef [] dels <- newIORef [] return (reqs, dels) -- the first time we schedule an IO request, the service thread -- will be created (cool, huh?) I don't know if this is a documented guarentee however.
Hmm. I'm not sure what that comment means. They are doing just what I did - creating only an empty IORef, with the actual resource allocated only when needed. Also, this is located inside a module that is explicitly GHC-specific. Regards, Yitz
participants (2)
-
Bryan Donlan -
Yitzchak Gale