#!/bin/sh
# -*-Mode: TCL;-*-

# 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

# Path to multiplexor socket
set MD_Socket "/var/spool/MIMEDefang/mimedefang-multiplexor.sock"

# Update interval in milliseconds
set UpdateInterval 500

# Point list
set PointList {}

# Message list
set MsgList {}

# Last time we did MSGS
set MSGS -1

# Leave "Result" alone for a while?
set ResultSet 0

# Max number of slaves
set MaxSlaves -1

proc y {h max val border} {
    set inner [expr $h - 2 * $border]
    if {$max > 0} {
	set step [expr (1.0 * $inner) / (1.0 * $max)]
    } else {
	set step 1
    }
    set y [expr $h - ($border + $val * $step)]
    return $y
}

#***********************************************************************
# %PROCEDURE: get_status
# %ARGUMENTS:
#  None
# %RETURNS:
#  A status string from the multiplexor
# %DESCRIPTION:
#  Gets mimedefang-multiplexor status
#***********************************************************************
proc get_status {} {
    global MD_Socket
    set fp [open "|md-mx-ctrl -s $MD_Socket rawstatus" "r"]
    gets $fp line
    close $fp
    return $line
}

#***********************************************************************
# %PROCEDURE: create_gui
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Creates the GUI
#***********************************************************************
proc create_gui {} {
    wm title . "Watch MIMEDefang"
    wm iconname . "Watch MIMEDefang"

    canvas .c -width 400 -height 120 -takefocus 0 -borderwidth 0 -background white
    canvas .d -width 400 -height 16 -takefocus 0 -borderwidth 1 -relief sunken
    frame .f
    scale .s -from 100 -to 10000 -resolution 100 -orient horizontal \
	-label "Update Interval (ms)" -variable UpdateInterval

    pack .c -side top -expand 1 -fill both
    pack .d -side top -expand 0 -fill x
    pack .f -side top -expand 0 -fill x -anchor w

    label .f.l1 -text "Max: " -fg black
    label .f.l2 -text "Busy: " -fg "#A00000"
    label .f.l3 -text "Idle: " -fg "#00A000"
    label .f.l4 -text "Queued: " -fg "#A0A000"

    label .f.max -fg black -width 4 -anchor w
    label .f.busy -fg "#A00000" -width 4 -anchor w
    label .f.idle -fg "#00A000" -width 4 -anchor w
    label .f.queued -fg "#A0A000" -width 4 -anchor w

    button .f.reread -text "Reread Filters" -command reread
    button .f.quit -text "Quit" -command exit
    label .f.result -text "" -relief sunken -anchor w

    grid .f.l1 -row 0 -column 0 -sticky e
    grid .f.max -row 0 -column 1 -sticky w
    grid .f.reread -row 0 -column 2 -sticky e

    grid .f.l2 -row 1 -column 0 -sticky e
    grid .f.busy -row 1 -column 1 -sticky w
    grid .f.quit -row 1 -column 2 -sticky e

    grid .f.l4 -row 2 -column 0 -sticky e
    grid .f.queued -row 2 -column 1 -sticky w

    grid .f.l3 -row 3 -column 0 -sticky e
    grid .f.idle -row 3 -column 1 -sticky w
    grid .f.result -row 3 -column 2 -sticky ew

    grid columnconfigure .f 0 -weight 0
    grid columnconfigure .f 1 -weight 0
    grid columnconfigure .f 2 -weight 1

    pack .s -side top -expand 0 -fill x
    bind .c <Configure> canvas_resized
    bind .d <Configure> leds_resized
}

proc reread {} {
    global MD_Socket
    if {[catch {set ans [exec md-mx-ctrl -s $MD_Socket reread]} err]} {
	.f.result configure -fg "#A00000" -text $err
    } else {
	.f.result configure -fg black -text $ans
    }
    set_result
    after 3000 clear_result
}

proc set_result {} {
    global ResultSet
    set ResultSet 1
}

proc do_result { text color } {
    global ResultSet
    if {!$ResultSet} {
	.f.result configure -fg $color -text $text
    }
}

proc clear_result {} {
    global ResultSet
    set ResultSet 0
    .f.result configure -text "" -fg black
}

proc canvas_resized {} {
    set w [winfo width .c]
    set h [winfo height .c]

    global MaxSlaves
    if {$MaxSlaves < 0} {
	return
    }

    .c delete all
    draw_gridlines $w $h $MaxSlaves
    plot_list $w $h $MaxSlaves
}

proc leds_resized {} {
    .d delete all
}

proc draw_gridlines {w h max} {
    for {set i 0} {$i <= $max} {incr i} {
	set y [y $h $max $i 6]
	.c create line 0 $y $w $y -width 1 -fill "#555555" -stipple gray25
    }
}

proc plot_list {w h max} {
    # Keep the last w entries
    global PointList
    set len [llength $PointList]
    if {$len > $w} {
	set toChop [expr $len - $w]
	set PointList [lrange $PointList $toChop end]
    }
    .c delete withtag graph
    set busy {}
    set idle {}
    set x 0
    foreach thing $PointList {
	foreach {b i} $thing {break}
	set y [y $h $max $b 6]
	# Offset a little
	set y [expr $y + 1]
	lappend busy $x $y
	set y [y $h $max $i 6]
	lappend idle $x $y
	incr x
    }
    if {[llength $busy] >= 4} {
	eval ".c create line $idle -width 2 -fill #00A000 -tags graph"
	eval ".c create line $busy -width 2 -fill #A00000 -tags graph"
    }
}

#***********************************************************************
# %PROCEDURE: add_point
# %ARGUMENTS:
#  status -- status string from MD
#  msgs -- number of messages processed since last check
#  queued -- number of queued requests
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Adds a point to the graph and replots; updates labels
#***********************************************************************
proc add_point {status msgs queued} {
    global PointList
    global MaxSlaves
    global MsgList

    lappend MsgList [list [clock seconds] $msgs]

    set max [string length $status]
    set busy 0
    set idle 0
    foreach thing [split $status {}] {
	if {"$thing" == "B"} { incr busy }
	if {"$thing" == "I"} { incr idle }
    }

    .f.max configure -text $max
    .f.busy configure -text $busy
    .f.idle configure -text $idle
    .f.queued configure -text $queued

    lappend PointList [list $busy $idle]
    if {$max != $MaxSlaves} {
	set PointList {}
	set MsgList {}
	set MaxSlaves $max
	canvas_resized
    }
    if {$MaxSlaves > 0} {
	set w [winfo width .c]
	set h [winfo height .c]
	plot_list $w $h $MaxSlaves
    }

    do_msgs_per_sec
}

proc do_msgs_per_sec {} {
    global MsgList

    # Find all messages within last 10 seconds
    set now [clock seconds]
    set oldmsgs $MsgList
    set MsgList {}

    foreach thing $oldmsgs {
	foreach {time msgs} $thing {break}
	if {$now - $time <= 10} {
	    lappend MsgList $thing
	}
    }

    if {[llength $MsgList] < 2} {
	return
    }
    set total [expr [lindex [lindex $MsgList end] 1] - [lindex [lindex $MsgList 0] 1]]
    set mpm [expr $total / 10.0]
    set mpm [format "%.1f" $mpm]
    do_result "Msgs/sec (10s avg.): $mpm" black
}

proc plot_leds { status } {
    set w [winfo width .d]
    set h [winfo height .d]
    set spacing 6
    set border 2
    set num [string length $status]

    set avail_w [expr $w - $border - $border]
    set led_width [expr (($avail_w + 2 * $spacing) / $num)]
    .d delete all

    set i 0
    foreach thing [split $status {}] {
	switch -- $thing {
	    "B" { set color "#A00000" }
	    "I" { set color "#00A000" }
	    "K" { set color "#A0A000" }
	    default { set color "#555555" }
	}
	set x1 [expr $border + ($led_width * $i)]
	set x2 [expr $x1 + $led_width - $spacing]
	.d create rectangle $x1 $border $x2 [expr $h - 2 * $border] -outline black -fill $color
	incr i
    }
}

#***********************************************************************
# %PROCEDURE: take_reading
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Takes a reading and updates GUI
#***********************************************************************
proc take_reading {} {
    global UpdateInterval
    global MSGS
    global PointList
    global MsgList

    if {[catch {set line [get_status]} ans]} {
	# Reading failed!
	set MSGS 0
	set PointList {}
	set MsgList {}
	do_result $ans "#A00000"
	after $UpdateInterval take_reading
	return
    }

    foreach {status msgs activations mqueue queue} $line {break}

    add_point $status $msgs $queue
    plot_leds $status
    update idletasks
    after $UpdateInterval take_reading
}


create_gui

# Kick things off
take_reading
