git.iko.soy/typeable/uuid
on master help sign in
In V1 if we can't lookup the system MAC fake it
9491bffAntoine Latter
Data/UUID/V1.hs+35−10
compare with master
unifiedsplit
@@ -5,7 +5,7 @@
5-- Module : Data.UUID.V1
5-- Module : Data.UUID.V1
6-- Copyright : (c) 2008 Jason Dusek
6-- Copyright : (c) 2008 Jason Dusek
7-- (c) 2009 Mark Lentczner
7-- (c) 2009 Mark Lentczner
8−-- (c) 2009-2010 Antoine Latter
8+-- (c) 2009-2010,2012 Antoine Latter
9--
9--
10-- License : BSD-style
10-- License : BSD-style
11--
11--
@@ -23,9 +23,12 @@ import Data.Time
23import Data.Bits
23import Data.Bits
24import Data.Word
24import Data.Word
25
25
26+import Control.Applicative ((<$>),(<*>))
26import Control.Concurrent.MVar
27import Control.Concurrent.MVar
27import System.IO.Unsafe
28import System.IO.Unsafe
28
29
30+import qualified System.Random as R
31+
29import qualified System.Info.MAC as SysMAC
32import qualified System.Info.MAC as SysMAC
30import Data.MAC
33import Data.MAC
31
34
@@ -42,9 +45,8 @@ import Data.UUID.Internal
42nextUUID :: IO (Maybe UUID)
45nextUUID :: IO (Maybe UUID)
43nextUUID = do
46nextUUID = do
44 res <- stepTime
47 res <- stepTime
45− mac <- SysMAC.mac
46− case (res, mac) of
48+ case res of
47− (Just (c, t), Just m) -> return $ Just $ makeUUID t c m
49+ Just (mac, c, t) -> return $ Just $ makeUUID t c mac
48 _ -> return Nothing
50 _ -> return Nothing
49
51
50
52
@@ -64,20 +66,20 @@ type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
64-- |Approximates the clock algorithm in RFC 4122, section 4.2
66-- |Approximates the clock algorithm in RFC 4122, section 4.2
65-- Isn't system wide or thread safe, nor does it properly randomize
67-- Isn't system wide or thread safe, nor does it properly randomize
66-- the clock value on initialization.
68-- the clock value on initialization.
67−stepTime :: IO (Maybe (Word16, Word64))
69+stepTime :: IO (Maybe (MAC, Word16, Word64))
68stepTime = do
70stepTime = do
69 h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
71 h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
70− modifyMVar state $ \s@(State c0 h0) ->
72+ modifyMVar state $ \s@(State mac c0 h0) ->
71 if h1 > h0
73 if h1 > h0
72 then
74 then
73− return (State c0 h1, Just (c0, h1))
75+ return (State mac c0 h1, Just (mac, c0, h1))
74 else
76 else
75 let
77 let
76 c1 = succ c0
78 c1 = succ c0
77 in if c1 <= 0x3fff -- when clock is initially randomized,
79 in if c1 <= 0x3fff -- when clock is initially randomized,
78 -- then this test will need to change
80 -- then this test will need to change
79 then
81 then
80− return (State c1 h1, Just (c1, h1))
82+ return (State mac c1 h1, Just (mac, c1, h1))
81 else
83 else
82 return (s, Nothing)
84 return (s, Nothing)
83
85
@@ -86,10 +88,33 @@ stepTime = do
86state :: MVar State
88state :: MVar State
87state = unsafePerformIO $ do
89state = unsafePerformIO $ do
88 h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
90 h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
91+ mac <- getMac
89− newMVar $ State 0 h0 -- the 0 should be a random number
92+ newMVar $ State mac 0 h0 -- the 0 should be a random number
90−
93+
94+-- SysMAC.mac can fail on some machines.
95+-- In those cases we fake it with a random
96+-- 6 bytes seed.
97+getMac :: IO MAC
98+getMac =
99+ SysMAC.mac >>= \macM ->
100+ case macM of
101+ Just m -> return m
102+ Nothing -> randomMac
103+
104+randomMac :: IO MAC
105+randomMac =
106+ -- I'm too lazy to thread through
107+ -- the random state ...
108+ MAC
109+ <$> R.randomIO
110+ <*> R.randomIO
111+ <*> R.randomIO
112+ <*> R.randomIO
113+ <*> R.randomIO
114+ <*> R.randomIO
91
115
92data State = State
116data State = State
117+ {-# UNPACK #-} !MAC
93 {-# UNPACK #-} !Word16
118 {-# UNPACK #-} !Word16
94 {-# UNPACK #-} !Word64
119 {-# UNPACK #-} !Word64
95 deriving (Show)
120 deriving (Show)