Check the latency from sBNC to IRC servers by sending a PING from just your own or all users on the bouncer. The PONG reply is intercepted and difference presented. Note that results are one-way. More accurately; the time it takes for your client to send PING until it gets the PONG back, divided with 2.

Since Build 2 it also checks the latency between sBNC and each connected client.

• Download
• Unzip
• Place latency.tcl in scripts/
• Add source scripts/latency.tcl to sbnc.tcl
• Rehash TCL
• Use

/sbnc latency
/sbnc latency all

Note that this source will/should be the development version, i.e. all changes noted in the history section, will have been made in this section.

#
# @name       Latency - Check latency between bnc and server
# @version    Build 2 (2006-12-05)
# @license    GPL 2 (http://www.gnu.org/licenses/gpl.html)
# @author     David Lorentsen <zyberdog@quakenet.org>
# @www        http://wiki.zyberdog.dk/sbnc:latency
#
 
if {[namespace exists ::latency]} {
	namespace delete ::latency
}
 
namespace eval ::latency {
 
	# Configuration
 
	# The output is aligned in a table-like format using spaces.
	# Enabling this will use "." characters instead of spaces. To help clients 
	# that handle spaces poorly if sent through the scripting engine. Like mIRC.
	# 0 = disabled, 1 = enabled
	variable fakealign 0
 
	# End of Configuration
 
	# Initialize variables
	variable target ""
	variable expect
 
	# Binds
	internalbind command [namespace current]::commands
	internalbind server [namespace current]::outercept PONG
	internalbind client [namespace current]::intercept PONG
 
	# Handle /sbnc commands
	proc commands {client parameters} {
		variable target
		variable expect
		variable fakealign
 
		if {[getbncuser $client "admin"]} {
			if {[string equal -nocase [lindex $parameters 0] "help"]} {
				bncaddcommand latency Admin "Check latency (one-way)" "Syntax: latency \[all|clear\]\nCheck latency (one-way). For all users if specified."
			} elseif {[string equal -nocase [lindex $parameters 0] "latency"]} {
				haltoutput
 
				if {[string equal $target ""]} {
					set target [getctx 1]
 
					internaltimer 10 0 [namespace current]::timeout
 
					bncreply [render "User           :  Client  :  Server  : Server"]
					bncreply "----------------------------------------------------------------------"
 
					if {[llength $parameters] > 1 && [string equal -nocase [lindex $parameters 1] "all"]} {
						array set expect {}
 
						foreach user [bncuserlist] {
							setctx $user
 
							set hass [getbncuser $user hasserver]
							set hassv ""
							set hasc [getbncuser $user hasclient]
							set hascv ""
 
							if {!$hass} {
								set hassv "n/a"
							}
							if {!$hasc} {
								set hascv "n/a"
							}
 
							if {!$hass && !$hasc} {
								setctx $target
								bncreply [render [format "%-15s: %8s : %8s : %s" $user "n/a" "n/a" "not connected"]]
								continue
							} else {
								set expect($user) [list $hascv $hassv]
							}
 
							if {$hass} {
								putserv "PING :sbnclatency [clock clicks -milliseconds]"
							}
 
							if {$hasc} {
								putclient "PING :sbnclatency [clock clicks -milliseconds]"
							}
						}
 
					} else {
						internaltimer 10 0 [namespace current]::timeout
 
 
						set hass [getbncuser $client hasserver]
						set hassv ""
						set hasc [getbncuser $client hasclient]
						set hascv ""
 
						if {!$hass} {
							set hassv "n/a"
						}
						if {!$hasc} {
							set hascv "n/a"
						}
 
						set expect($client) [list $hascv $hassv]
 
						if {$hass} {
							putserv "PING :sbnclatency [clock clicks -milliseconds]"
						}
 
						if {$hasc} {
							putclient "PING :sbnclatency [clock clicks -milliseconds]"
						}
 
 
					}
				} else {
					if {[llength $parameters] > 1 && [string equal -nocase [lindex $parameters 1] "clear"]} {
						if {![string equal $target $client]} {
							setctx $target
							bncreply "Your latency request has been cleared by \"$client\"."
						}
 
						set target ""
						array unset expect
 
						setctx $client
						bncreply "Previous latency request cleared."
					} else {
						if {[string equal $target $client]} {
							bncreply "A latency request is already in process, initiated by you."
						} else {
							bncreply "A latency request is already in process, initiated by \"$target\"."
						}
						bncreply "If this is an error you can clear the previous request with: /sbnc latency clear"
					}
				}
			}
		}
	}
 
	# Handle IRC Server -> sBNC PONG reply
	proc outercept {client parameters} {
		variable target
		variable expect
 
		if {![string equal -nocase [lindex $parameters 1] "PONG"]} { return }
		set response [split [lindex $parameters 3] " "]
		if {![string equal -nocase [lindex $response 0] "sbnclatency"]} { return }
 
		haltoutput
 
		set delta [expr ([clock clicks -milliseconds] - [lindex $response 1]) /2]
		set val $expect($client)
		set cval [lindex $val 0]
		set sval "$delta ms"
 
		# We got all data for this user, send it.
		if {![string equal $cval ""] && ![string equal $sval ""]} {
			setctx $target
			bncreply [render [format "%-15s: %8s : %8s : %s" $client $cval $sval [lindex $parameters 0]]]
 
			array unset expect $client
		} else {
			set expect($client) [list $cval $sval]
		}
 
		# Check if we are done.
		if {[array size expect] == 0} {
			bncreply "--------------------------- End of Results ---------------------------"
			set target ""
			internalkilltimer [namespace current]::timeout
		}
	}
 
	# Handle IRC Client -> sBNC PONG reply
	proc intercept {client parameters} {
		variable target
		variable expect
 
		if {![string equal -nocase [lindex $parameters 0] "PONG"]} { return }
		set response [split [lindex $parameters 1] " "]
		if {![string equal -nocase [lindex $response 0] "sbnclatency"]} { return }
 
		haltoutput
 
		set delta [expr ([clock clicks -milliseconds] - [lindex $response 1]) /2]
		set val $expect($client)
		set cval "$delta ms"
		set sval [lindex $val 1]
 
		# We got all data for this user, send it.
		if {![string equal $cval ""] && ![string equal $sval ""]} {
			setctx $target
 
			if {[getbncuser $client hasserver]} {
				set svald [getbncuser $client realserver]
			} else {
				set svald "not connected"
			}
 
			bncreply [render [format "%-15s: %8s : %8s : %s" $client $cval $sval $svald]]
 
			array unset expect $client
		} else {
			set expect($client) [list $cval $sval]
		}
 
		# Check if we are done.
		if {[array size expect] == 0} {
			bncreply "--------------------------- End of Results ---------------------------"
			set target ""
			internalkilltimer [namespace current]::timeout
		}
	}
 
 
	proc timeout {} {
		variable expect
		variable target
 
		if {[array size expect] > 0} {
 
			setctx $target
 
			foreach user [array names expect] {
				set val $expect($user)
				set cval [lindex $val 0]
				set sval [lindex $val 1]
 
				if {[string equal $cval ""]} {
					set cval "timeout"
				}
 
				if {[string equal $sval ""]} {
					set sval "timeout"
				}
 
				if {[getbncuser $user hasserver]} {
					set svald [getbncuser $user realserver]
				} else {
					set svald "not connected"
				}
 
				bncreply [render [format "%-15s: %8s : %8s : %s" $user $cval $sval $svald]]
			}
 
			array set expect {}
			set target ""
 
			bncreply "--------------------------- End of Results ---------------------------"
		}
	}
 
 
	proc render {string} {
		variable fakealign
 
		if {[string equal $fakealign "1"]} {
			return [string map {"               " " ............. " \
								"              " " ............ " \
								"             " " ........... " \
								"            " " .......... " \
								"           " " ......... " \
								"          " " ........ " \
								"         " " ....... " \
								"        " " ...... " \
								"       " " ..... " \
								"      " " .... " \
								"     " " ... " \
								"    " " .. " \
								"   " " . " \
								"  " " ."} $string]
		} else {
			return $string
		}
	}
 
 
	# Clean up from previous versions of latency.tcl
	if {![string equal [lsearch -exact [internalbinds] "command latency:commands * *"] "-1"]} {
		internalunbind command latency:commands
		internalunbind server latency:catch
	}
 
 
	# Clean up binds and namespace
	proc unload {} {
		internalunbind command [namespace current]::commands
		internalunbind server [namespace current]::intercept PONG
		namespace delete [namespace current]
 
		return "latency.tcl unloaded."
	}
 
}

• Made use of TCL namespaces.
• Tells when all PONG replies have been recieved.
• Added unload procedure.
• Added latency between client and sBNC.
• Added clear parameter to avoid issues with missing PONG replies.
• Added alternative output rendering.
• Added timeout for replies

• No prior releases to compare with.