Tcl中主解释器和从解释器之间的通信

Communication between master interpreter and slave interpreters in Tcl

我正在研究 Tcl 套接字通信,实际上我正在评估 java 客户端发送到 tcl 服务器的命令。根据每个客户的新请求,我正在创建新的 interp 并在连接关闭时将其删除。

基础代码参考了其他question & answer.

到目前为止,Java 代码没有问题。

proc writeJavaUTF {stream string} {
     set data [encoding convertto utf-8 $string]
     if {[string length $data] > 0xffff} {
         error "string to long after encoding"
     }
     set len [binary format S [string length $data]]
     puts -nonewline $stream $len$data
     flush $stream
 }

 proc readJavaUTF {stream} {
     binary scan [read $stream 2] S len
     if {[info exists len]} {
     set data [read $stream [expr {$len & 0xffff}]]
     return [encoding convertfrom utf-8 $data]
     } else {
        return "NULL"
     }
 }


set svcPort 9999

proc svcHandler {sock} {
  global tclEngine
  puts "receiving socket request from $sock"
  set userTclCmd [readJavaUTF $sock]; # Reading the user commands over socket 
  puts "The command received from user : $userTclCmd"
  if {[eof $sock]} {
     puts "Socket $sock is closing it's connection. Going to delete it's interpreter"
     interp delete $tclEngine($sock)
     close $sock
  } else {
    catch {interp eval $tclEngine($sock) $userTclCmd} cmdResponse
    puts "My response : $cmdResponse"
    writeJavaUTF $sock $cmdResponse; # Writing the response over socket 
  }
}
proc accept {sock addr port} {
  # Once connection is made, then creating a new slave interpreter 
  # for the client
  global tclEngine
  set tclEngine($sock) [interp create]
  fileevent $sock readable [list svcHandler $sock]
  fconfigure $sock -buffering line -blocking 0 -translation binary
  puts "Accepted socket connection from $addr on port $port "
}

#Tcl Array Engine to hold reference of all the client Tcl interpreters
array set tclEngine {}
# Listening for client requests
socket -server accept $svcPort
puts "I am waiting ..."
vwait events

对于 readJavaUTF,我已经从我这边添加了一张支票。

if {[info exists len]} {

}

问题 1: 当连接从客户端关闭时,通过 client.close() 的方式同时调用 readJavaUTF。为什么 ?早些时候,我已经按照您的(即 Mr.Donal 的代码)answer 清楚地使用了版本。

但是,我得到了以下错误

can't read "len": no such variable
    while executing
"expr {$len & 0xffff}"
    (procedure "readJavaUTF" line 4)
    invoked from within
"readJavaUTF $sock"
    (procedure "svcHandler" line 4)
    invoked from within
"svcHandler sock280"

为了处理这个问题,我刚刚添加了那段代码。

问题 2 : 如何从奴隶与主口译员互动,反之亦然。比如说,我必须从主人的全局 space 访问一个变量。那可能吗 ?在此之前,无论我现在采用哪种方法都是好的?还有其他建议或改进吗?

您不能直接访问主解释器中的变量。您需要在主服务器中实现一个命令,并在从服务器中使用别名来执行此操作。像

% interp alias slave shadow {} variable_access
shadow
% proc variable_access {var args} { uplevel #0 [list set $var {*}$args] }
% set x 2
2
% slave eval {shadow x}
2
% slave eval {shadow x 5}
5
% slave eval {shadow x}
5

您不想按原样使用上面的内容,因为您将失去所有保护。检查允许的特定变量名称,可能只允许读取。

您或许能够在从站中使用跟踪来提供直接变量访问的错觉。

第一个问题:文件事件回调中的文件结束处理

Tcl 在异常情况发生时调用读取回调。在执行 read.

之后,您应该使用 eof 命令来检查这类事情
set data [read $stream 2]
if {[string length $data] == 0 && [eof $data]} {
    # Closing unregisters all fileevent handlers too
    close $stream
    return
}
binary scan $data S len

第二个问题:解释器之间共享变量

解释器之间根本不共享变量。虽然 Tcl 有全局变量并且经常使用它们,但它们 对于那个解释器是全局的。所有其他解释器都有自己的变量。 (例外是 env,它实际上是全局共享的。仅将其用于将信息传递给子进程或从 OS 获取信息;它比几乎所有其他方法都慢得多。)

命令可以在从解释器中使用别名(interp alias),以便它们可以由主解释器执行。这种机制有点类似于系统调用的工作方式,它允许从设备访问完全可控的功能配置文件;任何没有别名的(并且不是由奴隶内部实现的)都是完全无法企及的。然后,您可以轻松地使用它以安全的方式实现对 master 中变量的访问。

proc read_my_vars {permittedList varName {value ""}} {
    if {$varName ni $permittedList} {
        return -code error "no such variable \"$varName\""
    }
    upvar "#0" $varName var
    return $var
}
proc write_my_vars {permittedList varName value} {
    if {$varName ni $permittedList} {
        return -code error "no such variable \"$varName\""
    }
    upvar "#0" $varName var
    set var $value
}

interp alias $slave READ {} read_my_vars {a b c}
interp alias $slave WRITE {} write_my_vars {a b c}
set a 1
set b 2
set c 3

$slave eval {
    puts "a = [READ a]"
}

您甚至可以在从站中使用跟踪来使其透明化:

$slave eval {
    trace add variable a read {apply {args {READ a}}}
    trace add variable a write {apply {args {global a;WRITE a $a}}}
}

$slave eval {
    puts "a = $a"
}