[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
        }
    }
 }
======

[abc] - 2017-08-20

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 [::tcl::pkgconfig get libdir,install]/tkconclient
 # 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]]
======

Edit by abc: nick change abc->ccbbaa ; reason: abc is not searchable

----

[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.








<<categories>> Debugging | Networking