Thank you for your prompt answer.
Anyway, I found a way to access an openacs thread without any changes to tkcon. If I open an openacs shell and input the code below, it will open a server socket which may be attached to a tkcon (even in a remote machine, of course). The code is mostly adapted from tkconclient. It will rest connected for indefinite time, althout the web client (firefox, for instance) will report a time out. Doesn't matter. Tkcon will keep connected to aolserver thread and will be able to introspect everything and interact with the interpreter. That's exactly what I wanted!
There is just one thing I have to do. Integrate this code in Developer Support, so I don't have to cut-n-paste in the openacs shell everytime... I have to learn a little yet on how to do this.
Here is the code (paste into openacs shell, press "ok", run tkcon and attach it to socket <your_server>,port 8765):
namespace eval ::tkconclient {
variable script ""
variable server ""
variable socket ""
variable wait ""
namespace export start stop
proc start {port {myaddr localhost}} {
variable socket
variable server
if {$socket ne "" || $server ne ""} stop
set server [socket -server [namespace current]::accept \
-myaddr $myaddr $port]
}
proc stop {} {
variable server
if {$server ne ""} {
closesocket
close $server
set server ""
}
}
proc closesocket {} {
variable socket
catch {close $socket}
set socket ""
# Restore [puts]
rename ::puts ""
rename [namespace current]::puts ::puts
}
proc accept {sock host port} {
variable socket
fconfigure $sock -blocking 0 -buffering none
if {$socket ne ""} {
puts $sock "Only one connection at a time, please!"
close $sock
} else {
set socket $sock
fileevent $sock readable [namespace current]::handle
# Redirect [puts]
rename ::puts [namespace current]::puts
interp alias {} ::puts {} [namespace current]::_puts
}
}
proc handle {} {
variable script
variable socket
if {[eof $socket]} {
closesocket
return
}
if {![catch {read $socket} chunk]} {
if {$chunk eq "bye\n"} {
puts $socket "Bye!"
closesocket
return
}
append script $chunk
if {[info complete $script]} {
catch {uplevel "#0" $script} result
if {$result ne ""} {
puts $socket $result
}
set script ""
}
} else {
closesocket
}
}
## This procedure is partially borrowed from tkcon
proc _puts args {
variable socket
set len [llength $args]
foreach {arg1 arg2 arg3} $args { break }
switch $len {
1 {
puts $socket $arg1
}
2 {
switch -- $arg1 {
-nonewline - stdout - stderr {
puts $socket $arg2
}
default {
set len 0
}
}
}
3 {
if {$arg1 eq "-nonewline" &&
($arg2 eq "stdout" || $arg2 eq "stderr")} {
puts $socket $arg3
} elseif {($arg1 eq "stdout" || $arg1 eq "stderr") \
&& $arg3 eq "-nonewline"} {
puts $socket $arg2
} else {
set len 0
}
}
default {
set len 0
}
}
## $len == 0 means it wasn't handled above.
if {$len == 0} {
global errorCode errorInfo
if {[catch [linsert $args 0 puts] msg]} {
regsub tkcon_tcl_puts $msg puts msg
regsub -all tkcon_tcl_puts $errorInfo puts errorInfo
return -code error $msg
}
return $msg
}
}
}
::tkconclient::start 8765 [ns_info address]
vwait ::tkconclient::wait
::tkconclient::stop
ReturnHeaders
ns_write "Remote Tkcon connection server stopped!"
