mimedefang 2.73-2build1 / usr / bin / watch-multiple-mimedefangs.tcl

#!/bin/sh
# -*-Mode: TCL;-*-
#
# Copyright (C) 2007 Roaring Penguin Software Inc.  This file may be
# distributed under the terms of the GNU General Public License, Version 2,
# or (at your option) any later version.

# Next line restarts using wish \
exec wish "$0" -- "$@" ; clear; echo "*****"; echo "Cannot find 'wish' -- you need Tcl/Tk installed to run this program"; exit 1

# Main update interval (ms)
set MainUpdateInterval 1500

# Busy slave update interval (ms)
set BusySlaveUpdateInterval 3000

# Trace command - pid is appended
set TraceCommand "strace -s 100 -t -p"

# Command to run SSH
set SSHCommand "ssh"

# Command to run md-mx-ctrl
set MD_MX_CTRL "md-mx-ctrl -i"

set DoArchive 0

if {[info exists env(MD_MX_CTRL)]} {
    set x $env(MD_MX_CTRL)
    if {"$x" != ""} {
	set MD_MX_CTRL $x
    }
}

proc strip_zeros { num } {
    return [regsub {\.0+$} $num ""]
}

# Don't edit anything below here!
set Machines {}
set ctr 0
set after_token {}
proc find_machine { mach } {
    global Machines
    set index 0
    foreach m $Machines {
	if {"[lindex $m 0]" == "$mach"} {
	    return $index
	}
	incr index
    }
    return -1
}

proc add_machine { mach } {
    if {[find_machine $mach] >= 0} {
	return
    }

    global Machines
    if {[catch {
	set fp [open_connection $mach]
	lappend Machines [list $mach $fp]
    } err]} {
	puts stderr $err
    }
}

proc host_plus_user { mach } {
    if { [string match "*@*" $mach] } {
	return $mach
    }
    return "root@$mach"
}

proc del_machine { mach } {
    global Machines
    global Data
    set mnew {}
    set index 0
    set did_something 0
    foreach m $Machines {
	if { "[lindex $m 0]" == "$mach"} {
	    catch {
		close [lindex $m 1]
	    }
	    catch { unset Data($mach,busy) }
	    catch { unset Data($mach,time) }
	    catch { unset Data($mach,persec) }
	    catch { unset Data($mach,busy_snap) }
	    catch { unset Data($mach,persec_snap) }
	    catch { unset Data($mach,time_snap) }
	    catch { unset Data($mach,qsize) }
	    catch { unset Data($mach,busyslavewin) }
	    catch { unset Data($mach,busyslaveafter) }
	    catch { unset Data($mach,error) }
	    set did_something 1
	    continue
	}
	lappend mnew $m
    }
    set Machines $mnew
    if {$did_something} {
	reconfigure
    }
}

proc open_connection { mach } {
    global SSHCommand
    global MD_MX_CTRL
    set hmach [host_plus_user $mach]
    set fp [open "| $SSHCommand $hmach $MD_MX_CTRL" "r+"]
    fconfigure $fp -blocking 0
    #fconfigure $fp -translation binary
    fileevent $fp readable [list connection_readable $mach $fp]
    return $fp
}

proc connection_readable { mach fp } {
    global DoArchive
    gets $fp line
    if {"$line" == ""} {
	if {[eof $fp]} {
	    catch { close $fp }
	    del_machine $mach
	}
	return
    }
    set index [find_machine $mach]
    if {$index >= 0} {
	catch { update_machine $line $index $mach }
	if {$DoArchive} {
	    if {[catch { log_stats $mach $line } err]} {
		puts stderr $err
	    }
	}

    }
}

proc log_stats { mach line } {
    set dir "~/.watch-multiple-mimedefangs/$mach"
    if {![file isdirectory $dir]} {
	file mkdir $dir
    }
    set fp [open "$dir/data" "a"]
    puts $fp "[clock seconds] $line"
    close $fp
}

proc mach_set_status_error { mach index err } {
    global Data
    set Data($mach,error) 1
    .top.name$index configure -foreground red
    .top.c$index itemconfigure statusText -text $err
    .top.c$index delete withtag data1
    .top.c$index delete withtag data2
    .top.c$index delete withtag data3
}

proc mach_set_status_normal { mach index status } {
    global Data
    set Data($mach,error) 0
    .top.name$index configure -foreground black
    .top.c$index itemconfigure statusText -text $status
}

proc mach_populate_data { mach index line } {
    global Data

    foreach { msg0 msg1 msg5 msg10 busy0 busy1 busy5 busy10 ms0 ms1 ms5 ms10 a0 a1 a5 a10 r0 r1 r5 r10 busy idle stopped killed msgs activations qsize qnum uptime} $line { break }
    set total_slaves [expr $busy + $idle + $stopped + $killed]
    set ms0 [format "%.0f" $ms0]
    set msg0 [format "%.2f" [expr $msg0 / 10.0]]

    lappend Data($mach,busy) $busy0
    lappend Data($mach,time) $ms0
    lappend Data($mach,persec) $msg0
    set Data($mach,total_slaves) $total_slaves
    set Data($mach,busy_snap) $busy
    set Data($mach,persec_snap) $msg0
    set Data($mach,time_snap) $ms0
    set Data($mach,qsize) $qsize
    schedule_redraw
}

proc schedule_redraw {} {
    global MainUpdateInterval
    global after_token
    if {"$after_token" == ""} {
	set after_token [after $MainUpdateInterval redraw]
    }
}

proc redraw {} {
    global Machines
    global after_token
    global Data
    global TotalData

    set after_token ""
    set index 0
    set persec_total 0
    set busy_slaves_total 0
    set avail_slaves_total 0
    set msgs_per_sec_total 0
    set ms_per_scan_total 0
    set num_machines 0

    foreach m $Machines {
	set mach [lindex $m 0]
	if {![info exists Data($mach,busy)]} {
	    incr index
	    continue
	}
	if {$Data($mach,error)} {
	    incr index
	    continue
	}

	set busy $Data($mach,busy_snap)
	set total_slaves $Data($mach,total_slaves)
	set msg0 $Data($mach,persec_snap)
	set ms0 $Data($mach,time_snap)
	set persec_total [expr $persec_total + $msg0]
	# Format $busy to have as many characters as $total_slaves
	set l [string length $total_slaves]
	set busy [format "%${l}d" $busy]
	.top.busy$index configure -text "$busy/$total_slaves"
	.top.persec$index configure -text $msg0
	.top.time$index configure -text $ms0
	if {$busy == $total_slaves} {
	    .top.name$index configure -background "#CCCC00"
	} else {
	    .top.name$index configure -background "#D9D9D9"
	}

	set Data($mach,busy) [graph 0 [expr 1.0/3] 0 $Data($mach,total_slaves) $Data($mach,busy) $index "Busy" 1 red 1]
	set Data($mach,persec) [graph [expr 1.0/3] [expr 2.0/3] 0 auto $Data($mach,persec) $index "Msgs/Sec" 2 green 1]
	set Data($mach,time) [graph [expr 2.0/3] 1 0 auto $Data($mach,time) $index "ms/scan" 3 blue 1]
	incr index

	if {$ms0 > 0 || $Data($mach,busy_snap) > 0 || $msg0 > 0} {
	    incr num_machines
	    incr busy_slaves_total $Data($mach,busy_snap)
	    incr avail_slaves_total $Data($mach,total_slaves);
	    incr ms_per_scan_total $ms0
	}
    }
    lappend TotalData(busy) $busy_slaves_total
    if {$num_machines > 0} {
	lappend TotalData(time) [expr 1.0 * $ms_per_scan_total / (1.0 * $num_machines)]
    } else {
	lappend TotalData(time) 0
    }
    lappend TotalData(persec) $persec_total

    incr index
    set TotalData(busy) [graph 0 [expr 1.0/3] 0 $avail_slaves_total $TotalData(busy) $index "Busy" 1 red 1]
    set TotalData(persec) [graph [expr 1.0/3] [expr 2.0/3] 0 auto $TotalData(persec) $index "Msgs/Sec" 2 green 1]
    set TotalData(time) [graph [expr 2.0/3] 1 0 auto $TotalData(time) $index "ms/scan" 3 blue 1]

    set msgs_per_sec_total $persec_total
    set hour [human_number [expr $persec_total * 3600.0]]
    set day  [human_number [expr $persec_total * 86400.0]]
    set persec_total [strip_zeros [format "%.1f" $persec_total]]
    .top.c configure -text "Total throughput $persec_total/s = $hour/hour = $day/day"
    set l [string length $avail_slaves_total]
    set busy_slaves_total [format "%${l}d" $busy_slaves_total]
    .top.busytotal configure -text "$busy_slaves_total/$avail_slaves_total"
    .top.persectotal configure -text [strip_zeros [format "%.1f" $msgs_per_sec_total]]
    if {$num_machines > 0} {
	.top.avgtime configure -text [strip_zeros [format "%.0f" [expr 1.0 * $ms_per_scan_total / (1.0 * $num_machines)]]]
    } else {
	.top.avgtime configure -text "--"
    }
    update
}

proc graph { start_frac end_frac min max data index label tag fill_color line_width} {
    set tag "data$tag"
    set c .top.c$index
    set h [winfo height $c]
    set w [winfo width $c]
    set x0 [expr int($start_frac * $w)]
    set x1 [expr int($end_frac * $w)]
    set x0 [expr $x0 + 40]
    set x1 [expr $x1 - 5]
    set diff [expr $x1 - $x0]
    set gridline_spacing 15
    if {[llength $data] > $diff} {
	set toChop [expr [llength $data] - $diff]
	set data [lrange $data $toChop end]
    }

    if {"$min" == "auto"} {
	set min [lindex $data 0]
	foreach thing $data {
	    if {$thing < $min} {set min $thing}
	}
	set min [nicenum $min 1]
    }
    if {"$max" == "auto"} {
	set max [lindex $data 0]
	foreach thing $data {
	    if {$thing > $max} {set max $thing}
	}
	set max [nicenum $max 0]
    }

    set x $x0
    $c delete withtag $tag
    set coords {}
    if {$max == $min} {
	set max [expr $max + 1.0]
    }
    set diff [expr 1.0 * ($max - $min)]
    set num_gridlines [expr int((1.0 * $h) / (1.0 * $gridline_spacing))]
    if {$num_gridlines > 10} {
	set num_gridlines 10
    }
    if {$num_gridlines < 1} {
	set num_gridlines 1
    }

    set delta [nicenum [expr $diff / $num_gridlines] 1]
    foreach point $data {
	set y [expr $point - $min]
	set y [expr (1.0 * $y * $h) / (1.0 * $diff)]
	set y [expr $h - $y]
	if {$y < 1} {
	    set y 1
	}
	if {$y >= $h} {
	    set y [expr $h - 1]
	}
	lappend coords $x $y
	incr x
    }
    if {$delta > 0.0} {
	set last_phys_y 99999
	for {set y $min} {$y <= $max} {set y [expr $y + $delta]} {
	    set cy [expr (1.0 * ($y-$min) * $h) / (1.0 * $diff)]
	    set cy [expr $h - $cy]
	    if {$cy < 0} {
		set cy 0
	    }
	    if {$cy > [expr $h-1]} {
		set cy [expr $h-1]
	    }
	    if {($last_phys_y - $cy) >= (2 * $gridline_spacing)} {
		set last_phys_y $cy
		set anc w
		if {$cy < $gridline_spacing} {
		    set anc nw
		}
		if {$cy >= ($h - $gridline_spacing)} {
		    set anc sw
		}
		$c create line [expr $x0 - 10] $cy $x1 $cy -fill "#A0A0A0" -tags $tag
		$c create text [expr $x0 - 37] $cy -text [human_number $y] -tag $tag -anchor $anc
	    } else {
		$c create line $x0 $cy $x1 $cy -fill "#DDDDDD" -tags $tag
	    }
	}
    } else {
	$c create text [expr $x0 - 37] 0 -anchor nw -text [human_number $max] -tag $tag
	$c create text [expr $x0 - 37] $h -anchor sw -text [human_number $min] -tag $tag
    }
    if {[llength $coords] >= 4} {
	$c create line $coords -fill $fill_color -width $line_width -tags $tag
    }
    return $data
}
proc update_machine { line index mach } {
    if {[string match "ERROR *" $line]} {
	mach_set_status_error $mach $index $line
	return
    }
    mach_set_status_normal $mach $index ""

    mach_populate_data $mach $index $line
}

proc interactive_add_machine {} {
    set mach [.top.new get]
    if {"$mach" != ""} {
	add_machine $mach
	reconfigure
    }
}

proc reconfigure {} {
    global Machines
    set index 0
    foreach m $Machines {
	grid_machine $m $index
	incr index
    }

    # Top row of labels
    catch { destroy .top.busy }
    catch { destroy .top.persec }
    catch { destroy .top.time }
    catch { destroy .top.c }
    catch { destroy .top.name }

    label .top.name -text "Machine Name"
    label .top.busy -text "Busy Slaves" -foreground "#A00000"
    label .top.persec -text "Msgs/s" -foreground "#00A000"
    label .top.time -text " ms/scan " -foreground "#0000A0"
    label .top.c -text ""
    grid .top.name -row 0 -column 0 -sticky new
    grid .top.busy -row 0 -column 1 -sticky new
    grid .top.persec -row 0 -column 2 -sticky new
    grid .top.time -row 0 -column 3 -sticky new
    grid .top.c -row 0 -column 4 -sticky new

    grid rowconfigure .top 0 -weight 0
    # If a machine has been deleted, destroy its windows
    catch { destroy .top.name$index}
    catch { destroy .top.busy$index}
    catch { destroy .top.persec$index}
    catch { destroy .top.time$index}
    catch { destroy .top.c$index}

    incr index
    # Bottom row of labels
    catch { destroy .top.busytotal }
    catch { destroy .top.persectotal }
    catch { destroy .top.avgtime }
    catch { destroy .top.totalrow }
    catch { destrop .top.c$index }

    # Mop up total window if a machine has been deleted
    set i [expr $index + 1]
    catch { destroy .top.c$i }

    label .top.totalrow -text "Totals:"
    label .top.busytotal
    label .top.persectotal
    label .top.avgtime
    canvas .top.c$index -width 400 -height 60 -takefocus 0 -borderwidth 0 -background #FFFFF0 -highlightthickness 0

    grid .top.totalrow -row $index -column 0 -sticky new
    grid .top.busytotal -row $index -column 1 -sticky new
    grid .top.persectotal -row $index -column 2 -sticky new
    grid .top.avgtime -row $index -column 3 -sticky new
    grid .top.c$index -row $index -column 4 -sticky nsew -pady 1
    grid rowconfigure .top $index -weight 3
    incr index
    # Now a spot for adding a new machine...
    catch { destroy .top.newlab }
    catch { destroy .top.new }

    label .top.newlab -text "Add Machine: "
    entry .top.new -width 20
    grid .top.newlab -row $index -column 0
    grid .top.new -row $index -column 1 -columnspan 4 -sticky ew
    bind .top.new <Return> interactive_add_machine
    grid rowconfigure .top $index -weight 0

    grid columnconfigure .top 0 -weight 0
    grid columnconfigure .top 1 -weight 0
    grid columnconfigure .top 2 -weight 0
    grid columnconfigure .top 3 -weight 0
    grid columnconfigure .top 4 -weight 1
    wm deiconify .top
}

proc busyslaves { mach } {
    global ctr
    global Data
    incr ctr
    set w .slaves$ctr
    catch { destroy $w }
    toplevel $w
    wm title $w "Busy slaves: $mach"
    wm iconname $w "$mach slaves"
    set Data($mach,busyslavewin) $w

    # Open a new SSH connection for the busyslaves info
    global SSHCommand
    global MD_MX_CTRL
    set hmach [host_plus_user $mach]
    set fp [open "| $SSHCommand $hmach $MD_MX_CTRL" "r+"]
    fconfigure $fp -blocking 0
    fileevent $fp readable [list busyslaves_readable $mach $fp]

    tickle_busyslaves $mach $fp

    text $w.t -width 80 -height 35
    pack $w.t -side left -expand 1 -fill both
    $w.t tag bind pid <Enter> [list enter_pid $w.t]
    $w.t tag bind pid <Leave> [list leave_pid $w.t]
    $w.t tag bind pid <ButtonPress-1> [list trace_slave $w.t $mach]
}

proc tickle_busyslaves { mach fp } {
    global Data

    catch {
	set Data($mach,busydata) ""
	puts $fp "busyslaves\nfoo_no_such_command"
	flush $fp
    }
}

proc busyslaves_readable { mach fp } {
    global Data

    gets $fp line
    if {"$line" == ""} {
	if {[eof $fp]} {
	    close $fp
	    catch { destroy $Data($mach,busyslavewin) }
	}
	return
    }
    if {"$line" != "error: Unknown command"} {
	lappend Data($mach,busydata) $line
	return
    }
    update_busyslaves $mach $fp
    global BusySlaveUpdateInterval
    after $BusySlaveUpdateInterval [list tickle_busyslaves $mach $fp]
}
proc trace_slave { w mach } {
    global TraceCommand
    set tags [$w tag names current]
    set index [lsearch -glob $tags "Z*"]
    if {$index >= 0} {
	set tag [lindex $tags $index]
	set pid [string range $tag 1 end]
	ssh $mach "$TraceCommand $pid" "Process $pid on $mach"
    }
}
proc enter_pid { w } {
    set tags [$w tag names current]
    set index [lsearch -glob $tags "Z*"]
    if {$index >= 0} {
	set tag [lindex $tags $index]
	$w tag configure $tag -foreground "#A00000"
    }
}

proc leave_pid { w } {
    set tags [$w tag names current]
    set index [lsearch -glob $tags "Z*"]
    if {$index >= 0} {
	set tag [lindex $tags $index]
	$w tag configure $tag -foreground "#000000"
    }
}

proc update_busyslaves { mach fp} {
    global Data
    set w $Data($mach,busyslavewin)
    if {![winfo exists $w]} {
	catch { close $fp }
	return
    }
    $w.t configure -state normal
    $w.t delete 1.0 end

    # Clear out tags
    foreach tag [$w.t tag names] {
	if {"$tag" != "pid"} {
	    $w.t tag delete $tag
	}
    }
    foreach line $Data($mach,busydata) {
	set lst [split $line]
	set slaveno [lindex $lst 0]
	set pid [lindex $lst 2]
	set len [string length "$slaveno B $pid "]
	set line [string range $line $len end]
	$w.t insert end [format "%4d" $slaveno] slaveno
	$w.t insert end " "
	$w.t tag delete "Z$pid"
	$w.t insert end [format "%6d" $pid] [list pid "Z$pid"]
	$w.t insert end " $line\n"

    }
}

proc popup_machine_menu { m index x y} {
    catch { destroy .m }
    menu .m -tearoff 0
    .m add command -label "SSH" -command [list ssh $m]
    .m add command -label "Busy Slaves" -command [list busyslaves $m]
    .m add separator
    .m add command -label "Delete" -command [list del_machine $m]
    tk_popup .m $x $y
}

proc grid_machine { m index } {
    set m [lindex $m 0]
    set row [expr $index + 1]

    catch { destroy .top.name$index}
    catch { destroy .top.busy$index}
    catch { destroy .top.persec$index}
    catch { destroy .top.time$index}
    catch { destroy .top.c$index}

    set disp_m $m
    if {[regexp {@(.*)$} $m foo host]} {
	set disp_m $host
    }

    label .top.name$index -text $disp_m -relief raised
    bind .top.name$index <ButtonPress-1> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-2> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-3> [list popup_machine_menu $m $index %X %Y]
    label .top.busy$index -text ""
    label .top.persec$index -text ""
    label .top.time$index -text ""
    canvas .top.c$index -width 400 -height 60 -takefocus 0 -borderwidth 0 -background white -highlightthickness 0
    .top.c$index create text 2 2 -anchor nw -text "" -tags statusText
    grid .top.name$index -row $row -column 0 -sticky new
    grid .top.busy$index -row $row -column 1 -sticky new
    grid .top.persec$index -row $row -column 2 -sticky new
    grid .top.time$index -row $row -column 3 -sticky new
    grid .top.c$index -row $row -column 4 -sticky nsew -pady 1
    grid rowconfigure .top $row -weight 1

}

proc kick_off_update {} {
    global Machines
    foreach m $Machines {
	set fp [lindex $m 1]
	puts $fp rawload
	flush $fp
    }
    global MainUpdateInterval
    after $MainUpdateInterval kick_off_update
}

## translated from C-code in Blt, who got it from:
##      Taken from Paul Heckbert's "Nice Numbers for Graph Labels" in
##      Graphics Gems (pp 61-63).  Finds a "nice" number approximately
##      equal to x.
proc nicenum {x floor} {

    if {$x == 0} {
	return 0
    }

    set negative 0

    if {$x < 0} {
        set x [expr -$x]
        set negative 1
    }

    set exponX [expr floor(log10($x))]
    set fractX [expr $x/pow(10,$exponX)]; # between 1 and 10
    if {$floor} {
        if {$fractX < 2.0} {
            set nf 1.0
        } elseif {$fractX < 5.0} {
            set nf 2.0
        } elseif {$fractX < 10.0} {
            set nf 5.0
        } else {
	   set nf 10.0
        }
    } elseif {$fractX <= 1.0} {
        set nf 1.0
    } elseif {$fractX <= 2.0} {
        set nf 2.0
    } elseif {$fractX <= 5.0} {
        set nf 5.0
    } else {
        set nf 10.0
    }
    if { $negative } {
        return [expr -$nf * pow(10,$exponX)]
    } else {
	set value [expr $nf * pow(10,$exponX)]
	return $value
    }
}

proc human_number { num } {
    if {$num <= 1000} {
	return [strip_zeros [format "%.1f" $num]]
    }
    set num [expr $num / 1000.0]
    if {$num <= 1000} {
	set num [strip_zeros [format "%.1f" $num]]
	return "${num}K"
    }
    set num [expr $num / 1000.0]
    if {$num <= 1000} {
	set num [strip_zeros [format "%.1f" $num]]
	return "${num}M"
    }
    set num [expr $num / 1000.0]
    set num [strip_zeros [format "%.1f" $num]]
    return "${num}G"
}

proc pick_color { host } {
    set color 0
    set components {AA BB CC EE}

    catch { set host [lindex $host end] }
    set host [split $host ""]
    foreach char $host {
	set color [expr $color + 1]
	binary scan $char "c" x
	incr color $x
	if { $color <= 0 } {
	    set color [expr $x + 1]
	}
    }
    set ans "#"
    expr srand($color)
    for {set i 0} {$i < 3} {incr i} {
	set off [expr int(4.0 * rand())]
	append ans [lindex $components $off]
    }
    return $ans
}

proc ssh { host {cmd ""} {title ""}} {
    set color [pick_color $host]
    if {"$title" == ""} {
	set title "SSH $host"
    }
    global SSHCommand
    set hmach [host_plus_user $host]
    exec xterm -hold -title $title -bg #000000 -fg $color -e $SSHCommand $hmach $cmd &
}

wm withdraw .
foreach mach $argv {
    if {"$mach" == "-archive"} {
	set DoArchive 1
	continue
    }
    add_machine $mach
}

catch { destroy .top}
toplevel .top
wm title .top "Watch Multiple MIMEDefangs"
wm iconname .top "MIMEDefangs"
wm withdraw .top
reconfigure
wm deiconify .top
update
kick_off_update
tkwait window .top
exit