#! /usr/X11R6/bin/wish8.0
#
# $Log: tkfirewall,v $
# Revision 1.18  1999/03/26 05:15:03  gi2
# bugfix: the filter deletion routine would try to delete meta-information twice
#         started experimenting with the BLT library to add drag and drop
#
# Revision 1.17  1999/02/11 11:14:55  gi2
# This revision moves the connection scanner into a separate program,
# since the GUI is supposed to be general-purpose whereas the scanner
# is (still) designed to support only certain types of networks. Thus it
# seems easier to develop and maintain the GUI separately from the scanner.
# The communication architecture between the scanner and the GUI is
# preliminary; the GUI calls the scanner program explicitly and executes
# commands from the scanner output (stdout), returning results to the scanner
# via stdout(GUI) -> stdin(scanner). This will most likely change in the
# future, in accordance with other decisions. The most important decision for
# the next revision(s) is the choice of the language and/or extension.
# There are some features that seem mandatory for the next revision(s), although
# standard Tcl/Tk 8.0 does not provide some of the facilities to implement them
# elegantly or to implement them at all. For this reason I will consider to
# either move to a different language like PerlTk (aka tkPerl) or Java at some
# point or to use one or more of the commonly available (Tcl/)Tk extensions. I
# think the following features will have to be supported:
#   a) network communication between the GUI and the scanner
#   b) interface/network scanner improvement: redesigning the scanner with a
#   better overall structure and extensibility and also make it work more
#   interactively with the user. It should be possible, for example, to ask the
#   scanner to create some specific rules, e.g. for anti-spoofing, and to let the
#   GUI insert them at a given point.
#   c) secure network communication
#   d) easier maintenance/extensibility: reformulation of the program with
#   object technology
#   e) drag and drop: cut and paste should be more visual. This is something
#   I wanted to have from an early stage on, but only some extensions (most
#   notably BLT) and Java support drag and drop.
#   f) preservation of rapid development benefits
# As of now, at least the following Tcl/Tk features, extensions or features in
# other languages are available to solve these problems:
#   a) Tcl/Tk: socket; Perl/Tk: socket (and many friends);
#   Java: socket, RMI, CORBA; Tcl-DP (distributed programming): RPC, several
#   network protocols
#   b) Tcl/Tk: using external programs like host; Perl/Tk: gethostbyname and
#   several other network functions; Java: ???; scotty (Tcl extension): icmp, dns
#   and friends
#   c) Tcl/Tk: encryption using trf, trCrypt or SSLtcl extensions, external
#   programs like ssh; Perl/Tk: external programs like ssh, SSLeay or other crypt
#   modules?; Java: crypto API
#   d) Tcl/Tk: limited object structure; Perl/Tk: objects/modules; Java: objects,
#   modules, beans, components,...
#   e) Tcl/Tk: using BLT (or Tix); Perl/Tk: ???; Java: using Swing (or others...)
#   f) Tcl/Tk: rapid development capabilities for small to medium size is there,
#   but maintainability questionable; Perl/Tk: rapid development is there, with
#   much reduced maintainability impact; Java: rapid development is questionable
#   (much more implementation work and debugging), maintainability is ok.
# It seems that the best choice for now would be a modestly extended Tcl/Tk,
# or Perl/Tk. The move to Java would mean a major rewrite (perhaps facilitated
# by TclBlend or even jacl). But Java would offer the greatest platform
# independence for the GUI (and maybe even for the scanner, if that is wanted).
# Also it would be advisable to use Java if the project wanted to include more
# components. At the time being, it is not clear what componets should be
# incorporated into this project. Thus a move to Java is not yet in order.
# The decision between extended Tcl/Tk and Perl/Tk with modules is not yet clear
# either, but it can be answered more easily after making some more progress
# anyway and the transition will be far less difficult to accomplish, so I won't
# bother now.
# This revision was actually finished on 1998/04/12 16:56:21. I was busy with
# a larger project in between, thus the late check in.
#
# Revision 1.16  1998/03/15 19:42:02  gi2
# added syncronization calls to many functions that synchronize the
# functions with undo / redo
#
# Revision 1.15  1998/03/10 03:51:15  gi2
# This finishes the second part of the major rewrite.
# Added a global undo / redo architecture. This is - of course - BETA.
# The next part will split the program in two: tkfirewall and
# firewallscan.
#
# Revision 1.14  1998/02/23 10:57:56  gi2
# completely revised and rewritten version
# includes categories for filters
# redesigned basic data structures to support referential integrity
# and unambiguos identification, making neccesary a complete rewrite
# GUI shifted from button madness to context menus
# uncounted minor changes
#
# Revision 1.13  1998/02/11 08:02:26  root
# several changes in the default scanner.
# next version will need to separate the scanner from the GUI.
# also planning to rewrite the whole package to support categories
# of filters, with support in the scanner API for that.
#
# Revision 1.12  1998/02/02 02:10:59  root
# new buttons to manipulate logging on whole filter columns
# added undo/redo functionality
# added "Show only..." to restrict the display of filters
# to a choice of devices
# significantly improved / debugged pre-scanner
# changed calling semantics. new option: -scan to invoke scanner
# some changes made to improve "Rebuild/Update" semantics
# minor changes such as sorting the device list...
#
# Revision 1.11  1998/01/28 14:53:03  root
# implemented the notion of "trusted/untrusted" internal nets
# by implementing a filter generator for these in the pre-scanner.
# Note: esp. "Ins" and "Ins2" are BETA!
#
# Revision 1.10  1998/01/23 16:18:15  root
# preliminary final 2 (ALPHA). Improved pre-scan and creation of
# default filters rules. More edit functions, specifically insert.
#
# Revision 1.9  1998/01/21 08:59:23  root
# This version is BETA 2, with some scrolling and color (speed!) bugfixes
# (see tk_bisque at the beginning of the script). Also, a new feature:
# The routing table is scanned to produce default entries on startup.
#
# Revision 1.8  1998/01/21 04:19:58  root
# This now is the definitive BETA. It has all the
# functions I want, including full resizing (down to a
# preset minimum), scrollbars, fast update (as compared
# to the slow refresh), automatic device scanning (introduced
# earlier, though) and cut, copy and paste. The only thing
# I want now is an automatic system scan (interfaces, routes
# and such) to generate a basic filter configuration including
# anti-spoofing.
#
# Revision 1.7  1998/01/20 14:57:26  root
# Update button. Devices are read from the system (see devicelist flag).
# Bugfixes (Dump state).
#
# Revision 1.6  1998/01/19 08:53:17  root
# Up and runnning.
#
# Revision 1.5  1998/01/19 08:03:47  root
# added more, seems rounder now...
#
# Revision 1.4  1998/01/18 16:44:56  root
# First beta version,
#
# Revision 1.3  1998/01/18 03:43:11  root
# Main GUI features done. Now starting to get serious.
#
# Revision 1.2  1998/01/17 22:58:16  root
# Several new widgets.
#
#

#set tcl_traceExec 1
#lappend auto_path /usr/X11R6/lib/blt2.4
#package require BLT
#namespace import blt::*
#namespace import -force blt::tile::*
#blt::bltdebug 1
#set tcl_traceCompile 1

# This will be obsoleted soon, and permanently set to 1:
# 0 - Interfaces are entered as text. 1 - Interfaces are chosen from a list
#  of the actually available Interfaces on this computer
set devicelist 1

# Set this to 1 get a "DumpAll" button that dumps all internal filter data
# structures when pressed.
# Now, this will also produce "Trace..." button.
set debug 1

# need to set this, to call tk_bisque once again after the whole
#  range of widget types that are used in this program have been set.
#  (a trace showed that oviously only presently existent widgets
#  have their resources recolored by this command...)
#tk_bisque
set firsttime 1

#
# Proc to produce a single entry in a filter column
#
# use as:
# Filterline $parent-widget $reference_number $filter_priority_number\
#                                                   $name_of_filterarray
#
# (see the description of the category handler to get more information
#  on the $reference_number)
#

proc Filterline { w catref filtpri fnam {mod ""} } {
	global devlist devicelist showdevs firsttime
	global filt_popup_functions
	upvar #0 $fnam thisfilt
	# This is neccessary to set up the variable traces later on
	global $fnam
	# This gets the direction: in forw out
	regsub filters $fnam "" dir

	# get filter reference number
	set filtref $thisfilt($catref.pri.$filtpri)
	# to make it easier for us to refer to "this filter line", we abbreviate
	#  "$catref.$filtref" with $rf
	set rf	"$catref.$filtref"

	# This filter is not displayed if its device is not marked in the showdevs
	#  array and if "all" is not marked as well.
	if { $showdevs(all) == 0 && $showdevs($thisfilt($rf.iface)) == 0 } { return }

	# if we are just asked to unmap and remap, do it now and return
	if { [string compare $mod "remap"] == 0 } {
		set range [lrange $thisfilt($catref.priorities)\
				[lsearch -exact $thisfilt($catref.priorities) $filtpri] end]
		foreach pri $range {
			set r $thisfilt($catref.pri.$pri)
			# unmap if mapped
			if [winfo exists $thisfilt($catref.parent).$r] {
				pack forget $thisfilt($catref.parent).$r
			}
		}
		foreach pri $range {
			set r $thisfilt($catref.pri.$pri)
			# map again (in order this time)
			if [winfo exists $thisfilt($catref.parent).$r] {
				pack $thisfilt($catref.parent).$r -side top -fill x
			} else {
				# map for the first time
				Filterline $w $catref $pri $fnam
			}
		}
		return
	}

	set wf $w.$filtref

	# If this filter widget does not exist, produce it.
	if { ! [winfo exists $wf] } {
		# Produce the frame for one filter line.
		frame $wf -relief groove -borderwidth 2
		# when mapped, unmapped or destroyed, set the length of the scrollbar,
		# the "displayed" and "refs" lists and the ratio in the title
		bind $wf <Map>		[list MapFilt $fnam $catref $filtref map]
		bind $wf <Unmap>	[list MapFilt $fnam $catref $filtref unmap]
		bind $wf <Destroy>	[list MapFilt $fnam $catref $filtref destroy]

		# This initializes single widgets within one filter.
		checkbutton $wf.select -variable $fnam\($rf.select)
		trace variable $fnam\($rf.select) w SyncUndo
		pack $wf.select -side left

		# This produces a grid, with four lines stacked vertically
		# Every "entry" is bound to SyncUndo on <FocusOut>, to close the current
		#  list of changes and open a new one. Here, SyncUndo is called with
		#  additional parameters that cause it to save the current entry's
		#  state before closing the list. This is done because the variable
		#  trace mechanism works only for some kinds of changes to entry
		#  variables.
		set g [frame $wf.g]
		label $g.label0 -textvariable $fnam\($catref.$filtref.pri) -width 5
		entry $g.name -textvariable $fnam\($rf.name) -relief sunken -width 16\
										-justify center -font {-family times}
		grid  $g.label0 $g.name - - -sticky ew
		bind  $g.name	<FocusOut>	[list SyncUndo $fnam $rf.name]

		# This produces the second line in the grid
		label $g.label1 -text Source
		entry $g.source -textvariable $fnam\($rf.source) -relief sunken\
		 						-width 16 -font {-family helvetica -weight bold}
		label $g.label2 -text Ports
		entry $g.sport -textvariable $fnam\($rf.sport) -relief sunken\
								-width 16 -font {-family helvetica -weight bold}
		grid  $g.label1 $g.source $g.label2 $g.sport -sticky ew
		bind  $g.source	<FocusOut>	[list SyncUndo $fnam $rf.source]
		bind  $g.sport	<FocusOut>	[list SyncUndo $fnam $rf.sport]

		# This is the third line of the grid
		label $g.label3 -text Dest
		entry $g.dest -textvariable $fnam\($rf.dest) -relief sunken\
								-width 16 -font {-family helvetica -weight bold}
		label $g.label4 -text Ports
		entry $g.dport -textvariable $fnam\($rf.dport) -relief sunken\
								-width 16 -font {-family helvetica -weight bold}
		grid  $g.label3 $g.dest $g.label4 $g.dport -sticky ew
		bind  $g.dest	<FocusOut>	[list SyncUndo $fnam $rf.dest]
		bind  $g.dport	<FocusOut>	[list SyncUndo $fnam $rf.dport]

		# now the fourth line, with some special formatting
		switch -exact -- $dir {
			in		{label $g.iflabel -text InDev}
			forw	-
			out		{label $g.iflabel -text OutDev}
		}

		set opts [frame $g.opts]
		if { $devicelist } {
			menubutton $opts.iface -textvariable $fnam\($rf.iface)\
										-relief groove -borderwidth 2 -width 5\
										-takefocus {} -menu $opts.iface.menu
			pack  $opts.iface -side left
			set m [menu $opts.iface.menu]
			foreach dev $devlist {
				$m add radiobutton -label $dev -value $dev\
													-variable $fnam\($rf.iface)
			}
			$m add radiobutton -label "" -value "" -variable $fnam\($rf.iface)
			trace variable $fnam\($rf.iface) w SyncUndo
		} else {
			entry $opts.iface -textvariable $fnam\($rf.iface) -relief sunken\
								-width 5 -font {-family helvetica -weight bold}
			bind  $opts.iface	<FocusOut>	[list SyncUndo $fnam $rf.iface]
			pack  $opts.iface -side left -expand 1 -fill x
		}
		menubutton $opts.proto -width 4 -relief groove -borderwidth 2\
			-textvariable $fnam\($rf.proto) -takefocus {} -menu $opts.proto.menu
		pack  $opts.proto -side left
		set m [menu $opts.proto.menu]
		$m add radiobutton -label all -value all	-variable $fnam\($rf.proto)
		$m add radiobutton -label TCP -value TCP	-variable $fnam\($rf.proto)
		$m add radiobutton -label UDP -value UDP	-variable $fnam\($rf.proto)
		$m add radiobutton -label ICMP -value ICMP	-variable $fnam\($rf.proto)
		trace variable $fnam\($rf.proto) w SyncUndo

		menubutton $opts.policy -width 6 -relief groove -borderwidth 2\
		-textvariable $fnam\($rf.policy) -takefocus {} -menu $opts.policy.menu
		pack  $opts.policy -side left
		set m [menu $opts.policy.menu]
		$m add radiobutton -label accept -value accept\
													-variable $fnam\($rf.policy)
		if { [string compare $dir "forw"] == 0 } {
			$m add radiobutton -label masq -value masq\
													-variable $fnam\($rf.policy)
		}
		$m add radiobutton -label deny -value deny	-variable $fnam\($rf.policy)
		$m add radiobutton -label reject -value reject\
													-variable $fnam\($rf.policy)
		trace variable $fnam\($rf.policy) w SyncUndo
		# This binds the variable to a proc that sets the new colors.
		trace variable $fnam\($rf.policy) w FilterConfigure

		menubutton $opts.flags -width 8 -relief groove -borderwidth 2\
			-textvariable $fnam\($rf.flags) -takefocus {} -menu $opts.flags.menu
		pack  $opts.flags -side left
		set m [menu $opts.flags.menu]
		$m add radiobutton -label out -value out	-variable $fnam\($rf.flags)
		$m add radiobutton -label in -value in		-variable $fnam\($rf.flags)
		$m add radiobutton -label bidir -value bidir -variable $fnam\($rf.flags)
		$m add radiobutton -label Ack -value Ack	-variable $fnam\($rf.flags)
		$m add radiobutton -label "Syn only" -value "Syn only"\
													-variable $fnam\($rf.flags)
		$m add radiobutton -label "" -value ""		-variable $fnam\($rf.flags)
		trace variable $fnam\($rf.flags) w SyncUndo

		checkbutton $opts.log -text log -variable $fnam\($rf.log)
		trace variable $fnam\($rf.log) w SyncUndo
		pack  $opts.log -side left
		grid  $g.iflabel $opts - - -sticky ew
		# configure entry widgets to grow if space is available
#		grid columnconfigure $g 1 -weight 1
		grid columnconfigure $g 3 -weight 2
		# the next line wants to stay below this, so pack this
		#  at the top, not left (also let the configured column(s) grow...)
		pack $g -side top -fill x

		pack   $wf -side top -fill x

		# now, for all children widgets of $wf, set selection binding on them
		AddBindtagToAll $wf cat.$dir.$catref
		# for all children widgets of $wf, set context menu binding on them
		AddBindtagToAll $wf cat.$dir.$catref.$filtref
		# bind a context menu to the right mousebutton
		Contextmenu .filtmenu$catref$dir$filtref "Filter Popup"\
							$filt_popup_functions $fnam $catref $filtref
		bind cat.$dir.$catref.$filtref	<Button-3> [list tk_popup\
										.filtmenu$catref$dir$filtref %X %Y]
		bind cat.$dir.$catref.$filtref	<Destroy>  [list destroy\
												.filtmenu$catref$dir$filtref]

		# This kludge sets the color of all window elements, the first time
		#  a filter line is displayed completely.
		if { $firsttime == 1 } {
			set firsttime 0
#			bind $opts.log <Map> [list puts stdout "" ; tk_bisque ; bind $opts.log <Map> {}]
		}
	}

	# Configure the policy button's color.
	SetColor $fnam $rf.policy $wf.g.opts.policy
}

proc FilterConfigure { vnam index action } {
	upvar 1 $vnam thisvar
	set vnam $thisvar(myname)
	# Get the reference numbers from the beginning of the index. 
	regexp {^([0-9]*).([0-9]*)} $index rf catref filtref

	# this configures the filter
	Filterline $thisvar($catref.parent) $catref $thisvar($rf.pri) $vnam
}

# this utility function recursively adds a binding tag to a widget and
#  all of its subwidgets.

proc AddBindtagToAll { w tag } {
	bindtags $w "[bindtags $w] $tag"
	foreach widget [winfo children $w] {
		AddBindtagToAll $widget $tag
	}
}

#
# Proc to produce a category entry in a scrolled list.
# If the category is already displayed, change the display state of
# the filter lines, according to $category($catref.open).
# If the last argument $args is set to "remap", this proc unmaps and remaps
# a list of categories, starting at $priority, ending in the last category. 
#
# use as:
# Categoryline $parent-widget $priority_of_category $name_of_categoryarray
#
# (This is a priority based function, thus we pass the priority to it, not
#  the reference to a category.)

proc Categoryline { w priority cnam {mod ""} } {
	global cat_popup_functions
	global selectcolor unselectcolor
	upvar #0 $cnam thiscat
	# this is neccessary for variable traces to be set up later
	global $cnam
	# get filter name from category
	set fnam $thiscat(filter)
	upvar #0 $fnam thisfilt
	# This gets the direction: in forw out
	regsub categories $cnam "" dir

	set ref  $thiscat(pri.$priority)
	set name $thiscat($ref.name)

	# To make the relationship between the widget and the category lifelong,
	#  I use the reference number.
	set wr $w.$ref

	# if we are just asked to unmap and remap, do it now and return
	if { [string compare $mod "remap"] == 0 } {
		set range [lrange $thiscat(priorities)\
					[lsearch -exact $thiscat(priorities) $priority] end]
		foreach pri $range {
			set r $thiscat(pri.$pri)
			# unmap if mapped
			if [winfo exists $thiscat(parent).$r] {
				pack forget $thiscat(parent).$r
			}
		}
		foreach pri $range {
			set r $thiscat(pri.$pri)
			# map again (in order this time)
			if [winfo exists $thiscat(parent).$r] {
				pack $thiscat(parent).$r -side top -fill x
			} else {
				# map for the first time
				Categoryline $w $pri $cnam 
			}
		}
		return
	}

	# display the border/button, but only if it does not already exist
	if { ! [winfo exists $wr] } {
		# create the border for this category
		frame $wr -relief groove -borderwidth 3
		# create a category title frame
		set wrt [frame $wr.t]
		# create a button to open/close this category
		button $wrt.open	-textvariable $cnam\($ref.name)\
						-command [list ToggleOpen $w $ref $cnam ]\
						-width 42
		trace variable $cnam\($ref.open) w SyncUndo
		# set the displayed / existent ratio
		SetRatio $fnam $ref
		label $wrt.label -textvariable $cnam\($ref.ratio) -width 5
		pack $wrt.open	-side left -fill x
		pack $wrt.label	-side right
		pack $wrt -side top -fill x

		# create bindings that "select" the frame if clicked inside
		# first, add a new binding tag
		bindtags $wr		"[bindtags $wr] cat.$dir.$ref"
		bindtags $wrt.open	"[bindtags $wrt.open]	cat.$dir.$ref"
		bindtags $wrt.label	"[bindtags $wrt.label]	cat.$dir.$ref"
		# now, bind the tag to the selection events
		#  (normal and multiple selection)
		bind cat.$dir.$ref <Button-1> [list SelectCategory $ref $cnam]
		bind cat.$dir.$ref <Shift-Button-1> [list SelectCategory $ref $cnam\
																"multi"]

		# bind a context menu to the right mousebutton
		Contextmenu .catmenu$dir$ref "Category Popup" $cat_popup_functions\
																	$cnam $ref
		bind $wr			<Button-3> [list tk_popup .catmenu$dir$ref %X %Y]
		bind $wrt			<Button-3> [list tk_popup .catmenu$dir$ref %X %Y]
		bind $wrt.open		<Button-3> [list tk_popup .catmenu$dir$ref %X %Y]
		bind $wrt.label		<Button-3> [list tk_popup .catmenu$dir$ref %X %Y]
		bind $wr			<Destroy>  [list destroy  .catmenu$dir$ref]

		# when mapped or destroyed, set the length of the scrollbar
		bind $wr <Map>		[list + SetScrollReg $fnam $cnam\(refs)]
		bind $wr <Destroy>	[list + SetScrollReg $fnam $cnam\(refs)]
		# Bind the open button variable to a proc that reconfigures the category
		#  automatically when the variable is changed.
		trace variable $cnam\($ref.open) w CategoryConfigure
		# Same for the selection variable.
		trace variable $cnam\($ref.sel) w CategoryConfigure
	}
	# configure the color of the category frame
	if { $thiscat($ref.sel) } {
		$wr configure -bg $selectcolor
	} else {
		$wr configure -bg $unselectcolor
	}
	# configure the button to "sunken" if open, "raised" if closed
	if { $thiscat($ref.open) } {
		$wr.t.open configure -relief sunken
	} else {
		$wr.t.open configure -relief raised
	}

	# If this category is open and the filters are not yet being displayed,
	#  display (construct / remap) an opened category box with the filters
	#  inside.  If this category is closed and the filters are being displayed,
	#  unmap them.
	if { ( $thiscat($ref.open) && (![winfo exists $wr.filt]) ) } {
		set wrf [frame $wr.filt]
		foreach filtpri $thisfilt($ref.priorities) {
			Filterline $wrf $ref $filtpri $fnam
		}
		pack $wrf -side top -fill x
		# remember parent widget of these filters
		set thisfilt($ref.parent) $wrf
		# when mapped, unmapped or destroyed, set the ratio in the title
		bind $wrf <Map>		[list + SetRatio $fnam $ref]
		bind $wrf <Unmap>	[list + SetRatio $fnam $ref]
		bind $wrf <Destroy>	[list + SetRatio $fnam $ref]
	} elseif { ( $thiscat($ref.open) &&  ([winfo exists $wr.filt]) &&
			 (![winfo ismapped $wr.filt]) ) } {
		pack $wr.filt -side top -fill x
	} elseif { ! $thiscat($ref.open) && [winfo exists $wr.filt] } {
		pack forget $wr.filt
	}
	pack $wr -side top -fill x
}

# This proc is called by variable traces that set up bindings between certain
#  variables and widget configurations. It reconfigures the category widgets.

proc CategoryConfigure { vnam index action } {
	upvar 1 $vnam thisvar
	set vnam $thisvar(myname)
	# Get the reference number from the beginning of the index (since only
	#  "core" variables may be bound to something, the index must start with a
	#  reference number).
	regexp {^[0-9]*} $index ref

	# this configures the category
	Categoryline $thisvar(parent) $thisvar($ref.pri) $vnam
}

# This procedure creates a menu with a widget, a title, a list of entries
#  and optional arguments that usually pass variables and identify the caller
#  to the called procedure.
#  No bindings are set yet.

proc Contextmenu { w title entries args } {
	destroy $w
	menu $w
	$w add command -label $title
	$w add separator
	# this sets up several menu entries that invoke procedures
	foreach {m p} $entries {
		# what entry type is this ?
		switch -glob -- $m {
			-	{
				$w add separator
			}
			default {
				$w add command -label $m\
				-command [concat $p $args]
			}
		}
	}
}

# The initialization of the window's widget is done by proc Refresh

proc Refresh { } {
	global infilters forwfilters outfilters devicelist devlist firsttime debug
	global toplevel_cat_popup_functions
	destroy .filters
	frame   .filters
	pack .filters -side top -expand true -fill both
	destroy .props
	set w [frame .props]

	# This produces the buttons at the bottom on the window
	button $w.load    -text "Load state" -height 1 -command { if { [Load] } { Refresh } }
	button $w.dump    -text "Dump state" -height 1 -command Dump
	pack   $w.load $w.dump -side left -pady 2 -padx 2

	# frame to put buttons in the left middle
	set m [frame $w.ml]
	label $m.label -text "Nameserver on"
	if { $devicelist } {
		menubutton $m.ndev -textvariable nameserver_dev\
									-relief groove -borderwidth 2 -width 5\
									-takefocus {} -menu $m.ndev.menu
		set mm [menu $m.ndev.menu]
		foreach dev $devlist {
			$mm add radiobutton -label $dev -value $dev\
												-variable nameserver_dev
		}
		trace variable nameserver_dev w SyncUndo
	} else {
		entry $m.ndev -textvariable nameserver_dev -relief sunken\
							-width 5 -font {-family helvetica -weight bold}
		bind  $m.ndev	<FocusOut>	[list SyncUndo nameserver_dev]
	}
	button $m.update  -text "Update Devices"   -height 1 -command Update
	button $m.refresh -text "Complete Refresh" -height 1 -command Refresh
	pack   $m.label $m.ndev $m.update $m.refresh -side left -pady 2 -padx 2 -expand 1
	pack   $m -side left -pady 2 -padx 2 -expand 1

	# frame to put buttons in the right middle
	set m [frame $w.mr]
if { $debug } {
		menubutton $m.trace -text "Trace..." -height 1 -relief raised -takefocus {} -menu $m.trace.menu
		CreateTraceMenu
		button $m.debug -text "DumpAll" -height 1 -command DumpAll
	}
	menubutton $m.show -text "Show only..."    -height 1 -relief raised -takefocus {} -menu $m.show.menu
if { $debug } { 
	pack   $m.trace $m.debug $m.show -side left -pady 2 -padx 2 -expand 1
} else {
	pack   $m.show -side left -pady 2 -padx 2 -expand 1
}
	pack   $m -side left -pady 2 -padx 2 -expand 1
	# now produce the menu itself
	ShowDevsMenu

	button $w.create  -text "Create from selected" -height 1 -command Create
	button $w.apply   -text "Apply selected" -height 1 -command Apply
	pack   $w.apply $w.create -side right -pady 2 -padx 2 -anchor e 

	pack   $w       -side bottom -fill x


	# this scans a list of lists, each sub-list containing a widget name to use
	# for this category table, a title text for the table and the name (!) of
	# an array with the category definitions.

	foreach entry {{.filters.in In incategories} {.filters.forw Forward forwcategories} {.filters.out Out outcategories}} {
		set w     [ lindex $entry 0 ]
		set txt   [ lindex $entry 1 ]
		# this is the name of the category array, used for "call by name"
		set cnam  [ lindex $entry 2 ]
		# we use $categories as an alias to the category array (not it's name)
		upvar #0  [ lindex $entry 2 ] categories
		# find out the name of the filter array for this category
		set fnam $categories(filter)
		# use $filters as an alias to the filter array...
		upvar #0 $fnam filters
		# This gets the direction: in forw out
		regsub categories $cnam "" dir

		# This creates a frame for this column
		frame $w

		# title
		label  $w.title -text $txt
		pack   $w.title -side top -pady 2

		# a separator line
		frame $w.pad -height 1 -background black
		pack  $w.pad -side top -pady 3 -fill x

		# these tags are used below to bind these to the context menu
		bindtags $w			"[bindtags $w]			menu.$dir"
		bindtags $w.title	"[bindtags $w.title]	menu.$dir"
		bindtags $w.pad		"[bindtags $w.pad]		menu.$dir"

		# bind the "unselect" to the background frame and the separator
		#  line on button 1
		bind $w			<Button-1> [list UnselectCategory $cnam]
		bind $w.title	<Button-1> [list UnselectCategory $cnam]
		bind $w.pad		<Button-1> [list UnselectCategory $cnam]

		# This creates a frame for the scrolled categories and the scrollbar
		#  (The canvas should not use borders itself, because they would
		#  overlap with its contents. That is the only reason for this frame.)
		set f [frame $w.frame -relief raised -borderwidth 2]
		# This creates a canvas for all scrolled categories of this filter type
		canvas $f.c -highlightthickness 0 -borderwidth 0 \
				-yscrollcommand [list $f.yscroll set]
		# scrollbar
		scrollbar $f.yscroll -orient vertical -command [list $f.c yview]
		pack $f.yscroll -side right -fill y
		pack $f.c       -side left -expand 1 -fill both
		# packing the canvas does the job. Everything below in the widget
		#  tree and in the frame associated with the window (see below)
		#  will be displayed. (The assoc. frame does is not packed, just
		#  "associated".)

		# This frame is there to hold everything inside and to be associated
		#  with the window that is on the canvas and thus the frame gets
		#  scrolled (see Welch, pg. 411)
		set fc [frame $f.c.categories -bd 0]
		# create a window here
		$f.c create window 0 0 -anchor nw -window $fc
		# save the names of the widgets in these filter variables to support
		# updating the scroll bar from everywhere
		set filters(scrollcanvas)		$f.c
		set filters(scrollassocframe)	$fc

		# remember the parent widget for this type's categories
		set categories(parent) $fc

		#  ... put the filters into the assoc. frame.
		# constructing the list of scrolled categories for this kind of filter
		foreach pri $categories(priorities) {
			Categoryline $fc $pri $cnam
		}

		# bind a context menu to the right mousebutton
		Contextmenu .menu$dir "Master Popup" $toplevel_cat_popup_functions\
																		$cnam
		bindtags $f.c		"[bindtags $f.c] menu.$dir"

		bind menu.$dir	<Button-3> [list tk_popup .menu$dir %X %Y]
		bind $f.c		<Destroy>  [list destroy  .menu$dir]

		# bind the "unselect" to the canvas on button 1
		bind $f.c		<Button-1> [list UnselectCategory $cnam]

		pack $f -side top  -anchor n -expand true -fill both

		# default rule button
		set fr [frame $w.defrule -relief groove -borderwidth 2]
		set d  [frame $fr.x]
		label		$d.label -text "Fallthrough policy:"
		menubutton	$d.policy -width 6 -relief groove -borderwidth 2\
				-textvariable $fnam\(policy) -takefocus {} -menu $d.policy.menu
		set filters(policy.widget) $d.policy
		SetColor $fnam "policy" $d.policy
		pack		$d.label $d.policy -side left
		set m [menu $d.policy.menu]
		$m add radiobutton -label accept -value accept	-variable $fnam\(policy)
		if { [string compare $dir "forw"] == 0 } {
			$m add radiobutton -label masq -value masq	-variable $fnam\(policy)
		}
		$m add radiobutton -label deny -value deny		-variable $fnam\(policy)
		$m add radiobutton -label reject -value reject	-variable $fnam\(policy)
		pack $d  -side top -anchor s
		pack $fr -side top -anchor s -fill x
		trace variable $fnam\(policy) w SyncUndo
		# This binds any variable change to a proc that sets the new colors.
		trace variable $fnam\(policy) w ToplevelConfigure

		# Props line
		set fr [frame  $w.props3 -relief groove -borderwidth 2]
		set p  [frame  $fr.x]
		button $p.undo -text "Undo" -relief groove -borderwidth 2 -height 1\
														-command "Undo $fnam"
		button $p.redo -text "Redo" -relief groove -borderwidth 2 -height 1\
														-command "Redo $fnam"
		pack $p.undo $p.redo -side left
		pack $p  -side top -anchor s
		pack $fr -side top -anchor s -fill x

		pack $w -side left -anchor n -expand true -fill both

		# Forbid automatic resizing of the main window
		# when the slaves grow in size...
#		pack propagate . 0
	}
	# this sets the colors, the first time the window is displayed.
if { $firsttime } {
#	bind $w <Map> [list puts stdout ""; tk_bisque ; bind $w <Map> {}]
}
}

# This proc is used to configure the configurable toplevel widgets via variable
#  traces.

proc ToplevelConfigure { vnam index action } {
	upvar 1 $vnam thisvar
	set vnam $thisvar(myname)
	# Get the reference numbers from the beginning of the index. 
	regexp {^([0-9]*).([0-9]*)} $index rf catref filtref

	# This configures the toplevel widgets that depend on variable values.
	SetColor $vnam "policy" $thisvar(policy.widget)
}

# this provides the "Show only..." menubutton with a refreshed menu (destroying
#  the old one first)

proc ShowDevsMenu { {action ""} } {
	global showdevs devlist
	# first, destroy the menu
	destroy .props.mr.show.menu
	# delete the array only if asked to to so
	if { [string compare $action "rebuild"] == 0 } {
		foreach name [array names showdevs] {
			# never delete the whole array. We keep the "all" element
			if { [string compare $name "all"] != 0 } {
				unset showdevs($name)
			}
		}
	}
	set m [menu .props.mr.show.menu]
	$m add checkbutton -label all -variable showdevs\(all)
	$m add separator
	foreach dev $devlist {
		# rebuild this variable if it does not exist
		if { ! [info exists showdevs($dev)] } {
			set showdevs($dev) 0
		}
		# add the menu entry
		$m add checkbutton -label $dev -variable showdevs\($dev)
	}
	set showdevs(empty) 0
	$m add checkbutton -label "" -variable showdevs\()
	$m add separator
	$m add command -label "Go" -command { Update 0 }
}

# sets the scroll region of a canvas according to the size of its windows's
#  associated frame

proc SetScrollReg { filt args } {
	upvar #0 $filt thisfilt
	# if the caller may have destroyed the last entry in the scrolled list
	#  (i.e., the last category), it will call this function with the number
	#  of entries left in the list. Otherwise, it is assumed that there is
	#  always an entry left over in the list.
	if { $args != "" } {
		upvar #0 $args array
		set num [llength $array]
	} else {
		set num 1
	}
	set canvas $thisfilt(scrollcanvas)
	set assocframe $thisfilt(scrollassocframe)

	# Timing is a problem when this is triggered on an <Unmap> event:
	#  we need to repeat this after five delays.
			   Do_SetScrollReg $canvas $assocframe $num
	after  100 Do_SetScrollReg $canvas $assocframe $num
	after  800 Do_SetScrollReg $canvas $assocframe $num
	after 1000 Do_SetScrollReg $canvas $assocframe $num
	after 1500 Do_SetScrollReg $canvas $assocframe $num
	after 3500 Do_SetScrollReg $canvas $assocframe $num
}

proc Do_SetScrollReg { canvas assocframe num } {
	set width [winfo reqwidth $assocframe]
	set height [winfo reqheight $assocframe]

	if { $num > 0 } {
		$canvas config -scrollregion "0 0 $width $height"
	} else {
		$canvas config -scrollregion "0 0 $width 1"
	}
}

#
# Here are the procs that are called by the buttons
#

#
# Category handling
#
#  This is the structure of category and filter variables:
#
#  There are three kinds of filters: in(put), forw(ard) and out(put).
#  The variables for the filters all exist with one of the indicated prefixes.
#  Here, I give the structure for the input filters; the others are analogous.
#
#  First, there is a sorted list of priorities. This list has one integer
#  entry for each category, representing the priority or order of the
#  categories' appearance (on screen and later in the firewall script).
#
#	incategories(priorities) --> "5 10 20"
#
#  The most important part of this data model are the so-called reference
#  numbers, which are the "primary keys" to access the category data structures
#  (and the filter data structures -- see below). For speed there is a list
#  containing all reference numbers which is used by functions that want to
#  iterate through all data structures without the need to do that in the
#  order of the priorities. The benefit is that this spares the additional
#  data access to resolve the priority into a name.
#
#	incategories(refs) --> "0 1 3"
#
#  The reference number list is necessarily ordered, since new numbers are
#  always added at the end and are always higher.  Deletions do not change the
#  order. Insertions are not done. The "next reference number" is the last
#  in the list + 1.
#
#  The data structures of the category and of the corresponding filters are
#  always linked to the same reference number, over the whole lifetime of
#  the category. This makes it easy to give away the name of a variable,
#  like "incategories(0.name)", and have it bound to a widget (as a
#  -textvariable for example) or to an event (as a parameter to a proc called
#  by the event). These bindings stay the same even if the priority or the
#  name of the category changes.
#
#  There is a variable containing the parent widget (the associated widget)
#  for all of the categories of this type:
#
#	incategories(parent)            --> .filters.....
#
#  The widget names of each category can be build by appending the reference
#  number to the parent widget name: $incategories(parent).$ref
#
#  The actual category data is accessed via the references. This is an example
#  (though there *might* be more data fields):
#
#	    references
#	             v
#	incategories(0.pri)     --> 10			# priority
#	              .name)    --> "another_name"
#	              .open)    --> 1			# opened state ?
#	              .sel)     --> 1			# selected ?
#	              .ratio)   --> "3/5"		# displayed/total filters
#	incategories(1.pri)     --> 5
#	              .name)    --> "a_name"
#	              .open)    --> 1
#	              .sel)     --> 1
#	              .ratio)   --> "4/4"
#	incategories(3.pri)     --> 20
#	              .name)    --> "still_another_name"
#	              .open)    --> 0
#	              .sel)     --> 0
#	              .ratio)   --> "1/3"
#
#  The mapping from priorities to reference numbers and from category names
#  to reference numbers (the latter one is needed to be able to access a
#  category by name, as from AddFilt) is done via two so-called indices:
#
#	incategories(pri.5)  --> 1
#	                .10) --> 0
#	                .20) --> 3
#
#	incategories(name.a_name)              -->  5
#	                 .another_name)        -->  10
#	                 .still_another_name)  -->  20
#
#  The purpose of this prefix code ("name.") is to provide the capability to
#  use category names freely, while still using one namespace for the names and
#  other indices (and the subfield designations).  The only restriction for
#  category names is that they must be unique. (Which is a restriction of the
#  "semantics" of categories: the names are used by humans as references to
#  categories. So they have to be unique.)
#
#  The reference number of a category is used to access a filter list.
#  The name of the corresponding filter array variable is found in this
#  category variable:
#  
#	incategories(filter) --> "infilters"
#
#  The reference numbers are then used like this:
#
#	  reference   
#	          v
#	infilters(1.refs) --> "0 1 2 17 18"
#	infilters(0.refs) --> "1 2 3 4"
#	infilters(3.refs) --> "0 1 2 3 4"
#
#  These are the lists of filters available in each category. These numbers
#  are reference numbers again, but this time each of them refers to a single
#  filter instead of a whole filter category. To make this difference clear
#  in local variable names, it is recommended to use "$catref" for category
#  references and "$filtref" for filter references. $catref and $filtref are
#  used together to access the filter definition subfields.
#
#  This is an examplary listing of filter variables:
#
#	   $catref   $filtref
#	          v v
#	infilters(1.7.name)   --> "Anti-spoofing from the world"
#	           .7.source) --> "192.168.200.0/24"
#	           .7.dest)   --> "0/0"
#	.
#	.
#	.
#	infilters(1.2.name)   --> "Anti-spoofing from the world"
#	           .2.source) --> "192.168.150.0/24"
#	           .2.dest)   --> "0/0"
#	...
#
#  the next category:
#
#	infilters(0.1.name)   --> "Access to router from trusted net"
#	           .1.source) --> "192.168.150.0/24"
#	           .1.dest)   --> "0/0"
#   ...
#
#  Again, there is a list of priorities (here shown for $catref 0):
#
#	infilters(0.priorities)  --> "0 1 2 3 4"
#
#  Also, a list of currently displayed filter references (for counting):
#
#	infilters(0.displayed)   --> "0 3 7"
#
#  And, there is an index that maps from priorities to filter references:
#
#       $catref     priority
#	          v     v
#	infilters(0.pri.0)  --> 7
#	           .pri.1)  --> 2
#	           .pri.3)  --> 8
#   .
#   .
#   .
#
#  Some variables are global for each filter type:
#
#	infilters(scrollcanvas) --> .filters......  # the canvas of this scrolled
#	                                            #  area
#	infilters(scrollassocframe) --> .filters... # the associated frame of this
#	                                            #  scrolled area
#	infilters(category)     --> "incategories"  # the category array that
#	                                            #  contains this filter
#
#  This field is global for each filter list:
#
#	infilters(0.parent)     --> .filters......  # the *parent* widget of these
#	                                            #  filters (i.e. the category)
#
#  OK, that's it!
#
#

# this proc adds a new category and initializes it
#  $name is the name of the category, $args contains an optional priority
#  designator (an integer number). If the priority designator is not
#  given, a new priority number is created with the value
#   (lowest priority (= highest number) + 20)
#
# e.g. AddFilt calls this without a priority number

proc AddCategory { cnam name args } {
	upvar #0 $cnam thiscat

	# initialize category array if it does not exist
	if { ! [info exists thiscat(priorities)] ||
		   [string compare $thiscat(priorities) ""] == 0 } {
		if { [lindex $args 0] != "" } {
			set priority [lindex $args 0]
		} else {
			set priority 0
		}
		# save the variable's name under "myname"
		set thiscat(myname)		"$cnam"
		# Initialize priorities to the empty list (below the list gets set to
		#  the priority). Same with the list of references.
		set thiscat(priorities)	""
		set thiscat(refs)		""
	} else {
		if { [lindex $args 0] != "" } {
			# insert
			set priority [lindex $args 0]
		} else {
			# append
			set priority [expr [lindex $thiscat(priorities) end] + 20]
		}
	}

	# now, "low level" insert the category into the initialized array
	InsCategory $cnam $name $priority

	# return the priority of this category
	return $priority
}

# This utility function inserts / appends a new category to an *existing*
#  category array (which may be empty)

proc InsCategory { cnam name priority args } {
	upvar #0 $cnam thiscat

	# optionally, the args may contain a list with the reference
	# number, the open state and the selection state of this category
	if { $args != "" } {
		set ref  [lindex $args 0]
		set open [lindex $args 1]
		set sel  [lindex $args 2]
	} else {
		set ref  [expr [lindex $thiscat(refs) end] + 1]
		set open 0
		set sel  0
	}

	if { [lsearch -exact $thiscat(priorities) $priority] >= 0 } {
		# if we already have a category with this priority, push all
		#  adjacent categories up one priority
		PushupCategories $cnam $priority
	}

	# Append to existing priorities. Then sort them. This is equivalent
	#  to an insert.
	lappend thiscat(priorities) $priority
	set thiscat(priorities) [lsort -integer $thiscat(priorities)]

	# Append to existing reference numbers. No need for sorting.
	lappend thiscat(refs) $ref

	# set name -> reference number index
	set thiscat(name.$name)	$ref
	# set priority -> reference number index
	set thiscat(pri.$priority) $ref
	# set category data
	set thiscat($ref.pri)	$priority
	set thiscat($ref.name)	$name
	set thiscat($ref.open)	$open
	set thiscat($ref.sel)	$sel

	# Initialize an empty filter array, but only if it does not already exist.
	set fnam $thiscat(filter)
	upvar #0 $fnam thisfilt
	if { ! [info exists thisfilt(policy)] } {
		set thisfilt(myname)	"$fnam"
		set thisfilt(category)	"$cnam"
		set thisfilt(policy)	"deny"
	}
	if { ! [info exists thisfilt($ref.priorities)] } {
		set thisfilt($ref.priorities)	""
		set thisfilt($ref.refs)			""
		set thisfilt($ref.displayed)	""
	}

	return $priority
}

# This utility function deletes an existing category

proc DelCategory { cnam priority args } {
	upvar #0 $cnam thiscat

	set del [lsearch -exact $thiscat(priorities) $priority]
	if { $del >= 0 } {
		set ref $thiscat(pri.$priority)
		# Do not delete filter contents if asked to leave them alone.
		if { [string compare [lindex $args 0] "savecontents"] != 0 } {
			# delete the filters referenced here
			set fnam $thiscat(filter)
			DelFilt $ref $fnam

			# If this category has a widget, destroy it.
			if [info exists thiscat(parent)] {
				set w "$thiscat(parent).$ref"
				if [winfo exists $w] {
					destroy $w
				}
			}
		}

		# delete from the index lists
		set del [lsearch -exact $thiscat(priorities) $priority]
		set thiscat(priorities) [lreplace $thiscat(priorities) $del $del]
		set del [lsearch -exact $thiscat(refs) "$ref"]
		set thiscat(refs) [lreplace $thiscat(refs) $del $del]

		# now, unset all variables for this category
		set name $thiscat($ref.name)

		# remove all structure elements
		foreach idx [array names thiscat "$ref.*"] {
			unset thiscat($idx)
		}
		# remove all other indices
		unset thiscat(name.$name)
		unset thiscat(pri.$priority)

		return 0
	} else {
		return -1
	}
}

#
# This proc is a utility function that recursively calls itself to push
#  up category entries one by one as long as necessary to make room for
#  an additional category. This version just changes the priority -> reference
#  mapping and the default names (if any).

proc PushupCategories { cnam priority } {
	upvar #0 $cnam thiscat
	# save reference for this priority (the reference stays the same...)
	set ref	$thiscat(pri.$priority)

	# delete these index entries
	unset thiscat(pri.$priority)
	unset thiscat($ref.pri)
	# delete from the priorities list
	set pos [lsearch -exact $thiscat(priorities) $priority]
	set thiscat(priorities) [lreplace $thiscat(priorities) $pos $pos]
	# push it up
	incr priority

	if { [lsearch -exact $thiscat(priorities) $priority] >= 0 } {
		# if we already have a category with this (new) priority, push all
		#  adjacent categories up one priority
		PushupCategories $cnam $priority
	}
	# add to the priorities list
	lappend thiscat(priorities) $priority
	set thiscat(priorities) [lsort -integer $thiscat(priorities)]

	# Some categories have default names. These should remain unique under
	#  all circumstances. We transform such names into a new form.
	if [TestDefName $thiscat($ref.name)] {
		set name [GetDefName $priority]
		set thiscat($ref.name)	$name
		set thiscat(name.$name)	$ref
	}

	# insert index entries with new priority
	set thiscat(pri.$priority)	$ref
	set thiscat($ref.pri)		$priority
}

# This proc toggles a category line between the opened and closed states.
# $w is the top level widget for this category frame, priority is the priority
# of this category (used as an identifier...) and $cnam is the name of the
# category array.
# Also used to specifically open / close a category line.

proc ToggleOpen { w ref cnam {val 2} } {
	# the name of the category
	upvar #0 $cnam thiscat
	# Depending on $val, switch on, switch off or toggle.
	switch -exact -- $val {
		0	{ set thiscat($ref.open) [expr $thiscat($ref.open) & !1] }
		1	{ set thiscat($ref.open) [expr $thiscat($ref.open) | 1] }
	default	{ set thiscat($ref.open) [expr $thiscat($ref.open) ^ 1] }
	}
	# the actual action will be done by the proc that is bound to the variable
	#  change
}

# This proc selects a given category widget, or adds it to a selection

proc SelectCategory { ref cnam {multi ""} } {
	upvar #0 $cnam thiscat

	# if we are not using multiple selection and if another category is
	#  already selected, unselect it
	if { $multi == "" } {
		UnselectCategory $cnam $ref
	}

	# if we do single selection, set the "selected" flag, otherwise toggle it
	if { $multi == "" } {
		if { $thiscat($ref.sel) == 0 } { set thiscat($ref.sel) 1 }
	} else {
		set thiscat($ref.sel) [expr $thiscat($ref.sel) ^ 1]
	}
	# The color is set automatically... (the variable is being traced...)
}

# This proc unselects all category widgets of a given type. If the $catref
#  parameter is supplied, the corresponding category is not deselected.

proc UnselectCategory { cnam {catref ""} } {
	upvar #0 $cnam thiscat

	foreach ref $thiscat(refs) {
		if { $thiscat($ref.sel) } {
			if { $ref != $catref } {
				set thiscat($ref.sel) 0
			}
		}
	}
}

# This proc adds a new category at the end of the list and refreshes the
#  display.

proc AddCatRefr { cnam {ref ""} {def 0} } {
	SyncUndo $cnam
	upvar #0 $cnam thiscat
	regsub categories $cnam "" dir
	set fnam $thiscat(filter)

	# if $ref is set, put a new category between this one and the next
	if { $ref != "" } {
		# get the priorities of this category and the one immediately
		#  following this one
		set northpriority $thiscat($ref.pri)
		set southpriority [lindex $thiscat(priorities) [expr \
				[lsearch -exact $thiscat(priorities) "$northpriority"] + 1]]
		# If we have a "southern" category, interpolate between its priority
		#  and the "northern" priority, rounding *up*. Otherwise, leave the
		#  resulting priority empty.
		if { $southpriority != "" } {
			set newpriority [expr int(ceil(($southpriority -\
								 $northpriority)/2.0)) + $northpriority]
		} else {
			set newpriority ""
		}
		# add new category without a name but with a specified priority
		set newpriority [AddCategory $cnam "" $newpriority]
		set newref $thiscat(pri.$newpriority)
	} else {
		# add new category without a name
		set newpriority [AddCategory $cnam ""]
		set newref $thiscat(pri.$newpriority)
	}
	# add a default filter entry
	AddDefFilt $fnam ""
	# display the category, reordering all widgets after it
	Categoryline $thiscat(parent) $newpriority $cnam remap

	# now set the name
	RenameCatRefr $cnam $newref $def
	SyncUndo $cnam
}

# This is a dummy proc that just exists because of the name scheme.
#  It calls AddCatRefr to add a default category.

proc AddDefaultCatRefr { cnam {ref ""} } {
	# Trying to pass 3 args to AddCatRefr, no matter how many provided.
	AddCatRefr $cnam $ref 1
}

# This proc deletes the "calling" category, or all selected categories,
#  if there are any

proc DeleteCatRefr { cnam {ref ""} } {
	SyncUndo $cnam
	upvar #0 $cnam thiscat

	# are there selected categories ?
	set deleted 0
	foreach pri $thiscat(priorities) {
		if { $thiscat($thiscat(pri.$pri).sel) } {
			DelCategory $cnam $pri
			set deleted 1
		}
	}

	# if nothing was deleted, delete this category
	if { ! $deleted && $ref != "" } {
		set priority $thiscat($ref.pri)
		DelCategory $cnam $priority
	}
	SyncUndo $cnam
}

# Dummy stub to add a filter from the category menu

proc AddFilterCatRefr { cnam catref } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	AddFiltRefr $fnam $catref
}

# This proc selects all categories of this type

proc SelectAllCatRefr { cnam {ref ""} } {
	upvar #0 $cnam thiscat
	foreach ref $thiscat(refs) {
		if { ! $thiscat($ref.sel) } { set thiscat($ref.sel) 1 }
	}
}

# This proc unselects all categories of this type (dummy stub)

proc DeselectAllCatRefr { cnam {ref ""} } {
	UnselectCategory $cnam
}

# This proc asks the user for a new name for a category (must be unique)

proc RenameCatRefr { cnam ref {def 0} } {
	SyncUndo $cnam
	upvar #0 $cnam thiscat

	# get the priority number of this category
	set priority $thiscat($ref.pri)

	# remember the old name
	set oldname $thiscat($ref.name)

	# If we only set a default name, get that name and set it.
	#  Otherwise, open a requestor to set the name.
	if { $def == 1 } {
		set thiscat($ref.name) [GetDefName $priority]
	} else {
		RequestString "Rename category"\
					  "Please enter a new name\n for this category"\
					  "Ok" "Default" "Cancel" "$cnam" "$ref.name"\
					  "CheckCatName" [list $cnam $ref $priority $oldname]
	}
	# set the rest of the variables to the new value
	set name $thiscat($ref.name)
	unset thiscat(name.$oldname)
	set thiscat(name.$name) $ref
	SyncUndo $cnam
}

# This is the name checker for category names.

proc CheckCatName { title cnamevar cnameidx cnam ref priority oldname } {
	upvar #0 $cnam thiscat
	global dialogbutton

	set name $thiscat($ref.name)
	# On OK, check wether the name is unique or a reserved default name.
	#  If not, return to dialog.
	# On Cancel, take the $oldname but check it before returning.
	# On "Default", set a unique default name.
	if { $dialogbutton < 2 } {
		if { $dialogbutton == 0 } { set thiscat($ref.name) $oldname }
		if { ! ( [info exists thiscat(name.$name)]		&&
				 $thiscat(name.$name) != $priority )	&&
				 $name != ""							&&
			 ! ( [string match {Priority[0-9]*} $name]	&&
				![string match Priority$priority $name] ) } {
			return 1
		} else {
			# Display a reminder on name syntax
			Reminder $title\
	"The name \"$name\" is not unique\n or reserved for other categories"
			return 0
		}
	} elseif { $dialogbutton == 2 } {
		# Set a unique default name
		set thiscat($ref.name) [GetDefName $priority]
		return 1
	}
}

# this utility proc returns a default name for a category

proc GetDefName { priority } {
	return "Priority$priority"
}

# this utility proc checks wether its argument is a default name for a category

proc TestDefName { name } {
	if [string match {Priority[0-9]*} $name] { return 1 }
	return 0
}

# This is a universal requestor with a title, a string entry widget, two or
#  three buttons and a callback capability to check the value

proc RequestString { title msg ok default cancel tvar tidx checker checkvar } {
	global dialogbutton
	# create the dialog box
	set r .request
	set exitok 0
	while { $exitok == 0 } {
		if [Dialog_Create $r $title] {
			message $r.msg -text $msg -aspect 1000 -justify center
			if { $tidx != "" } {
				entry $r.entry -textvariable $tvar\($tidx)
			} else {
				entry $r.entry -textvariable $tvar
			}
			bind  $r.entry	<FocusOut>	[list SyncUndo $tvar $tidx]
			set b [frame $r.buttons]
			pack $r.msg $r.entry $r.buttons -side top -fill x
			pack $r.entry -pady 5
			button $b.ok -text $ok -command {set dialogbutton 1}
			pack $b.ok -side left
			if { $default != "" } {
				button $b.default -text $default -command {set dialogbutton 2}
				pack $b.default -side left -expand 1
			}
			button $b.cancel -text $cancel -command {set dialogbutton 0}
			pack $b.cancel -side right
			bind $r.entry <Return> {set dialogbutton 1 ; break}
			bind $r.entry <Control-c> {set dialogbutton 0 ; break}
		} else {
			# use a new textvariable for the entry widget
			if { $tidx != "" } {
				$r.entry -textvariable $tvar\($tidx)
			} else {
				$r.entry -textvariable $tvar
			}
		}
		# reset variable
		set dialogbutton 0
		Dialog_Wait $r dialogbutton $r.entry
		Dialog_Dismiss $r
		# check input for conformity (the "eval {x y z} {a b c}" construct
		#  executes this: "x y z a b c" ... see ?)
		set exitok [eval {$checker $title $tvar $tidx} $checkvar]
	}
	# delete binding between entry widget and global variable:
	#  bind to a dummy instead.
	$r.entry configure -textvariable dialogbutton

	# return the exitok value, in case the caller needs information from
	#  the checker
	return $exitok
}

# This is a universal reminder that displays a message and an OK button.

proc Reminder { title msg } {
	global dialogbutton
	set rem .reminder
	if [Dialog_Create $rem $title] {
		message $rem.msg -text $msg -aspect 1000 -justify center
		set b [frame $rem.buttons]
		pack $rem.msg $rem.buttons -side top -fill x
		button $b.ok -text OK -command {set dialogbutton 1}
		pack $b.ok -side left -expand 1
	} else {
		$rem.msg configure -text $msg
	}
	set dialogbutton 0
	Dialog_Wait $rem dialogbutton
	Dialog_Dismiss $rem
}

# support procedures for dialogs

proc Dialog_Create {top title args} {
	global dialog
	if [winfo exists $top] {
		switch -- [wm state $top] {
			normal {
				# Raise a buried window
				raise $top
			}
			withdrawn -
			iconified {
				# Open and restore geometry
				wm deiconify $top
				catch {wm geometry $top $dialog(geo,$top)}
			}
		}
		return 0
	} else {
		eval {toplevel $top} $args
		wm title $top $title
		return 1
	}
}
proc Dialog_Wait {top varName {focus {}}} {
	upvar $varName var
	global dialog

	# Poke the variable if the user nukes the window
	bind $top <Destroy> [list set $varName $var]

	# Grab focus for the dialog
	if {[string length $focus] == 0} {
		set focus $top
	}
	set old [focus -displayof $top]
	focus $focus
	catch {tkwait visibility $top}
#	if { ! [info exists dialog(geo,$top)] } tk_bisque
	catch {grab $top}

	# Wait for the dialog to complete
	tkwait variable $varName
	catch {grab release $top}
	focus $old
}
proc Dialog_Dismiss { top } {
	global dialog
	# Save current size and position
	catch {
		# window may have been deleted
		set dialog(geo,$top) [wm geometry $top]
		wm withdraw $top
	}
}

# This proc opens all categories of a type

proc OpenAllCatRefr { cnam {ref ""} } {
	BeginSyncUndo $cnam
	upvar #0 $cnam thiscat
	foreach catref $thiscat(refs) {
		ToggleOpen $thiscat(parent) $catref $cnam 1
	}
	EndSyncUndo $cnam
}

# This proc closes all categories of a type

proc CloseAllCatRefr { cnam {ref ""} } {
	BeginSyncUndo $cnam
	upvar #0 $cnam thiscat
	foreach catref $thiscat(refs) {
		ToggleOpen $thiscat(parent) $catref $cnam 0
	}
	EndSyncUndo $cnam
}

#
# Filter handling
#

# when filters are mapped, unmapped or destroyed, set the length of the
# scrollbar, the "displayed" list and the ratio in the title

proc MapFilt { fnam catref filtref action } {
	upvar #0 $fnam thisfilt
	SetScrollReg $fnam
	switch -exact $action {
		map		{ lappend thisfilt($catref.displayed) $filtref }
		unmap	-
		destroy	{
			if {[lsearch -exact $thisfilt($catref.displayed) $filtref] != -1} {
				set del [lsearch -exact $thisfilt($catref.displayed) $filtref]
				set thisfilt($catref.displayed) [lreplace $thisfilt($catref.displayed) $del $del]
			}
		}
	}
	# set height of parent widget after destruction of last filter inside
	switch -exact $action {
		destroy	{
			if { [string compare $thisfilt($catref.refs) ""] == 0 } {
				$thisfilt($catref.parent) configure -height 1
			}
		}
	}
	SetRatio $fnam $catref
}

# this proc sets the ratio of displayed / existent filters

proc SetRatio { fnam catref } {
	regsub filters $fnam categories cnam
	upvar #0 $fnam thisfilt
	upvar #0 $cnam thiscat
	if { [info exists	thisfilt($catref.parent)] &&
		[winfo exists	$thisfilt($catref.parent)] &&
		[winfo ismapped	$thisfilt($catref.parent)] } {
		set thiscat($catref.ratio) [join [list\
								[llength $thisfilt($catref.displayed)] "/"\
								[llength $thisfilt($catref.refs)]] ""]
	} else {
		set thiscat($catref.ratio) [join [list "0/"\
								[llength $thisfilt($catref.refs)]] ""]
	}
}

# this proc is a utility function that returns a list of default values
# for a new filter

proc GetDefaults { fnam } {
	global devicelist devlist showdevs
	# yes, this sets the name to in, forw or out.
	regsub filters $fnam "" name

	set val [list 1 $name all "0/0" "1024:65535" "0/0"]
	lappend val ""
	if { $devicelist } {
		# use the first device that is actually on the display, or the
		#  first device in $devlist as the default
		set thisdev [lindex $devlist 0]
		if { [info exists showdevs()] && $showdevs() } { set thisdev "" }
		foreach dev $devlist {
			if { [info exists showdevs($dev)] && $showdevs($dev) } { set thisdev $dev ; break }
		}
		lappend val $thisdev
	} else {
		lappend val ""
	}
	lappend val accept "" 0
	return $val
}

# This proc adds a default filter to a given filter array in a given category.
# Both the category and the filter array are created if necessary.

proc AddDefFilt { filt args } {
	# If we specify a category for this filter, use this category.
	#  Otherwise, use the "generic" category.
	if { $args != "" } {
		set catname [lindex $args 0]
	} else {
		set catname "generic"
	}
	return [AddFilt $filt $catname "" [GetDefaults $filt]]
}

# This utility function creates an empty filter array and initializes
#  global filter variables to default values.
#  Returns the next free priority and reference numbers, after *appending*
#  them to their respective lists! (The pri -> ref index is not changed, since
#  this depends on the caller (Add or Ins).)

proc InitFilt { cnam fnam catref } {
	upvar #0 $fnam thisfilt

	if { ! [info exists thisfilt(policy)] } {
		# save the variable's own name under the "myname" index
		set thisfilt(myname)	"$fnam"
		set thisfilt(category)	"$cnam"
		set thisfilt(policy)	"deny"
	}
	# initialize filter array if it does not exist
	if { ! [info exists thisfilt($catref.priorities)] ||
		   [string compare $thisfilt($catref.priorities) ""] == 0 } {
		set filtpri	0
		set filtref	0
		set thisfilt($catref.priorities)	[list $filtpri]
		set thisfilt($catref.refs)			[list $filtref]
		set thisfilt($catref.displayed)		""
	} else {
		set filtpri	[expr [lindex $thisfilt($catref.priorities) end] + 1]
		set filtref	[expr [lindex $thisfilt($catref.refs) end] + 1]
		lappend thisfilt($catref.priorities)	$filtpri
		lappend thisfilt($catref.refs)			$filtref
	}

	return "$filtpri $filtref"
}

# This proc adds a filter with specific values to the specified filter array,
# into the specified category. If the filter array does not exist, it will be
# created.
# $v is the list of values. $catname is the name of the category the filter
# is to be added to. $catpri is the priority of the target category.
# If both are given, $catpri takes precedence.
# Returns "$catref $filtref" of the added filter.

proc AddFilt { fnam catname catpri v } {
	upvar #0 $fnam thisfilt
	regsub filters $fnam categories cnam
	upvar #0 $cnam thiscat

	# make sure the category exists
	# is it name or priority ?
	if { $catpri != "" } {
		if { ! [info exists thiscat(pri.$catpri)] } {
			AddCategory $cnam $catname $catpri
		}
		# just in case, get the category name (to get the reference below)
		set catname $thiscat($thiscat(pri.$catpri).name)
	} elseif { ! [info exists thiscat(name.$catname)] } {
		AddCategory $cnam $catname
	}

	# get the reference number for this category
	set catref		$thiscat(name.$catname)

	# the values needed to initialize a specific filter are in the
	#  global variable $cap
	global cap

	# initialize filter array if it does not exist and get the next
	# priority and reference number for this filter
	set ret		[InitFilt $catname $fnam $catref]
	set filtpri	[lindex $ret 0]
	set filtref	[lindex $ret 1]

	# This index identifies the new priority with the new reference
	#  and vice versa
	set thisfilt($catref.pri.$filtpri)	$filtref
	set thisfilt($catref.$filtref.pri)	$filtpri

	# The filter values start at 0.
	set i 0
	foreach c $cap {
		set thisfilt($catref.$filtref.$c)	[lindex $v $i]
		incr i
	}

	return "$catref $filtref"
}

# This proc inserts a filter with specific values to the top of an array,
#  or creates the array. $v is the list of values. $inspri is the filter
#  priority where the insertion is to take place.
# Returns "$catref $filtref" of the inserted filter.

proc InsFilt { fnam catname catpri v inspri } {
	upvar #0 $fnam thisfilt
	regsub filters $fnam categories cnam
	upvar #0 $cnam thiscat

	# make sure the category exists
	# is it name or priority ?
	if { $catpri != "" } {
		if { ! [info exists thiscat(pri.$catpri)] } {
			AddCategory $cnam $catname $catpri
		}
		# just in case, get the category name (to get the reference below)
		set catname $thiscat($thiscat(pri.$catpri).name)
	} elseif { ! [info exists thiscat(name.$catname)] } {
		AddCategory $cnam $catname
	}

	# get the reference number for this category
	set catref $thiscat(name.$catname)

	# the values needed to initialize a specific filter are in the
	#  global variable $cap
	global cap

	# initialize filter array if it does not exist and get the next
	# priority and reference number for the next free filter (which is used
	# in the "pushup" below).
	set ret		[InitFilt $catname $fnam $catref]
	set filtpri	[lindex $ret 0]
	set filtref	[lindex $ret 1]

	# update the indices
	# need to copy up ?
	if { [llength $thisfilt($catref.priorities)] > 1 } {
		# copy all filter references in the index "one up" (this can not be
		# done with foreach, since we want to copy the last element first, the
		# first element last...)
		for { set idx [expr [llength $thisfilt($catref.priorities)] - 2] } \
		 { $idx >= $inspri } { set idx [expr $idx - 1] } {
			set upperpri [expr $idx + 1]
			# update priority -> reference index
			set thisref $thisfilt($catref.pri.$idx)
			set thisfilt($catref.pri.$upperpri) $thisref
			# update reference -> priority index
			set thisfilt($catref.$thisref.pri) $upperpri
		}
	}
	# insert new filter into indices
	set thisfilt($catref.pri.$inspri)	$filtref
	set thisfilt($catref.$filtref.pri)	$inspri

	# create the data for filter at $filtref
	set i 0
	foreach c $cap {
		set thisfilt($catref.$filtref.$c)	[lindex $v $i]
		incr i
	}

	return "$catref $filtref"
}

# Add a filter below the filter clicked on in the GUI

proc AddFiltRefr { fnam catref {filtref ""} } {
	SyncUndo $fnam
	upvar #0 $fnam thisfilt
	set cnam $thisfilt(category)
	upvar #0 $cnam thiscat

	set ret [AddSingleFilt $fnam [GetDefaults $fnam] $catref $filtref]

	set newref [lindex $ret 1]
	set newpriority $thisfilt($catref.$newref.pri)
	# display the filter, reordering all widgets after it
	Filterline $thisfilt($catref.parent) $catref $newpriority $fnam remap
	SyncUndo $fnam
}

# This utility proc adds / inserts a specified filter structure at a specified
#  point in the filter list.

proc AddSingleFilt { fnam v catref {filtref ""} } {
	upvar #0 $fnam thisfilt
	regsub filters $fnam "" dir
	set cnam $thisfilt(category)
	upvar #0 $cnam thiscat

	# if $filtref is set, put a new filter between this one and the next
	if { $filtref != "" } {
		# get the priorities of this filter and the one immediately
		#  following this one
		set northpriority $thisfilt($catref.$filtref.pri)
		set southpriority [lindex $thisfilt($catref.priorities) [expr \
		 [lsearch -exact $thisfilt($catref.priorities) "$northpriority"] + 1]]
		# If we have a "southern" filter, interpolate between its priority
		#  and the "northern" priority, rounding *up*. Otherwise, leave the
		#  resulting priority empty.
		if { $southpriority != "" } {
			set newpriority [expr int(ceil(($southpriority -\
								 $northpriority)/2.0)) + $northpriority]
			# add new filter with specified priority
			set ret [InsFilt $fnam "" $thiscat($catref.pri) $v $newpriority]
		} else {
			set ret [AddFilt $fnam "" $thiscat($catref.pri) $v]
		}
	} else {
		# add new filter with a new priority
		set ret [AddFilt $fnam "" $thiscat($catref.pri) $v]
	}
	return $ret
}

# This proc deletes a whole filter array, regardless of the state of the
#  filters, and removes them from the display

proc DelFilt { catref fnam } {
	upvar #0 $fnam thisfilt

	if { ! [info exists thisfilt($catref.priorities)] } return

	regsub filters $fnam "" dir

	# delete every selected filter
	foreach filtpri $thisfilt($catref.priorities) {
		# first, remove widgets from display (otherwise we can not
		#  unset variables bound to widgets!)
		if [info exists thisfilt($catref.parent)] {
			destroy $thisfilt($catref.parent)
		}

		foreach name [array names thisfilt "$catref.*"] {
			unset thisfilt($name)
		}
	}
}

# This proc deletes the specified filter and removes it from the display

proc DeleteFilt { fnam catref filtref } {
	upvar #0 $fnam thisfilt
	set filtpri $thisfilt($catref.$filtref.pri)
	if { ! [info exists thisfilt($catref.priorities)] } return

	# first (!), remove from the list of references
	set del [lsearch -exact $thisfilt($catref.refs) $filtref]
	set thisfilt($catref.refs) [lreplace $thisfilt($catref.refs) $del $del]
	# The list of displayed filters does not need to be reset, since
	#  the destruction of the widget calls a proc that takes care of that.
	#  (The deletion of the reference from the refs list needs to be done
	#  prior to that, since the ratio in the category title will be updated
	#  by the proc called by "destroy".)

	# remove widgets from display (otherwise we can not
	#  unset variables bound to widgets!)
	destroy $thisfilt($catref.parent).$filtref

	foreach name [array names thisfilt "$catref.$filtref.*"] {
		unset thisfilt($name)
	}
#	# delete priority -> reference index ### This seems to conflict with
#	unset thisfilt($catref.pri.$filtpri) ### "remove highest priority -> reference index" (18 lines below)

	# update the indices
	# need to update ?
	if { [llength $thisfilt($catref.priorities)] > 1 } {
		# copy all filter references in the index "one down"
		set first [expr [lsearch -exact $thisfilt($catref.priorities) $filtpri]\
																			+ 1]
		foreach idx [lrange $thisfilt($catref.priorities) $first end] {
			set lowerpri [expr $idx - 1]
			# update priority -> reference index
			set thisref $thisfilt($catref.pri.$idx)
			set thisfilt($catref.pri.$lowerpri) $thisref
			# update reference -> priority index
			set thisfilt($catref.$thisref.pri) $lowerpri
		}
		# remove highest priority -> reference index
		unset thisfilt($catref.pri.[lindex $thisfilt($catref.priorities) end])
	}
	# remove from the priority list
	set del [expr [llength $thisfilt($catref.priorities)] - 1]
	set thisfilt($catref.priorities) [lreplace $thisfilt($catref.priorities)\
																	$del $del]
}

# This proc deletes the "calling" filter, or all selected and displayed filters,
#  if there are any. If the parameter $def is 1, the "calling" filter is not
#  deleted even if there are no selected and displayed filters.
# Also, if the filter's category is not open, all selcted filters are deleted,
#  not only those that are displayed.

proc DeleteFiltRefr { fnam catref filtref {def 0} } {
	SyncUndo $fnam
	upvar #0 $fnam thisfilt
	upvar #0 $thisfilt(category) thiscat

	if { ! [info exists thisfilt($catref.priorities)] } return

	set open $thiscat($catref.open)

	# delete every selected filter
	set deleted 0
	foreach ref $thisfilt($catref.refs) {
		# delete only *selected* *and* *displayed* filters
		if { ! $thisfilt($catref.$ref.select) || \
			( $open &&
			[lsearch -exact $thisfilt($catref.displayed) $ref] == -1 ) } continue
		DeleteFilt $fnam $catref $ref
		set deleted 1
	}

	# if nothing was deleted and the caller does not inhibit this action,
	#  delete this filter
	if { ! $deleted && ! $def } { DeleteFilt $fnam $catref $filtref }
	SyncUndo $fnam
}

#
# Selection
#

# select all filters in this category

proc SelectAllFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.select) 1
	}
	EndSyncUndo $fnam
}

# unselect all filters in this category

proc DeselectAllFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.select) 0
	}
	EndSyncUndo $fnam
}

proc InvertSelectionFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.select) [expr $thisfilt($catref.$ref.select)\
																		^ 1]
	}
	EndSyncUndo $fnam
}

# Cut selected filters from this filter list to copyfilters list

proc CutFilt { fnam catref {filtref ""} } {
	SyncUndo $fnam
	CopyFilt $fnam $catref $filtref
	DeleteFiltRefr $fnam $catref $filtref 1
	SyncUndo $fnam
}

# Copy selected filters to the copyfilters

proc CopyFilt { fnam catref {filtref ""} } {
	SyncUndo $fnam
	upvar #0 $fnam thisfilt
	global copyfilters cap

	# delete copyfilters
	foreach name [array names copyfilters] {
		unset copyfilters($name)
	}
	# This is the priority of the first copied filter.
	set newpri 0
	# run through the filters in priority order
	foreach pri $thisfilt($catref.priorities) {
		set ref $thisfilt($catref.pri.$pri)
		if { $thisfilt($catref.$ref.select) == 1 } {
			# append selected filter to copyfilters
			set v [FiltValList $fnam "$catref.$ref"]
			# This routine is a specialized version of AddFilt. It's a shame
			#  that we do not have object orientation here.
			# Copy the filter values. They start at index 0.
			set i 0
			foreach c $cap {
				set copyfilters($ref.$c) [lindex $v $i]
				incr i
			}
			# The only other thing we preserve is the order: we build a priority
			#  index.
			set copyfilters(pri.$newpri) $ref
			if [info exists copyfilters(priorities)] {
				lappend copyfilters(priorities) $newpri
			} else {
				set copyfilters(priorities) $newpri
			}
			incr newpri
		}
	}
	SyncUndo $fnam
}

proc FiltValList { fnam reference } {
	upvar #0 $fnam thisfilt
	global cap

	set val ""
	foreach c $cap {
		lappend val "$thisfilt($reference.$c)"
	}

	return $val
}

# copy filters from copyfilters to this filter

proc PasteFiltRefr { fnam catref {filtref ""} } {
	SyncUndo $fnam
	global copyfilters
	upvar #0 $fnam thisfilt

	if { ! [info exists copyfilters(priorities)] } { return }

	# If we have a filter reference, paste in at this point and insert the last
	#  filter first. Otherwise paste in at the end and paste first filter first.
	if { $filtref != "" } {
		set idx [expr [llength $copyfilters(priorities)] - 1]
	} else {
		set idx 0
	}
	while {$idx >= 0 && $idx < [llength $copyfilters(priorities)]} {
		set pri [lindex $copyfilters(priorities) $idx]
		set ref $copyfilters(pri.$pri)
		# append a filter from copyfilters to this filter
		set v [FiltValList copyfilters $ref]
		# If the destination filter does not support masquerading, replace
		#  a "masq" with an "accept"
		if { [string compare $fnam "forwfilters"] != 0 } {
			set pos [lsearch -exact $v "masq"]
			if {$pos != -1} {set v [lreplace $v $pos $pos "accept"]}
		}
		set ret [AddSingleFilt $fnam $v $catref $filtref]
		if { $filtref != "" } {
			set idx [expr $idx - 1]
		} else {
			incr idx
			if { ! [info exists firstret] } { set firstret $ret }
			set ret $firstret
		}
	}

	set newref [lindex $ret 1]
	set newpriority $thisfilt($catref.$newref.pri)
	# display the filters, reordering all widgets after it
	Filterline $thisfilt($catref.parent) $catref $newpriority $fnam remap
	SetRatio $fnam $catref
	SyncUndo $fnam
}

proc SwapDir { fnam {catref ""} {filtref ""} } {
	SyncUndo $fnam
	upvar #0 $fnam thisfilt

	if { $filtref == "" } {
		foreach filtref $thisfilt($catref.refs) {
			if { $thisfilt($catref.$filtref.select) == 1 } {
				# swap source and destination in this filter
				SwapVal thisfilt($catref.$filtref.source) thisfilt($catref.$filtref.dest)
				SwapVal thisfilt($catref.$filtref.sport)  thisfilt($catref.$filtref.dport)
			}
		}
	} else {
		SwapVal thisfilt($catref.$filtref.source) thisfilt($catref.$filtref.dest)
		SwapVal thisfilt($catref.$filtref.sport)  thisfilt($catref.$filtref.dport)
	}
	SyncUndo $fnam
}

proc SwapVal { val1 val2 } {
	upvar $val1 v1 $val2 v2
	set temp $v1
	set v1 $v2
	set v2 $temp
}

# These are dummy procs that just exist because of the name scheme.

proc CutCat { cnam {catref ""} } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	CutFilt $fnam $catref
}

proc CopyCat { cnam {catref ""} } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	CopyFilt $fnam $catref
}

proc PasteCatRefr { cnam {catref ""} } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	PasteFiltRefr $fnam $catref
}

proc SwapCatDir { cnam {catref ""} } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	SwapDir $fnam $catref
}

# Swap source and destination specs in selected filters

# Logging

proc LogAllFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.log) 1
	}
	EndSyncUndo $fnam
}

proc LogNoneFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.log) 0
	}
	EndSyncUndo $fnam
}

proc InvertLogFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		set thisfilt($catref.$ref.log) [expr $thisfilt($catref.$ref.log) ^ 1]
	}
	EndSyncUndo $fnam
}

# switch on logging on all "deny" filters

proc LogDenyFiltRefr { fnam catref filtref } {
	BeginSyncUndo $fnam
	upvar #0 $fnam thisfilt
	foreach ref $thisfilt($catref.refs) {
		if { [string compare $thisfilt($catref.$ref.policy) "deny"] == 0 } {
			set thisfilt($catref.$ref.log) 1
		}
	}
	EndSyncUndo $fnam
}

# stubs for master context menu logging

proc LogCatRefr { cnam function } {
	upvar #0 $cnam thiscat
	set fnam $thiscat(filter)
	foreach catref $thiscat(refs) {
		$function $fnam $catref ""
	}
}

proc LogAllCatRefr { cnam } {
	LogCatRefr $cnam "LogAllFiltRefr"
}

proc LogNoneCatRefr { cnam } {
	LogCatRefr $cnam "LogNoneFiltRefr"
}

proc InvertLogCatRefr { cnam } {
	LogCatRefr $cnam "InvertLogFiltRefr"
}

proc LogDenyCatRefr { cnam } {
	LogCatRefr $cnam "LogDenyFiltRefr"
}

# Just sets the color of widget $m according to the policy in $fnam, $index
proc SetColor { fnam index m } {
	upvar #0 $fnam thisfilt
	set color [GetColor $thisfilt($index)]
	set color1 [lindex $color 0]
	set color2 [lindex $color 1]
	$m configure -bg $color1 -activebackground $color2
}

# Return a color name depending on $policy
proc GetColor { policy } {
	switch -exact -- $policy {
        accept { return [list "#00ee00" "#90ee90"] }
        deny   { return [list "#ee0000" "#e79093"] }
        reject { return [list "#ffc500" "#eec590"] }
        masq   { return [list "#5da8ee" "#adc8f6"] }
    }
}

# get a list of devices
proc GetDev {} {
	global devlist
	set devlist ""

	set f [open {|cat /proc/net/dev | grep ":" | awk -F ":" "{print $1}" | awk "{print $1}" | sort} r]

	while {[gets $f line] >= 0} {
		set devlist [concat $devlist $line]
	}
	close $f
}

# This proc destroys all filter widgets for a given filter

#proc DeleteFilt { filt } {
#	upvar #0 $filt thisfilt
#	if { ! [info exists thisfilt(priorities)] } return
#	regsub filters $filt "" dir
#
#	# destroy all filter widgets
#	foreach num $thisfilt(priorities) {
#		destroy .filters.$dir.frame.c.filt.$num
#	}
#	# empty the list of displayed filters for this filter
#	set thisfilt(displayed) ""
#}

# This proc rebuilds all filter widgets for a given filter

proc RebuildFilt { filt } {
	global firsttime
	upvar #0 $filt thisfilt
	if { ! [info exists thisfilt(priorities)] } continue
	regsub filters $filt "" dir

	# rebuild all filter widgets
	foreach num $thisfilt(priorities) {
		Filterline .filters.$dir.frame.c.filt $num $filt
if { $firsttime == 1 && [string compare $thisfilt(priorities) ""] != 0 } {
#	tk_bisque
	set firsttime 0
}
	}
	SetScrollReg .filters.$dir.frame.c .filters.$dir.frame.c.filt [llength $thisfilt(displayed)]
	after 5000 SetScrollReg .filters.$dir.frame.c .filters.$dir.frame.c.filt [llength $thisfilt(displayed)]
}

# This proc re-reads the devicelist, deletes and rebuilds the display.

proc Update { } {
	destroy .filters
	destroy .props
	GetDev
	Refresh
}

# Function to dump our state
proc Dump { args } {
	global devlist typelist filename wintitle
	global infilters forwfilters outfilters
	global incategories forwcategories outcategories
	global nameserver_dev
	if { [lindex $args 0] != "" } {
		set file $args
		if { [string match "*.tkfw" [lindex $args 0]] != 1 } {
			append file ".tkfw"
		}
		# in this case, we do not store the geometry of the non-existent window
		set nogeom 1
	} else {
		set file [tk_getSaveFile -filetypes $typelist -defaultextension ".tkfw"\
							-initialfile $filename]
	}
	if { [string compare $file ""] == 0} { return 0 }
	set f [open "$file" "w+"]

	# First, dump the current window size and position
	if { ! [info exists nogeom] } {
		puts $f "wm geometry . [wm geometry .]"
	}
	# Next, dump the current device list
	puts $f "set devlist \[list $devlist\]"
	# dump the nameserver device
	puts $f "set nameserver_dev $nameserver_dev"
	# dump the categories and filters
	foreach var { incategories forwcategories outcategories
		 infilters forwfilters outfilters } {
		upvar #0 $var thisvar
		foreach name [ array names $var ] {
			if { ! [string match {[0-9]*.displayed} $name] } {
				puts $f "set name \{$name\}"
				puts $f "set $var\(\$name) \{$thisvar($name)\}"
			} else {
				puts $f "set $var\($name) \{\}"
			}
		}
	}
	close $f

	set name [lindex [file split "$file"] end]
	if [info exists env(DISPLAY)] { wm title . "$wintitle      $name" }
	set filename $name
}

# This flushes all categories and all filter definitions.
proc Flush {} {
	global incategories forwcategories outcategories

	foreach cnam { incategories forwcategories outcategories } {
		upvar #0 $cnam thiscat

		foreach priority $thiscat(priorities) {
			# delete all categories
			DelCategory $cnam $priority
		}
	}
}

# Function to load our state
proc Load { args } {
	global devlist typelist filename wintitle
	global infilters forwfilters outfilters
	global incategories forwcategories outcategories
	global nameserver_dev

	if { $args != "" } {
		if { ! [file exists $args] } { return 0 }
		set file $args
	} else {
		set file [tk_getOpenFile -filetypes $typelist]
	}
	if { ! [file exists $file] } { return 0 }
	set f [open "$file" "r"]

	# As we are about to delete all filter lines, we need to stop
	# all outstanding requests to set the scrollbars' scrollregions
	# (maybe not...)
	foreach id [after info] { after cancel $id }

	# First, delete all state
	Flush

	while {[gets $f line] >= 0} {
		eval $line
	}
	close $f

	set name [lindex [file split "$file"] end]
	wm title . "$wintitle      $name"
	set filename $name

	return 1
}

#
# Supplementary functions
#

# Debugging

# Dump all global variables that are in the list $dumpvariables to stdout.
#  If this proc receives an argument, it is taken as the filename. This
#  filename is suffixed with the number of calls to DumpAll and to that
#  file the dump is written.

proc DumpAll { args } {
	global dumpvariables dumpcount defaultdumpfile
	set fnam [lindex $args 0]
	if { $fnam == "" } {
		if [ info exists defaultdumpfile ] {
			set fnam $defaultdumpfile
			append fnam [format "%04d" $dumpcount]
			incr dumpcount
			set file [open "$fnam" w]
		} else {
			set file stdout
		}
	} else {
		append fnam [format "%04d" $dumpcount]
		incr dumpcount
		set file [open "$fnam" w]
	}
	foreach var $dumpvariables {
		upvar #0 $var thisvar
		# need this for the "array names" below
		global $var
		puts $file "# $var:"
		foreach name [lsort -dictionary [array names $var]] {
			puts $file "set $var\($name) \"$thisvar($name)\""
		}
	}
	puts $file "# --------------------------------------------"
	if { $fnam != "" } { close $file }
}

# This proc creates a menu that lets the user choose from a list of global
#  variables to trace.

proc CreateTraceMenu {} {
	global defaultglobals traceglobals
	# first, destroy the menu and delete the array
	destroy .props.mr.trace.menu
	foreach name [array names traceglobals] {
		unset traceglobals($name)
	}
	set m [menu .props.mr.trace.menu]
	foreach g [lsort -dictionary [info globals]] {
		# rebuild the variable, but only if it is not in the
		#  unwanted $defaultglobals
		if { [lsearch -exact $defaultglobals $g] == -1 } {
			set traceglobals($g) 0
			# add the menu entry
			$m add checkbutton -label $g -variable traceglobals\($g)\
										-command [list ToggleTrace $g]
		}
	}
}

# This proc toggles tracing of a global variable / array on and off

proc ToggleTrace { varname } {
	global $varname traceglobals
	if { $traceglobals($varname) } {
		trace variable $varname wu Tracer
	} else {
		trace vdelete  $varname wu Tracer
	}
}

# This proc actually prints variable tracing output

proc Tracer { vname index action } {
	upvar 1 $vname var
	if [info exists var(myname)] { set vname $var(myname) }
	if { $index != "" } {
		set vname "$vname\($index)"
		if { [string compare $action "u"] != 0 } { set value $var($index) }
	} else {
		if { [string compare $action "u"] != 0 } { set value $var }
	}
	switch -exact $action {
		w	{ puts stdout "Setting $vname to \"$value\"" }
		u	{ puts stdout "Unsetting $vname" }
	}
}

# Undo / Redo

# This proc closes the current undo list and creates a new one. If an array
#  name and an index into that array are passed to it, it passes this in-
#  formation to the UndoTracer.

proc SyncUndo { vnam {index ""} {action ""} } {
	# To avoid syncing in the middle of an undo or redo operation,
	#  return immediately then. Also, a proc can inhibit syncing that is caused
	#  by lower level functions if it sets the global variable $nosync.
	global inundo nosync
	if { $inundo || $nosync } { return }

#global undorepository undolist
	if { $index != "" } {
		upvar 1 $vnam thisvar
		set vnam $thisvar(myname)
		# needed for the call to UndoTracer
		global $vnam
#puts "vnam is $vnam\($index)  contents: $thisvar($index)"
#puts "undorepository is $undorepository($vnam.$index)"
		# If $vnam has changed, record the change and move to next undo list.
		UndoTracer $vnam $index "w" "move"
	} else {
		upvar #0 $vnam thisvar
		set vnam $thisvar(myname)
		global $vnam
		NextUndoList [GetDir $vnam]
	}
}

# This utility proc sets or clears the global variable $nosync in a way
#  that makes nesting possible.

proc SetNoSync { val } {
	global nosync
	if { $val > 0 } {
		incr nosync
	} else {
		set nosync [expr $nosync - 1]
	}
}

# These utility procs combine a SyncUndo and a SetNoSync. Used in top level
#  functions that repeatedly call lower level functions.

proc BeginSyncUndo { vnam } {
	SyncUndo $vnam
	SetNoSync 1
}

proc EndSyncUndo { vnam } {
	SetNoSync 0
	SyncUndo $vnam
}

# This utility proc moves to the next undo list for filter of type $dir, unless
#  the current undo list is empty.

proc NextUndoList { dir } {
	global undolist
	if [info exists undolist($dir.$undolist($dir.current))] {
		incr undolist($dir.current)
		# If the next entry is not already in the list, append it.
		if { [lsearch $undolist($dir.lists) $undolist($dir.current)] == -1 } {
			lappend undolist($dir.lists) $undolist($dir.current)
		}
	}
}

# This utility proc returns the "direction" that a specific variable name
#  belongs to: in, forw or out. This is done independend of the actual suffix
#  after the direction prefix.

proc GetDir { vnam } {
	switch -glob $vnam {
		in*		{ return "in" }
		forw*	{ return "forw" }
		out*	{ return "out" }
	}
}

proc UndoTracer { vnam index action {move ""} } {
	global undorepository undolist inundo
	upvar 1 $vnam thisvar
	# All variables under undo control need to have a "myname" entry.
	set vnam $thisvar(myname)
	set dir [GetDir $vnam]
#puts "UndoTracer: $vnam $index $action"

	set current $undolist($dir.current)
	set haschanged 0

	switch -exact $action {
		w	{
			# If there is a difference between this var and the repository,
			#  then adjust the undo list & repository.
			if { [info exists undorepository($vnam.$index)] &&
				 $thisvar($index) != $undorepository($vnam.$index) } {
				# modifications to existing variables are only saved if
				#  these variables are "interesting" !
				switch -regexp $index {
					"[0-9]*.parent"		-
					"[0-9]*.ratio"		-
					"[0-9]*.displayed"	{}
					default				{
						lappend undolist($dir.$current) "w" "$vnam" "$index"\
												"$undorepository($vnam.$index)"
						set haschanged 1
#puts "UT: new entry in list $dir.$current: \"w\" \"$vnam\" \"$index\" \"$undorepository($vnam.$index)\""
					}
				}
			} elseif { ! [info exists undorepository($vnam.$index)] } {
				# If the entry does not exist, then adjust...
				switch -regexp $index {
					"[0-9]*.parent"		{}
					default				{
						lappend undolist($dir.$current) "u" "$vnam" "$index" {}
						set haschanged 1
#puts "UT: new entry in list $dir.$current: \"u\" \"$vnam\" \"$index\" \"{}\""
					}
				}
			}
			# (If nothing changed, this does not hurt anyway...)
			set undorepository($vnam.$index) $thisvar($index)
		}
		u	{
			lappend undolist($dir.$current) "c" "$vnam" "$index"\
												"$undorepository($vnam.$index)"
			set haschanged 1
#puts "UT: new entry in list $dir.$current: \"c\" \"$vnam\" \"$index\" \"$undorepository($vnam.$index)\""
			unset undorepository($vnam.$index)
		}
	}

	# If we are not in the middle of an undo and no undo list entry was
	#  appended, truncate the undo list.
	if { ! $inundo && $haschanged } {
		set start [expr [lsearch -exact $undolist($dir.lists) $current] + 1]
		foreach l [lrange $undolist($dir.lists) $start end] {
			if [info exists undolist($dir.$l)] { unset undolist($dir.$l) }
		}
		set undolist($dir.lists) [lrange $undolist($dir.lists) 0 $current]
#puts "UT: truncating undo list to $undolist($dir.lists)"
	}

	# If this undo list is not empty and we are asked to do so, move to the
	#  next undo list...
	if { $move == "move" } { NextUndoList $dir }
}

# Saves the state of all filters and categories in a repository for later
#  undos / redos

proc InitUndo { } {
	global undorepository undolist undovars inundo nosync

	foreach v $undovars {
		upvar #0 $v thisv
		# needed by "trace variable"... at least...
		global $v
		foreach name [array names thisv] {
			set undorepository($v.$name) $thisv($name)
		}
		# initialize tracing
		trace variable $v wu UndoTracer
#		trace variable $v wu Tracer
	}

	# Initialize the undo lists.
	foreach dir {in forw out} {
		set undolist($dir.current) 	0
		set undolist($dir.lists)	[list 0]
	}
	# Currently we are not in the middle of an undo:
	set inundo 0
	# Also syncing is allowed:
	set nosync 0
}

proc Undo { fnam } {
#puts "Start of Undo -------------------------------------"
	global undolist inundo
	set dir [GetDir $fnam]

	set current $undolist($dir.current)

	# If the current undo buffer is empty, try the previous one. If that one
	#  does not exist either, just return.
	if { ! [info exists undolist($dir.$current)] } {
		if { ! [info exists undolist($dir.[expr $current - 1])] } {
			return
		} else {
			set current [expr $current - 1]
		}
	}

	# Just for this undo, set "current" to the next undo list.
	NextUndoList $dir

	UndoRedo $dir $current

	# Retarget the "current" undo list to the previous list.
	set undolist($dir.current) $current
#puts "End of Undo ---------------------------------------"
}

proc Redo { fnam } {
#puts "Start of Redo -------------------------------------"
	global undolist inundo
	set dir [GetDir $fnam]

	set next [expr $undolist($dir.current) + 1]

	# If the next undo buffer is empty, just return.
	if { ! [info exists undolist($dir.$next)] } { return }

	UndoRedo $dir $next

	# Retarget the "current" undo list to the next list.
	NextUndoList $dir
#puts "End of Redo ---------------------------------------"
}
	
# This is the core function of an Undo or Redo. Since the core is the same
#  for both of them, this is called by both Undo and Redo.

proc UndoRedo { dir this } {
	global undolist inundo
	set inundo 1
#puts "UndoRedo: working on undo list $this"

	# Now, loop over the list and execute all variable updates.
	for { set i [llength $undolist($dir.$this)] }\
		{ $i > 0 } { set i [expr $i - 4] } {
		set action	[lindex $undolist($dir.$this) [expr $i - 4]]
		set vnam	[lindex $undolist($dir.$this) [expr $i - 3]]
		set index	[lindex $undolist($dir.$this) [expr $i - 2]]
		set value	[lindex $undolist($dir.$this) [expr $i - 1]]
		upvar #0 $vnam thisvar
		set ret			[GetContainer $vnam $index]
		set container	[lindex $ret 0]
		set catref		[lindex $ret 1]
		set filtref		[lindex $ret 2]
		switch -exact $action {
			u	{
#puts "UndoRedo: unset $vnam\($index)"
				# before unsetting, destroy the widget
				#  (see comment at GetContainer)
				if [winfo exists $container] { destroy $container }
				unset thisvar($index)
			}
			c	{
#puts "UndoRedo: create $vnam\($index) = $value"
				if { $container != "" } {
#puts "          this is a core variable: container is $container"
					if { $filtref == "" } {
						lappend created($vnam) $catref
					} else {
						lappend created($vnam.$catref) $filtref
					}
				}
				set thisvar($index) $value
			}
			w	{
#puts "UndoRedo: write $vnam\($index) = $value"
				set thisvar($index) $value
			}
		}
	}

	# After using this undo list, empty it.
	unset undolist($dir.$this)

	# Now, find out which categories / filters need to be remapped.
	foreach name [array names created {*categories}] {
#puts "working on created($name) = $created($name)"
		# handle category references
		upvar #0 $name thisvar
		set minpri 2000000000
		foreach catref $created($name) {
			set pri $thisvar($catref.pri)
			if { $pri < $minpri } { set minpri $pri }
		}
		Categoryline $thisvar(parent) $minpri $name "remap"
	}
	foreach name [array names created {*filters*}] {
#puts "working on created($name) = $created($name)"
		# handle filter references
		regexp {([^0-9\.]+)\.([0-9]+)$} $name match vnam catref
		upvar #0 $vnam thisvar
		set minpri 2000000000
		foreach filtref $created($name) {
			set pri $thisvar($catref.$filtref.pri)
			if { $pri < $minpri } { set minpri $pri }
		}
		if [info exists thisvar($catref.parent)] {
			Filterline $thisvar($catref.parent) $catref $minpri $vnam remap
		}
		# Just in case the previous line does not create unmap/remap events.
		SetRatio $vnam $catref
	}
	set inundo 0
}

# This utility proc returns the name of the widget that contains the category
#  or filter that corresponds to the given variable and index. The result is
#  used by the caller to destroy the widget. This allows the caller to sub-
#  sequently unset the $variable($index).
#  Since the destruction of the container widget should only be done if
#  needed to undo a filter / category creation, this proc only returns the
#  container widget if the index points to a "core" variable, not just to an
#  index (which, in case of the category name -> ref index might have been
# This proc can also be used to determine wether a variable(index) is a "core"
#  variable (i.e. a variable that requires a remap of category- or filterlines
#  after it is created.) The return value is the empty string if the variable
#  is not a core variable.

proc GetContainer { vnam index } {
	upvar #0 $vnam thisvar
#puts "GetContainer for $vnam $index"
	if [string match "*categories" $vnam] {
		if [regexp {^[0-9]+} $index catref] {
			return [list $thisvar(parent).$catref $catref]
		} else {
			return ""
		}
	} else {
		if [regexp {^([0-9]+)\.([0-9]+)} $index match catref filtref] {
			if [info exists thisvar($catref.parent)] {
				return [list $thisvar($catref.parent).$filtref $catref $filtref]
			} else {
				return ""
			}
		} else {
			return ""
		}
	}
}

# This proc applies the filters (called by the "Apply selected" button)
proc Apply {} {
	set f [Create]
	# as setting permissions is not yet implemented in wish 8.0, I use this
	exec /bin/sh $f
}

# This proc creates the firewall.sh file (the "Create from selected" button)
proc Create {} {
	global incategories forwcategories outcategories
	global infilters forwfilters outfilters nameserver_dev

	set fname "firewall.sh"

	set f [open $fname "w+"]

	puts $f {#! /bin/sh}
	puts $f {IPFWADM=/sbin/ipfwadm}
	puts $f {# First, cut off all traffic and flush all filters}
	puts $f {$IPFWADM -I -p deny}
	puts $f {$IPFWADM -F -p deny}
	puts $f {$IPFWADM -O -p deny}
	puts $f {$IPFWADM -I -f}
	puts $f {$IPFWADM -F -f}
	puts $f {$IPFWADM -O -f}

	puts $f {# As we may need to resolve names during the setup process,}
	puts $f {# we allow name server queries to be made. (Yes. This is not}
	puts $f {# totally secure. Using names instead of IP addresses is a}
	puts $f {# compromise made to ease user configurability.)}
	puts $f "\$IPFWADM -O -a accept -P udp -S 0/0 1024:65535 -D 0/0 domain -W $nameserver_dev"
	puts $f "\$IPFWADM -I -a accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -F -a accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -O -a accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -I -a accept -P udp -S 0/0 domain -D 0/0 1024:65535 -W $nameserver_dev"

	puts $f {# Just in case: if we use masquerading, set the TCP timeout}
	puts $f {#  to 60 min., TCP timeout after FIN to 1 minute and UDP to 5 min.}
	puts $f {$IPFWADM -M -s 3600 60 300}
	puts $f {# Now, set the filter rules}

    foreach cat { incategories forwcategories outcategories } {
		upvar #0 $cat  thiscat
		set filt $thiscat(filter)
        upvar #0 $filt this

		switch -exact -- $filt {
			infilters	{ set under ""		; set dir "input"		}
			forwfilters	{ set under "-----" ; set dir "forwarding"	}
			outfilters	{ set under "-"		; set dir "output"		}
		}

		puts $f {#}
		puts $f "# These are the $dir filter rules"
		puts $f "# --------------------------------$under"
		puts $f {#}
		foreach cpri $thiscat(priorities) {
			set cref $thiscat(pri.$cpri)
			foreach fpri $this($cref.priorities) {
				set fref $this($cref.pri.$fpri)
				set n "$cref.$fref"
				if { $this($n.select) != 1 } continue

				puts $f "# $this($n.name)"

				switch -exact -- $filt {
					infilters	{ set l "-I" }
					forwfilters	{ set l "-F" }
					outfilters	{ set l "-O" }
				}

				set proto [string tolower $this($n.proto)]

				set l [concat $l "-a" $this($n.policy) "-P" $proto]
				set l [concat $l "-S" $this($n.source) $this($n.sport)]
				set l [concat $l "-D" $this($n.dest)   $this($n.dport)]

				switch -glob -- "$this($n.iface)" {
				""			{ }
				"[0-9]**"	{ set l [concat $l "-V" $this($n.iface)] }
				default		{ set l [concat $l "-W" $this($n.iface)] }
				}

				if { $this($n.log) == 1 } { set l [concat $l "-o"] }

				# depending on the policy, we need to handle "in" and "out"
				#  differently
				switch -exact -- "$this($n.policy)" {
					masq   -
					accept {
						switch -exact -- "$this($n.flags)" {
							in	{
								regsub -- "-S" $l "-Q" l2
								regsub -- "-D" $l2 "-S" l3
								regsub -- "-Q" $l3 "-D" l2
								set l [concat $l "-k"]
								puts $f "\$IPFWADM $l"
								puts $f "\$IPFWADM $l2"
							}
							out	{
								regsub -- "-S" $l "-Q" l2
								regsub -- "-D" $l2 "-S" l3
								regsub -- "-Q" $l3 "-D" l2
								set l2 [concat $l2 "-k"]
								puts $f "\$IPFWADM $l"
								puts $f "\$IPFWADM $l2"
							}
							bidir {
								set l [concat $l "-b"]
								puts $f "\$IPFWADM $l"
							}
							Ack	{
								set l [concat $l "-k"]
								puts $f "\$IPFWADM $l"
							}
							"Syn only" {
								set l [concat $l "-y"]
								puts $f "\$IPFWADM $l"
							}
							default {
								puts $f "\$IPFWADM $l"
							}
						}
					}
					reject -
					deny   {
						switch -exact -- "$this($n.flags)" {
							in	{
								regsub -- "-S" $l "-Q" l2
								regsub -- "-D" $l2 "-S" l3
								regsub -- "-Q" $l3 "-D" l2
								set l2 [concat $l2 "-y"]
								puts $f "\$IPFWADM $l2"
							}
							out	{
								set l [concat $l "-y"]
								puts $f "\$IPFWADM $l"
							}
							bidir {
								set l [concat $l "-b"]
								puts $f "\$IPFWADM $l"
							}
							Ack	{
								set l [concat $l "-k"]
								puts $f "\$IPFWADM $l"
							}
							"Syn only" {
								set l [concat $l "-y"]
								puts $f "\$IPFWADM $l"
							}
							default {
								puts $f "\$IPFWADM $l"
							}
						}
					}
				}
			}
        }
    }

	puts $f {# Last, we set the selected default policies...}
	puts $f "\$IPFWADM -I -p $infilters(policy)"
	puts $f "\$IPFWADM -F -p $forwfilters(policy)"
	puts $f "\$IPFWADM -O -p $outfilters(policy)"

	puts $f {# ...and remove the helpful DNS rules we inserted in the preamble.}
	puts $f "\$IPFWADM -O -d accept -P udp -S 0/0 1024:65535 -D 0/0 domain -W $nameserver_dev"
	puts $f "\$IPFWADM -I -d accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -F -d accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -O -d accept -P udp -S 0/0 domain -D 0/0 domain"
	puts $f "\$IPFWADM -I -d accept -P udp -S 0/0 domain -D 0/0 1024:65535 -W $nameserver_dev"
	puts $f {# Done.}

	close $f

	exec chmod ug+x $fname

	return $fname
}

proc Scan {} {
	global infilters forwfilters outfilters devlist nameserver_dev
	set f [open "| tkfirewallscan" "r+"]

	while {[gets $f line] >= 0} {
		set ret [eval $line]
		puts $f "$ret"
		flush $f
	}
	catch { close $f }
}

#
# This is the startup code
#

if [info exists env(DISPLAY)] { wm minsize . 1020 480 }

# initialize first set of global variables

# Save the list of default global variables to exclude them from the list
# of global variables shown, if debbuging is turned on.
if { $debug } { set defaultglobals [info globals] }

# These arrays are printed on a call to DumpAll
#set dumpvariables [list incategories forwcategories outcategories\
#						infilters forwfilters outfilters copyfilters\
#						undorepository undolist]
set dumpvariables [list incategories infilters]
set dumpcount 0
# This is used as the default basename for DumpAll filenames, if set.
#set defaultdumpfile "yyy"

# colors for category selection
set selectcolor		"blue3"
# SteelBlue1 ??
set unselectcolor	"grey"

# This is the central list of elements in a filter definition.
# Used in all functions that access filters generically.
set cap {select name proto source sport dest dport iface policy flags log}

set typelist {
	{"TkFirewall Dump Files" {.tkfw}}
	{"All Files" {*}}
}

set filename "dump.tkfw"

if [info exists env(DISPLAY)] {
	set wintitle [concat [wm title .] "on" [exec hostname]]
	wm title . $wintitle
}

# This supplies a default device list, which will be overwritten by a "Load"
GetDev

# global state for the "Show only..." menu
set showdevs(all) 1

# These are indices of all entries for context menus.
# They consist of an entry name and the name of the procedure to be called.
set toplevel_cat_popup_functions	"{Add category} AddCatRefr\
									{Add default category} AddDefaultCatRefr\
									- -\
									{Select all categories} SelectAllCatRefr\
									{Deselect all categories} DeselectAllCatRefr\
									{Open all categories} OpenAllCatRefr\
									{Close all categories} CloseAllCatRefr\
									- -\
									{Log all filters} LogAllCatRefr\
									{Log no filters} LogNoneCatRefr\
									{Invert filter logging} InvertLogCatRefr\
									{Log deny filters} LogDenyCatRefr"
set cat_popup_functions		"{Add category} AddCatRefr\
							{Add default category} AddDefaultCatRefr\
							{Delete categories} DeleteCatRefr\
							{Rename category} RenameCatRefr\
							- -\
							{Cut selected filters} CutCat\
							{Copy selected filters} CopyCat\
							{Paste filters} PasteCatRefr\
							{Swap source & destination} SwapCatDir\
							- -\
							{Select all categories} SelectAllCatRefr\
							{Deselect all categories} DeselectAllCatRefr\
							{Open all categories} OpenAllCatRefr\
							{Close all categories} CloseAllCatRefr\
							- -\
							{Add filter} AddFilterCatRefr"
set filt_popup_functions	"{Add filter} AddFiltRefr\
							{Delete filters} DeleteFiltRefr\
							- -\
							{Cut selected filters} CutFilt\
							{Copy selected filters} CopyFilt\
							{Paste filters} PasteFiltRefr\
							{Swap source & destination} SwapDir\
							- -\
							{Select all filters} SelectAllFiltRefr\
							{Deselect all filters} DeselectAllFiltRefr\
							{Invert filter selection} InvertSelectionFiltRefr\
							- -\
							{Log all filters} LogAllFiltRefr\
							{Log no filters} LogNoneFiltRefr\
							{Invert filter logging} InvertLogFiltRefr\
							{Log deny filters} LogDenyFiltRefr"

# global variables for dialog boxes
set dialogbutton 0

# set up links between the category arrays and the filter arrays
set incategories(filter)	"infilters"
set forwcategories(filter)	"forwfilters"
set outcategories(filter)	"outfilters"

# supply defaults for the first "Refresh"

foreach filt { infilters forwfilters outfilters } {
	AddDefFilt $filt
}

# variables to trace for Undo / Redo
set undovars	{ incategories forwcategories outcategories\
				  infilters forwfilters outfilters }

if {$argc > 0} {
	switch -exact -- [lindex $argv 0] {
		--scan	-
		-scan	{
			Flush
			Scan
			Refresh
		}
		--dump	-
		-dump	{
			# Dump state after setting up defaults and exit normally.
			Flush
			Scan
			Dump [lindex $argv 1]
			exit
		}
		--apply	-
		-apply	-
		-a		{
			# create firewall.sh and apply it after loading or setting up
			# defaults and exit
			# this just fails if no name was supplied on the command line
			Flush
			if { ! [Load [lindex $argv 1]] } { Scan }
			Apply
			exit
		}
		--create -
		-create	-
		-c		{
			# create firewall.sh after loading or setting up defaults and exit.
			# this just fails if no name was supplied on the command line
			if { ! [Load [lindex $argv 1]] } { Scan }
			Create
			exit
		}
		default	{
			Load [lindex $argv 1]
			Refresh
		}
	}
} else {
	Refresh
}

# For undo / redo: save current state

InitUndo

# End of startup code....
