The Network Dtrace Server Demo

One of the good features of Tcl is really easy networking. Do here you go: an example of how easy it is to create a telnet-operated Dtrace server for multiple clients.

Usage

Run the netdemo.tcl sript from demos directory with DTrace privileges. Then connect to the port 1986 with something telnet-compatible.

Now you can enter your script. Enter a line containing just GO to finish and enable tracing. Disconnect (close the application) to finish - the server cleans up by itself.

Screenshot

Source code

package require dtrace

proc accept {sock addr port} {
    global handles scripts
    set handles($sock) [::dtrace::open -foldpdesc 1]
    set scripts($sock) ""
    fconfigure $sock -buffering line
    fileevent $sock readable [list receive $sock $addr $port]
    puts "Client connected from $addr:$port"
}

proc receive {sock addr port} {
    global handles scripts
    if {[eof $sock] || [catch {gets $sock line}]} {
        close $sock
        ::dtrace::close $handles($sock)
        unset handles($sock) scripts($sock)
        puts "Client $addr:$port disconnected"
    } else {
        if {[string equal $line "GO"]} {
            ::dtrace::exec [::dtrace::compile $handles($sock) $scripts($sock)]
            ::dtrace::go $handles($sock) probe_desc [list callback $sock]
            puts $sock "CPU\tid\tprobe"
            dtraceLoop $sock
            puts "Tracing for $addr:$port started"
        } else {
            set scripts($sock) "$scripts($sock)\n$line"
        }
    }
}

proc callback {probe cpu id sock} {
    puts $sock "$cpu\t$id\t$probe"
}

proc dtraceLoop {sock} {
    global handles
    catch {::dtrace::process $handles($sock)}
    after 300 dtraceLoop $sock
}

socket -server accept 1986
vwait forever