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"

module "/pliant/protocol/dns/client.pli" # force using Pliant names database

(gvar TraceSlot remote_trace) configure "remote execution client"


function execute_within_context a f
  arg Address a ; arg Function f
  indirect

function remote_execute da fun server
  arg_rw DelayedAction da ; arg RemoteFunction fun ; arg Str server
  (var TraceSession log) bind remote_trace
  if server=computer_fullname
    if not (exists fun:local_streaming) and not (exists fun:remote_streaming)
      if fun:site_offset=defined
        (da:parameter translate Byte fun:site_offset) map Str := computer_fullname
      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_offset) map Str
  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=defined port remote_tcp_port)+"/"+computer_fullname in+out+safe
  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 tf:offset) tf:type ""
    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 Str value))
      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) tf:type value ""
        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=defined
      (da:parameter translate Byte fun:ls_offset) map Address := addressof s
      execute_within_context da:parameter fun:local_streaming
    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



dual_keyword remote 2 14 local_streaming 2 2
dual_keyword remote 2 14 remote_streaming 2 2
dual_keyword remote 2 14 success 1 1
dual_keyword remote 2 14 failure 1 2

method da get_address -> a
  arg DelayedAction da ; arg Address a
  a := da parameter

constant to_index (the_function '. to string' Universal Str -> Str):generic_index

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

meta control e
  if e:size=2
    e compile_as (expression duplicate control_prototype substitute v e:0 substitute c e:1)

method type offset field_name -> offset
  arg Type type ; arg Str field_name ; arg Int offset
  for (var Int i) 0 type:nb_fields-1
    var Pointer:TypeField tf :> type field i
    if tf:name=field_name
      return tf:offset
  offset := undefined

meta modify e
  var Pointer:Arrow r :> e:module first "pliant remote modify"
  if r=null or entry_type:r<>Dictionary
    return
  var Pointer:Dictionary modify :> r map Dictionary
  if e:size<1
    return
  for (var Int i) 0 e:size-1
    if not e:i:is_pure_ident
      return
  for (var Int i) 0 e:size-1
    e:i compile ?
  for (var Int i) 0 e:size-1
    modify insert e:i:ident true addressof:void
  if e:size=1
    e set_result e:0:result e:0:access
  else
    e set_void_result

meta ignore e
  var Pointer:Arrow r :> e:module first "pliant remote ignore"
  if r=null or entry_type:r<>Dictionary
    return
  var Pointer:Dictionary ignore :> r map Dictionary
  if e:size<1
    return
  for (var Int i) 0 e:size-1
    if not e:i:is_pure_ident
      return
  for (var Int i) 0 e:size-1
    e:i compile ?
  for (var Int i) 0 e:size-1
    ignore insert e:i:ident true addressof:void
  if e:size=1
    e set_result e:0:result e:0:access
  else
    e set_void_result

meta remote e
  var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
  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)<>null
    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):ident<>"" and e:(i+2):ident="{}"
      ls_index := i
      i += 3
    eif i+2<e:size and e:i:ident="remote_streaming" and e:(i+1):ident<>"" and e:(i+2):ident="{}"
      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="{}" and failure2_index=undefined
      failure_index := i
      i += 2
    eif i+2<e:size and e:i:ident="failure" and e:(i+1):ident<>"" and e:(i+2):ident="{}" and failure_index=undefined
      failure2_index := i
      i += 3
    else
      console "i = " i eol
      return
  e suckup e:0
  var Pointer:Module module :> e module ; var Address mark := module 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 arguments')
  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:void
    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:name)=null
      if ls_index=undefined or tf:name<>e:(ls_index+1):ident
        if rs_index=undefined or tf:name<>e:(rs_index+1):ident
          if failure2_index=undefined or tf:name<>e:(failure2_index+1):ident
            var Pointer:Function conv :> tf:type get_generic_method to_index
            if not exists:conv or conv=(the_function '. to string' Universal Str -> Str)
              error error_id_compile "Cannot convert '"+tf:name+"' to a string that could be passed to the remote computer."
              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):ident
  e add (instruction (the_function remote_execute DelayedAction RemoteFunction Str) body:result (argument mapped_constant RemoteFunction fun) e:0:result)
  var Link:Argument adr :> argument local Address
  e add (instruction (the_function '. get_address' DelayedAction -> Address) body:result adr)
  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 tf:name
    if c<>null and entry_type:c=LocalVariable
      var Link:LocalVariable l :> c map LocalVariable
      var Link:Argument field :> argument indirect Address adr tf:offset
      e add (instruction (the_function 'copy Universal' Universal Universal Type) field l:body (argument mapped_constant Type tf:type))
    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

export remote


#--------------------------------------------------------------------------

module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"


method item is_one_of set -> c
  arg Str item set ; arg CBool c
  c := (" "+set+" " search " "+item+" " -1)<>(-1)


method stream file_send filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Status status
  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
  while remain>0 and { var Int step := raw_copy data stream 1 (shunt remain<2^24 (cast remain Int) 2^24) ; step<>0 }
  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
        var Int step := shunt remain<4096 (cast remain Int) 4096
        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" "failure")
  else
    if status=failure
      stream error "Failed to send file "+filename
  if stream=failure
    status := failure

method stream file_send filename -> status
  arg_rw Stream stream ; arg Str filename ; arg Status status
  status := stream file_send filename ""


method stream file_tree_send path options -> status
  arg_rw Stream stream ; arg Str path options ; arg Status status
  status := success
  var Array:FileInfo files := file_list path standard+recursive+relative
  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_tree_send path -> status
  arg_rw Stream stream ; arg Str path ; arg Status status
  status := stream file_tree_send path ""


method stream file_receive filename options -> status
  arg_rw Stream stream ; arg Str filename options ; arg Status status
  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
  while remain>0 and { var Int step := raw_copy stream data 1 (shunt remain<2^24 (cast remain Int) 2^24) ; step<>0 }
  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

method stream file_receive filename -> status
  arg_rw Stream stream ; arg Str filename ; arg Status status
  status := stream file_receive filename ""


method stream file_tree_receive path options -> status
  arg_rw Stream stream ; arg Str path options ; arg ExtendedStatus status
  status := success
  while { var Str l := stream readline ; l parse word:"file" (var Str filename) }
    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 status
  status := stream file_tree_receive path ""


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