/pliant/util/crypto/random.pli
 
 1  abstract 
 2    [A true and strong pseudo random generator.] ; eol 
 3   
 4  doc 
 5    listing 
 6      function memory_true_random buffer size study 
 7        arg Address buffer ; arg Int size ; arg CBool study 
 8    [Fills the memory area with true random numbers] ; eol 
 9    [By true random numbers, I mean that they come from real events (the clock or the /dev/random device) rather than computations.] ; eol 
 10    [If 'study' is set, then the number of bits in the buffer should be high, and a basic study will be applyed on the generated sequence in order to reject a too based distribution that would obviously show that the timer did not provide random bits as expected. ] ; eol  
 11    [Should I say: This is slow.] 
 12    listing 
 13      function memory_strong_init bits 
 14        arg Int bits 
 15    [Initialised the strong pseudo random generator with 'bits' true random bits. ] 
 16    [If you never call this function, it will be automatically the first time you request bits from the strong pseudo random generator. ] 
 17    [So, you shoud call it only if the default number of bits defined in 'cipher_init_bits' is too low for your application. Anyway, do not request more than 2048 bits because the RC4 state contains only 2048 bits. If you really need more, you have to change 'rc4_bits' from 8 to 16 in ] ; link "rc4.pli" "rc4.pli" ; [, but modifying rc4.pli directly would make your computer incompatiable with other Pliant computers, so you would rather copy rc4.pli in random.pli and make the change local.] 
 18    listing 
 19      function memory_strong_random buffer size 
 20        arg Address buffer ; arg Int size 
 21    [Fills the memory area with strong pseudo random numbers] ; eol 
 22    [It's much faster.] 
 23    listing 
 24      function random_string len -> s 
 25        arg Int len ; arg Str s 
 26    [Returns a strong pseudo random string with length 'len'] 
 27   
 28  doc 
 29    para 
 30      [Depending on the 'random_device' constant, we either use /etc/random device, or a Pliant algorithm based on the computer clock (implemented in 'memory_true_random' function) in order to generate the true random bits. ] 
 31      [In the second case, if you use a Pentium or better i386 processor, you can set 'pentium' constant to true in order to use the processor clock instead of the system one. It should be better because it changes more often, but I had more problems with it. ] 
 32      [Anyway, when using the clock, I use the sum of the bits instead of the last one and it revealed to be much better, also I suspect it might simply be too tricky to be discovered by my naive statistic study, but still not be random at all.] 
 33    para 
 34      [We use RC4 as the strong pseudo random generator. The key provided to RC4 is a true random bits sequence added to the timestamp, in order to reduce the probability to get two times the same sequence even if the true random bits generator is deaply biased.] ; eol 
 35      [In order to make the pseudo random generator even better, we continuously poke in some true random numbers that are computed from another thread.] 
 36   
 37   
 38  module "/pliant/language/compiler.pli" 
 39  module "/pliant/language/os.pli" 
 40  module "/pliant/language/context.pli" 
 41  module "/pliant/language/stream.pli" 
 42  module "/pliant/language/schedule/daemon.pli" 
 43  module "rc4.pli" 
 44  module "/pliant/language/schedule/pentium.pli" 
 45   
 46  module "/pliant/language/os/socket.pli" 
 47  module "/pliant/language/stream/openmode.pli" 
 48   
 49   
 50  if os_api="linux" or os_kernel="Linux" 
 51    function is_random_device -> rd 
 52      arg Str rd 
 53      for (var Int lap) 0 1 
 54        (var Stream d) open (shunt lap="device:/random" "device:/urandom") in+safe 
 55        if d=success 
 56          return d:name 
 57      rd := "" 
 58    constant random_device is_random_device 
 59  else 
 60    constant random_device "" 
 61   
 62  constant fast_weak_generator true 
 63   
 64  constant initial_wait_time 0.001 
 65   
 66  constant cipher_init_bits 512 # number of bits 
 67  constant cipher_init_laps 10 
 68  constant cipher_shake_laps 3 
 69   
 70  constant trace false 
 71   
 72   
 73  if random_device="" and fast_weak_generator 
 74    compile_log "Using fast weak random generator." 
 75   
 76   
 77 
 
 78   
 79  doc 
 80    [The true random generator.] 
 81   
 82   
 83  function datetime_string -> s 
 84    arg Str s 
 85    var DateTime dt := datetime 
 86    := repeat DateTime:size " " 
 87    memory_copy addressof:dt s:characters DateTime:size 
 88   
 89   
 90  if not fast_weak_generator 
 91   
 92    function ones adr size -> n 
 93      arg Address adr ; arg Int size n 
 94      n := 0 
 95      for (var Int i) 0 size*8-1 
 96        if (((adr translate uInt8 i\8) map uInt8) .and. 2^(i%8))<>0 
 97          n += 1 
 98     
 99    function random_bit -> b 
 100      arg Int b 
 101      if processor_is_pentium 
 102        pentium_counter (var uInt low) (var uInt high) 
 103        b := (ones addressof:low uInt:size) .and. 1 
 104      else 
 105        var DateTime dt := datetime 
 106        b := (ones addressof:dt DateTime:size) .and. 1 
 107   
 108   
 109  gvar Float wait_time := initial_wait_time 
 110   
 111  function memory_true_random buffer size study 
 112    arg Address buffer ; arg Int size ; arg CBool study 
 113    var Int done := 0 
 114    if random_device<>"" 
 115      (var Stream rd) open random_device in+safe+nocache 
 116      while done<size and (os_socket_wait rd:stream_handle in 15)=success 
 117        os_read rd:stream_handle (buffer translate Byte done) 1 ; done += 1 
 118      if done=size 
 119        return 
 120      else 
 121        console "Timeout reading OS random device." eol 
 122    if fast_weak_generator 
 123      module "/pliant/admin/md5.pli" 
 124      var RC4Ctx ctx 
 125      var DateTime start := datetime 
 126      var Str all := "" 
 127      while datetime:seconds-start:seconds<or all:len<64 
 128        all += datetime_string 
 129        if all:len>=431 
 130          all := (all all:len-297 all:len)+string_md5_binary_signature:(all all:len-297) 
 131        rc4_init ctx all cipher_init_laps 
 132      for (var Int i) done size-1 
 133        (buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255 
 134      wait_time := 2^0.5 
 135    else 
 136      part generate 
 137        if trace 
 138          var DateTime start := datetime 
 139        var Int last := 0 ; var Int same := 0 ; var Int ones := 0 
 140        memory_clear buffer size 
 141        var Int bits := 8*size 
 142        for (var Int i) 0 bits-1 
 143          sleep wait_time 
 144          var Pointer:uInt8 b :> (buffer translate uInt8 i\8) map uInt8 
 145          var Int r := random_bit 
 146          b := b .or. r*2^(i%8) 
 147          if r=last 
 148            same += 1 
 149          ones += r 
 150          last := r 
 151        if study 
 152          var Float same_ratio := same/bits 
 153          var Float ones_ratio := ones/bits 
 154          var Float delta := 0.1 # 1/bits^0.5 
 155          var CBool biased := (abs same_ratio-0.5)>delta or (abs ones_ratio-0.5)>delta 
 156          if trace 
 157            console "generated " bits " random bits (sleep " wait_time " -> " (datetime:seconds-start:seconds)/bits " s): " same_ratio*100 "% same , " ones_ratio*100 "% ones , maximum delta " delta*100 "% -> " (shunt biased "failure" "success") eol 
 158          if biased 
 159            console "The random seed is biased. " 
 160            if wait_time<2 
 161              console "retrying." eol 
 162              wait_time *= shunt wait_time<0.5 2.6 1.3 
 163              restart generate 
 164            else 
 165              console "surrendering." eol 
 166   
 167   
 168 
 
 169   
 170  doc 
 171    [The pseudo random generator.] 
 172   
 173   
 174  gvar RC4Ctx ctx 
 175  gvar Sem sem 
 176  gvar CBool initialized := false 
 177   
 178   
 179  function memory_strong_init bits 
 180    arg Int bits 
 181    var Int len := (bits+7)\8 
 182    (var Str key) set (memory_allocate len addressof:key) len true 
 183    memory_true_random key:characters len true 
 184    sem request 
 185    rc4_init ctx datetime_string+key cipher_init_laps 
 186    initialized := true 
 187    sem release 
 188   
 189  function memory_strong_init 
 190    memory_strong_init cipher_init_bits 
 191   
 192  function memory_strong_random buffer size 
 193    arg Address buffer ; arg Int size 
 194    if not initialized 
 195      memory_strong_init 
 196    daemon "shake random numbers generator" 
 197      part shake 
 198        for (var Int lap) 1 cipher_shake_laps 
 199          if daemon_emergency 
 200            leave shake 
 201          if rc4_bits=8 
 202            memory_true_random addressof:(var uInt8 offset) uInt8:size false 
 203            memory_true_random addressof:(var uInt8 value) uInt8:size false 
 204          eif rc4_bits=16 
 205            memory_true_random addressof:(var uInt16 offset) uInt16:size false 
 206            memory_true_random addressof:(var uInt16 value) uInt16:size false 
 207          else 
 208            error error_id_missing "Unsupported number of bits in the RC4 implementation" 
 209          ctx:perm:offset := value 
 210          sleep 0.25 
 211    sem request 
 212    for (var Int i) size-1 
 213      (buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255 
 214    sem release 
 215   
 216   
 217  function random_string len -> s 
 218    arg Int len ; arg Str s 
 219    set (memory_allocate len addressof:s) len true 
 220    memory_strong_random s:characters s:len 
 221   
 222   
 223  export memory_true_random memory_strong_init memory_strong_random 
 224  export random_string 
 225   
 226   
 227  doc 
 228    [We want to get a new random pseudo random sequence each time the program is run, so we must set 'initialized' back to false if the module is loaded from a Pliant .dump file (in other words, if it's precompiled).] 
 229   
 230  function restart p fh 
 231    arg Address p ; arg Int fh 
 232    initialized := false 
 233  gvar DelayedAction da 
 234  da function :> the_function restart Address Int 
 235  pliant_restore_actions append addressof:da 
 236