Patch title: Release 96 bulk changes
Abstract:
File: /pliant/util/pml/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 memory buffer might not be properly cleared be


abstract
  [This is complete secured channel implementation, but it's
  list
    item [it has not been seriously review yet.]
    item [the memory buffer might not be properly cleared be


module "/pliant/fullpliant/this_computer.pli"
constant root_proxy_client this_computer:env:"pliant":"multiplexer":"root_proxy_client"="true"
if root_proxy_client
  module "/pliant/language/context.pli"
  module "/pliant/storage/database.pli"
  module "/pliant/protocol/dns/name.pli"
  module "/pliant/fullpliant/user.pli"
  module "/pliant/language/type/text/str8.pli"
  module "/pliant/language/stream/count.pli"

(gvar TraceSlot server_trace) configure "secured channel2 se
(gvar TraceSlot client_trace) configure "secured channel2 cl



function open_client_channel service server_class server_nam
  arg Str service server_class server_name client_class clie
  # 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
(gvar TraceSlot server_trace) configure "secured channel2 se
(gvar TraceSlot client_trace) configure "secured channel2 cl



function open_client_channel service server_class server_nam
  arg Str service server_class server_name client_class clie
  # 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
    resolve_ip server_class server_name "" (options option "
    if ip="" or forward
      return (failure "failed to find IP and port for '"+ser
    var Link:Stream s :> new Stream
    s open "tcp://"+ip+"/client/"+string:port "" in+out+(fla
    if s=failure
      log trace "failed to connect to " s:name
      return (failure "failed to connect to '"+ip+"' TCP por
    var Int index := 0
    part connect
      resolve_ip server_class server_name "" index (var CBool distant) (var Str ip) (var Int port) (var Int count)
      if ip=""
        return (failure "failed to find IP and port for '"+server_name+"'")
      var Link:Stream s :> new Stream
      s open "tcp://"+ip+"/client/"+string:port "" in+out+(flags .and. safe)
      if s=failure
        if index+1<count
          index += 1
          restart connect
        log trace "failed to connect to " s:name
        return (failure "failed to connect to '"+ip+"' TCP port "+string:port)
  s otag "pliant"
  s oattr "service" service
  s oattr "from_class" client_class
  s oattr "from" client_name
  s oattr "to_class" server_class
  s oattr "to" server_name
  s oattr "secured"
  # send a seed
  var Blob client_seed := random_seed client_seed_bits\8
  var Int client_laps := client_rc4_laps
  s otag "channel1"
  s oattr "seed" client_seed ; s oattr "rc4" client_laps
  if (options option "query_server_key")
    s oattr "query_server_key"
  if (options option "query_client_key")
    s oattr "query_client_key"
  if (options option "deflate")
    s oattr "encoding" "deflate"
  eif (options option "zlib")
    s oattr "encoding" "zlib"
  # receive MD5 digest of shared secret + client seed
  # also receive the server seed
  (var Blob back) size := 0
  (var Blob server_seed) size := 0
  var Int server_laps := undefined
  var Str encoding := ""
  if not s:iavailable or not (s itag "channel2")
    return failure:"expected channel2 instruction"
  if (s iattr "sign" (var Blob blob))
    back := blob
  if (s iattr "seed" (var Blob blob))
    server_seed := blob
  if (s iattr "rc4" (var Int i))
    server_laps := i
  if (s iattr "encoding" (var Str enc))
    if enc="deflate" or enc="zlib"
      encoding := enc
      log trace encoding+" encoding accepted."
  log trace "secured client: new connection from " client_na
  if server_seed:size=0 or server_laps=undefined
    log trace "wrong server seed or laps."
    return failure:"wrong server seed or laps"
  # retreive the shared secret with this client (may be empt
  var Blob key := resolve_get_shared_key client_class client
  # send MD5 digest of server seed + shared secret
  s otag "channel3"
  s oattr "sign" (string_md5_binary_signature server_seed+ke
  var Blob sign := string_md5_binary_signature key+client_se
  if (memory_different back:content back:size sign:content s
    # 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_class server_name cl
    if key:size=0
      log trace "failed to exchange a shared key."
      return failure:"failed to exchange a shared key"
  s flush anytime
  s iflush
  log trace "session opened (" key:size ")."
  var Link:SecuredStreamDriver2 drv :> new SecuredStreamDriv
  if (flags .and. out)<>0
    var Blob final := server_seed+key+client_seed
    rc4_init drv:write_ctx (addressof:final map Str) client_
  if (flags .and. in)<>0
    var Blob final := client_seed+key+server_seed
    rc4_init drv:read_ctx (addressof:final map Str) server_l
  drv local_class := client_class
  drv local_name := client_name
  drv remote_class := server_class
  drv remote_name := server_name
  drv security_level := min rsa_nbbits:(resolve_public_key s
  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 "null2:" 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 SecuredFileSystem2 fs ; arg Str name options ; arg 
  var TraceSession log
  if (name parse "/server/" (var Int port))
    status := open_server_channel port log options flags str
  eif (name parse "/" any:(var Str service) "/" any:(var Str
  s otag "pliant"
  s oattr "service" service
  s oattr "from_class" client_class
  s oattr "from" client_name
  s oattr "to_class" server_class
  s oattr "to" server_name
  s oattr "secured"
  # send a seed
  var Blob client_seed := random_seed client_seed_bits\8
  var Int client_laps := client_rc4_laps
  s otag "channel1"
  s oattr "seed" client_seed ; s oattr "rc4" client_laps
  if (options option "query_server_key")
    s oattr "query_server_key"
  if (options option "query_client_key")
    s oattr "query_client_key"
  if (options option "deflate")
    s oattr "encoding" "deflate"
  eif (options option "zlib")
    s oattr "encoding" "zlib"
  # receive MD5 digest of shared secret + client seed
  # also receive the server seed
  (var Blob back) size := 0
  (var Blob server_seed) size := 0
  var Int server_laps := undefined
  var Str encoding := ""
  if not s:iavailable or not (s itag "channel2")
    return failure:"expected channel2 instruction"
  if (s iattr "sign" (var Blob blob))
    back := blob
  if (s iattr "seed" (var Blob blob))
    server_seed := blob
  if (s iattr "rc4" (var Int i))
    server_laps := i
  if (s iattr "encoding" (var Str enc))
    if enc="deflate" or enc="zlib"
      encoding := enc
      log trace encoding+" encoding accepted."
  log trace "secured client: new connection from " client_na
  if server_seed:size=0 or server_laps=undefined
    log trace "wrong server seed or laps."
    return failure:"wrong server seed or laps"
  # retreive the shared secret with this client (may be empt
  var Blob key := resolve_get_shared_key client_class client
  # send MD5 digest of server seed + shared secret
  s otag "channel3"
  s oattr "sign" (string_md5_binary_signature server_seed+ke
  var Blob sign := string_md5_binary_signature key+client_se
  if (memory_different back:content back:size sign:content s
    # 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_class server_name cl
    if key:size=0
      log trace "failed to exchange a shared key."
      return failure:"failed to exchange a shared key"
  s flush anytime
  s iflush
  log trace "session opened (" key:size ")."
  var Link:SecuredStreamDriver2 drv :> new SecuredStreamDriv
  if (flags .and. out)<>0
    var Blob final := server_seed+key+client_seed
    rc4_init drv:write_ctx (addressof:final map Str) client_
  if (flags .and. in)<>0
    var Blob final := client_seed+key+server_seed
    rc4_init drv:read_ctx (addressof:final map Str) server_l
  drv local_class := client_class
  drv local_name := client_name
  drv remote_class := server_class
  drv remote_name := server_name
  drv security_level := min rsa_nbbits:(resolve_public_key s
  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 "null2:" 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 SecuredFileSystem2 fs ; arg Str name options ; arg 
  var TraceSession log
  if (name parse "/server/" (var Int port))
    status := open_server_channel port log options flags str
  eif (name parse "/" any:(var Str service) "/" any:(var Str
    status := open_client_channel service server_class serve
    if root_proxy_client and client_class="user" and user_secret_database:data:user:client_name:private_key:len=0
      var Int port := (name_database:data:host name_database:data:host:computer_fullname:physical) port
      var Link:Stream tcp :> new Stream
      status := tcp open "tcp://127.0.0.1/client/"+string:port in+out+safe
      if status=success
        tcp otag "iam"
        tcp oattr "service" service
        tcp oattr "from_class" client_class
        tcp oattr "from" client_name
        tcp oattr "to_class" server_class
        tcp oattr "to" server_name
        tcp oattr "password" client_password
        if (options option "deflate")
          tcp oattr "encoding" "deflate"
        eif (options option "zlib")
          tcp oattr "encoding" "zlib"
        pliant_default_file_system open "count:" options flags stream tcp
    else
      status := open_client_channel service server_class server_name client_class client_name client_password log options flags stream support
  else
    status := failure



export '. channel_support2'
  else
    status := failure



export '. channel_support2'