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

# Default globals

# default directory to look for fifo's in.
set fifodir "/etc/diald/"
set monfifo ""
set monfd ""
set fifofd ""

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

# 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 {$fifofd!=""} {
    	puts $fifofd "monitor"
    }
    if {$monfd!=""} {close $monfd}
    if {$monfifo!=""} {exec rm $monfifo}

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

#    set monfifo /tmp/dialdmon.[pid]
    set monfifo /tmp/dialdmon
    catch {exec mkfifo $monfifo}
    puts $fifofd "monitor $monfifo"
    flush $fifofd
    set monfd [open $monfifo r]
    fileevent $monfd readable {stateChange}
}

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

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

proc stateChange {} {
    global monfd status
    set foo [gets $monfd]
    if {$foo=="STATE"} {
	set status(fsm) [gets $monfd]
        wm iconname . $status(fsm)
    }
    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]
	.queue.text delete 0.0 end
	while {$foo!="END QUEUE"} {
	    .queue.text insert end $foo
	    .queue.text insert end "\n"
	    set foo [gets $monfd]
	}
    }
    if {$foo=="INTERFACE"} {
	set status(iface) [gets $monfd]
	set status(lip) [gets $monfd]
	set status(rip) [gets $monfd]
    }
    update
}

proc dctrlQuit {} {
    global fifofd

    if {$fifofd!=""} {
    	puts $fifofd "monitor"
    	flush $fifofd
    }
    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"}
set col2 {status(fsm) status(up) status(timeout)
	status(force) status(force_timeout)}
set col3 {"Impulse State" "Initial Impulse"
	"Impulse Length" "Impulse Fuzz" "Impulse Timeout"}
set col4 {status(impmode) status(imp_itime) status(imp_time)
	status(imp_fuzz) status(imp_timeout)}

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

