Patch title: Release 94 bulk changes
Abstract:
File: /pliant/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.]
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.]
    item [the memory buffer might not be properly cleared before beeing freed.]


module "/pliant/language/compiler.pli"
module "random.pli"
module "rsa.pli"
module "rc4.pli"
module "cipher.pli"
module "/pliant/admin/md5.pli"
module "/pliant/util/encoding/base64.pli"


module "/pliant/language/compiler.pli"
module "random.pli"
module "rsa.pli"
module "rc4.pli"
module "cipher.pli"
module "/pliant/admin/md5.pli"
module "/pliant/util/encoding/base64.pli"
module "/pliant/language/type/text/str8.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/protocol/dns/name.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/fullpliant/user.pli"


function server_exchange_key s server_site client_site clien
  arg_rw Stream s ; arg Str server_site client_site client_u
  var Str server_public := name_database:data:host:server_si
  var Str server_private := name_secret_database:data:host:s
  var CBool is_host := true
  if server_public=""
    server_public := site:server_site public_key
    server_private := site_secret_database:data:site:server_
    is_host := false
  if server_public="" or server_private=""
    log trace "missing server key (server_exchange_key)."
    return ""
  var Str client_public
  if client_site<>""
    client_public := name_database:data:host:client_site pub
    if client_public=""
      client_public := site:client_site public_key
  eif client_user<>""
    client_public := user:client_user public_key
  if client_public=""
    log trace "missing client key (server_exchange_key)."
    return ""
  # wait for the client seed
  var Str client_key := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "key:" any:(var Str encoded))
      client_key := rsa_cipher base64_decode:encoded server_
  if client_key=""
    log trace "wrong client seed (server_exchange_key)."
    return ""
  # send the server seed
  var Str server_key := random_string (max rsa_nbbits:server
  s writeline "key: "+base64_encode:(rsa_cipher server_key c
  # send the client seed back
  s writeline "sign-rsa: "+base64_encode:(rsa_cipher client_
  s writeline "" ; s flush anytime
  # wait for the server seed back
  var Str back := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-rsa:" any:(var Str encoded))
      back := rsa_cipher base64_decode:encoded server_privat
  if back<>server_key
    # client answer is wrong (server seed back)
    log trace "wrong client answer (server_exchange_key)."
    return ""
  key := client_key+server_key
  # stores the new shared key in the users database
  var Str client_id := shunt client_site<>"" client_site cli
  if is_host
    name_secret_database:data:host:server_site:session creat
module "/pliant/util/encoding/html.pli"
module "/pliant/protocol/dns/name.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/fullpliant/user.pli"


function server_exchange_key s server_site client_site clien
  arg_rw Stream s ; arg Str server_site client_site client_u
  var Str server_public := name_database:data:host:server_si
  var Str server_private := name_secret_database:data:host:s
  var CBool is_host := true
  if server_public=""
    server_public := site:server_site public_key
    server_private := site_secret_database:data:site:server_
    is_host := false
  if server_public="" or server_private=""
    log trace "missing server key (server_exchange_key)."
    return ""
  var Str client_public
  if client_site<>""
    client_public := name_database:data:host:client_site pub
    if client_public=""
      client_public := site:client_site public_key
  eif client_user<>""
    client_public := user:client_user public_key
  if client_public=""
    log trace "missing client key (server_exchange_key)."
    return ""
  # wait for the client seed
  var Str client_key := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "key:" any:(var Str encoded))
      client_key := rsa_cipher base64_decode:encoded server_
  if client_key=""
    log trace "wrong client seed (server_exchange_key)."
    return ""
  # send the server seed
  var Str server_key := random_string (max rsa_nbbits:server
  s writeline "key: "+base64_encode:(rsa_cipher server_key c
  # send the client seed back
  s writeline "sign-rsa: "+base64_encode:(rsa_cipher client_
  s writeline "" ; s flush anytime
  # wait for the server seed back
  var Str back := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-rsa:" any:(var Str encoded))
      back := rsa_cipher base64_decode:encoded server_privat
  if back<>server_key
    # client answer is wrong (server seed back)
    log trace "wrong client answer (server_exchange_key)."
    return ""
  key := client_key+server_key
  # stores the new shared key in the users database
  var Str client_id := shunt client_site<>"" client_site cli
  if is_host
    name_secret_database:data:host:server_site:session creat
    name_secret_database:data:host:server_site:session:clien
    name_secret_database:data:host:server_site:session:client_id:key := straight_to_Str8 key
    name_secret_database:data:host:server_site:session:clien
    name_secret_database store
  else
    site_secret_database:data:site:server_site:session creat
    name_secret_database:data:host:server_site:session:clien
    name_secret_database store
  else
    site_secret_database:data:site:server_site:session creat
    site_secret_database:data:site:server_site:session:clien
    site_secret_database:data:site:server_site:session:client_id:key := straight_to_Str8 key
    site_secret_database:data:site:server_site:session:clien
    site_secret_database store


function client_exchange_key s server_site client_site clien
  arg_rw Stream s ; arg Str server_site client_site client_u
  var Str server_public := name_database:data:host:server_si
  var CBool is_host := true
  if server_public=""
    server_public := site:server_site public_key
    is_host := false
  if server_public=""
    log trace "missing server key (client_exchange_key)."
    return ""
  var Str client_public client_private
  if client_site<>""
    client_public := name_database:data:host:client_site pub
    client_private := name_secret_database:data:host:client_
    if client_public=""
      client_public := site:client_site public_key
      client_private := site_secret_database:data:site:clien
  eif client_user<>""
    client_public := user:client_user public_key
    site_secret_database:data:site:server_site:session:clien
    site_secret_database store


function client_exchange_key s server_site client_site clien
  arg_rw Stream s ; arg Str server_site client_site client_u
  var Str server_public := name_database:data:host:server_si
  var CBool is_host := true
  if server_public=""
    server_public := site:server_site public_key
    is_host := false
  if server_public=""
    log trace "missing server key (client_exchange_key)."
    return ""
  var Str client_public client_private
  if client_site<>""
    client_public := name_database:data:host:client_site pub
    client_private := name_secret_database:data:host:client_
    if client_public=""
      client_public := site:client_site public_key
      client_private := site_secret_database:data:site:clien
  eif client_user<>""
    client_public := user:client_user public_key
    client_private := uncipher (user_secret_database:data:us
    client_private := uncipher straight_to_Str:(user_secret_database:data:user:client_user private_key) password
  if client_public="" or client_private=""
    log trace "missing client key (client_exchange_key)."
    return ""
  var Str client_key := random_string (max rsa_nbbits:server
  s writeline "key: "+base64_encode:(rsa_cipher client_key s
  s writeline "" ; s flush anytime
  # send the client seed
  # wait for the server seed and the client seed back
  var Str server_key := ""
  var Str back := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-rsa:" any:(var Str encoded))
      back := rsa_cipher base64_decode:encoded client_privat
    if (l parse "key:" any:(var Str encoded))
      server_key := rsa_cipher base64_decode:encoded client_
  if server_key="" or back<>client_key
    # server answer is wrong (client seed back)
    log trace "wrong server answer (client_exchange_key)."
    return ""
  # send the server seed back
  s writeline "sign-rsa: "+base64_encode:(rsa_cipher server_
  s writeline "" ; s flush anytime
  key := client_key+server_key
  # stores the new shared key in the users database
  if client_site<>"" and is_host
    name_secret_database:data:host:client_site:session creat
  if client_public="" or client_private=""
    log trace "missing client key (client_exchange_key)."
    return ""
  var Str client_key := random_string (max rsa_nbbits:server
  s writeline "key: "+base64_encode:(rsa_cipher client_key s
  s writeline "" ; s flush anytime
  # send the client seed
  # wait for the server seed and the client seed back
  var Str server_key := ""
  var Str back := ""
  while not s:atend and { var Str l := s:readline ; l<>"" }
    if (l parse "sign-rsa:" any:(var Str encoded))
      back := rsa_cipher base64_decode:encoded client_privat
    if (l parse "key:" any:(var Str encoded))
      server_key := rsa_cipher base64_decode:encoded client_
  if server_key="" or back<>client_key
    # server answer is wrong (client seed back)
    log trace "wrong server answer (client_exchange_key)."
    return ""
  # send the server seed back
  s writeline "sign-rsa: "+base64_encode:(rsa_cipher server_
  s writeline "" ; s flush anytime
  key := client_key+server_key
  # stores the new shared key in the users database
  if client_site<>"" and is_host
    name_secret_database:data:host:client_site:session creat
    name_secret_database:data:host:client_site:session:serve
    name_secret_database:data:host:client_site:session:server_site:key := straight_to_Str8 key
    name_secret_database:data:host:client_site:session:serve
    name_secret_database store
  eif client_site<>"" and not is_host
    site_secret_database:data:site:client_site:session creat
    name_secret_database:data:host:client_site:session:serve
    name_secret_database store
  eif client_site<>"" and not is_host
    site_secret_database:data:site:client_site:session creat
    site_secret_database:data:site:client_site:session:serve
    site_secret_database:data:site:client_site:session:server_site:key := straight_to_Str8 key
    site_secret_database:data:site:client_site:session:serve
    site_secret_database store
  else
    user_secret_database:data:user:client_user:session creat
    site_secret_database:data:site:client_site:session:serve
    site_secret_database store
  else
    user_secret_database:data:user:client_user:session creat
    user_secret_database:data:user:client_user:session:serve
    user_secret_database:data:user:client_user:session:server_site:key := straight_to_Str8 (cipher key password)
    user_secret_database:data:user:client_user:session:serve
    user_secret_database store



function open_server_channel port log options flags stream s
    user_secret_database:data:user:client_user:session:serve
    user_secret_database store



function open_server_channel port log options flags stream s
  arg Int port ; arg_rw TraceSession log ; arg Str options ;
  arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  log bind server_trace
  # this is the server side: this code is executed on the se
  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.
    if s=failure
      log trace "Failed to connect to " s:name
      return (failure "failed to listen TCP port "+string:po
  # 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:" a
      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="de
      encoding := enc
  if query_client
    if client_site<>""
      var Str client_public := name_database:data:host:clien
      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_
    if server_public<>""
      if not (server_public parse word:"rsa" _ any:(var Str 
        server_public := "corrupted key"
    else
      server_public := site:server_site public_key
      if server_public<>""
        if not (server_public parse word:"rsa" _ any:(var St
          server_public := "corrupted key"
    s writeline "server-key: "+server_public
  if encoding<>""
    s writeline "encoding: "+encoding
  log trace "secured server: connection from " (shunt client
  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=
    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 empt
  log bind server_trace
  # this is the server side: this code is executed on the se
  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.
    if s=failure
      log trace "Failed to connect to " s:name
      return (failure "failed to listen TCP port "+string:po
  # 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:" a
      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="de
      encoding := enc
  if query_client
    if client_site<>""
      var Str client_public := name_database:data:host:clien
      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_
    if server_public<>""
      if not (server_public parse word:"rsa" _ any:(var Str 
        server_public := "corrupted key"
    else
      server_public := site:server_site public_key
      if server_public<>""
        if not (server_public parse word:"rsa" _ any:(var St
          server_public := "corrupted key"
    s writeline "server-key: "+server_public
  if encoding<>""
    s writeline "encoding: "+encoding
  log trace "secured server: connection from " (shunt client
  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=
    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 empt
  var Str key := name_secret_database:data:host:server_site:
  var Str key := straight_to_Str name_secret_database:data:host:server_site:session:(shunt client_site<>"" client_site client_user):key
  if key=""
  if key=""
    key := site_secret_database:data:site:server_site:sessio
    key := straight_to_Str 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_
  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 
    # the MD5 was wrong or there was no shared secret: we mu
    log trace "secured server: needs to exchange a shared ke
    part exchange "exchange secret keys"
      key := server_exchange_key s server_site client_site c
    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 SecuredStreamDrive
  if (flags .and. out)<>0
    rc4_init drv:write_ctx client_seed+key+server_seed serve
  if (flags .and. in)<>0
    rc4_init drv:read_ctx server_seed+key+client_seed client
  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:pub
  log trace "secured server: security level is " drv:securit
  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
      return failure
  else
    stream stream_driver :> drv
  status := success
  log trace "secured channel " server_site " <- " (shunt cli

function open_client_channel server_site client_site client_
  # send MD5 digest of shared secret + client seed
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_
  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 
    # the MD5 was wrong or there was no shared secret: we mu
    log trace "secured server: needs to exchange a shared ke
    part exchange "exchange secret keys"
      key := server_exchange_key s server_site client_site c
    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 SecuredStreamDrive
  if (flags .and. out)<>0
    rc4_init drv:write_ctx client_seed+key+server_seed serve
  if (flags .and. in)<>0
    rc4_init drv:read_ctx server_seed+key+client_seed client
  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:pub
  log trace "secured server: security level is " drv:securit
  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
      return failure
  else
    stream stream_driver :> drv
  status := success
  log trace "secured channel " server_site " <- " (shunt cli

function open_client_channel server_site client_site client_
  arg Str server_site client_site client_user password ; arg
  arg Str server_site client_site client_user password ; arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  # 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
    if s=failure
      log trace "failed to connect to " s:name
      return (failure "failed to connect to '"+server_site+"
  # send a seed
  # 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
    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 Str client_seed := random_seed client_seed_bits\8
  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 ""
  # 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<>""
  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 ""
  # 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
    key := straight_to_Str name_secret_database:data:host:client_site:session:server_site:key
    if key=""
    if key=""
      key := site_secret_database:data:site:client_site:sess
      key := straight_to_Str site_secret_database:data:site:client_site:session:server_site:key
  eif client_user<>""
  eif client_user<>""
    key := uncipher user_secret_database:data:user:client_us
    key := uncipher (straight_to_Str user_secret_database:data:user:client_user:session:server_site:key) password
  # send MD5 digest of server seed + shared secret
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_
  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


export '. channel_support'
  # send MD5 digest of server seed + shared secret
  s writeline "sign-md5: "+base64_encode:(string_md5_binary_
  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


export '. channel_support'