#! /local/bin/wish -f

#---------------------------------------------------------------------------
# Copyright (C) 1994    Institut Pasteur
# Copyright (C) 1994    Pierre David & Universite de Versailles - St. Quentin
#                       en Yvelines
# Copyright (C) 1993-94 OLEANE
# All rights reserved.
# See the file COPYRIGHT for the terms and licence of use.
#---------------------------------------------------------------------------

#
# xnetup
#
# A X interface to a host monitoring utility.
#
# Authors :
#	Pierre David		<pda@prism.uvsq.fr>
#	Christophe Wolfhugel	<wolf@pasteur.fr>
#
# Bugs: netup@pasteur.fr

set conf(conf)	/local/adm/conf/netup.conf

set dotfile	$env(HOME)/.xnetuprc

# RCS ID: do not change, use this revision number to report bugs.
set version	{$Id: xnetup,v 1.4 1994/11/10 08:44:03 wolf Exp $}

#
# Options
#

set options(fixedfont)		fixed
set options(sortstatus)		name
set options(showip)		yes
set options(showfiltered)	yes
set options(filteryes)		{}
set options(filterno)		{}
set options(historyreverse)	yes
set options(showactive)		yes
set options(scrollright)	yes
set options(topgeometry)	{}
set options(historygeometry)	{}
set options(writedotfile)	yes

#
# Cmd line options
#
set cmdopt(telnet)		yes

#
# Global variables
#
set hnametoip(nothing)		{}

set compiledfilters(yes)	{}
set compiledfilters(no)		{}

set historysize			0

set dateglobalfile		0


###############################################################################
# Perl configuration reading
###############################################################################

#
# Read the perl configuration file
#

proc read-perl-conf {} {
    global hnametoip conf

    unset hnametoip
    set mandatory {delay dir hist global}

    # just to save typing and limit long lines
    set f $conf(conf)

    # destroy variables since reload will say that the corresponding
    # keywords will be present twice.
    foreach i $mandatory {
	if {[info exists conf($i)]} then {
	    unset conf($i)
	}
    }

    # test if configuration file exists
    if {! [file exists $f]} then {
	puts stderr "$f doesn't exist!"
	exit 1
    }

    # read the perl configuration file
    set n 0
    set fd [open $f r]
    while {[gets $fd line] > -1} {
	incr n

	# remove comments, then remove trailing blanks, and skip blank lines
	regsub {#.*} $line "" line
	regsub {[ 	]*$} $line "" line
	if {[string length $line] == 0} then { continue }

	set keyword [lindex $line 0]
	switch -- $keyword {
	    delay  -
	    dir    -
	    global -
	    hist   {
		if {[info exists conf($keyword)]} then {
		    puts stderr "warning: duplicate '$keyword' in $f, line $n"
		}
		set conf($keyword) [lindex $line 1]
	    }
	    iaction { }
	    action { }
	    fping { }
	    chkpnt { }
	    host {
		set addr [lindex $line 1]
		set file [lindex $line 3]
		set hnametoip($file) $addr
	    }
	    default {
		puts stderr "warning: invalid keyword ($keyword) in $f, line $n"
	    }
	}
    }
    close $fd

    # check mandatory fields
    foreach i $mandatory {
	if {! [info exists conf($i)]} then {
	    puts stderr "error: keyword '$i' not present in $f"
	    exit 1
	}
    }

    # updates directories
    foreach i {hist global} {
	set firstchar [string index $conf($i) 0]
	if {[string compare $firstchar /] != 0} then {
	    set conf($i) $conf(dir)/$conf($i)
	}
    }

    # local modifications
    set conf(delay) [expr $conf(delay) / 4 ]
}

proc getip {host} {
    global hnametoip

    if {[info exists hnametoip($host)]} then {
	set ip $hnametoip($host)
    } else {
	set ip "??"
    }
    return $ip
}


###############################################################################
# Configuration file processing
###############################################################################

proc read-dotfile {} {
    global dotfile
    global options

    if {[file exists $dotfile]} then {
	source $dotfile
    }

    foreach f {yes no} {
	set err [filter-compile $f $options(filter$f)]
	if {[string length $err] != 0} then {
	    puts stderr "error: bad filter in $dotfile"
	    puts stderr "options($f)"
	    puts stderr $err
	    exit 1
	}
    }
}

proc write-dotfile {} {
    global dotfile
    global options

    if {[string compare $options(writedotfile) yes] == 0} then {
    	if {! [file exists $dotfile] || [file writable $dotfile]} then {
	    foreach l {{. top} {.history history}} {
		set w [lindex $l 0]
		set n [lindex $l 1]
		if {[winfo exists $w]} then {
		    set options(${n}geometry) [wm geometry $w]
		}
	    }

	    set fd [open $dotfile w]
	    puts $fd {# This file contains only machine generated command}
	    puts $fd {# Do not edit!}
	    set optl [array names options]
	    foreach i $optl {
		puts $fd "set options($i) {$options($i)}"
	    }
	    close $fd
	}
    }
}

proc quit {} {
    write-dotfile
    exit 0
}

###############################################################################
# Widget management subroutines
###############################################################################

#
# Create a frame, an item (listbox or text widget) and a scrollbar.
# The frame is not packed.
#

proc itemscroll  {item w} {
    global options

    frame $w -borderwidth 0

    $item $w.item -relief sunken -setgrid yes \
        -yscrollcommand "$w.sb set"
    pack $w.item -expand yes -fill both -side left

    scrollbar $w.sb -command "$w.item yview"

    if {[string compare $options(scrollright) yes] == 0} then {
	pack $w.sb -after $w.item -side right -fill y
    } else {
	pack $w.sb -before $w.item -side left -fill y
    }
}

proc topwidget {w title icontitle} {
    catch {destroy $w}

    toplevel $w
    wm title $w $title
    wm iconname $w $icontitle
    wm minsize $w 1 1
    wm group $w .
}

###############################################################################
# Main window management
###############################################################################

#
# Install the current date in a label widget
#

proc install-date {} {
     .status.date configure -text [exec date]
}

#
# Create all widgets of our application
#

proc create-widgets {} {
    global options

    # buttons at the top
    frame .head -relief raised
    pack .head -side top -fill x

    menubutton .head.file -text "File" \
			-menu .head.file.m -underline 0
    pack .head.file -side left
    menubutton .head.options -text "Options" \
			-menu .head.options.m -underline 0
    pack .head.options -side left
    menubutton .head.filters -text "Filters" \
			-menu .head.filters.m -underline 4
    pack .head.filters -side left
    menubutton .head.help -text "Help" \
			-menu .head.help.m -underline 0
    pack .head.help -side right

    tk_menuBar .head .head.file .head.options .head.filters .head.help
    focus .head

    menu .head.file.m
    .head.file.m add command -label "Reload" -underline 0 -command manual-reload
    .head.file.m add command -label "Quit"   -underline 0 -command quit

    menu .head.options.m
    .head.options.m add checkbutton -label "Scrollbar on the Right" \
		-underline 17 \
		-variable options(scrollright) -onvalue yes -offvalue no \
		-command scroll-right
    .head.options.m add checkbutton -label "Show IP Addresses" \
		-underline 5 \
		-variable options(showip) -onvalue yes -offvalue no \
		-command showip
    .head.options.m add separator
    .head.options.m add checkbutton -label "Show Active Hosts" \
		-underline 5 \
		-variable options(showactive) -onvalue yes -offvalue no \
		-command show-active
    .head.options.m add cascade     -label "Sort..." \
		-underline 0 \
		-menu .head.options.m.sort
    .head.options.m add separator
    .head.options.m add checkbutton -label "Show History Window" \
		-underline 5 \
		-variable options(showhistory) -onvalue yes -offvalue no \
		-command show-history

    menu .head.options.m.sort
    .head.options.m.sort add radiobutton -label "By name" \
		-underline 3 \
		-variable options(sortstatus) -value name \
		-command display-global
    .head.options.m.sort add radiobutton -label "By time" \
		-underline 3 \
		-variable options(sortstatus) -value time \
		-command display-global
    .head.options.m.sort add radiobutton -label "By IP address" \
		-underline 3 \
		-variable options(sortstatus) -value ipaddr \
		-command display-global

    menu .head.filters.m
    .head.filters.m add checkbutton -label "Show Filtered Lists" \
		-underline 0 \
		-variable options(showfiltered) -onvalue yes -offvalue no \
		-command display-global
    .head.filters.m add command -label "Edit Active hosts" \
		-underline 5 \
		-command {filters yes}
    .head.filters.m add command -label "Edit Unreachable hosts" \
		-underline 5 \
		-command {filters no}

    menu .head.help.m
    .head.help.m add command -label "on this Window" \
		-underline 3 -command {help mainwindow}
    .head.help.m add command -label "on History Window" \
		-underline 3 -command {help history}
    .head.help.m add command -label "on Filters" \
		-underline 3 -command {help filters}

    # status area
    frame .status -borderwidth 0
    pack .status -side top -expand yes -fill both

    # date at the top
    label .status.date  -anchor center
    pack .status.date -side top -fill x
    install-date

    foreach i {{no {Unreachable hosts}} {yes {Active hosts}}} {
	set name [lindex $i 0]
	set text [lindex [lrange $i 1 end] 0]

	frame .status.$name
	pack .status.$name -side right -expand yes -fill both

	# label
	label .status.$name.label -text $text -anchor center
	pack .status.$name.label -side top -fill x

	# listbox
	itemscroll listbox .status.$name.list
	pack .status.$name.list -expand yes -fill both
	.status.$name.list.item configure -font $options(fixedfont)
	.status.$name.list.item configure -geometry 56x30
	tk_listboxSingleSelect .status.$name.list.item
	bind .status.$name.list.item <Double-1> "start-action $name %W %y"
    }

    #
    # Make the window resizable
    #
    wm minsize . 1 1

    #
    # restore old geometry if any.
    #
    if {[string length $options(topgeometry)] != 0} then {
	wm geometry . $options(topgeometry)
    }

    # for menu traversal
    focus default .head
}

proc start-action {type w y} {
    global cmdopt

    if {[string compare $cmdopt(telnet) yes] != 0} then {
	return
    }

    set index [$w nearest $y]
    set listitem [$w get $index]

    if {[llength $listitem] == 3} then {
	# ip file time
	set ip [lindex $listitem 0]
    } else {
	# file time
	set ip [getip [lindex $listitem 0]]
    }

    exec xterm -e telnet $ip &
}

proc show-active {} {
    global options

    switch -- $options(showactive) {
	yes	{ catch {pack .status.yes -side left -expand yes -fill both }}
	no	{ catch {pack forget .status.yes }}
    }
}

proc scroll-right {} {
    global options

    foreach w {.status.yes.list .status.no.list .help.contents \
		.history.list .filters-yes.text .filters-no.text} {
	if {[winfo exists $w]} then {
	    pack forget $w.sb
	    if {[string compare $options(scrollright) yes] == 0} then {
		pack $w.sb -after $w.item -side right -fill y
	    } else {
		pack $w.sb -before $w.item -side left -fill y
	    }
	}
    }
}

###############################################################################
# Active/Unreachable hosts update
###############################################################################

proc periodic-reload {} {
    global conf

    reload
    reload-modified-history
    after $conf(delay)000 {periodic-reload}
}

proc manual-reload {} {
    global dateglobalfile

    read-perl-conf

    # force reload of global file
    set dateglobalfile 0
    reload

    reload-all-history
}

# a short hand to display without reloading global file
proc showip {} {
    display-global
    reload-all-history
}

#
# Reload a list in a listbox
#

proc reload-listbox {w l} {
    global options

    #
    # Remove stuff from listbox if already present
    #
    $w delete 0 end

    #
    # Insert each list element in the listbox
    #
    foreach i $l {
	set ipaddr [lindex $i 0]
	set name   [lindex $i 1]
	set time   [lindex $i 2]

	if {[string compare $options(showip) yes] == 0} then {
	    set i [format "%-15s %-29s %9s" $ipaddr $name $time]
	} else {
	    set i [format "%-29s %9s"               $name $time]
	}
        $w insert end $i
    }
}

#
# Reads the global file and returns two global variables:
# - lyes : list of active hosts
# - lno  : list of unreachable hosts
# These lists are in row state (not sorted, not filtered)
#

proc read-global-file {} {
    global conf
    global dateglobalfile
    global lyes lno

    if {[catch  "file mtime $conf(global)" newdate]} then {
	# file doesn't exists
        return 0
    }

    if {$newdate <= $dateglobalfile} then {
	return 0
    }
    set dateglobalfile $newdate

    #
    # Read data file maintened by the perl engine.
    #

    set lyes {}
    set lno  {}

    set fd [open $conf(global) "r"]
    while {[gets $fd line] > -1} {
	if {[llength $line] == 3} then {
	    set name [lindex $line 0]
	    set stat [lindex $line 1]
	    set time [lindex $line 2]

	    set ip [getip $name]
	    set l [list $ip $name $time]

	    switch -- $stat {
		alive       { lappend lyes $l}
		unreachable { lappend lno  $l}
	    }
	}
    }
    close $fd

    # return code 1 means that we have read something
    return 1
}

#
# Display the global variables "lyes" and "lno",
# with filtering and sorting in the listbox.
#

proc display-global {} {
    global options
    global compiledfilters
    global lyes lno

    if {[info exists lyes] && [info exists lno]} then {
	#
	# Filter these variables
	#
	set newlyes [filter-active $compiledfilters(yes) $lyes]
	set newlno  [filter-active $compiledfilters(no)  $lno ]

	#
	# Sort these variables
	#
	set newlyes [sort-active $options(sortstatus) $newlyes]
	set newlno  [sort-active $options(sortstatus) $newlno ]

	#
	# updates the listboxes
	#
	reload-listbox .status.yes.list.item $newlyes
	reload-listbox .status.no.list.item  $newlno
    }

}

proc reload {} {
    #
    # read the file maintained  by the perl engine and set
    # the two lists "lyes" and "lno" accordingly.
    #
    set r [read-global-file]

    #
    # Install the date
    #
    install-date

    #
    # if the global file didn't change, there is no need to update
    # the display.
    #
    if {$r} then {
	display-global
    }
}

proc sort-active {crit l} {
    # l if of the form {{ip name time} {ip name time} ...}
    switch -- $crit {
	name	{ set l [lsort -command active-comp-name $l] }
	time	{ set l [lsort -command active-comp-time $l] }
	ipaddr	{ set l [lsort -command active-comp-ip $l]   }
    }
    return $l
}

proc active-comp-name {l1 l2} {
    set n1 [lindex $l1 1]
    set n2 [lindex $l2 1]
    return [string compare $n1 $n2]
}

proc active-comp-time {l1 l2} {
    set e1 [format "%10s" [lindex $l1 2]]
    set e2 [format "%10s" [lindex $l2 2]]
    set r [string compare $e1 $e2]
    if {$r == 0} then {
	# if identical, the names become the secondary key
	set n1 [lindex $l1 1]
	set n2 [lindex $l2 1]
	set r [string compare $n1 $n2]
    }
    return $r
}

proc active-comp-ip {l1 l2} {
    set ip1 [lindex $l1 0]
    set ip2 [lindex $l2 0]

    # unknown IP addresses are represented as "??"
    set isip1 [expr "[string compare $ip1 ??]==0?0:1"]
    set isip2 [expr "[string compare $ip2 ??]==0?0:1"]

    switch -- $isip1$isip2 {
	00	{ set r [string compare [lindex $l1 1] [lindex $l2 1]] }
	01	{ set r -1 }
	10	{ set r  1 }
	11	{
		    # convert ip addresses to a 32 bit number
		    set n1 [iptonumber $ip1]
		    set n2 [iptonumber $ip2]
		    if {$n1 < $n2} then {
			set r -1
		    } elseif {$n1 > $n2} then {
			set r 1
		    } else {
			set r 0
		    }
		}
    }
    return $r
}

proc iptonumber {ip} {
    set n 0
    set l [split $ip .]
    foreach i $l {
	set n [expr "($n*256)+$i"]
    }
    return $n
}


###############################################################################
# Active/Unreachable list filtering
###############################################################################

#
# Applies the filter "filter" on list "list"
#

proc filter-active {filter list} {
    global options

    if {[string compare $options(showfiltered) no] == 0} then {
	return $list
    }

    set filteredlist {}

    foreach item $list {
	set ok [filter-active-pattern $filter $item]
	if {$ok} then {
	    lappend filteredlist $item
	}
    }
    return $filteredlist
}

proc filter-active-pattern {filter item} {
    set ipaddr [lindex $item 0]
    set name   [lindex $item 1]
    set time   [lindex $item 2]

    # we stop as soon as we get a match
    set match 0

    foreach pattern $filter {
	set include [lindex $pattern 0]
	set type    [lindex $pattern 1]
	set arg     [lindex $pattern 2]

	switch -- $type {
	    ipaddr	{
			    if {[string match $arg $ipaddr]} then {
				set match 1
			    }
			}
	    name	{
			    if {[string match $arg $name]} then {
				set match 1
			    }
			}
	    time	{
			    set relop $arg
			    set arg   [lindex $pattern 3]

			    set r [string compare $time $arg]
			    if {[expr $r $relop 0]} then {
				set match 1
			    }
		    	}
	}

	if {$match} then {
	    # include is 1 (include) or 0 (exclude)
	    return $include
	}
    }

    # default is to include everything
    return 1
}

###############################################################################
# Help text
###############################################################################

########## main window

set helptext(mainwindow) {The main window shows 2 lists:
    - the list of active hosts       (on the left)
    - the list of unreachable hosts  (on the right)

Depending on an option (see below), the list of active hosts may not be present
on the screen.

Each list shows 2 or 3 columns, depending on an option (see below):
    - IP address (may be hidden)
    - name of host as written in the configuration file
    - time of last status change. Format is: day+hour:minute.
	For example: 2+05:20 means that the last recorded change has been
	2 days, 5 hours and 20 minutes ago.

Status of these hosts is checked every 2 minutes by a separate program which
writes in a file. Date of last reading of this file is located under the
menu bar.

If you double click (with the mouse button 1) on a host in the list of
active hosts, a "telnet" window is opened (unless this has been deactivated
with the command line).

The "File" menu contains 2 items:
    - "Reload": reloads the configuration file, rereads the file and
	updates the two lists as well as the "history" list (see help on
	"History window").
    - "Quit": updates the ~/.xnetuprc and quits.

The "Options" menu contains the following items:
    - "Scrollbar on the Right": places all scrollbars on the right of the
	corresponding list (listbox or text area).
    - "Show IP Addresses": shows IP addresses in the 2 lists (active and
	unreacheable) as well as in the history window.
    - "Show Active Hosts": shows or hides the "Active" list.
    - "Sort": sorts the 2 lists (active and unreachable) according to name,
	IP address or time of last change. Please note that you can sort
	by IP address even if these informations are not shown.
    - "Show History Window": makes the history window appears (see help on
	"History Window").

The "Filters" menu contains the following items:
    - "Show Filtered Lists": enables or disables the filtering of the 2
	lists.
    - "Edit Active hosts" and "Edit Unreachable hosts": specifies the
	filters to use for these lists. See the help on "Filters".
}


########## filters

set helptext(filters) {You can filter some information in the following contexts:
    - list of active hosts
    - list of unreachable hosts
Each of these lists is filtered by a particular set of patterns.

Each of these patterns contains the keyword "include" or "exclude" in
order to accept or reject the matching line.

Selection is made:
    - by name          (keyword is name)
    - by time          (keyword is time)
    - by IP address    (keyword is ipaddr)

Patterns are applied in order. The first match is taken. The default
last pattern is to include everything.

Comments begin with the "#" character and continue until the end of the line.

Please, don't input braces ("{" and "}") or other special characters in
patterns as well as in comments. This would cause big problems when saving
these filters.

The complete syntax of one pattern is:

<pattern> ::= <inc> <rest>
<inc>     ::= include | exclude
<rest>    ::= <name> | <time> | <ipaddr>

<name>    ::= name <regexp>
<regexp>  ::= <any-shell-regular-expression>

<time>    ::= time <relop> <delay>
<relop>   ::= < | <= | > | >= | == | !=
<delay>   ::= <digit>* <digit> + <digit> <digit> : <digit> <digit>

<ipaddr>  ::= ipaddr <regexp>

Examples:
    - to show only hosts on an hypothetical backbone which have been
	down for less than 2 hours

		# include every host on our backbone network 10.1.x.y
		include ipaddr 10.1.*.*        # could have been 10.1.*
		# include only hosts which have changed state for 2 hours
		include time < 0+02:00
		# exclude everything else
		exclude name *

    - to exclude from display all hosts from site "site"

		# this is another example
		exclude name site/*
}


########## history

set helptext(history) {The history window displays last changes in host status.
The list contains 4 columns:
    - date of last change
    - name of host as it appears in the configuration file
    - IP address of this host if the "Show IP Addresses" options has been set
	in the "Options" menu of the main window.
    - previous status, which is: "alive", "unreachable" or "??" which means that
	the previous status was not know.
    - current status, which is: "alive" or "unreachable"

The "File" menu allows you to close this window.

The "Options" menu contains one item:
    - "Reverse Display": (generally on) if this option is turned on,
	the history file is displayed most recent change first.
}

###############################################################################
# Help
###############################################################################

proc help {type} {
    global helptext

    if {! [winfo exists .help]} then {
	topwidget .help Help help

	# buttons
	frame .help.head -relief raised
	pack .help.head -side top -fill x

	menubutton .help.head.file -text "File" \
		-underline 0 -menu .help.head.file.m
	pack .help.head.file -side left

	menu .help.head.file.m
	.help.head.file.m add command -label "Close" \
		-underline 0 -command {destroy .help}

	tk_menuBar .help.head .help.head.file
	focus .help.head

	# help text
	itemscroll text .help.contents
	pack .help.contents -side top -expand yes -fill both
	.help.contents.item configure -height 24 -width 80 -wrap word
    }

    .help.contents.item configure -state normal
    .help.contents.item delete 1.0 end
    .help.contents.item insert end $helptext($type)
    .help.contents.item configure -state disabled
}

###############################################################################
# Filter management
###############################################################################

# format of constants:
# item 0 : title
# item 1 : is there a "copy active filter" button ?
# item 2 : -

set filtersconst(yes)		{{Active hosts} no}
set filtersconst(no)		{{Unreachable hosts} no}

#
# Create a top level window to edit filters
# type is one of : yes or no
#

proc filters {type} {
    global filtersconst

    if {! [info exists filtersconst($type)]} then {
	return
    }
    set title [lindex $filtersconst($type) 0]
    set copyb [lindex $filtersconst($type) 1]

    set w .filters-$type

    topwidget $w "Filters on $title" "[string tolower $title] filters"

    # button bar
    frame $w.head -relief raised
    pack $w.head -side top -fill x -expand yes

    menubutton $w.head.file -text "File" \
	    -underline 0 -menu $w.head.file.m
    pack $w.head.file -side left

    menubutton $w.head.help -text "Help" \
	    -underline 0 -menu $w.head.help.m
    pack $w.head.help -side right

    menu $w.head.file.m
    $w.head.file.m add command -label "Apply" \
	    -underline 0 -command "filters-apply $type"
    $w.head.file.m add command -label "Close without Install" \
	    -underline 6 -command "destroy $w"
    $w.head.file.m add command -label "Close and Install" \
	    -underline 0 -command "filters-ok $type"

    menu $w.head.help.m
    $w.head.help.m add command -label "on Filters" \
	    -underline 3 -command "help filters"
	
    tk_menuBar $w.head $w.head.file $w.head.help


    # pattern editing
    itemscroll text $w.text
    pack $w.text -side top -expand yes -fill both
    focus $w.text.item

    filters-reload $type
}

proc filters-reload {type} {
    global options

    .filters-$type.text.item delete 1.0 end
    foreach f $options(filter$type) {
	.filters-$type.text.item insert end $f
	.filters-$type.text.item insert end \n
    }
}

proc filters-ok {type} {
    filters-apply $type
    destroy .filters-$type
    write-dotfile
}

proc filters-apply {type} {
    global options

    set l [filter-get $type]
    set err [filter-compile $type $l]
    if {[string length $err] != 0} then {
	tk_dialog .err "Incorrect filter" $err "" 0 OK
    }

    set options(filter$type) $l
    set options(showfiltered) yes
    display-global
}

proc filter-get {type} {
    set l [.filters-$type.text.item get 1.0 end]
    set l [split $l \n]
    return $l
}

#
# Compile a filter (a list of lines containing comments and patterns)
# into an intermediate form.
# This form is:
#  {{name/time/ipaddr comparison-operator parameter} ...}
# A sanity check is also performed.
# If the filter is syntaxically correct, the compiled form is placed in
# the compiledfilters array and the null list is returned.
# If the filter is not correct, a error message is returned giving
# the location where the problem has been found.
#

proc filter-compile {type f} {
    global compiledfilters

    set lineno 0
    set c {}
    foreach p $f {
	incr lineno
	set line $p
	regsub {#.*} $line "" line
	regsub {[ 	]*$} $line "" line
	if {[string length $line] != 0} then {
	    set v [pattern-compile $line]
	    set err [lindex $v 0]
	    set comp [lindex $v 1]
	    if {[string length $err] != 0} then {
		return "$err\nin line $lineno\n$p"
	    }
	    lappend c $comp
	}
    }
    set compiledfilters($type) $c
    return {}
}

#
# returns a two element list : {err comp}
# err is the error code if not compiled successfully
# comp is the compiled form if compiled successufully
#

proc pattern-compile {p} {
    set wordno 0
    set comp {}

    set timeregexp {^[0-9]+\+[0-9][0-9]:[0-9][0-9]$}

    while {$p != {}} {
	set word [lindex $p 0]
	set p [lreplace $p 0 0]
	incr wordno

	if {$wordno == 1} then {
	    switch -- $word {
		include	{ lappend comp 1 }
		exclude	{ lappend comp 0 }
		default	{ return [list "first word is not include/exclude" {}]}
	    }
	} elseif {$wordno == 2} then {
	    switch -- $word {
		name	{ lappend comp $word }
		time	{ lappend comp $word }
		ipaddr	{ lappend comp $word }
		default	{ return [list "selector is not name/time/ipaddr" {}] }
	    }
	    set type $word
	} elseif {$wordno == 3} then {
	    switch -- $type {
		name	-
		ipaddr	{
			    lappend comp $word
			}
		time	{
			    if {[lsearch {< > <= >= == !=} $word] == -1} then {
				return [list "illegal operator: $word" {}]
			    }
			    lappend comp $word
			}
	    }
	} elseif {$wordno == 4} then {
	    switch -- $type {
		name	-
		ipaddr	{ return [list "illegal number of terms: $word" {}] }
		time	{
			    if {[regexp $timeregexp $word]} then {
				lappend comp $word
			    } else {
				return [list "illegal time specification: $word" {}]
			    }
			}
	    }
	} else {
	    return [list "illegal number of terms: $word" {}]
	}
    }
    return [list {} $comp]
}

###############################################################################
# History management
###############################################################################

#
# Display the history window
#

proc show-history {} {
    global options

    if {[string compare $options(showhistory) yes] == 0} then {
	topwidget .history History history

	# buttons
	frame .history.head -relief raised
	pack .history.head -side top -fill x

	menubutton .history.head.file -text "File" \
		-underline 0 -menu .history.head.file.m
	pack .history.head.file -side left
	menubutton .history.head.options -text "Options" \
		-underline 0 -menu .history.head.options.m
	pack .history.head.options -side left
	menubutton .history.head.help -text "Help" \
		-underline 0 -menu .history.head.help.m
	pack .history.head.help -side right

	menu .history.head.file.m
	.history.head.file.m add command -label "Close" \
		-underline 0 -command unshow-history

	menu .history.head.options.m
	.history.head.options.m add checkbutton -label "Reverse Display" \
		-underline 0 \
		-variable options(historyreverse) -onvalue yes -offvalue no \
		-command reload-all-history
	
	menu .history.head.help.m
	.history.head.help.m add command -label "on History Window" \
		-underline 3 -command {help history}

	tk_menuBar .history.head \
		.history.head.file .history.head.options .history.head.help
	focus .history.head

	# list
	itemscroll listbox .history.list
	pack .history.list -side top -expand yes -fill both
	.history.list.item configure -font $options(fixedfont)
	.history.list.item configure -geometry 90x30

	# Make the window resizable
	wm minsize .history 1 1

	# get the last remembered size if any
	if {[string length $options(historygeometry)] != 0} then {
	    wm geometry .history $options(historygeometry)
	}

	reload-all-history
    } else {
	unshow-history
    }
}

proc unshow-history {} {
    global options

    set options(showhistory) no
    if {[winfo exists .history]} then {
	set options(historygeometry) [wm geometry .history]
    }
    catch {destroy .history}
}

#
# Install the history data
#

proc reload-all-history {} {
    global historysize

    set historysize 0
    reload-modified-history
}

#
# Update the history list, tracking file size changes
#

proc reload-modified-history {} {
    global historysize
    global conf
    global options

    # no need to update if no history window present
    if {! [winfo exists .history]} then {
	return
    }

    # no need to update if no history file present
    if {! [file exists $conf(hist)]} then {
	return
    }

    # no need to update if history file didn't changed size
    set new_historysize [file size $conf(hist)]
    if {$new_historysize == $historysize} then {
	return
    }

    # if history file is new, or if file has been removed, then
    # we need to refresh the whole list.
    if {$historysize == 0 || $new_historysize < $historysize} then {
	set historysize 0
	.history.list.item delete 0 end
    }

    # do we need to add at the end or at the beginning
    if {[string compare $options(historyreverse) yes] == 0} then {
	set insertpos 0
    } else {
	set insertpos end
    }

    # open the file and set the file pointer
    set fd [open $conf(hist) r]
    seek $fd $historysize start

    # read the file
    while {[gets $fd line] > -1} {
	# yyyymmddhhmm
	set date [lindex $line 0]
	# file name
	set host [lindex $line 1]
	# previous state
	set prev [lindex $line 2]
	# current state
	set curr [lindex $line 3]

	set item [format "%s  " [format-date $date]]
	append item [format "%-30s " $host]
	if {[string compare $options(showip) yes] == 0} then {
	    append item [format "%-15s " [getip $host]]
	}
	append item [format "%-11s %-11s" $prev $curr]

	.history.list.item insert $insertpos $item
    }

    # remember current position and close the file
    set historysize [tell $fd]
    close $fd
}

# process a date given as yyyymmddhhmm
# returns : Mon dd yyyy hh:mm (17 chars)
set monthes {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}

proc format-date {date} {
    global monthes

    set year [string range $date 0 3]
    set mo   [string range $date 4 5]
    set dy   [string range $date 6 7]
    set hr   [string range $date 8 9]
    set mn   [string range $date 10 11]

    # a leading 0 implies an octal number with "expr"
    if {[string index $mo 0] == 0} then { set mo [string index $mo 1] }

    set mon [lindex $monthes [expr $mo - 1]]

    # Mon dd yyyy hh:mm
    set newdate [format "%s %s %s %s:%s" $mon $dy $year $hr $mn]

    return $newdate
}

###############################################################################
# Management of key bindings in text widgets
###############################################################################

bind Text <Up>		{%W mark set insert insert-1lines }
bind Text <Down>	{%W mark set insert insert+1lines }
bind Text <Left>	{%W mark set insert insert-1chars }
bind Text <Right>	{%W mark set insert insert+1chars }

bind Text <2>		{%W insert insert [selection get] }

###############################################################################
# Options processing
###############################################################################

proc basename {path} {
    set p [split $path /]
    set n [llength $p]
    return [lindex $p [expr $n-1]]
}

proc set-options {argv0 argv} {
    global conf options cmdopt version

    read-dotfile

    set usage {[-version] [-display <dsp>] [-[no]rc] [-notelnet] [-conf <file>"}

    while {[llength $argv] != 0} {
	set opt [lindex $argv 0]
	set arg [lindex $argv 1] ; set choparg 1
	switch -- $opt {
	    {-conf}	{ set conf(conf) $arg }
	    {-rc}	{ set options(writedotfile) yes ; set choparg 0}
	    {-norc}	{ set options(writedotfile) no ; set choparg 0}
	    {-notelnet}	{ set cmdopt(telnet) no ; set choparg 0}
	    {-v}	-
	    {-version}	{ 
		puts stderr "$argv0: version $version"
		exit 0
	    }
	    default	{
		puts stderr "invalid option: $opt"
		puts stderr "usage: $argv0 $usage"
		exit 1
	    }
	}
	set argv [lreplace $argv 0 $choparg]
    }

    read-perl-conf
}

###############################################################################
# Main program
###############################################################################

set tk_strictMotif 1
set argv0 [basename $argv0]

set-options $argv0 $argv
create-widgets
show-active
show-history
scroll-right
periodic-reload
