#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# User tunable parameters
# default directory to look for fifo's in.
set fifodir "/etc/diald/"
set default_FIFO "/etc/diald/diald.ctl"

# Default globals
set monfifo ""
set monfd ""
set fifofd ""

set trans(DOWN) Down
set trans(CONNECT) Connect
set trans(CLOSE) Close
set trans(START_LINK) Start
set trans(UP) Up
set trans(HALF_DEAD) HalfDead
set trans(STOP_LINK) StopLink
set trans(KILL_LINK) KillLink
set trans(STOP_DIAL) StopDial
set trans(KILL_DIAL) KillDial
set trans(DISCONNECT) Disconnect
set trans(RETRY) Retry
set trans(ERROR) Error
set trans(ZOMBIE) Zombie

set colors(DOWN)	{{} {} red}
set colors(CONNECT)	{{} yellow red}
set colors(START_LINK)	{{} yellow {}}
set colors(STOP_DIAL)	{{} red red}
set colors(KILL_DIAL)	{{} black red}
set colors(UP) 		{green {} {}}
set colors(HALF_DEAD) 	{yellow {} {}}
set colors(DISCONNECT)	{green yellow {}}
set colors(STOP_LINK)	{green red {}}
set colors(KILL_LINK)	{green black {}}
set colors(CLOSE)	{{} yellow yellow}
set colors(RETRY)	{yellow yellow yellow}
set colors(ERROR)	{red red red}
set colors(ZOMBIE)	{black black black}

proc make_icon {} {
	toplevel .icon -width 50 -height 50
	canvas .icon.canv -width 50 -height 32
	.icon.canv create text 2 2 \
		-font -adobe-helvetica-medium-r-*-*-11-*-*-*-*-*-*-* \
        	-text "Diald" -anchor nw
	.icon.canv create text 2 15 \
		-font -adobe-helvetica-medium-r-*-*-11-*-*-*-*-*-*-* \
        	-text "Status" -anchor nw
	.icon.canv create rectangle 35 2 45 32 -fill grey75
	.icon.canv create oval 37 4 43 10 -tag top
	.icon.canv create oval 37 14 43 20 -tag mid
	.icon.canv create oval 37 24 43 30 -tag bot
	label .icon.message -textvar status(fsm_trans) -border 0 -width 50 \
		-font -adobe-helvetica-bold-r-*-*-11-*-*-*-*-*-*-*
	pack propagate .icon 0
	pack .icon.canv -padx 0 -pady 0 -fill x -expand 1
	pack .icon.message -padx 0 -pady 0 -fill x -expand 1
	bind .icon <Destroy> {if {"%W"==".icon"} {after idle make_icon}}
	wm iconwindow . .icon
}

make_icon
wm iconposition . 520 0

# Set up the basic data for the app
wm title . "Diald Control"
wm iconname . "Diald"
wm minsize . 1 1
wm iconify .

# The following lines are a modified version of a directory browser
# written by
#
#	Doug Hughes
#	doug@eng.auburn.edu	doug@happy.vf.ge.com
#
# Eventually this should be replaced with a nicer interface.


# The procedure below is invoked to open a browser on a given file;  if the
# file is a directory then another instance of this program is invoked; if
# the file is a regular file then the Mx editor is invoked to display
# the file.

proc newlist {dir} {
    .browse.l.list delete 0 end
    foreach i [exec ls -1a $dir] {
        if [file isdirectory "$dir/$i"] {
	    if {$i != "."} {
	        .browse.l.list insert end $i
	    }
        }
    }
#    puts newlist
    pack forget .browse.l.list
    pack .browse.l.list -side left -fill both -expand yes
}
    
proc browse {file} {
    global env dir

#    puts "enter browse $dir"
#    if {[string compare $dir "."] != 0} {set file $dir/$file}
    if {$dir == "/"} {		# gone to top, sub dirs auto concat "/"
	set dir ""
    }
    if [file isdirectory $dir] {
	set sel [selection get]
	if {$sel == ".."} {
#	    puts "dir $dir"
	    set lastslash [string last "/" $dir]
	    if {$lastslash == 0} {		# we're at the root
		set lastslash 1
            }
	    set dir [string range $dir 0 [expr $lastslash - 1]]
	    if {$dir == ""} {set dir "/"}
	} else {
	    set dir "$dir/$sel"
#	    puts "newdir $dir"
        }
	newlist "$dir"
    }
}

proc closeout {} {
    global dir dirout

#    catch {set i [selection get]} error
#    if {[lindex $error 0] != "selection"} {
#        set dirout "$dir/$i"
#    } else {
	set dirout "$dir"
#    }
#    exit
}

proc dirbrowser {directory} {
    global dir dirout i

    catch {destroy .browse}
    # Create a scrollbar on the right side of the main window and a listbox
    # on the left side.
    toplevel .browse
    frame .browse.l
    scrollbar .browse.l.scroll -command ".browse.l.list yview"
    pack .browse.l.scroll -side right -fill y
    listbox .browse.l.list -yscroll ".browse.l.scroll set" -relief raised -width 20 -height 20 \
	    -setgrid yes

    pack .browse.l.list -side left -fill both -expand yes
    pack .browse.l -side top -pady 8

    # Text entry follows selection
    frame .browse.ent
    message .browse.ent.msg -text "Dir: "
    entry .browse.ent.entry -textvariable dir -relief sunken -width 20
    pack .browse.ent.msg .browse.ent.entry -side left -expand 1 -anchor n
    pack .browse.ent -pady 1 -anchor center -fill y

    # Button follows text entry
    button .browse.ok -text "OK" -command closeout -width 5
    pack .browse.ok -side bottom -anchor n -expand yes -pady 3

    wm minsize .browse 1 1
    wm title .browse "Directory Browser"

    # Set up bindings for the browser.

    bind .browse.l.list <Control-q> {destroy .browse}
    bind .browse.l.list <Control-c> {destroy .browse}
    bind .browse.l.list <Double-Button-1> {
	foreach i [selection get] {browse $i}
    }
    bind .browse.ent.entry <Return> {newlist [.browse.ent.entry get]}
    focus .browse.ent.entry
    set dir $directory
    newlist $dir

    tkwait variable dirout
    destroy .browse
    return $dirout
}

# The procedure below will fill in the dialds sub-menu with a list
# of all the instances of diald that currently have FIFO's in the
# default FIFO directory.

proc fillDialdsMenu {} {
    global fifodir
    catch {.menu.file.m.dialds delete 0 last}
    foreach i [lsort [exec find $fifodir -type p -print]] {
        .menu.file.m.dialds add command -label $i -command [list openFifo $i]
    }
}

proc openFifo {fname} {
    global fifofd monfifo monfd

    # Turn off any previous monitoring
    if {$monfd!=""} {close $monfd}
    if {$monfifo!=""} {catch {exec rm -f $monfifo}}

    # get new monitoring fifo
    set fifofd [open $fname w]

    set monfifo /tmp/dctrl.[pid]
    catch {exec mkfifo -m 0600 $monfifo}
    fifoCmd "monitor $monfifo"
    set monfd [open $monfifo r]
    fileevent $monfd readable {stateChange}
}

proc fifoCmd {cmd} {
    global fifofd
    if {$fifofd!=""} {
	puts $fifofd $cmd
	catch {flush $fifofd}
    }
}

proc setfifodir {} {
    global fifodir
    set fifodir [dirbrowser $fifodir]
}

proc cmp {a b} {
    if {[lindex $a 3]<[lindex $b 3]} {
	return 1;
    }
    if {[lindex $a 3]>[lindex $b 3]} {
	return -1;
    }
    return 0;
}

proc stateChange {} {
    global monfd status trans colors
    set foo [gets $monfd]
    if {$foo=="STATE"} {
	set status(fsm) [gets $monfd]
	if {$status(fsm)=="CONNECT"} {.message.text delete 0.0 end}
	set status(fsm_trans) [set trans($status(fsm))]
	set clist [set colors($status(fsm))]
	set tcol [lindex $clist 0]
	set mcol [lindex $clist 1]
	set bcol [lindex $clist 2]
	.icon.canv itemconfig top -fill $tcol
	.icon.canv itemconfig mid -fill $mcol
	.icon.canv itemconfig bot -fill $bcol
    }
    if {$foo=="STATUS"} {
	set status(up) [gets $monfd]
	set status(force) [gets $monfd]
	set status(impmode) [gets $monfd]
	set status(imp_itime) [gets $monfd]
	set status(imp_time) [gets $monfd]
	set status(imp_fuzz) [gets $monfd]
	set status(imp_timeout) [gets $monfd]
	set status(force_timeout) [gets $monfd]
	set status(timeout) [gets $monfd]
    }
    if {$foo=="QUEUE"} {
    	set foo [gets $monfd]
	set lst [list]
	.queue.text delete 0.0 end
	while {$foo!="END QUEUE"} {
	    lappend lst $foo
	    set foo [gets $monfd]
	}
	foreach i $lst {
	    .queue.text insert end $i
	    .queue.text insert end "\n"
	}
    }
    if {$foo=="MESSAGE"} {
	set message [gets $monfd]
	.message.text insert end $message
	.message.text insert end "\n"
    }
    if {$foo=="INTERFACE"} {
	set status(iface) [gets $monfd]
	set status(lip) [gets $monfd]
	set status(rip) [gets $monfd]
    }
    if {$foo=="LOAD"} {
	set txtotal [gets $monfd]
	set rxtotal [gets $monfd]
	set e5 ".81873075307798185867"
	set e150 ".99335550625503441537"
	set fp "1"
	set status(rx_load5) [expr {$status(rx_load5)*$e5+$rxtotal*($fp-$e5)}]
	set status(tx_load5) [expr {$status(tx_load5)*$e5+$txtotal*($fp-$e5)}]
	set status(rx_load150) [expr {$status(rx_load150)*$e150+$rxtotal*($fp-$e150)}]
	set status(tx_load150) [expr {$status(tx_load150)*$e150+$txtotal*($fp-$e150)}]
	set status(rx_load) [format "%.3f %.3f" [expr {$status(rx_load5)/1000}] [expr {$status(rx_load150)/1000}]]
	set status(tx_load) [format "%.3f %.3f" [expr {$status(tx_load5)/1000}] [expr {$status(tx_load150)/1000}]]
    }
    update
}

proc dctrlQuit {} {
    global fifofd monfifo

    if {$fifofd!=""} {
    	if {$monfifo!=""} {catch {exec rm -f $monfifo}}
    	catch {flush $fifofd}
    }
    bind .icon <Destroy> {}
    exit
#    destroy .
}

# Create menu bar.

frame .menu -relief raised -bd 2
pack .menu -side top -fill x

menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add command -label "Set FIFO directory" \
	-command "setfifodir" -underline 0
.menu.file.m add cascade -label "Choose FIFO" \
	-menu .menu.file.m.dialds -underline 0
.menu.file.m add command -label "Quit" -command dctrlQuit -underline 0
menu .menu.file.m.dialds  -postcommand fillDialdsMenu
pack .menu.file -side left

menubutton .menu.control -text "Control" -menu .menu.control.m -underline 0
menu .menu.control.m
.menu.control.m add check -label "Block connection" -underline 0 \
    -variable blocked -command {
   	 if {$blocked} {fifoCmd "block"} {fifoCmd "unblock"}
    }
.menu.control.m add check -label "Forced up" -underline 0 \
    -variable forced -command {
   	 if {$forced} {fifoCmd "force"} {fifoCmd "unforce"}
    }
.menu.control.m add sep
.menu.control.m add command -label "Up request" -underline 0 \
	-command "fifoCmd up"
.menu.control.m add command -label "Down request" -underline 0 \
	-command "fifoCmd down"
.menu.control.m add command -label "Terminate on idle" -underline 0 \
	-command "fifoCmd delayed-quit"
.menu.control.m add command -label "Quit diald" -underline 0 \
	-command "fifoCmd quit"
pack .menu.control -side left

# Link status display
frame .status -bor 2 -rel groove
pack .status -side top -fill x -padx 2 -pady 2

set col1 {"State" "Link Status" "Next Alarm" "Forcing Rule" "Forcing Timeout" "RX Load"}
set col2 {status(fsm) status(up) status(timeout)
	status(force) status(force_timeout) status(rx_load)}
set col3 {"Impulse State" "Initial Impulse"
	"Impulse Length" "Impulse Fuzz" "Impulse Timeout" "TX Load"}
set col4 {status(impmode) status(imp_itime) status(imp_time)
	status(imp_fuzz) status(imp_timeout) status(tx_load)}

frame .status.col1
frame .status.col2
frame .status.col3
frame .status.col4
pack .status.col1 -side left -anchor nw
pack .status.col2 -side left -expand 1 -fill x -anchor nw
pack .status.col3 -side left -anchor nw
pack .status.col4 -side left -expand 1 -fill x -anchor nw

set i0 0
foreach i $col1 {
    label .status.col1.$i0 -text $i
    pack .status.col1.$i0 -side top -anchor nw
    incr i0
}

set i0 0
foreach i $col2 {
    message .status.col2.$i0 -textvar $i -rel sunken -bor 1 -width 150 -anchor nw
    pack .status.col2.$i0 -side top -fill x -expand 1 -anchor nw
    incr i0
}

set i0 0
foreach i $col3 {
    label .status.col3.$i0 -text $i
    pack .status.col3.$i0 -side top -anchor nw
    incr i0
}

set i0 0
foreach i $col4 {
    message .status.col4.$i0 -textvar $i -rel sunken -bor 1 -width 150 -anchor nw
    pack .status.col4.$i0 -side top -fill x -expand 1 -anchor nw
    incr i0
}

frame .q
label .q.title -text "Connection Queue on Interface "
label .q.interface -textvar status(iface)
label .q.from -text " from "
label .q.lip -textvar status(lip)
label .q.to -text " to "
label .q.rip -textvar status(rip)
pack .q.title -side left -anchor nw
pack .q.interface -side left -anchor nw
pack .q.from -side left -anchor nw
pack .q.lip -side left -anchor nw
pack .q.to -side left -anchor nw
pack .q.rip -side left -anchor nw
pack .q -side top -anchor nw
frame .queue
text .queue.text -border 2 -rel groove -yscrollcommand ".queue.scroll set" -height 6 -width 60
scrollbar .queue.scroll -relief sunken -command ".queue.text yview"
pack .queue.text -side left -fill both -padx 2 -pady 2 -expand 1
pack .queue.scroll -side right -fill y
pack .queue -side top -fill both -expand 1
label .m -text "Dialing log"
pack .m -side top -anchor nw
frame .message
text .message.text -border 2 -rel groove -yscrollcommand ".message.scroll set" -height 3 -width 60
scrollbar .message.scroll -relief sunken -command ".message.text yview"
pack .message.text -side left -fill both -padx 2 -pady 2 -expand 1
pack .message.scroll -side right -fill y
pack .message -side top -fill both -expand 1

set status(rx_load5) "0.0"
set status(tx_load5) "0.0"
set status(rx_load30) "0.0"
set status(tx_load30) "0.0"
set status(rx_load150) "0.0"
set status(tx_load150) "0.0"
openFifo $default_FIFO
