/pliant/util/crypto/channel.pli
 
 1  abstract 
 2    [This is complete secured channel implementation, but it's not because:] ; eol 
 3    list 
 4      item [it has not been seriously review yet.] 
 5      item [the memory buffer might not be properly cleared before beeing freed.] 
 6   
 7  doc 
 8    [It uses RSA public/private key pairs for exchanging a secret shared key.] ; eol 
 9    [All informations on the secured chanel are MD5 signed, then RC4 ciphered. ] 
 10   
 11  constant server_seed_bits 128 
 12  constant server_rc4_laps 10 
 13  constant client_seed_bits 128 
 14  constant client_rc4_laps 10 
 15  constant backward_compatibility true 
 16   
 17  module "/pliant/language/compiler.pli" 
 18  module "random.pli" 
 19  module "rsa.pli" 
 20  module "rc4.pli" 
 21  module "cipher.pli" 
 22  module "/pliant/admin/md5.pli" 
 23  module "/pliant/util/encoding/base64.pli" 
 24  module "/pliant/language/type/text/str8.pli" 
 25  module "/pliant/util/encoding/html.pli" 
 26  module "/pliant/protocol/dns/name.pli" 
 27  module "/pliant/protocol/http/site.pli" 
 28  module "/pliant/fullpliant/user.pli" 
 29   
 30  module "/pliant/language/stream/filesystembase.pli" 
 31  module "/pliant/language/stream/openmode.pli" 
 32  module "/pliant/language/stream/flushmode.pli" 
 33  module "/pliant/language/stream.pli" 
 34  module "/pliant/language/stream/multi.pli" 
 35   
 36  (gvar TraceSlot server_trace) configure "secured channel server" 
 37  (gvar TraceSlot client_trace) configure "secured channel client" 
 38   
 39   
 40  function random_seed len -> s 
 41    arg Int len ; arg Str s 
 42    var DateTime dt := datetime 
 43    var Str timestamp := repeat DateTime:size " " 
 44    memory_copy addressof:dt timestamp:characters DateTime:size 
 45    part generate 
 46      := timestamp+random_string:(max len-DateTime:size 1) 
 47      if (s:len-1):number=0 
 48        restart generate 
 49   
 50   
 51 
 
 52   
 53   
 54  type SecuredStreamDriver 
 55    field Link:Stream s 
 56    field RC4Ctx read_ctx 
 57    field Str read_buffer 
 58    field CBool read_crashed <- false 
 59    field RC4Ctx write_ctx 
 60    field CBool write_crashed <- false 
 61    field Str local_site 
 62    field Str local_user 
 63    field Str remote_site 
 64    field Str remote_user 
 65    field Int security_level 
 66    field Str errmsg 
 67    field Str wrong_block 
 68    field Str encoding 
 69  StreamDriver maybe SecuredStreamDriver 
 70   
 71   
 72  doc 
 73    [Read RC4 ciphered bytes.] 
 74   
 75  method drv read1 buf size -> status 
 76    arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int size ; arg Status status 
 77    var Int red := 0 
 78    while red<size 
 79      drv:read_available (var Address adr) (var Int step) size-red 
 80      if step=0 
 81        return failure 
 82      rc4_cipher drv:read_ctx adr (buf translate Byte red) step 
 83      red += step 
 84    status := success 
 85   
 86  doc 
 87    [Read MD5 signed packets.] ; eol 
 88    ['read_buffer' contains the bytes from the last packet that have not yet been consumed.] 
 89   
 90  method drv read buf mini maxi -> red 
 91    arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int mini maxi red 
 92    red := 0 
 93    if drv:read_crashed 
 94      return 
 95    while red<mini 
 96      if drv:read_buffer:len>0 
 97        var Int step := min drv:read_buffer:len maxi 
 98        memory_copy drv:read_buffer:characters (buf translate Byte red) step 
 99        drv:read_buffer := drv:read_buffer step drv:read_buffer:len 
 100        red += step 
 101      else 
 102        if (drv read1 addressof:(var uInt16_li step16) uInt16:size)=failure 
 103          drv errmsg := "read block size" 
 104          drv read_crashed := true ; return 
 105        drv:read_buffer set (memory_allocate step16 (addressof drv:read_buffer)) step16 true 
 106        if (drv read1 drv:read_buffer:characters step16)=failure 
 107          drv errmsg := "read block data" 
 108          drv read_crashed := true ; return 
 109        var Str correct := string_md5_binary_signature drv:read_buffer 
 110        (var Str provided) set (memory_allocate correct:len addressof:provided) correct:len true 
 111        if (drv read1 provided:characters provided:len)=failure 
 112          drv errmsg := "read block signature" 
 113          drv read_crashed := true ; return 
 114        if provided<>correct 
 115          drv wrong_block := drv read_buffer 
 116          drv errmsg := "wrong block signature" 
 117          drv read_crashed := true ; return 
 118          
 119   
 120  doc 
 121    [Writes RC4 ciphered bytes.] 
 122   
 123  method drv write1 buf size -> status 
 124    arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int size ; arg Status status 
 125    var Int written := 0 
 126    while written<size 
 127      var Int step := min (cast drv:s:stream_write_stop Int).-.(cast drv:s:stream_write_cur Int) size-written 
 128      rc4_cipher drv:write_ctx (buf translate Byte written) drv:s:stream_write_cur step 
 129      drv:stream_write_cur := drv:s:stream_write_cur translate Byte step 
 130      if drv:s:stream_write_cur=drv:s:stream_write_stop 
 131        drv:flush anytime 
 132        if drv:s:is_crashed 
 133          return failure 
 134      written += step 
 135    status := success 
 136   
 137  doc 
 138    [Writes MD5 signed packets.] 
 139   
 140  method drv write buf mini maxi -> written 
 141    arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int mini maxi written 
 142    written := 0 
 143    if drv:write_crashed 
 144      return 
 145    while written<mini 
 146      var uInt16_li step16 := min maxi-written 2^16-1 
 147      if (drv write1 addressof:step16 uInt16:size)=failure 
 148        drv errmsg := "write block size" 
 149        drv write_crashed := true ; return 
 150      if (drv write1 (buf translate Byte written) step16)=failure 
 151        drv errmsg := "write block data" 
 152        drv write_crashed := true ; return 
 153      (var Str temp) set (buf translate Byte written) step16 false 
 154      var Str digest := string_md5_binary_signature temp 
 155      if (drv write1 digest:characters digest:len)=failure 
 156        drv errmsg := "write block signature" 
 157        drv write_crashed := true ; return 
 158      written += step16 
 159   
 160   
 161  method drv flush level -> status 
 162    arg_rw SecuredStreamDriver drv ; arg Int level ; arg Status status 
 163    if level<>end 
 164      drv:flush level 
 165    status := shunt drv:s=success success failure 
 166   
 167   
 168  method drv query command stream answer -> status 
 169    arg_rw SecuredStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status  
 170    if command="local_site" 
 171      answer := drv local_site 
 172      status := success 
 173    eif command="local_user" 
 174      answer := drv local_user 
 175      status := success 
 176    eif command="remote_site" 
 177      answer := drv remote_site 
 178      status := success 
 179    eif command="remote_user" 
 180      answer := drv remote_user 
 181      status := success 
 182    eif command="security_level" 
 183      answer := string drv:security_level 
 184      status := success 
 185    eif command="error_message" 
 186      answer := drv errmsg 
 187      status := success 
 188    eif command="wrong_block" 
 189      answer := drv wrong_block 
 190      status := success 
 191    eif command="encoding" 
 192      answer := drv encoding 
 193      status := success 
 194    else 
 195      status := drv:s:stream_driver query command drv:answer 
 196   
 197   
 198  method drv configure command stream -> status 
 199    arg_rw SecuredStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 200    status := drv:s:stream_driver configure command drv:s 
 201   
 202   
 203 
 
 204   
 205   
 206  doc 
 207    [Exchange a new shared secret key between the client and the server.] ; eol 
 208    list 
 209      item [The client will generate a seed and send it to the server, ciphered with the server public key (1)] 
 210      item [The server will reply with a seed of it's own, ciphered with the client public key (2a)] 
 211      item [Then the server will send the client seed, ciphered with the client public key (2b)] 
 212      item [The client will check it's own seed sent back by the server: the server identity is proved] 
 213      item [Then the client will send the server seed, ciphered with the server public key (3)] 
 214      item [The server will check it's own seed sent back by the client: the client identity is proved] 
 215      item [The new shared secret is the client seed followed by the server seed.] 
 216   
 217   
 218  function server_exchange_key s server_site client_site client_user log -> key 
 219    arg_rw Stream s ; arg Str server_site client_site client_user ; arg_rw TraceSession log ; arg Str key 
 220    var Str server_public := name_database:data:host:server_site public_key 
 221    var Str server_private := name_secret_database:data:host:server_site private_key 
 222    var CBool is_host := true 
 223    if server_public="" 
 224      server_public := site:server_site public_key 
 225      server_private := site_secret_database:data:site:server_site private_key 
 226      is_host := false 
 227    if server_public="" or server_private="" 
 228      log trace "missing server key (server_exchange_key)." 
 229      return "" 
 230    var Str client_public 
 231    if client_site<>"" 
 232      client_public := name_database:data:host:client_site public_key 
 233      if client_public="" 
 234        client_public := site:client_site public_key 
 235    eif client_user<>"" 
 236      client_public := user:client_user public_key 
 237    if client_public="" 
 238      log trace "missing client key (server_exchange_key)." 
 239      return "" 
 240    # wait for the client seed 
 241    var Str client_key := "" 
 242    while not s:atend and { var Str := s:readline ; l<>"" } 
 243      if (parse "key:" any:(var Str encoded)) 
 244        client_key := rsa_cipher base64_decode:encoded server_private 
 245    if client_key="" 
 246      log trace "wrong client seed (server_exchange_key)." 
 247      return "" 
 248    # send the server seed 
 249    var Str server_key := random_string (max rsa_nbbits:server_public rsa_nbbits:client_public)\8 
 250    writeline "key: "+base64_encode:(rsa_cipher server_key client_public) 
 251    # send the client seed back 
 252    writeline "sign-rsa: "+base64_encode:(rsa_cipher client_key client_public) 
 253    writeline "" ; flush anytime 
 254    # wait for the server seed back 
 255    var Str back := "" 
 256    while not s:atend and { var Str := s:readline ; l<>"" } 
 257      if (parse "sign-rsa:" any:(var Str encoded)) 
 258        back := rsa_cipher base64_decode:encoded server_private 
 259    if back<>server_key 
 260      # client answer is wrong (server seed back) 
 261      log trace "wrong client answer (server_exchange_key)." 
 262      return "" 
 263    key := client_key+server_key 
 264    # stores the new shared key in the users database 
 265    var Str client_id := shunt client_site<>"" client_site client_user 
 266    if is_host 
 267      name_secret_database:data:host:server_site:session create client_id 
 268      name_secret_database:data:host:server_site:session:client_id:key := straight_to_Str8 key 
 269      name_secret_database:data:host:server_site:session:client_id:timestamp := datetime 
 270      name_secret_database store 
 271    else 
 272      site_secret_database:data:site:server_site:session create client_id 
 273      site_secret_database:data:site:server_site:session:client_id:key := straight_to_Str8 key 
 274      site_secret_database:data:site:server_site:session:client_id:timestamp := datetime 
 275      site_secret_database store 
 276   
 277   
 278  function client_exchange_key s server_site client_site client_user password log -> key 
 279    arg_rw Stream s ; arg Str server_site client_site client_user password ; arg_rw TraceSession log ; arg Str key 
 280    var Str server_public := name_database:data:host:server_site public_key 
 281    var CBool is_host := true 
 282    if server_public="" 
 283      server_public := site:server_site public_key 
 284      is_host := false 
 285    if server_public="" 
 286      log trace "missing server key (client_exchange_key)." 
 287      return "" 
 288    var Str client_public client_private 
 289    if client_site<>"" 
 290      client_public := name_database:data:host:client_site public_key 
 291      client_private := name_secret_database:data:host:client_site private_key 
 292      if client_public="" 
 293        client_public := site:client_site public_key 
 294        client_private := site_secret_database:data:site:client_site private_key 
 295    eif client_user<>"" 
 296      client_public := user:client_user public_key 
 297      client_private := uncipher straight_to_Str:(user_secret_database:data:user:client_user private_key) password 
 298    if client_public="" or client_private="" 
 299      log trace "missing client key (client_exchange_key)." 
 300      return "" 
 301    var Str client_key := random_string (max rsa_nbbits:server_public rsa_nbbits:client_public)\8 
 302    writeline "key: "+base64_encode:(rsa_cipher client_key server_public) 
 303    writeline "" ; flush anytime 
 304    # send the client seed 
 305    # wait for the server seed and the client seed back 
 306    var Str server_key := "" 
 307    var Str back := "" 
 308    while not s:atend and { var Str := s:readline ; l<>"" } 
 309      if (parse "sign-rsa:" any:(var Str encoded)) 
 310        back := rsa_cipher base64_decode:encoded client_private 
 311      if (parse "key:" any:(var Str encoded)) 
 312        server_key := rsa_cipher base64_decode:encoded client_private 
 313    if server_key="" or back<>client_key 
 314      # server answer is wrong (client seed back) 
 315      log trace "wrong server answer (client_exchange_key)." 
 316      return "" 
 317    # send the server seed back 
 318    writeline "sign-rsa: "+base64_encode:(rsa_cipher server_key server_public) 
 319    writeline "" ; flush anytime 
 320    key := client_key+server_key 
 321    # stores the new shared key in the users database 
 322    if client_site<>"" and is_host 
 323      name_secret_database:data:host:client_site:session create server_site 
 324      name_secret_database:data:host:client_site:session:server_site:key := straight_to_Str8 key 
 325      name_secret_database:data:host:client_site:session:server_site:timestamp := datetime 
 326      name_secret_database store 
 327    eif client_site<>"" and not is_host 
 328      site_secret_database:data:site:client_site:session create server_site 
 329      site_secret_database:data:site:client_site:session:server_site:key := straight_to_Str8 key 
 330      site_secret_database:data:site:client_site:session:server_site:timestamp := datetime 
 331      site_secret_database store 
 332    else 
 333      user_secret_database:data:user:client_user:session create server_site 
 334      user_secret_database:data:user:client_user:session:server_site:key := straight_to_Str8 (cipher key password) 
 335      user_secret_database:data:user:client_user:session:server_site:timestamp := datetime 
 336      user_secret_database store 
 337   
 338   
 339 
 
 340   
 341  doc 
 342    [Open a new secured channel.] ; eol 
 343    list 
 344      item [The client will send a seed (1)] 
 345      item [The server will send a seed (2a)] 
 346      item [The server will answer with a MD5 digest of the shared secret + client seed (2b)] 
 347      item [The client will answer with a MD5 digest of server seed + shared secret (3)] 
 348      item [Both sides check the MD5 answers, and a new shared secret is negociated if they where wrong or there was no shared secret yet.] 
 349    [The server will cipher using RC4 and the key will be client seed + shared secret + server seed] ; eol 
 350    [The client will cipher using RC4 and the key will be server seed + shared secret + client seed] 
 351   
 352   
 353  type SecuredFileSystem 
 354    void 
 355  FileSystem maybe SecuredFileSystem 
 356   
 357  function open_server_channel port log options flags stream support -> status 
 358    arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 359    log bind server_trace 
 360    # this is the server side: this code is executed on the server when a client is asking for a secured channel 
 361    var Link:Stream s 
 362    if addressof:support<>null 
 363      :> support 
 364    else 
 365      var Link:Stream :> new Stream 
 366      open "tcp:/server/"+string:port "" in+out+(flags .and. safe) 
 367      if s=failure 
 368        log trace "Failed to connect to " s:name 
 369        return (failure "failed to listen TCP port "+string:port) 
 370    # receive the client seed 
 371    var Str server_site := "" 
 372    var Str client_site := "" 
 373    var Str client_user := "" 
 374    var Str client_seed := "" 
 375    var Int client_laps := undefined 
 376    var CBool query_client := false 
 377    var CBool query_server := false 
 378    var Str encoding := "" 
 379    while not s:atend and { var Str := s:readline ; l<>"" } 
 380      if (parse "server-site:" any:(var Str encoded)) 
 381        server_site := base64_decode encoded 
 382      eif backward_compatibility and (parse "server-user:" any:(var Str encoded)) 
 383        server_site := base64_decode encoded 
 384      eif (parse "client-site:" any:(var Str encoded)) 
 385        client_site := base64_decode encoded 
 386      eif (parse "client-user:" any:(var Str encoded)) 
 387        client_user := base64_decode encoded 
 388      eif (parse "seed-rc4:" any:(var Str encoded)) 
 389        client_seed := base64_decode encoded 
 390      eif (parse "laps-rc4:" (var Int i)) 
 391        client_laps := i 
 392      eif (parse "query-client-key") 
 393        query_client := true 
 394      eif (parse "query-server-key") 
 395        query_server := true 
 396      eif (parse "encoding:" any:(var Str enc)) and (enc="deflate" or enc="zlib") 
 397        encoding := enc 
 398    if query_client 
 399      if client_site<>"" 
 400        var Str client_public := name_database:data:host:client_site public_key 
 401        if client_public="" 
 402          client_public := site:client_site public_key 
 403        writeline "client-key: "+client_public 
 404      else 
 405        var Str client_public := user:client_user public_key 
 406        writeline "client-key: "+client_public 
 407    if query_server 
 408      var Str server_public := name_database:data:host:server_site public_key 
 409      if server_public<>"" 
 410        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 
 411          server_public := "corrupted key" 
 412      else 
 413        server_public := site:server_site public_key 
 414        if server_public<>"" 
 415          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 
 416            server_public := "corrupted key" 
 417      writeline "server-key: "+server_public 
 418    if encoding<>"" 
 419      writeline "encoding: "+encoding 
 420    log trace "secured server: connection from " (shunt client_site<>"" "site "+client_site "user "+client_user) " to site " server_site 
 421    if client_seed="" or client_laps=undefined 
 422      log trace "wrong client seed or laps." 
 423      return failure 
 424    if name_secret_database:data:host:server_site:private_key="" and site_secret_database:data:site:server_site:private_key="" 
 425      log trace "no private key for " server_site 
 426      return failure 
 427    # send server seed 
 428    var Str server_seed := random_seed server_seed_bits\8 
 429    var Int server_laps := server_rc4_laps 
 430    writeline "seed-rc4: "+base64_encode:server_seed 
 431    writeline "laps-rc4: "+string:server_laps 
 432    # retreive the shared secret with this client (may be empty if they never talked together or the sever discarded it) 
 433    var Str key := straight_to_Str name_secret_database:data:host:server_site:session:(shunt client_site<>"" client_site client_user):key 
 434    if key="" 
 435      key := straight_to_Str site_secret_database:data:site:server_site:session:(shunt client_site<>"" client_site client_user):key 
 436    # send MD5 digest of shared secret + client seed 
 437    writeline "sign-md5: "+base64_encode:(string_md5_binary_signature key+client_seed) 
 438    writeline "" 
 439    # wait for the MD5 digest of server seed + shared secret 
 440    var Str back := "" 
 441    while not s:atend and { var Str := s:readline ; l<>"" } 
 442      if (parse "sign-md5:" any:(var Str encoded)) 
 443        back := base64_decode encoded 
 444    if back<>(string_md5_binary_signature server_seed+key) or key="" 
 445      # the MD5 was wrong or there was no shared secret: we must negotiate a new one using RSA keys 
 446      log trace "secured server: needs to exchange a shared key." 
 447      part exchange "exchange secret keys" 
 448        key := server_exchange_key server_site client_site client_user log 
 449      if key="" 
 450        log trace "failed to exchange a shared key." 
 451        return failure 
 452    log trace "secured server: session opened (" key:len ")." 
 453    var Link:SecuredStreamDriver drv :> new SecuredStreamDriver 
 454    if (flags .and. out)<>0 
 455      rc4_init drv:write_ctx client_seed+key+server_seed server_laps 
 456    if (flags .and. in)<>0 
 457      rc4_init drv:read_ctx server_seed+key+client_seed client_laps 
 458    drv local_site := server_site 
 459    if client_site<>"" 
 460      drv remote_site := client_site 
 461    eif client_user<>"" 
 462      drv remote_user := client_user 
 463    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)) 
 464    log trace "secured server: security level is " drv:security_level " bits" 
 465    drv :> s 
 466    if encoding<>"" 
 467      log trace "secured server: encoding is " encoding 
 468      drv encoding := encoding 
 469      var Link:Stream zs :> new Stream 
 470      if (zs open "null:" options flags)=failure 
 471        return failure 
 472      zs stream_driver :> drv 
 473      if (pliant_default_file_system open encoding+":" options flags stream zs)=failure 
 474        return failure 
 475    else 
 476      stream stream_driver :> drv 
 477    status := success 
 478    log trace "secured channel " server_site " <- " (shunt client_site<>"" "site "+client_site "user "+client_user) 
 479   
 480  function open_client_channel server_site client_site client_user password port log options flags stream support -> status 
 481    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 
 482    # this is the client side: this code is executed on the client when trying to get a secured channel to a server 
 483    log bind client_trace 
 484    var Link:Stream s 
 485    if addressof:support<>null 
 486      :> support 
 487    else 
 488      var Link:Stream :> new Stream 
 489      open "tcp://"+server_site+"/client/"+string:port "" in+out+(flags .and. safe) 
 490      if s=failure 
 491        log trace "failed to connect to " s:name 
 492        return (failure "failed to connect to '"+server_site+"' TCP port "+string:port) 
 493    # send a seed 
 494    var Str client_seed := random_seed client_seed_bits\8 
 495    var Int client_laps := client_rc4_laps 
 496    writeline "server-site: "+base64_encode:server_site 
 497    if backward_compatibility 
 498      writeline "server-user: "+base64_encode:server_site 
 499    if client_site<>"" 
 500      writeline "client-site: "+base64_encode:client_site 
 501    eif client_user<>"" 
 502      writeline "client-user: "+base64_encode:client_user 
 503    writeline "seed-rc4: "+base64_encode:client_seed 
 504    writeline "laps-rc4: "+string:client_laps 
 505    if (options option "query_server_key") 
 506      writeline "query-server-key" 
 507    if (options option "query_client_key") 
 508      writeline "query-client-key" 
 509    if (options option "deflate") 
 510      writeline "encoding: deflate" 
 511    eif (options option "zlib") 
 512      writeline "encoding: zlib" 
 513    writeline "" 
 514    # receive MD5 digest of shared secret + client seed 
 515    # also receive the server seed 
 516    var Str back := "" 
 517    var Str server_seed := "" 
 518    var Int server_laps := undefined 
 519    var Str encoding := "" 
 520    while not s:atend and { var Str := s:readline ; l<>"" } 
 521      if (parse "sign-md5:" any:(var Str encoded)) 
 522        back := base64_decode:encoded 
 523      eif (parse "seed-rc4:" any:(var Str encoded)) 
 524        server_seed := base64_decode:encoded 
 525      eif (parse "laps-rc4:" (var Int i)) 
 526        server_laps := i 
 527      eif (parse "encoding:" any:(var Str enc)) and (enc="deflate" or enc="zlib") 
 528        encoding := enc 
 529        log trace encoding+" encoding accepted." 
 530    log trace "secured client: new connection from " (shunt client_site<>"" "site "+client_site "user "+client_user) " to " server_site 
 531    if server_seed="" or server_laps=undefined 
 532      log trace "wrong server seed or laps." 
 533      return failure 
 534    # retreive the shared secret with this client (may be empty if they never talked together or the sever discarded it) 
 535    var Str key 
 536    if client_site<>"" 
 537      key := straight_to_Str name_secret_database:data:host:client_site:session:server_site:key 
 538      if key="" 
 539        key := straight_to_Str site_secret_database:data:site:client_site:session:server_site:key 
 540    eif client_user<>"" 
 541      key := uncipher (straight_to_Str user_secret_database:data:user:client_user:session:server_site:key) password 
 542    # send MD5 digest of server seed + shared secret 
 543    writeline "sign-md5: "+base64_encode:(string_md5_binary_signature server_seed+key) 
 544    writeline "" 
 545    if back<>(string_md5_binary_signature key+client_seed) or key="" 
 546      # the MD5 was wrong or there was no shared secret: we must negotiate a new one using RSA keys 
 547      log trace "needs to exchange a shared key." 
 548      key := client_exchange_key server_site client_site client_user password log 
 549      if key="" 
 550        log trace "failed to exchange a shared key." 
 551        return failure 
 552    log trace "session opened (" key:len ")." 
 553    var Link:SecuredStreamDriver drv :> new SecuredStreamDriver 
 554    if (flags .and. out)<>0 
 555      rc4_init drv:write_ctx server_seed+key+client_seed client_laps 
 556    if (flags .and. in)<>0 
 557      rc4_init drv:read_ctx client_seed+key+server_seed server_laps 
 558    if client_site<>"" 
 559      drv local_site := client_site 
 560    eif client_user<>"" 
 561      drv local_user := client_user 
 562    drv remote_site := server_site 
 563    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)) 
 564    log trace "security level is " drv:security_level " bits" 
 565    drv :> s 
 566    if encoding<>"" 
 567      log trace "encoding is " encoding 
 568      drv encoding := encoding 
 569      var Link:Stream zs :> new Stream 
 570      if (zs open "null:" options flags)=failure 
 571        return failure 
 572      zs stream_driver :> drv 
 573      if (pliant_default_file_system open encoding+":" options flags stream zs)=failure 
 574        return failure 
 575    else 
 576      stream stream_driver :> drv 
 577    status := success 
 578   
 579  method fs open name options flags stream support -> status 
 580    arg_rw SecuredFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 581    var TraceSession log 
 582    if (name parse "/server/" (var Int port)) 
 583      status := open_server_channel port log options flags stream support 
 584    eif (name parse "//" any:(var Str server_site) "/user/" (var Int port) "/" any:(var Str client_user) "/" any:(var Str password)) 
 585      status := open_client_channel server_site "" client_user password port log options flags stream support 
 586    eif (name parse "//" any:(var Str server_site) "/site/" (var Int port) "/" any:(var Str client_site)) 
 587      status := open_client_channel server_site client_site "" "" port log options flags stream support 
 588    eif backward_compatibility and (name parse "//" any:(var Str site) "/client/" (var Int port) "/" any:(var Str server_site) "/" any:(var Str client_user) "/" any:(var Str password)) and site=server_site 
 589      status := open_client_channel server_site client_site client_user password port log options flags stream support 
 590    else 
 591      status := failure 
 592   
 593   
 594  method fs query filename options flags info -> status 
 595    arg_rw SecuredFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw FileInfo info ; arg ExtendedStatus status 
 596    if backward_compatibility and (filename parse "//" any:(var Str site) "/client/" (var Int port) "/" any:(var Str server_site) "/" any:(var Str client_user) "/" any:(var Str password)) 
 597      (var Stream s) open "tcp://"+site+"/client/"+string:port "" in+out+(flags .and. safe+noautopost) 
 598      if s=failure 
 599        return failure 
 600      writeline "server-site: "+base64_encode:server_site 
 601      writeline "client-user: "+base64_encode:client_user 
 602      writeline "query-server-key" 
 603      writeline "query-client-key" 
 604      writeline "" 
 605      var Str answer := "" 
 606      while not s:atend and { var Str := s:readline ; l<>"" } 
 607        if (parse "server-key:" any:(var Str encoded)) 
 608          answer += " server_key "+string:encoded 
 609        eif (parse "client-key:" any:(var Str encoded)) 
 610          answer += " client_key "+string:encoded 
 611      info options := answer answer:len 
 612      status := shunt answer<>"" success failure 
 613    else 
 614      status := failure 
 615   
 616   
 617  gvar SecuredFileSystem secured_file_system 
 618  pliant_multi_file_system mount "channel:" "" "" secured_file_system 
 619  pliant_multi_file_system mount "zchannel:" "" "zlib" secured_file_system 
 620   
 621   
 622 
 
 623   
 624   
 625  type NullStreamDriver 
 626    void 
 627  StreamDriver maybe NullStreamDriver 
 628   
 629  method drv read buf mini maxi -> red 
 630    arg_rw NullStreamDriver drv ; arg Address buf ; arg Int mini maxi red 
 631    memory_clear buf maxi 
 632    red := maxi 
 633   
 634  method drv write buf mini maxi -> written 
 635    arg_rw NullStreamDriver drv ; arg Address buf ; arg Int mini maxi written 
 636    written := maxi 
 637   
 638   
 639  type NullFileSystem 
 640    void 
 641  FileSystem maybe NullFileSystem 
 642   
 643  method fs open name options flags stream support -> status 
 644    arg_rw NullFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 645    stream stream_driver :> new NullStreamDriver 
 646    status := success 
 647   
 648  gvar NullFileSystem null_file_system 
 649  pliant_multi_file_system mount "null:" "" null_file_system 
 650   
 651   
 652 
 
 653   
 654   
 655  method ch channel_support -> s 
 656    arg_rw Stream ch ; arg_C Stream s 
 657    :> ch 
 658    while { var Pointer:Type :> entry_type (addressof s:stream_driver) ; t=SecuredStreamDriver or t:name="CompressZlibStreamDriver" } 
 659      :> (addressof s:stream_driver) map Link:Stream 
 660   
 661  export '. channel_support'