Patch title: Release 92 bulk changes
Abstract:
File: /util/remote/client.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/parser.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/crypto/channel.pli"
module "/pliant/language/data/string_cast.pli"
module "/pliant/protocol/dns/name.pli"
module "common.pli"


function remote_execute da fun server
  arg_rw DelayedAction da ; arg RemoteFunction fun ; arg Str
  (var TraceSession log) bind remote_trace
  if server=computer_fullname
    if not (exists fun:local_streaming) and not (exists fun:
module "/pliant/language/compiler.pli"
module "/pliant/language/parser.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/crypto/channel.pli"
module "/pliant/language/data/string_cast.pli"
module "/pliant/protocol/dns/name.pli"
module "common.pli"


function remote_execute da fun server
  arg_rw DelayedAction da ; arg RemoteFunction fun ; arg Str
  (var TraceSession log) bind remote_trace
  if server=computer_fullname
    if not (exists fun:local_streaming) and not (exists fun:
      if fun:site_offset=defined
        (da:parameter translate Byte fun:site_offset) map St
      if fun:host_offset=defined
        (da:parameter translate Byte fun:host_offset) map Str := computer_fullname
      execute_within_context da:parameter fun:body
      if (exists fun:success_code)
        execute_within_context da:parameter fun:success_code
      return
  var Pointer:Str message
  if fun:message_offset=defined
    message :> (da:parameter translate Byte fun:message_offs
  else
    message :> var Str drop
  message := ""
  var Link:Stream s :> new Stream
  var Int port := name_database:data:host:server remote_port
  s open "zchannel://"+server+"/site/"+string:(shunt port=de
  if s=failure
    message := "failed to connect to "+server
    log trace "failed to connect to " server
  s writeline "call "+fun:id
      execute_within_context da:parameter fun:body
      if (exists fun:success_code)
        execute_within_context da:parameter fun:success_code
      return
  var Pointer:Str message
  if fun:message_offset=defined
    message :> (da:parameter translate Byte fun:message_offs
  else
    message :> var Str drop
  message := ""
  var Link:Stream s :> new Stream
  var Int port := name_database:data:host:server remote_port
  s open "zchannel://"+server+"/site/"+string:(shunt port=de
  if s=failure
    message := "failed to connect to "+server
    log trace "failed to connect to " server
  s writeline "call "+fun:id
  log trace "call "+fun:id
  log trace "call "+fun:id+" on "+server
  var Pointer:Int index :> fun:ro_list first
  while exists:index
    var Pointer:TypeField tf :> fun:type field index
    var Str value := to_string (da:parameter translate Byte 
    s writeline "set "+tf:name+" "+value
    log trace "output " tf:name+" "+value
    index :> fun:ro_list next index
  s writeline ""
  while { var Str line := s readline ; line<>"" }
    if (line parse word:"set" _ any:(var Str variable) _ any
      var Pointer:Int index :> fun:rw_dict first variable
      if exists:index
        var Pointer:TypeField tf :> fun:type field index
        from_string (da:parameter translate Byte tf:offset) 
        log trace "input " variable " " value
      else
        log trace "unexpected input " variable " " value
    eif (line parse word:"failure" (var Str msg))
      message := msg
      log trace msg
    else
      log trace "unsupported line: " line
  if message="" and s=failure
    message := "remote process crashed"
  if message=""
    if (exists fun:local_streaming) and fun:ls_offset=define
      (da:parameter translate Byte fun:ls_offset) map Addres
      execute_within_context da:parameter fun:local_streamin
    if (exists fun:success_code)
      execute_within_context da:parameter fun:success_code
  else
    if (exists fun:failure_code)
      execute_within_context da:parameter fun:failure_code




named_expression control_prototype
  var Pointer:Int index :> fun:ro_list first
  while exists:index
    var Pointer:TypeField tf :> fun:type field index
    var Str value := to_string (da:parameter translate Byte 
    s writeline "set "+tf:name+" "+value
    log trace "output " tf:name+" "+value
    index :> fun:ro_list next index
  s writeline ""
  while { var Str line := s readline ; line<>"" }
    if (line parse word:"set" _ any:(var Str variable) _ any
      var Pointer:Int index :> fun:rw_dict first variable
      if exists:index
        var Pointer:TypeField tf :> fun:type field index
        from_string (da:parameter translate Byte tf:offset) 
        log trace "input " variable " " value
      else
        log trace "unexpected input " variable " " value
    eif (line parse word:"failure" (var Str msg))
      message := msg
      log trace msg
    else
      log trace "unsupported line: " line
  if message="" and s=failure
    message := "remote process crashed"
  if message=""
    if (exists fun:local_streaming) and fun:ls_offset=define
      (da:parameter translate Byte fun:ls_offset) map Addres
      execute_within_context da:parameter fun:local_streamin
    if (exists fun:success_code)
      execute_within_context da:parameter fun:success_code
  else
    if (exists fun:failure_code)
      execute_within_context da:parameter fun:failure_code




named_expression control_prototype
  var Str v := 'remote site'
  var Str v := 'remote host'
  if not c
    'remote rejected' := true
    return


meta remote e
  var Pointer:Arrow c :> pliant_general_dictionary first "pl
  if c=null or entry_type:c<>Function
    return
  var Link:Function current_function :> c map Function
  if e:size<2 or not (e:0 cast Str)
    return
  var Str id
  var Pointer:Expression body
  var Int ls_index := undefined
  var Int rs_index := undefined
  var Int success_index := undefined
  var Int failure_index := undefined
  var Int failure2_index := undefined
  var Int i
  if e:size>=4 and e:1:ident="id" and (e:2 constant Str)<>nu
    id := (e:2 constant Str) map Str
    body :> e 3
    i := 4
  else
    id := e:external_module:name+" "+current_function:name
    body :> e 1
    i := 2
  while i<e:size
    if i+2<e:size and e:i:ident="local_streaming" and e:(i+1
      ls_index := i
      i += 3
    eif i+2<e:size and e:i:ident="remote_streaming" and e:(i
      rs_index := i
      i += 3
    eif i+1<e:size and e:i:ident="success" and e:(i+1):ident
      success_index := i
      i += 2
    eif i+1<e:size and e:i:ident="failure" and e:(i+1):ident
      failure_index := i
      i += 2
    eif i+2<e:size and e:i:ident="failure" and e:(i+1):ident
      failure2_index := i
      i += 3
    else
      console "i = " i eol
      return
  e suckup e:0
  var Pointer:Module module :> e module ; var Address mark :
  if not c
    'remote rejected' := true
    return


meta remote e
  var Pointer:Arrow c :> pliant_general_dictionary first "pl
  if c=null or entry_type:c<>Function
    return
  var Link:Function current_function :> c map Function
  if e:size<2 or not (e:0 cast Str)
    return
  var Str id
  var Pointer:Expression body
  var Int ls_index := undefined
  var Int rs_index := undefined
  var Int success_index := undefined
  var Int failure_index := undefined
  var Int failure2_index := undefined
  var Int i
  if e:size>=4 and e:1:ident="id" and (e:2 constant Str)<>nu
    id := (e:2 constant Str) map Str
    body :> e 3
    i := 4
  else
    id := e:external_module:name+" "+current_function:name
    body :> e 1
    i := 2
  while i<e:size
    if i+2<e:size and e:i:ident="local_streaming" and e:(i+1
      ls_index := i
      i += 3
    eif i+2<e:size and e:i:ident="remote_streaming" and e:(i
      rs_index := i
      i += 3
    eif i+1<e:size and e:i:ident="success" and e:(i+1):ident
      success_index := i
      i += 2
    eif i+1<e:size and e:i:ident="failure" and e:(i+1):ident
      failure_index := i
      i += 2
    eif i+2<e:size and e:i:ident="failure" and e:(i+1):ident
      failure2_index := i
      i += 3
    else
      console "i = " i eol
      return
  e suckup e:0
  var Pointer:Module module :> e module ; var Address mark :
  e local_variable "remote site" Str
  e local_variable "remote host" Str
  e local_variable "remote rejected" CBool
  var Link:List expressions :> new List
  var Link:List byaddress :> new List
  expressions append addressof:body
  if ls_index=defined
    e local_variable e:(ls_index+1) Stream
    expressions append addressof:(e ls_index+2)
  if rs_index=defined
    e local_variable e:(rs_index+1) Stream
    expressions append addressof:(e rs_index+2)
  if success_index=defined
    expressions append addressof:(e success_index+1)
  if failure_index=defined
    expressions append addressof:(e failure_index+1)
  if failure2_index=defined
    e local_variable e:(failure2_index+1) Str
    expressions append addressof:(e failure2_index+2)
  var List functions ; var Link:Type type
  module define "control" addressof:(the_meta control)
  module define "modify" addressof:(the_meta modify)
  module define "ignore" addressof:(the_meta ignore)
  module define "pliant shared" addressof:byaddress
  module define "share" addressof:(the_meta 'pliant share ar
  var Link:Dictionary modify :> new Dictionary
  module define "pliant remote modify" addressof:modify
  var Link:Dictionary ignore :> new Dictionary
  module define "pliant remote ignore" addressof:ignore
  e freeze expressions byaddress functions type
  module rewind mark
  void ?
  var Pointer:Arrow ba :> byaddress first
  while ba<>null
    ignore insert (cast (ba map Ident) Str) true addressof:v
    ba :> byaddress next ba
  var Link:RemoteFunction fun :> new RemoteFunction
  fun body :> functions:first map Function
  fun type :> type
  fun id := id
  e local_variable "remote rejected" CBool
  var Link:List expressions :> new List
  var Link:List byaddress :> new List
  expressions append addressof:body
  if ls_index=defined
    e local_variable e:(ls_index+1) Stream
    expressions append addressof:(e ls_index+2)
  if rs_index=defined
    e local_variable e:(rs_index+1) Stream
    expressions append addressof:(e rs_index+2)
  if success_index=defined
    expressions append addressof:(e success_index+1)
  if failure_index=defined
    expressions append addressof:(e failure_index+1)
  if failure2_index=defined
    e local_variable e:(failure2_index+1) Str
    expressions append addressof:(e failure2_index+2)
  var List functions ; var Link:Type type
  module define "control" addressof:(the_meta control)
  module define "modify" addressof:(the_meta modify)
  module define "ignore" addressof:(the_meta ignore)
  module define "pliant shared" addressof:byaddress
  module define "share" addressof:(the_meta 'pliant share ar
  var Link:Dictionary modify :> new Dictionary
  module define "pliant remote modify" addressof:modify
  var Link:Dictionary ignore :> new Dictionary
  module define "pliant remote ignore" addressof:ignore
  e freeze expressions byaddress functions type
  module rewind mark
  void ?
  var Pointer:Arrow ba :> byaddress first
  while ba<>null
    ignore insert (cast (ba map Ident) Str) true addressof:v
    ba :> byaddress next ba
  var Link:RemoteFunction fun :> new RemoteFunction
  fun body :> functions:first map Function
  fun type :> type
  fun id := id
  fun site_offset := type offset "remote site"
  fun host_offset := type offset "remote host"
  fun rejected_offset := type offset "remote rejected"
  for (var Int i) 0 type:nb_fields-1
    var Pointer:TypeField tf :> type field i
    if (tf:name search " " -1)=(-1) and (ignore first tf:nam
      if ls_index=undefined or tf:name<>e:(ls_index+1):ident
        if rs_index=undefined or tf:name<>e:(rs_index+1):ide
          if failure2_index=undefined or tf:name<>e:(failure
            var Pointer:Function conv :> tf:type get_generic
            if not exists:conv or conv=(the_function '. to s
              error error_id_compile "Cannot convert '"+tf:n
              return
            fun:ro_dict insert tf:name i
            fun ro_list += i
            if (modify first tf:name)<>null
              fun:rw_dict insert tf:name i
              fun rw_list += i
  var Pointer:Arrow c :> functions first
  if ls_index=defined
    c :> functions next c
    fun local_streaming :> c map Function
    fun ls_offset := type offset e:(ls_index+1):ident
  if rs_index=defined
    c :> functions next c
    fun remote_streaming :> c map Function
    fun rs_offset := type offset e:(rs_index+1):ident
  if success_index=defined
    c :> functions next c
    fun success_code :> c map Function
  if failure_index=defined
    c :> functions next c
    fun failure_code :> c map Function
  if failure2_index=defined
    c :> functions next c
    fun failure_code :> c map Function
    fun message_offset := type offset e:(failure2_index+1):i
  e add (instruction (the_function remote_execute DelayedAct
  var Link:Argument adr :> argument local Address
  e add (instruction (the_function '. get_address' DelayedAc
  var Pointer:Int index :> fun:ro_list first
  while exists:index
    var Pointer:TypeField tf :> fun:type field index
    var Pointer:Arrow c :> pliant_general_dictionary first t
    if c<>null and entry_type:c=LocalVariable
      var Link:LocalVariable l :> c map LocalVariable
      var Link:Argument field :> argument indirect Address a
      e add (instruction (the_function 'copy Universal' Univ
    index :> fun:ro_list next index
  remote_sem request
  remote_functions remove id null
  remote_functions insert id true addressof:fun
  remote_sem release
  e set_void_result


method stream file_send filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Stat
  var FileInfo info := file_query filename standard
  if info=undefined
    stream writeline ""
  fun rejected_offset := type offset "remote rejected"
  for (var Int i) 0 type:nb_fields-1
    var Pointer:TypeField tf :> type field i
    if (tf:name search " " -1)=(-1) and (ignore first tf:nam
      if ls_index=undefined or tf:name<>e:(ls_index+1):ident
        if rs_index=undefined or tf:name<>e:(rs_index+1):ide
          if failure2_index=undefined or tf:name<>e:(failure
            var Pointer:Function conv :> tf:type get_generic
            if not exists:conv or conv=(the_function '. to s
              error error_id_compile "Cannot convert '"+tf:n
              return
            fun:ro_dict insert tf:name i
            fun ro_list += i
            if (modify first tf:name)<>null
              fun:rw_dict insert tf:name i
              fun rw_list += i
  var Pointer:Arrow c :> functions first
  if ls_index=defined
    c :> functions next c
    fun local_streaming :> c map Function
    fun ls_offset := type offset e:(ls_index+1):ident
  if rs_index=defined
    c :> functions next c
    fun remote_streaming :> c map Function
    fun rs_offset := type offset e:(rs_index+1):ident
  if success_index=defined
    c :> functions next c
    fun success_code :> c map Function
  if failure_index=defined
    c :> functions next c
    fun failure_code :> c map Function
  if failure2_index=defined
    c :> functions next c
    fun failure_code :> c map Function
    fun message_offset := type offset e:(failure2_index+1):i
  e add (instruction (the_function remote_execute DelayedAct
  var Link:Argument adr :> argument local Address
  e add (instruction (the_function '. get_address' DelayedAc
  var Pointer:Int index :> fun:ro_list first
  while exists:index
    var Pointer:TypeField tf :> fun:type field index
    var Pointer:Arrow c :> pliant_general_dictionary first t
    if c<>null and entry_type:c=LocalVariable
      var Link:LocalVariable l :> c map LocalVariable
      var Link:Argument field :> argument indirect Address a
      e add (instruction (the_function 'copy Universal' Univ
    index :> fun:ro_list next index
  remote_sem request
  remote_functions remove id null
  remote_functions insert id true addressof:fun
  remote_sem release
  e set_void_result


method stream file_send filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Stat
  var FileInfo info := file_query filename standard
  if info=undefined
    stream writeline ""
    stream writeline "failure"
    if (options option "recover")
      stream writeline "failure"
    return failure
  stream writeline "datetime "+(string info:datetime)
  stream writeline "size "+(string info:size)
  stream writeline ""
  var Intn remain := info size
  (var Stream data) open filename in+safe
    return failure
  stream writeline "datetime "+(string info:datetime)
  stream writeline "size "+(string info:size)
  stream writeline ""
  var Intn remain := info size
  (var Stream data) open filename in+safe
  while remain>0 and { var Int step := raw_copy data stream 
  while remain>0 and { var Int step := raw_copy data stream 1 (cast (shunt remain<2^22 remain 2^22) Int) ; step>0 }
    remain -= step
  status := shunt remain=0 success failure
  if (options option "recover")
    if remain>0
      var Address buf := memory_zallocate 4096 null
      while remain>0 and stream=success
    remain -= step
  status := shunt remain=0 success failure
  if (options option "recover")
    if remain>0
      var Address buf := memory_zallocate 4096 null
      while remain>0 and stream=success
        var Int step := shunt remain<4096 (cast remain Int) 
        var Int step := cast (shunt remain<4096 remain 4096) Int
        stream raw_write buf step
        remain -= step
      memory_free buf
    stream writeline (shunt status=success "success" "failur
  else
    if status=failure
      stream error "Failed to send file "+filename
  if stream=failure
    status := failure


method stream file_tree_send path options -> status
  arg_rw Stream stream ; arg Str path options ; arg Status s
  status := success
  var Array:FileInfo files := file_list path standard+recurs
  for (var Int i) 0 files:size-1
    stream writeline "file "+(string files:i:name)
        stream raw_write buf step
        remain -= step
      memory_free buf
    stream writeline (shunt status=success "success" "failur
  else
    if status=failure
      stream error "Failed to send file "+filename
  if stream=failure
    status := failure


method stream file_tree_send path options -> status
  arg_rw Stream stream ; arg Str path options ; arg Status s
  status := success
  var Array:FileInfo files := file_list path standard+recurs
  for (var Int i) 0 files:size-1
    stream writeline "file "+(string files:i:name)
    if (stream file_send path+files:i:name)=failure
    if (stream file_send path+files:i:name options)=failure
      status := failure
  stream writeline "end of file tree"


method stream file_receive filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Stat
  var Intn remain := 0 ; var DateTime dt := undefined
  while { var Str l := stream readline ; l<>"" }
    l parse word:"size" remain
    l parse word:"datetime" dt
      status := failure
  stream writeline "end of file tree"


method stream file_receive filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Stat
  var Intn remain := 0 ; var DateTime dt := undefined
  while { var Str l := stream readline ; l<>"" }
    l parse word:"size" remain
    l parse word:"datetime" dt
  var Str temp := file_temporary filename ""
  var Str temp := file_temporary filename options
  (var Stream data) open temp out+safe
  (var Stream data) open temp out+safe
  while remain>0 and { var Int step := raw_copy stream data 
  while remain>0 and { var Int step := raw_copy stream data 1 (cast (shunt remain<2^22 remain 2^22) Int) ; step>0 }
    remain -= step
  status := shunt remain=0 success failure
  if data:close=failure
    status := failure
  if (options option "recover")
    if stream:readline<>"success"
      status := failure
  if status=success
    file_configure temp "datetime "+string:dt
    file_move temp filename
  else
    file_delete temp


    remain -= step
  status := shunt remain=0 success failure
  if data:close=failure
    status := failure
  if (options option "recover")
    if stream:readline<>"success"
      status := failure
  if status=success
    file_configure temp "datetime "+string:dt
    file_move temp filename
  else
    file_delete temp



method stream file_tree_receive path options -> status
  arg_rw Stream stream ; arg Str path options ; arg Extended
  status := success
  while { var Str l := stream readline ; l parse word:"file"
    file_tree_create path+filename
method stream file_tree_receive path options -> status
  arg_rw Stream stream ; arg Str path options ; arg Extended
  status := success
  while { var Str l := stream readline ; l parse word:"file"
    file_tree_create path+filename
    if (stream file_receive path+filename)=failure
    if (stream file_receive path+filename options)=failure
      status := failure "File '"+filename+"' is corrupted"
  if l<>"end of file tree" and status=success
    status := failure "File tree is corrupted"
  
method stream file_tree_receive path -> status
  arg_rw Stream stream ; arg Str path ; arg ExtendedStatus s
  status := stream file_tree_receive path ""

      status := failure "File '"+filename+"' is corrupted"
  if l<>"end of file tree" and status=success
    status := failure "File tree is corrupted"
  
method stream file_tree_receive path -> status
  arg_rw Stream stream ; arg Str path ; arg ExtendedStatus s
  status := stream file_tree_receive path ""


export '. is_one_of'
export '. file_send' '. file_tree_send' '. file_receive' '. 

export '. is_one_of'
export '. file_send' '. file_tree_send' '. file_receive' '.