Patch title: Release 93 bulk changes
Abstract:
File: /util/crypto/channel.pli
Key:
    Removed line
    Added line
   
abstract
  [This is complete secured channel implementation, but it's
  list
    item [it has not been seriously review yet.]
    item [the legal maximum key size is too low.]


abstract
  [This is complete secured channel implementation, but it's
  list
    item [it has not been seriously review yet.]
    item [the legal maximum key size is too low.]


function open_server_channel port log options flags stream support -> status
  arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg Status status
  log bind server_trace
  # this is the server side: this code is executed on the server when a client is asking for a secured channel
  var Link:Stream s
  if addressof:support<>null
    s :> support
  else
    var Link:Stream s :> new Stream
    s open "tcp:/server/"+string:port "" in+out+(flags .and. safe)
    if s=failure
      log trace "Failed to connect to " s:name
      return (failure "failed to listen TCP port "+string:port)
  # receive the client seed
  var Str server_site := ""
  var Str client_site := ""
  var Str client_user := ""
  var Str client_seed := ""
  var Int client_laps := undefined
  var CBool query_client := false
  var CBool query_server := false
  var Str encoding := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "server-site:" any:(var Str encoded))
      server_site := base64_decode encoded
    eif backward_compatibility and (l parse "server-user:" any:(var Str encoded))
      server_site := base64_decode encoded
    eif (l parse "client-site:" any:(var Str encoded))
      client_site := base64_decode encoded
    eif (l parse "client-user:" any:(var Str encoded))
      client_user := base64_decode encoded
    eif (l parse "seed-rc4:" any:(var Str encoded))
      client_seed := base64_decode encoded
    eif (l parse "laps-rc4:" (var Int i))
      client_laps := i
    eif (l parse "query-client-key")
      query_client := true
    eif (l parse "query-server-key")
      query_server := true
    eif (l parse "encoding:" any:(var Str enc)) and (enc="deflate" or enc="zlib")
      encoding := enc
  if query_client
    if client_site<>""
      var Str client_public := name_database:data:host:client_site public_key
      if client_public=""
        client_public := site:client_site public_key
      s writeline "client-key: "+client_public
    else
      var Str client_public := user:client_user public_key
      s writeline "client-key: "+client_public
  if query_server
    var Str server_public := name_database:data:host:server_site public_key
    if server_public<>""
      if not (server_public parse word:"rsa" _ any:(var Str part1a) _ any ) or not (name_secret_database:data:host:server_site:private_key parse word:"rsa" _ any:(var Str part1b) _ any) or part1a<>part1b
        server_public := "corrupted key"
    else
      server_public := site:server_site public_key
      if server_public<>""
        if not (server_public parse word:"rsa" _ any:(var Str part1a) _ any ) or not (site_secret_database:data:site:server_site:private_key parse word:"rsa" _ any:(var Str part1b) _ any) or part1a<>part1b
          server_public := "corrupted key"
    s writeline "server-key: "+server_public
  if encoding<>""
    s writeline "encoding: "+encoding
  log trace "secured server: connection from " (shunt client_site<>"" "site "+client_site "user "+client_user) " to site " server_site
  if client_seed="" or client_laps=undefined
    log trace "wrong client seed or laps."
    return failure
  if name_secret_database:data:host:server_site:private_key="" and site_secret_database:data:site:server_site:private_key=""
    log trace "no private key for " server_site
    return failure
  # send server seed
  var Str server_seed := random_seed server_seed_bits\8
  var Int server_laps := server_rc4_laps
  s writeline "seed-rc4: "+base64_encode:server_seed
  s writeline "laps-rc4: "+string:server_laps
  # retreive the shared secret with this client (may be empty if they never talked together or the sever discarded it)
  var Str key := name_secret_database:data:host:server_site:session:(shunt client_site<>"" client_site client_user):key
  if key=""
    key := site_secret_database:data:site:server_site:session:(shunt client_site<>"" client_site client_user):key
  # send MD5 digest of shared secret + client seed
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_signature key+client_seed)
  s writeline ""
  # wait for the MD5 digest of server seed + shared secret
  var Str back := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-md5:" any:(var Str encoded))
      back := base64_decode encoded
  if back<>(string_md5_binary_signature server_seed+key) or key=""
    # the MD5 was wrong or there was no shared secret: we must negotiate a new one using RSA keys
    log trace "secured server: needs to exchange a shared key."
    part exchange "exchange secret keys"
      key := server_exchange_key s server_site client_site client_user log
    if key=""
      log trace "failed to exchange a shared key."
      return failure
  log trace "secured server: session opened (" key:len ")."
  var Link:SecuredStreamDriver drv :> new SecuredStreamDriver
  if (flags .and. out)<>0
    rc4_init drv:write_ctx client_seed+key+server_seed server_laps
  if (flags .and. in)<>0
    rc4_init drv:read_ctx server_seed+key+client_seed client_laps
  drv local_site := server_site
  if client_site<>""
    drv remote_site := client_site
  eif client_user<>""
    drv remote_user := client_user
  drv security_level := min (rsa_nbbits site:server_site:public_key) (shunt client_site<>"" (rsa_nbbits site:client_site:public_key) (rsa_nbbits user:client_user:public_key))
  log trace "secured server: security level is " drv:security_level " bits"
  drv s :> s
  if encoding<>""
    log trace "secured server: encoding is " encoding
    drv encoding := encoding
    var Link:Stream zs :> new Stream
    if (zs open "null:" options flags)=failure
      return failure
    zs stream_driver :> drv
    if (pliant_default_file_system open encoding+":" options flags stream zs)=failure
      return failure
  else
    stream stream_driver :> drv
  status := success
  log trace "secured channel " server_site " <- " (shunt client_site<>"" "site "+client_site "user "+client_user)

function open_client_channel server_site client_site client_
  arg Str server_site client_site client_user password ; arg
  # this is the client side: this code is executed on the cl
  log bind client_trace
  var Link:Stream s
  if addressof:support<>null
    s :> support
  else
    var Link:Stream s :> new Stream
function open_client_channel server_site client_site client_
  arg Str server_site client_site client_user password ; arg
  # this is the client side: this code is executed on the cl
  log bind client_trace
  var Link:Stream s
  if addressof:support<>null
    s :> support
  else
    var Link:Stream s :> new Stream
    s open "tcp://"+server_site+"/client/"+string:port "" in
    s open "tcp://"+server_site+"/client/"+string:port "" in+out+(flags .and. safe)
    if s=failure
      log trace "failed to connect to " s:name
      return (failure "failed to connect to '"+server_site+"
  # send a seed
  var Str client_seed := random_seed client_seed_bits
  var Int client_laps := client_rc4_laps
  s writeline "server-site: "+base64_encode:server_site
  if backward_compatibility
    s writeline "server-user: "+base64_encode:server_site
  if client_site<>""
    s writeline "client-site: "+base64_encode:client_site
  eif client_user<>""
    s writeline "client-user: "+base64_encode:client_user
  s writeline "seed-rc4: "+base64_encode:client_seed
  s writeline "laps-rc4: "+string:client_laps
  if (options option "query_server_key")
    s writeline "query-server-key"
  if (options option "query_client_key")
    s writeline "query-client-key"
  if (options option "deflate")
    s writeline "encoding: deflate"
  eif (options option "zlib")
    s writeline "encoding: zlib"
    if s=failure
      log trace "failed to connect to " s:name
      return (failure "failed to connect to '"+server_site+"
  # send a seed
  var Str client_seed := random_seed client_seed_bits
  var Int client_laps := client_rc4_laps
  s writeline "server-site: "+base64_encode:server_site
  if backward_compatibility
    s writeline "server-user: "+base64_encode:server_site
  if client_site<>""
    s writeline "client-site: "+base64_encode:client_site
  eif client_user<>""
    s writeline "client-user: "+base64_encode:client_user
  s writeline "seed-rc4: "+base64_encode:client_seed
  s writeline "laps-rc4: "+string:client_laps
  if (options option "query_server_key")
    s writeline "query-server-key"
  if (options option "query_client_key")
    s writeline "query-client-key"
  if (options option "deflate")
    s writeline "encoding: deflate"
  eif (options option "zlib")
    s writeline "encoding: zlib"
  s writeline "" ; s flush anytime
  s writeline ""
  # receive MD5 digest of shared secret + client seed
  # also receive the server seed
  var Str back := ""
  var Str server_seed := ""
  var Int server_laps := undefined
  var Str encoding := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-md5:" any:(var Str encoded))
      back := base64_decode:encoded
    eif (l parse "seed-rc4:" any:(var Str encoded))
      server_seed := base64_decode:encoded
    eif (l parse "laps-rc4:" (var Int i))
      server_laps := i
    eif (l parse "encoding:" any:(var Str enc)) and (enc="de
      encoding := enc
      log trace encoding+" encoding accepted."
  log trace "secured client: new connection from " (shunt cl
  if server_seed="" or server_laps=undefined
    log trace "wrong server seed or laps."
    return failure
  # retreive the shared secret with this client (may be empt
  var Str key
  if client_site<>""
    key := name_secret_database:data:host:client_site:sessio
    if key=""
      key := site_secret_database:data:site:client_site:sess
  eif client_user<>""
    key := uncipher user_secret_database:data:user:client_us
  # send MD5 digest of server seed + shared secret
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_
  # receive MD5 digest of shared secret + client seed
  # also receive the server seed
  var Str back := ""
  var Str server_seed := ""
  var Int server_laps := undefined
  var Str encoding := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-md5:" any:(var Str encoded))
      back := base64_decode:encoded
    eif (l parse "seed-rc4:" any:(var Str encoded))
      server_seed := base64_decode:encoded
    eif (l parse "laps-rc4:" (var Int i))
      server_laps := i
    eif (l parse "encoding:" any:(var Str enc)) and (enc="de
      encoding := enc
      log trace encoding+" encoding accepted."
  log trace "secured client: new connection from " (shunt cl
  if server_seed="" or server_laps=undefined
    log trace "wrong server seed or laps."
    return failure
  # retreive the shared secret with this client (may be empt
  var Str key
  if client_site<>""
    key := name_secret_database:data:host:client_site:sessio
    if key=""
      key := site_secret_database:data:site:client_site:sess
  eif client_user<>""
    key := uncipher user_secret_database:data:user:client_us
  # send MD5 digest of server seed + shared secret
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_
  s writeline "" ; s flush anytime
  s writeline ""
  if back<>(string_md5_binary_signature key+client_seed) or 
    # the MD5 was wrong or there was no shared secret: we mu
    log trace "needs to exchange a shared key."
    key := client_exchange_key s server_site client_site cli
    if key=""
      log trace "failed to exchange a shared key."
      return failure
  log trace "session opened (" key:len ")."
  var Link:SecuredStreamDriver drv :> new SecuredStreamDrive
  if (flags .and. out)<>0
    rc4_init drv:write_ctx server_seed+key+client_seed clien
  if (flags .and. in)<>0
    rc4_init drv:read_ctx client_seed+key+server_seed server
  if client_site<>""
    drv local_site := client_site
  eif client_user<>""
    drv local_user := client_user
  drv remote_site := server_site
  drv security_level := min (rsa_nbbits site:server_site:pub
  log trace "security level is " drv:security_level " bits"
  drv s :> s
  if encoding<>""
    log trace "encoding is " encoding
    drv encoding := encoding
    var Link:Stream zs :> new Stream
    if (zs open "null:" options flags)=failure
      return failure
    zs stream_driver :> drv
    if (pliant_default_file_system open encoding+":" options
      return failure
  else
    stream stream_driver :> drv
  status := success

method fs open name options flags stream support -> status
  arg_rw SecuredFileSystem fs ; arg Str name options ; arg I
  var TraceSession log
  if (name parse "/server/" (var Int port))
  if back<>(string_md5_binary_signature key+client_seed) or 
    # the MD5 was wrong or there was no shared secret: we mu
    log trace "needs to exchange a shared key."
    key := client_exchange_key s server_site client_site cli
    if key=""
      log trace "failed to exchange a shared key."
      return failure
  log trace "session opened (" key:len ")."
  var Link:SecuredStreamDriver drv :> new SecuredStreamDrive
  if (flags .and. out)<>0
    rc4_init drv:write_ctx server_seed+key+client_seed clien
  if (flags .and. in)<>0
    rc4_init drv:read_ctx client_seed+key+server_seed server
  if client_site<>""
    drv local_site := client_site
  eif client_user<>""
    drv local_user := client_user
  drv remote_site := server_site
  drv security_level := min (rsa_nbbits site:server_site:pub
  log trace "security level is " drv:security_level " bits"
  drv s :> s
  if encoding<>""
    log trace "encoding is " encoding
    drv encoding := encoding
    var Link:Stream zs :> new Stream
    if (zs open "null:" options flags)=failure
      return failure
    zs stream_driver :> drv
    if (pliant_default_file_system open encoding+":" options
      return failure
  else
    stream stream_driver :> drv
  status := success

method fs open name options flags stream support -> status
  arg_rw SecuredFileSystem fs ; arg Str name options ; arg I
  var TraceSession log
  if (name parse "/server/" (var Int port))
    log bind server_trace
    # this is the server side: this code is executed on the 
    var Link:Stream s
    if addressof:support<>null
      s :> support
    else
      var Link:Stream s :> new Stream
      s open "tcp:/server/"+string:port "" in+out+(flags .an
      if s=failure
        log trace "Failed to connect to " s:name
        return (failure "failed to listen TCP port "+string:
    # receive the client seed
    var Str server_site := ""
    var Str client_site := ""
    var Str client_user := ""
    var Str client_seed := ""
    var Int client_laps := undefined
    var CBool query_client := false
    var CBool query_server := false
    var Str encoding := ""
    while not s:atend and { var Str l := s:readline ; l<>"" 
      if (l parse "server-site:" any:(var Str encoded))
        server_site := base64_decode encoded
      eif backward_compatibility and (l parse "server-user:"
        server_site := base64_decode encoded
      eif (l parse "client-site:" any:(var Str encoded))
        client_site := base64_decode encoded
      eif (l parse "client-user:" any:(var Str encoded))
        client_user := base64_decode encoded
      eif (l parse "seed-rc4:" any:(var Str encoded))
        client_seed := base64_decode encoded
      eif (l parse "laps-rc4:" (var Int i))
        client_laps := i
      eif (l parse "query-client-key")
        query_client := true
      eif (l parse "query-server-key")
        query_server := true
      eif (l parse "encoding:" any:(var Str enc)) and (enc="
        encoding := enc
    if query_client
      if client_site<>""
        var Str client_public := name_database:data:host:cli
        if client_public=""
          client_public := site:client_site public_key
        s writeline "client-key: "+client_public
      else
        var Str client_public := user:client_user public_key
        s writeline "client-key: "+client_public
    if query_server
      var Str server_public := name_database:data:host:serve
      if server_public<>""
        if not (server_public parse word:"rsa" _ any:(var St
          server_public := "corrupted key"
      else
        server_public := site:server_site public_key
        if server_public<>""
          if not (server_public parse word:"rsa" _ any:(var 
            server_public := "corrupted key"
      s writeline "server-key: "+server_public
    if encoding<>""
      s writeline "encoding: "+encoding
    log trace "info" "secured server: connection from " (shu
    if client_seed="" or client_laps=undefined
      log trace "wrong client seed or laps."
      return failure
    if name_secret_database:data:host:server_site:private_ke
      log trace "no private key for " server_site
      return failure
    # send server seed
    var Str server_seed := random_seed server_seed_bits\8
    var Int server_laps := server_rc4_laps
    s writeline "seed-rc4: "+base64_encode:server_seed
    s writeline "laps-rc4: "+string:server_laps
    # retreive the shared secret with this client (may be em
    var Str key := name_secret_database:data:host:server_sit
    if key=""
      key := site_secret_database:data:site:server_site:sess
    # send MD5 digest of shared secret + client seed
    s writeline "sign-md5: "+base64_encode:(string_md5_binar
    s writeline "" ; s flush anytime
    # wait for the MD5 digest of server seed + shared secret
    var Str back := ""
    while not s:atend and { var Str l := s:readline ; l<>"" 
      if (l parse "sign-md5:" any:(var Str encoded))
        back := base64_decode encoded
    if back<>(string_md5_binary_signature server_seed+key) o
      # the MD5 was wrong or there was no shared secret: we 
      log trace "info" "secured server: needs to exchange a 
      part exchange "exchange secret keys"
        key := server_exchange_key s server_site client_site
      if key=""
        log trace "failed to exchange a shared key."
        return failure
    log trace "success" "secured server: session opened (" k
    var Link:SecuredStreamDriver drv :> new SecuredStreamDri
    if (flags .and. out)<>0
      rc4_init drv:write_ctx client_seed+key+server_seed ser
    if (flags .and. in)<>0
      rc4_init drv:read_ctx server_seed+key+client_seed clie
    drv local_site := server_site
    if client_site<>""
      drv remote_site := client_site
    eif client_user<>""
      drv remote_user := client_user
    drv security_level := min (rsa_nbbits site:server_site:p
    log trace "bits" "secured server: security level is " dr
    drv s :> s
    if encoding<>""
      log trace "encoding" "secured server: encoding is " en
      drv encoding := encoding
      var Link:Stream zs :> new Stream
      if (zs open "null:" options flags)=failure
        return failure
      zs stream_driver :> drv
      if (pliant_default_file_system open encoding+":" optio
        return failure
    else
      stream stream_driver :> drv
    status := success
    log trace "connection" "secured channel " server_site " 
    status := open_server_channel port log options flags stream support
  eif (name parse "//" any:(var Str server_site) "/user/" (v
    status := open_client_channel server_site "" client_user
  eif (name parse "//" any:(var Str server_site) "/site/" (v
    status := open_client_channel server_site client_site ""
  eif backward_compatibility and (name parse "//" any:(var S
    status := open_client_channel server_site client_site cl
  else
    status := failure



export '. channel_support'
  eif (name parse "//" any:(var Str server_site) "/user/" (v
    status := open_client_channel server_site "" client_user
  eif (name parse "//" any:(var Str server_site) "/site/" (v
    status := open_client_channel server_site client_site ""
  eif backward_compatibility and (name parse "//" any:(var S
    status := open_client_channel server_site client_site cl
  else
    status := failure



export '. channel_support'