Tkcon Remote Access over TCP Sockets

Reinhard Max - 2005-09-12

This piece of code can be added to any Tcl application to allow remote access from tkcon (or even telnet or netcat). To open the debugging socket, call

 tkconclient::start port ?myaddr?

The default value for myaddr is localhost. Applications that want to use this code need to run the Tcl event loop. When a remote connection exists, [puts] output to stdout and stderr is redirected to the socket.

The code doesn't currently support concurrent client connections. Subsequent connection attempts are rejected if a connection is established already.

If the remote access capability isn't needed anymore, the command tkconclient::stop can be used to shut down the server socket, and the current client connection if there exists one. To shut down a client connection from the remote side, the word bye can be sent as a pseudo-command.

There is currently no access control to the socket!, so care must be taken, especially when opening debugging connections on a publically accessible interface.

 # save this file as tkconclient.tcl then also save pkgIndex.tcl from lower on this page +abc
 package require Tk                  ;# can also run under tclsh with vwait event loop   +abc
 package provide tkconclient 0.1     ;# bogus version number                             +abc 20.08.2017

 namespace eval tkconclient {
    variable script ""
    variable server ""
    variable socket ""
    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
        }
    }
 }

ccbbaa - 2017-08-20 + Edit by abc: nick change abc->ccbbaa ; reason: abc is not searchable ccbbaa - 20180526 - changed comments for pkgIndex file below

Since a complete tkconclient package could only be found in androwish (!) I edited the wiki to add the key headers above at +abc and the pkgIndex.tcl here.

 # save this file as pkgIndex.tcl ; copy this file and tkconclient.tcl to
 # a suitable path from $auto_path, for example if /usr/share/tcltk/tcllib1.18
 # exists, then make the directory under /usr/share/tcltk/
 # pkgIndex file for tkconclient; bogus version number 0.1
 if { ![package vsatisfies [package provide Tcl] 8.4] } { return }
 package ifneeded tkconclient 0.1 [list source [file join $dir tkconclient.tcl]]

The following code is due to chw and his androwish examples. tkconclient is in androwish. To add a tkconclient to any tcl or tk program:

Note1: remember to enter the event loop using a vwait in tclsh - not needed in wish Note2: there should be some minimal security check, at least that one is on the home network

set ::TkconDebugSocket 12345

if {[info exists ::TkconDebugSocket]} {
  package require tkconclient
  tkconclient::start $::TkconDebugSocket
}

Use:

$ telnet 7.8.9.1 12345

puts $tcl_version; FooUserProc ;# any tcl commands

There is no prompt '#'. Do not paste large pieces of tcl into the terminal without checking the outcome. The tclsh/wish underlying tkconclient reports tcl errors, syntax, etc., as usual, but it can be brought into a nonresponsive state (see below at Caveat). In that case, only stopping the tcl program and restarting it helps. To stop the remote tclsh when it is working (not blocked as below) issue exit. To disable the remote tkconclient socket without exiting the tcl program issue tkconclient::stop. The remote tcl program continues running, but subsequent socket telnet / Tkcon connections are not possible. The socket listener can be restarted using tkconclient::start from within the running program. The original Tkcon gui client can also be used instead of telnet, of course.

Caveat: Using code like:

set in [read stdin 1]

Will block both the socket attached interpreter and the main interpreter (command line), and, possibly the whole gui application under wish. Do not use read or gets on the socket! The relevant stdin redirection is not implemented at all currently ( 20190526 ccbbaa ).


KPV Very cool, I'd not known about this page. It uses some obscure tkcon features which I'm sure many people aren't familiar with. So here's some explicit instructions on how to use this package.

In program you want to be able to debug remotely:

  • load this package either by source tkconclient.tcl or, if you've done the setup described above, package require tkconclient
  • somewhere in your code add, tkconclient::start 9876

Now to remotely control this program:

  • start tkcon
  • click menu Console -> Attach to... -> Socket -> Create Connection
  • enter localhost and 9876

Now everything you type in the tkcon console is sent to your program and it's output is displayed on console.