Blackbox Collection of Network Statistics

This page describes a package for automatically collecting network statistics in a blackbox manner. The idea is to keep untouched existing libraries (implementing whichever protocol at hand) and to collect read and written bytes by the connections created within these libraries from the outside, thus providing a way to instrument network usage. This is still rough and not ready for production yet, but I thought that it would be a good idea to push it here to collect some insights and comments.

The implementation captures the core ::socket command and automatically pushes a channel transformation onto all sockets that are created. The transform will not transform anything at all, it will just collect length of bytes and provides connection lifecycle callbacks. EF

##################
## Module Name     --  netstats.tcl
## Original Author --  Emmanuel Frecon - [email protected]
## Description:
##
##     This package aims at collecting network statistics for underlying
##     connections using a black-box approach. It works by overloading the core
##     socket command and by stacking a transform onto all clients connections
##     that are created. The stacked transformations collects buffer sizes on
##     reception/transmission. The implementation allows to collect network
##     statistics without modifying underlying libraries in any way.
##
##     The package uses a callback that will be triggered at different times of
##     the life of the connection(s). This callback always takes the state of
##     the connection as a first argument, as well as the client socket as a
##     second argument. Additional arguments may be provided for several stages:
##
##     'open' will be called when the socket has just been created or manually
##     registered to the library.
##
##     'read' will be called whenever bytes are being read. The callback then
##     takes the number of bytes that are being read as an additional arguments.
##
##     'write' will be called whenever bytes are being written. The callback then
##     takes the number of bytes that are being written as an additional
##     arguments.
##
##     'close' will be called just before the connection is being terminated.
##     This might be where you want to enquire for statistics for that very
##     connection before information is automatically been cleaned up.
##
##################


package require Tcl 8.6;     # We need transchan

namespace eval ::netstats {
    namespace eval vars {
        variable overloaded 0;      # Have we overloaded the socket command?
        variable latest {};         # List of latest captured channels
        namespace eval channels {}; # Will contain channel specific information
    }
    namespace export {[a-z]*}
    namespace ensemble create
}

# ::netstats::capture -- Start capturing connections
#
#       Start to automatically capture the creation of client socket connections.
#
# Arguments:
#        cmd        A command to callback during the life of the connection (see above).
#
# Results:
#       None.
#
# Side Effects:
#       Overloads core socket command.
proc ::netstats::capture { cmd } {
    if { ! $vars::overloaded } {
        rename ::socket [namespace current]::RealSocket
        interp alias {} ::socket {} [namespace current]::Socket $cmd
        set vars::overloaded 1
    }
}


# ::netstats::release -- Stop capturing
#
#       Stop capturing and collecting network statistics.
#
# Arguments:
#       None.
#
# Results:
#       Return the list of connections that were detected since last capturing
#       period was started.
#
# Side Effects:
#       Return the core socket command to its previous implementation.
proc ::netstats::release {} {
    if { $vars::overloaded } {
        interp alias {} ::socket {}
        rename [namespace current]::RealSocket ::socket
        set vars::overloaded 0
    }
    
    # Return the list of connections that were created since last collection
    # started.
    set collect $vars::latest
    set vars::latest [list]
    return $collect
}


# ::netstats::register -- Register socket for statistics
#
#       Registers a known and existing socket for statistics collection. This
#       might be usefull if you want to collect statistics in your own module
#       and do not need the blackbox approach. The callback is triggered at once
#       at the 'open' state.
#
# Arguments:
#        sock        Existing client socket.
#        cmd        A command to callback during the life of the connection (see above).
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::netstats::register { sock cmd } {
    lappend vars::latest $sock
    chan push $sock [list [namespace current]::Stats $sock $cmd]
    Stats $sock $cmd initialize $sock
}


# ::netstats::stats -- Statistics so far
#
#       Return collected statistics so far. When called with no argument apart
#       from the socket, the procedure returns a dictionary containing all
#       existing statistics. Otherwise, this should be the type of statistics
#       details to return. See switch below.
#
# Arguments:
#        sock        Known client socket connection.
#        what        What to return, empty or one of "rx", "tx", "open" (aliases exist).
#
# Results:
#       A dictionary or the requested value.
#
# Side Effects:
#       None.
proc ::netstats::stats { sock { what "" } } {
    if { [info exists vars::channels::$sock] } {
        switch -nocase -glob -- $what {
            "r*" {
                return [dict get [set vars::channels::$sock] rx]
            }
            "sent" -
            "t*" {
                return [dict get [set vars::channels::$sock] tx]
            }
            "open*" -
            "since" {
                return [dict get [set vars::channels::$sock] timestamp]                
            }
            "marks" {
                return [dict get [set vars::channels::$sock] marks]
            }
            "" {
                return [set vars::channels::$sock]
            }
        }
    }
}


# ::netstats::reset -- Reset stats counters
#
#       Reset the statistics counters for an existing connection.
#
# Arguments:
#        sock        Existing client socket.
#        full        When true, reinitialise the opening timestamp also.
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::netstats::reset { sock { full false } } {
    if { ![info exists vars::channels::$sock] } {
        set vars::channels::$sock [dict create]
    }
    dict set vars::channels::$sock rx 0
    dict set vars::channels::$sock tx 0
    dict set vars::channels::$sock marks [list]
    
    if { $full } {
        dict set vars::channels::$sock timestamp [clock milliseconds]
    }
}


# ::netstats::mark -- Insert mark
#
#       Create a mark that refers to some special state for the underlying
#       connection. Marks will automatically collect statistics since the
#       previous mark (or the beginning of statistics collection). 
#
# Arguments:
#        sock        Existing client socket.
#        name        Name (meaningfull to you) for the mark.
#
# Results:
#       Return a dictionary with three keys: rx, tx, timestamp containing,
#       respecively, the number of bytes read, number of bytes written and time
#       elapsed since the last mark.
#
# Side Effects:
#       None.
proc ::netstats::mark { sock { name "" } } {
    if { [info exists vars::channels::$sock] } {
        # Arrange for prev to point at the previous mark or the dictionary
        # containing information for this connection.
        if { [llength [dict get [set vars::channels::$sock] marks]] } {
            set prev [lindex [dict get [set vars::channels::$sock] marks] end]
        } else {
            set prev [set vars::channels::$sock]
        }
        
        # Create a mark and append it to the list of marks.
        set mark [dict create name $name timestamp [clock milliseconds]]
        dict set mark rx [dict get [set vars::channels::$sock] rx]
        dict set mark tx [dict get [set vars::channels::$sock] tx]
        dict set mark rate_rx [expr {[dict get $mark rx] - [dict get $prev rx]}]
        dict set mark rate_tx [expr {[dict get $mark tx] - [dict get $prev tx]}]
        dict set mark rate_timestamp [expr {[dict get $mark timestamp] - [dict get $prev timestamp]}]
        dict lappend vars::channels::$sock marks $mark
        
        return [dict create \
                    rx [dict get $mark rate_rx] \
                    tx [dict get $mark rate_tx] \
                    timestamp [dict get $mark rate_timestamp]]   
    }
    return [dict create]
}

#########
##
## All procedures below internal to package implementation
##
#########

# ::netstats::Socket -- Register socket
#
#       Register client socket for statistics collection. This works by blindly
#       passing all arguments to the real socket command and overlaying a
#       channel transform on the created socket.
#
# Arguments:
#        cmd        Command for socket connection stages reporting.
#        args        All arguments to regular socket command.
#
# Results:
#       Return the socket created.
#
# Side Effects:
#       None.
proc ::netstats::Socket { cmd args } {
    if { "-server" in $args } {
        tailcall [namespace current]::RealSocket {*}$args
    } else {
        # Make following fail, do not catch!
        set sock [uplevel 1 [linsert $args 0 [namespace current]::RealSocket]]
        lappend vars::latest $sock
        chan push $sock [list [namespace current]::Stats $sock $cmd]
        return $sock
    }
}

# ::netstats::Stats -- Statistics collection
#
#       This is the core of this package and will collect statistics as bytes
#       are sent and received along the connection, and provides appropriate
#       callbacks during the lifetime of the connection.
#
# Arguments:
#        sock        Socket that was created/registered to package
#        cmd        Command for callbacking.
#        option        Type of the channel transform callback.
#        handle        Identifier of the stacked channel.
#        args        All remaining arguments (transchan compatible).
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::netstats::Stats { sock cmd option handle args } {
    switch -- $option {
        "initialize" {
            reset $sock true
            if { [catch {eval [linsert $cmd end open $sock]} err] } {
                Error $sock "Error when triggering opening callback: $err"
            }
            return [list "initialize" "read" "write" "finalize"]
        }
        "read" {
            lassign $args buffer
            set len [string length $buffer]
            dict incr vars::channels::$sock rx $len
            if { [catch {eval [linsert $cmd end read $sock $len]} err] } {
                Error $sock "Error when triggering reading callback: $err"                
            }
            return $buffer;   # Don't transform anything...
        }
        "write" {
            lassign $args buffer
            set len [string length $buffer]
            dict incr vars::channels::$sock tx $len
            if { [catch {eval [linsert $cmd end write $sock $len]} err] } {
                Error $sock "Error when triggering writing callback: $err"                
            }
            return $buffer;   # Don't transform anything...
        }
        "finalize" {
            if { [catch {eval [linsert $cmd end close $sock]} err] } {
                Error $sock "Error when triggering closing callback: $err"                
            }
            unset -nocomplain -- vars::channels::$sock
        }
    }
}

# ::netstats::Error -- Internal error handler
#
#       Handler for internal or caught errors, they all end up here.
#
# Arguments:
#        sock        Existing client connection.
#        err        Error message.
#
# Results:
#       None.
#
# Side Effects:
#       Prints out error on stderr, this should change!
proc ::netstats::Error { sock err } {
    puts stderr "Error collecting stats for $sock: $err"
}


#####################################
##
## Simple test whenever this file is sourced directly. This performs
## initialisation and registers a procedure that will be called whenever data
## for an HTTP/S connection has been read or written.
##
#####################################

if { [info exists argv0] && [info script] eq $argv0 } {
    package require http
    package require tls

    proc ::dump { option handle { len -1 } } {
        switch -- $option {
            "open" {
                puts "Opened connection $handle"
            }
            "read" {
                puts "Reading $len bytes from $handle"
            }
            "write" {
                puts "Writing $len bytes to $handle"
            }
            "close" {
                puts "Read [netstats stats $handle rx] bytes, Written [netstats stats $handle tx] bytes"
                after idle exit
            }
        }
    }
    
    ::http::register https 443 [list ::tls::socket -tls1 1]    
    netstats capture dump
    set tok [::http::geturl https://wiki.tcl-lang.org/ -keepalive 0]
    netstats release

    vwait forever
}

package provide netstats 0.1