Patch title: Release 87 bulk changes
Abstract:
File: /pliant/util/crypto/random.pli
Key:
    Removed line
    Added line
abstract
  [A true and strong pseudo random generator.] ; eol

doc
  listing
    function memory_true_random buffer size study
      arg Address buffer ; arg Int size ; arg CBool study
  [Fills the memory area with true random numbers] ; eol
  [By true random numbers, I mean that they come from real events (the clock or the /dev/random device) rather than computations.] ; eol
  [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 
  [Should I say: This is slow.]
  listing
    function memory_strong_init bits
      arg Int bits
  [Initialised the strong pseudo random generator with 'bits' true random bits. ]
  [If you never call this function, it will be automatically the first time you request bits from the strong pseudo random generator. ]
  [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.]
  listing
    function memory_strong_random buffer size
      arg Address buffer ; arg Int size
  [Fills the memory area with strong pseudo random numbers] ; eol
  [It's much faster.]
  listing
    function random_string len -> s
      arg Int len ; arg Str s
  [Returns a strong pseudo random string with length 'len']

doc
  para
    [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. ]
    [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. ]
    [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.]
  para
    [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
    [In order to make the pseudo random generator even better, we continuously poke in some true random numbers that are computed from another thread.]


module "/pliant/language/compiler.pli"
module "/pliant/language/os.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/schedule/daemon.pli"
module "rc4.pli"
module "/pliant/language/schedule/pentium.pli"

module "/pliant/language/os/socket.pli"
module "/pliant/language/stream/openmode.pli"


if os_api="linux" or os_kernel="Linux"
  function is_random_device -> rd
    arg Str rd
    for (var Int lap) 0 1
      (var Stream d) open (shunt lap=0 "device:/random" "device:/urandom") in+safe
      if d=success
        return d:name
    rd := ""
  constant random_device is_random_device
else
  constant random_device ""

constant fast_weak_generator true

constant initial_wait_time 0.001

constant cipher_init_bits 512 # number of bits
constant cipher_init_laps 10
constant cipher_shake_laps 3

constant trace false


if random_device="" and fast_weak_generator
  console "Using fast weak random generator." eol
  compile_log "Using fast weak random generator."


#---------------------------------------------------------------------

doc
  [The true random generator.]


function datetime_string -> s
  arg Str s
  var DateTime dt := datetime
  s := repeat DateTime:size " "
  memory_copy addressof:dt s:characters DateTime:size


if not fast_weak_generator

  function ones adr size -> n
    arg Address adr ; arg Int size n
    n := 0
    for (var Int i) 0 size*8-1
      if (((adr translate uInt8 i\8) map uInt8) .and. 2^(i%8))<>0
        n += 1
  
  function random_bit -> b
    arg Int b
    if processor_is_pentium
      pentium_counter (var uInt low) (var uInt high)
      b := (ones addressof:low uInt:size) .and. 1
    else
      var DateTime dt := datetime
      b := (ones addressof:dt DateTime:size) .and. 1


gvar Float wait_time := initial_wait_time

function memory_true_random buffer size study
  arg Address buffer ; arg Int size ; arg CBool study
  var Int done := 0
  if random_device<>""
    (var Stream rd) open random_device in+nocache
    while done<size and (os_socket_wait rd:stream_handle in 120)=success
      os_read rd:stream_handle (buffer translate Byte done) 1 ; done += 1
    if done=size
      return
    else
      console "Timeout reading OS random device." eol
  if fast_weak_generator
    module "/pliant/admin/md5.pli"
    var RC4Ctx ctx
    var DateTime start := datetime
    var Str all := ""
    while datetime:seconds-start:seconds<2 or all:len<64
      all += datetime_string
      if all:len>=431
        all := (all all:len-297 all:len)+string_md5_binary_signature:(all 0 all:len-297)
      rc4_init ctx all cipher_init_laps
    for (var Int i) done size-1
      (buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255
    wait_time := 2^0.5
  else
    part generate
      if trace
        var DateTime start := datetime
      var Int last := 0 ; var Int same := 0 ; var Int ones := 0
      memory_clear buffer size
      var Int bits := 8*size
      for (var Int i) 0 bits-1
        sleep wait_time
        var Pointer:uInt8 b :> (buffer translate uInt8 i\8) map uInt8
        var Int r := random_bit
        b := b .or. r*2^(i%8)
        if r=last
          same += 1
        ones += r
        last := r
      if study
        var Float same_ratio := same/bits
        var Float ones_ratio := ones/bits
        var Float delta := 0.1 # 1/bits^0.5
        var CBool biased := (abs same_ratio-0.5)>delta or (abs ones_ratio-0.5)>delta
        if trace
          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
        if biased
          console "The random seed is biased. "
          if wait_time<2
            console "retrying." eol
            wait_time *= shunt wait_time<0.5 2.6 1.3
            restart generate
          else
            console "surrendering." eol


#---------------------------------------------------------------------

doc
  [The pseudo random generator.]


gvar RC4Ctx ctx
gvar Sem sem
gvar CBool initialized := false


function memory_strong_init bits
  arg Int bits
  var Int len := (bits+7)\8
  (var Str key) set (memory_allocate len addressof:key) len true
  memory_true_random key:characters len true
  sem request
  rc4_init ctx datetime_string+key cipher_init_laps
  initialized := true
  sem release

function memory_strong_init
  memory_strong_init cipher_init_bits

function memory_strong_random buffer size
  arg Address buffer ; arg Int size
  if not initialized
    memory_strong_init
  daemon "shake random numbers generator"
    part shake
      for (var Int lap) 1 cipher_shake_laps
        if daemon_emergency
          leave shake
        if rc4_bits=8
          memory_true_random addressof:(var uInt8 offset) uInt8:size false
          memory_true_random addressof:(var uInt8 value) uInt8:size false
        eif rc4_bits=16
          memory_true_random addressof:(var uInt16 offset) uInt16:size false
          memory_true_random addressof:(var uInt16 value) uInt16:size false
        else
          error error_id_missing "Unsupported number of bits in the RC4 implementation"
        ctx:perm:offset := value
        sleep 0.25
  sem request
  for (var Int i) 0 size-1
    (buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255
  sem release


function random_string len -> s
  arg Int len ; arg Str s
  s set (memory_allocate len addressof:s) len true
  memory_strong_random s:characters s:len


export memory_true_random memory_strong_init memory_strong_random
export random_string


doc
  [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).]

function restart p fh
  arg Address p ; arg Int fh
  initialized := false
gvar DelayedAction da
da function :> the_function restart Address Int
pliant_restore_actions append addressof:da