Patch title: Release 92 bulk changes
Abstract:
File: /util/remote/server.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/data/string_cast.pli"
submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/util/crypto/channel.pli"
module "/pliant/fullpliant/this_computer.pli"
module "common.pli"

(gvar TraceSlot remote_trace) configure "remote execution server"

function tcp_port -> port
  arg Int port
  if not (this_computer:env:"pliant":"remote":"port" parse port)
    port := remote_tcp_port

public
  type RemoteServer
    tcp_server_fields "Remote execution" constant:tcp_port
TcpServer maybe RemoteServer

function build server
  arg_w RemoteServer server
  server:channel size := 1
  server:channel 0 := "channel:/server/"+string:tcp_port


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

method remote service s
  arg_rw RemoteServer remote ; arg_rw Stream s
  (var TraceSession log) bind remote_trace
  var Str cmd := s readline
  log trace "command " cmd
  if not (cmd parse word:"call" any:(var Str id))
    return
  remote_sem rd_request
  var Pointer:Arrow c :> remote_functions first id
  if c=null
    var Str module_name := id 0 (id search " " 0)
    if (reverse:module_name parse (pattern reverse:".remote") any)
      remote_sem rd_release
      pliant_compiler_semaphore request
      pliant_load_module module_name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
      pliant_compiler_semaphore release
      remote_sem rd_request
      var Pointer:Arrow c :> remote_functions first id
    if c=null
      remote_sem rd_release
      s writeline "failure "+(string "function "+id+" is not available on "+computer_fullname)
      log trace "function "+id+" is not available on "+computer_fullname
      s writeline ""
      return
  var Link:RemoteFunction fun :> c map RemoteFunction
  remote_sem rd_release
  var Address buf ; buf := memory_allocate fun:type:size null
  fun:type build_instance buf
  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:ro_dict first variable
      if exists:index
        var Pointer:TypeField tf :> fun:type field index
        from_string (buf translate Byte tf:offset) tf:type value ""
        log trace "input " variable " " value
  var Str site := s safe_query "remote_site"
  var Str host := s safe_query "remote_site"
  var CBool rejected
  if site<>""
    if fun:site_offset=defined
      (buf translate Byte fun:site_offset) map Str := site
  if host<>""
    if fun:host_offset=defined
      (buf translate Byte fun:host_offset) map Str := host
    if fun:rejected_offset=defined
      (buf translate Byte fun:rejected_offset) map CBool := false
    execute_within_context buf fun:body
    rejected := fun:rejected_offset=defined and ((buf translate Byte fun:rejected_offset) map CBool)
    if rejected
      s writeline "failure [dq]rejected by control rule[dq]"
      log trace "rejected by control rule"
  else
    rejected := true
    s writeline "failure [dq]failed to get site identity[dq]"
    log trace "failed to get site identity"
  if not rejected
    var Pointer:Int index :> fun:rw_list first
    while exists:index
      var Pointer:TypeField tf :> fun:type field index
      var Str value := to_string (buf translate Byte tf:offset) tf:type ""
      s writeline "set "+tf:name+" "+value
      log trace "output " tf:name " " value
      index :> fun:rw_list next index
  s writeline ""
  if not rejected
    s flush async
    if (exists fun:remote_streaming) and fun:rs_offset=defined
      (buf translate Byte fun:rs_offset) map Address := addressof s
      execute_within_context buf fun:remote_streaming
  fun:type destroy_instance buf
  memory_free buf


define_tcp_server RemoteServer remote_server
export remote_server