Patch title: Release 94 bulk changes
Abstract:
File: /pliant/util/crypto/rsa.pli
Key:
    Removed line
    Added line
abstract
  [This is Pliant (Rivest-Shamir-Adelman) RSA implementation.] ; eol

doc
  para
    [The RSA key is encoded in a string, using the three 'rsa' letters followed by a space, then the 'n' base64 encoded number followed by another space, and finally the 'e' or 'd' base64 encoded number. ]
    [When we say base64 encoded number, we mean the bits representing it, in low indan order, encoded through the well known ] ; link "base64" "/pliant/util/encoding/base64.pli" ; [ encoding standard.] ; eol
  para
    [The RSA algorithm was patended in the US, but the patent is now expired.]


module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/util/encoding/base64.pli"
module "/pliant/language/type/text/str8.pli"
module "/pliant/language/type/misc/blob.pli"
module "/pliant/admin/md5.pli"
module "intn.pli"
module "random.pli"
module "legal.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/protocol/dns/name.pli"
module "/pliant/protocol/http/site.pli"
module "cipher.pli"

constant mp processor_count>1
constant trace false
constant verbose false
constant wait true

doc
  listing
    function rsa_nbbits key -> bits
      arg Str key ; arg Int bits
  [What is the size of the RSA key.] ; eol

function rsa_nbbits key -> bits
  arg Str key ; arg Int bits
  if (key parse word:"rsa" _ any:(var Str encoded_n) _ any:(var Str encoded_e_or_d))
    (var Intn n) binary_decode base64_decode:encoded_n true
    bits := n:nbbits
  else
    bits := undefined

doc
  listing
    function rsa_cipher input key -> output
      arg Str input key output
  [Applys the RSA key.]
  [The 'input' and 'output' string are binary encoded numbers.] ; eol

function rsa_cipher input key -> output
  arg Str input key output
  if not (key parse word:"rsa" _ any:(var Str encoded_n) _ any:(var Str encoded_e_or_d))
    return ""
  (var Intn n) binary_decode base64_decode:encoded_n true
  if n:nbbits>max_legal_key_bits
    return ""
  if verbose
    console "(message " input:len*8 " bis ; rsa key " rsa_nbbits:key " bits "
  var DateTime start := datetime
  if trace
    console "n=" n eol
  (var Intn e_or_d) binary_decode base64_decode:encoded_e_or_d true
  if trace
    console "e_or_d=" e_or_d eol
  (var Intn in) binary_decode input true
  if trace
    console "in=" in eol
  var Intn out := 0
  var Intn f := 1
  if mp
    parallel
      while in<>0
        var Intn out_i
        task
          share n e_or_d
          var Intn in_i := in%n
          out_i := ( in_i^e_or_d%n )*f
        post
          share out
          out := out+out_i
        f := f*n
        in := in\n
  else
    while in<>0
      var Intn in_i := in%n
      var Intn out_i := in_i^e_or_d%n
      out := out+out_i*f
      f := f*n
      in := in\n
  if trace
    console "out=" out eol
  output := out binary_encode
  if verbose
    console "-> time " datetime:seconds-start:seconds "s)" eol
  if wait
    sleep 0.25*(datetime:seconds-start:seconds)*(cast random:1000000n Int)/1000000

function rsa_cipher input key -> output
  arg Blob input ; arg Str key ; arg Blob output
  addressof:output map Str := rsa_cipher (addressof:input map Str) key

doc
  listing
    function rsa_generate nbits error_probability public private
      arg Int nbits ; arg Float error_probability ; arg_w Str public private
  [Generates a new RSA keys pair.] ; eol
  ['nbits' specify how many bits we want in the two prime numbers that will be used to generate the RSA keys pair.]
  [The 'error_probability' should be a very small number such as 1e-100. The smaller it is, the slower the algorithm will be.] ; eol
  [The size of the key you can generate using this software is limited to 'max_key_bits' due to legal constains in France.]

function rsa_generate nbits error_probability public private -> status
  arg Int nbits ; arg Float error_probability ; arg_w Str public private ; arg Status status
  if nbits>max_legal_key_bits
    console "Since this software has been written in france, it will not allow you to generate keys with more than " max_legal_key_bits " bits." eol
    return failure
  part generate
    var Intn p q
    if mp
      parallel
        task
          share p := prime 2n^(nbits\2) error_probability
        task
          share q := prime 2n^(nbits\2) error_probability
    else
      p := prime 2n^(nbits\2) error_probability
      q := prime 2n^(nbits\2) error_probability
    if trace
      console "p=" p eol
      console "q=" q eol
    var Intn n := p*q
    if trace
      console "n=" n " (" n:nbbits ")" eol
    if n:nbbits<nbits-2
      restart generate # the key is too small
    part pick_e
      var Intn e := random (p-1)*(q-1)
      if (pgcd e (p-1)*(q-1))<>1
        restart pick_e
    var Intn d := inverse e (p-1)*(q-1)
    if trace
      console "e=" e " (" e:nbbits ")" eol
      console "d=" d " (" d:nbbits ")" eol
    public := "rsa "+(base64_encode n:binary_encode)+" "+(base64_encode e:binary_encode)
    private := "rsa "+(base64_encode n:binary_encode)+" "+(base64_encode d:binary_encode)
    if trace
      console "public key is " public " (" rsa_nbbits:public " bits)" eol
      console "private key is " private " (" rsa_nbbits:private " bits)" eol
  return success


doc
  listing
    function rsa_check public private test_message_bits -> status
      arg Str public private ; arg Int test_message_bits ; arg Status status
  [Test the RSA pair on a random message.]

function rsa_check public private test_message_bits -> status
  arg Str public private ; arg Int test_message_bits ; arg Status status
  var Str m := (random_string test_message_bits\8)+"."
  var Str c := rsa_cipher m public
  var Str m2 := rsa_cipher c private
  var Str c := rsa_cipher m private
  var Str m3 := rsa_cipher c public
  status := shunt m2=m and m3=m success failure


doc
  listing
    function rsa_generate username nbits error_probability -> status
      arg Str username ; arg Int nbits ; arg Float error_probability ; arg Status status 
  [Also generates a new RSA keys pair, but the result is stored in Pliant sites and users database.] ; eol
  [The Pliant sites and users database are the security:/site.pdb file (usualy /etc/pliant/site.pdb or /pliant_security/site.pdb), security:/site_secret.pdb, security:/user.pdb and security:/user_secret.pdb and they contains the definition of all users Pliant is awared of on this system, including the RSA public and private keys.] ; eol
  color hsl 0 75 50
    [You must keep the security:/site_secret.pdb file very secret because anybody that can read it will also read the RSA private keys it contains, so can get administrator access to all your sites, and you should keep the security:/user_secret.pdb also secret because somebody that can read it will only need to grab users passwords to get their secret keys.]

function rsa_generate name nbits password -> status
  arg Str name ; arg Int nbits ; arg Str password ; arg Status status 
  if verbose
    console "Now "
    random 2n^nbits
    console "generating a " nbits " bits RSA key." eol
    var DateTime dt := datetime
  status := rsa_generate nbits 1e-90 (var Str public) (var Str private)
  if verbose
    var Float s := datetime:seconds-dt:seconds
  if status=success
    status := rsa_check public private 1024
  if status=success
    if (name eparse "user:" any:(var Str username))
      user:username public_key := public
      user_secret_database:data:user create username
      user_secret_database:data:user:username private_key := cipher private password
      user_secret_database:data:user:username private_key := straight_to_Str8 (cipher private password)
      user_secret_database:data:user:username key_md5 := string_md5_hexa_signature private
      data_reset user_secret_database:data:user:username:session
      user_database store
      user_secret_database store
    eif (name eparse "host:" any:(var Str hostname))
      name_database:data:host create hostname
      name_database:data:host:hostname public_key := public
      name_secret_database:data:host create hostname
      name_secret_database:data:host:hostname private_key := private
      data_reset name_secret_database:data:host:hostname:session
      name_database store
      name_secret_database store
    eif (name eparse "site:" any:(var Str sitename))
      site_database:data:site create sitename
      site:sitename public_key := public
      site_secret_database:data:site create sitename
      site_secret_database:data:site:sitename private_key := private
      data_reset site_secret_database:data:site:sitename:session
      site_database store
      site_secret_database store
    eif (name eparse "target:" any:(var Str hostname))
      name_database:data:host create hostname
      name_database:data:host:hostname public_key := public
      name_database store
      var (Link Database:NameDatabase) name_db :> new Database:NameDatabase
      name_db load "target:/pliant_security/name.pdb"
      var (Data Set:NameHost) name_tbl :> name_db:data:host
      name_tbl create hostname
      name_tbl:hostname public_key := public
      name_db store
      var (Link Database:NameSecretDatabase) secret_db :> new Database:NameSecretDatabase
      secret_db load "target:/pliant_security/name_secret.pdb"
      var (Data Set:NameSecret) secret_tbl :> secret_db:data:host
      secret_tbl create hostname
      secret_tbl:hostname private_key := private
      data_reset secret_tbl:hostname:session
      secret_db store
   if verbose
      console "Succeded to generate a valid " rsa_nbbits:public " bits RSA key in " s " seconds" eol
  else
    console "Failed to generate a valid RSA key." eol


export rsa_cipher rsa_nbbits
export rsa_generate