dbohdan's implementation

[coders-irc_Bot]

#!/usr/bin/env tclsh
# An event-based netcat clone for Tcl 8.5+, version 0.1.0 (2015-08-13).
# Written by dbohdan.
# License: MIT.

namespace eval ::netcat {
    variable bufferSize 4096
    variable connectionCount 0
    variable connections
}

proc ::netcat::copy-when-readable {chanFrom chanTo} {
    puts -nonewline $chanTo [read $chanFrom $::netcat::bufferSize]
    if {[eof $chanFrom]} {
        close $chanFrom
        delete-connection $chanFrom
    }
}

proc ::netcat::delete-connection chan {
    variable connections
    set n [dict get $connections $chan]
    foreach {key _} [dict filter $connections value $n] {
        dict unset connections $key
    }

    set varName [gen-variable-name $n]
    set $varName 1
}

proc ::netcat::gen-variable-name n {
    return [namespace current]::nc${n}Done
}

proc ::netcat::connect {host port {inputChan stdin} {outputChan stdout}
    {prelude {}}} {

    set socket [socket $host $port]
    fconfigure $socket -blocking 0 -translation binary -buffering none
    fconfigure $inputChan -blocking 0 -translation binary -buffering none
    fconfigure $outputChan -blocking 0 -translation binary -buffering none
    fileevent $socket readable [
        namespace code [list copy-when-readable $socket $outputChan]]
    fileevent $inputChan readable [
        namespace code [list copy-when-readable $inputChan $socket]]
    apply [list socket $prelude] $socket

    variable connectionCount
    variable connections
    set n $connectionCount
    incr connectionCount
    dict set connections $socket $n
    dict set connections $inputChan $n
    dict set connections $outputChan $n
    set varName [gen-variable-name $n]
    set $varName 0
    return $varName
}

# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    lassign $argv host port preludeScript
    if {($host eq {}) || ![string is integer -strict $port]} {
        set u {}
        append u "usage: $argv0 host port \[preludeScript\]\n"
        append u "\nThe optional parameter preludeScript is a Tcl script "
        append u "that can manipulate the connection socket after the "
        append u "connection is established but before any input is "
        append u "transmitted or any received data is output. Example:\n"
        append u "\t$argv0 localhost 7777 'puts \$socket \$::env(REMOTE_ADDR)'"
        puts $u
        exit 1
    } else {
        vwait [::netcat::connect $host $port stdin stdout $preludeScript]
    }

The following is my take on netcat in Tcl. It is event-based and mildly scriptable. In theory it should be possible to use from other Tcl applications and can handle multiple simultaneous connections as long as they don't use the same channels as each other (i.e., only one connection can access the stdin and the stdout). However, I have not tested that functionality extensively.

Download with wiki-reaper: wiki-reaper -x 14702 1 15 > netcat-0.1.0.tcl