Rshd and Rcp in Tcl

This is a Tcl implentation of the Unix Remote Shell Server (rshd) and it also supports the remote copy command (rcp). I use it to save and load Cisco device configuration files and software images. I have not tested it with the rsh commands from a Unix host. You may need to tighten the security but I will leave that to others.

In the future I hope to combine it with TclHttpd Jeff Smith

Jeff Smith 22-Oct-2004: "Receptacle" is a Starkit of a Rcp Server combined with TclHttpd available at [L1 ].


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