PT 14-Jul-2004: Security - with rsh? That would be 'use ssh' then :) There is also rexec kicking around. How do you feel about contributing this as tcllib module?Jeff Smith 15-Jul-2004: That would be great! I checked the tcllib page on the wiki but I don't have the necessary skill set to meet the "ground rules" required to make it a module. If others wish to, feel free!! :)DKF 22-Oct-2004: Seriously, ssh is what you should use if at all possible.
# Rshd.tcl is an implementation of the Unix Remote Shell Server and
# also supports the remote copy command (rcp). This is an enhanced
# version of Victor Wagner's "Rshd for Windows". Thanks to Victor and
# all those who have contributed to the Tcler's Wiki.
#
# Testing has been done using Cisco switches and routers which support
# the rcp command. It can copy "to" and "from" the device, configuration
# files and software images.
# Set mynet to the IP address or IP address starting with.
# eg 10.8.200.11 or 10 or 10.8 or 10.8.200
set mynet {10}
proc Rshd_Accept {sock remote port} {
global Rshd mynet
upvar #0 Rshd$sock data
if {$port>1024||![regexp "$mynet" $remote]} {
puts "Refused connection from $remote:$port"
close $sock
} else {
puts "Accepted connection $sock from $remote:$port"
fileevent $sock readable "RshdGet $sock"
set data(remote) $remote
}
}
proc RshdGet {sock} {
global Rshd errorCode
upvar #0 Rshd$sock data
if [eof $sock] {
close $sock
} else {
if {[info exist data(rcpflag)]} {
if {[catch {rcp_control $sock} err]} {
puts $err
unset data
close $sock
} else {
return
}
} else {
fconfigure $sock -blocking 0 -buffering none
append data(line) [read $sock ]
if {[regexp "(.*)\0(.*)\0(.*)\0(.*)\0$" $data(line)]} {
set l [split $data(line) "\0"]
set data(stderr) [lindex $l 0]
set data(remote_user) [lindex $l 1]
set data(local_user) [lindex $l 2]
set data(command) [lindex $l 3]
set address 770
if {$data(stderr)==""||$data(stderr)==0} {
# if no port for stderr supplied
set result stdout
} else {
while {[catch {socket -myport $address\
$data(remote) $data(stderr)} result]} {
if {[lindex $errorCode 1]=="EADDRINUSE"} {
incr address
} else {
puts $result
return
}
}
}
set data(stderr) $result
parray ::Rshd$sock
puts ""
if [ catch {eval $data(command)} res] {
puts $data(stderr) $res
unset data
close $sock
} else {
puts -nonewline $sock $res
}
} else {
return
}
}
}
}
proc rcp {direction copy_file} {
global Rshd
upvar sock sock
upvar #0 Rshd$sock data
switch -exact -- $direction {
-t {
set data(rcpflag) t1
set data(copy_file) $copy_file
puts -nonewline $sock "\0\0"
return ""
}
-f {
set data(rcpflag) "f1"
send_file $sock $copy_file
return
}
}
}
proc receive_file {sock copy_file} {
global Rshd
upvar #0 Rshd$sock data
set data(transferID) [lindex $data(line) 0]
set data(fileSize) [lindex $data(line) 1]
set data(fileName) [lindex $data(line) 2]
set data(rcpflag) t2
puts -nonewline $sock "\0"
return
}
proc copy_data {sock} {
global Rshd
upvar #0 Rshd$sock data
if {![info exists data(copy_run)]} {
set data(copy_run) 1
set fully_qualified_filename [file join [pwd] $data(copy_file)]
set fp [open $fully_qualified_filename w]
fconfigure $sock -translation binary
fconfigure $fp -translation binary
fcopy $sock $fp -size $data(fileSize) -command [list copy_data_done $fp $sock]
return
} else {
return
}
}
proc copy_data_done {fp sock bytes {error {}}} {
global Rshd
upvar #0 Rshd$sock data
close $fp
set data(rcpflag) t3
}
proc rcp_control {sock} {
global Rshd
upvar #0 Rshd$sock data
switch -exact -- $data(rcpflag) {
"t1" {
set data(line) [read $sock ]
receive_file $sock $data(copy_file)
return
}
"t2" {
copy_data $sock
return
}
"t3" {
set data(line) [read $sock ]
if {[string match $data(line) "\0"]} {
puts -nonewline $sock "\0\0"
set data(rcpflag) t4
return
}
}
"t4" {
unset data
close $sock
return
}
"f1" {
set data(line) [read $sock ]
if {[string match $data(line) "\0"]} {
set data(rcpflag) f2
puts -nonewline $sock "C0644 $data(fileSize) $data(copy_file)\n"
return
}
}
"f2" {
set data(line) [read $sock ]
if {[string match $data(line) "\0"]} {
send_copy $sock
return
}
}
}
}
proc send_file {sock copy_file} {
global Rshd
upvar #0 Rshd$sock data
if {[file exists $copy_file]} {
set data(copy_file) $copy_file
set data(fileSize) [file size $copy_file]
puts -nonewline $sock "\0"
return
} else {
error "No such file \"$copy_file\"!"
}
}
proc send_copy {sock} {
global Rshd
upvar #0 Rshd$sock data
if {![info exists data(copy_send)]} {
set data(copy_send) 1
set fully_qualified_filename [file join [pwd] $data(copy_file)]
set fp [open $fully_qualified_filename r]
fconfigure $fp -translation binary
fconfigure $sock -translation binary
fcopy $fp $sock -size $data(fileSize) -command [list send_copy_done $fp $sock]
return
} else {
return
}
}
proc send_copy_done {fp sock bytes {error {}}} {
global Rshd
upvar #0 Rshd$sock data
close $fp
unset data
close $sock
return
}
socket -server Rshd_Accept 514
vwait forever