hkoba Basic idea:
ssh has port forwarding. It is ready-to-run MUX (multiplexer). With this, we can avoid re-inventing a MUX protocol on single ssh stream. Also, we already have proven package for script remoting:
comm.
So, I simply glued these two.
2012-11-11: Now revised version of sshcomm is available on
github
.
#!/usr/bin/tclsh
# -*- mode: tcl; tab-width: 8 -*-
# $Id: 13351,v 1.7 2005-12-19 07:01:24 jcw Exp $
#
# Usage:
#
# set num [sshcomm::client::create $host]
# comm::comm send $num {script...}
package provide sshcomm 0.1
namespace eval ::sshcomm {
namespace eval server {}
namespace eval client {
variable SCRIPT [info script]
}
}
proc ::sshcomm::definition-of-proc {proc} {
set args {}
foreach var [info args $proc] {
if {[info default $proc $var default]} {
lappend args [list $var $default]
} else {
lappend args $var
}
}
list proc $proc $args [info body $proc]
}
proc ::sshcomm::definition {{ns {}}} {
if {$ns == ""} {
return [definition [namespace current]]
} else {
set result {}
append result [list namespace eval $ns {}]\n
foreach proc [info procs [set ns]::*] {
append result [definition-of-proc $proc]\n
}
foreach ns [namespace children $ns] {
# puts "ns=$ns"
append result [definition $ns]\n
}
set result
}
}
proc ::sshcomm::sshcmd {} {
set cmdName [namespace current]::sshcmd/$::tcl_platform(platform)
if {[info procs $cmdName] != ""} {
$cmdName
} else {
return "ssh -T"
}
}
proc ::sshcomm::sshcmd/windows {} {
return plink
}
#########################################
# Server
#
proc ::sshcomm::create-comm {port listen args} {
lappend args -port $port -listen $listen
if {[info exists ::comm::comm]} {
eval [list ::comm::comm config] $args
} else {
namespace eval ::comm {variable comm; array set comm {comm,port 0}}
package require comm
unset ::comm::comm(comm,port)
eval [list ::comm::comm new ::comm::comm] $args
}
}
proc ::sshcomm::server::create {port args} {
::sshcomm::create-comm $port 1
puts "OK port $port"
fileevent stdin readable [list [namespace current]::terminator stdin]
keepalive
vwait [namespace current]::forever
}
proc ::sshcomm::server::keepalive {{sec 30}} {
puts [clock seconds]
variable keepalive_id [after [expr {$sec * 1000}] \
[namespace code [info level 0]]]
}
proc ::sshcomm::server::terminator {fh args} {
set count [gets $fh line]
if {$count < 0} {
close $fh
exit
}
if {$count > 0} {
uplevel \#0 $line
}
}
#########################################
# Client
#
proc ::sshcomm::client::probe-available-port host {
package require comm
# To recycle local listener port
set local [comm::comm self]
comm::comm destroy
::comm::comm new ::comm::comm
eval [list lappend cmd] [sshcomm::sshcmd]
lappend cmd $host tclsh
lappend cmd << {
package require comm
puts [comm::comm self]
}
set remote [eval [list exec] $cmd]
list $local $host $remote
}
# ::sshcomm::client::create --
#
#
#
# Arguments:
# host remote hostname.
#
# Results:
# comm id.
proc ::sshcomm::client::create host {
set forward [probe-available-port $host]
if {[llength $forward] != 3} {
error "Can't detect available ports for $host"
}
eval [list create-forward] $forward
}
proc ::sshcomm::client::create-forward {lport host rport} {
set fh [connect $lport $host $rport]
setup-server $fh $rport
wait-server $lport $fh $rport
}
proc ::sshcomm::client::connect {lport host rport} {
variable $lport; upvar 0 $lport data
set cmd "| [sshcomm::sshcmd] -L $lport:localhost:$rport $host"
append cmd " tclsh"
set fh [open $cmd w+]
fconfigure $fh -buffering line
array set data [list fh $fh host $host rport $rport]
set fh
}
proc ::sshcomm::client::setup-server {fh rport} {
puts $fh {
fconfigure stdout -buffering line
fconfigure stderr -buffering line
}
puts $fh [sshcomm::definition]
puts $fh {}
puts $fh [list ::sshcomm::server::create $rport]
flush $fh
}
proc ::sshcomm::client::wait-server {lport fh rport} {
if {[gets $fh line] <= 0} {
error "Can't invoke sshcomm!"
}
if {$line != "OK port $rport"} {
error "Unknown result: $line"
}
fileevent $fh readable [list gets $fh [namespace current]::last-click]
comm::comm connect $lport
set lport
}
proc ::sshcomm::client::last-click {} {
variable last-click
set last-click
}
proc ::sshcomm::fread {fn} {
set fh [open $fn]
set data [read $fh]
close $fh
set data
}
