--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/edit-whiteclnt.in	Tue Mar 10 13:49:58 2009 +0100
@@ -0,0 +1,1068 @@
+#! @PERL@ -wT
+
+# display and edit a DCC whitelist file
+
+# Copyright (c) 2008 by Rhyolite Software, LLC
+#
+# This agreement is not applicable to any entity which sells anti-spam
+# solutions to others or provides an anti-spam solution as part of a
+# security solution sold to other entities, or to a private network
+# which employs the DCC or uses data provided by operation of the DCC
+# but does not provide corresponding data to other users.
+#
+# Permission to use, copy, modify, and distribute this software without
+# changes for any purpose with or without fee is hereby granted, provided
+# that the above copyright notice and this permission notice appear in all
+# copies and any distributed versions or copies are either unchanged
+# or not called anything similar to "DCC" or "Distributed Checksum
+# Clearinghouse".
+#
+# Parties not eligible to receive a license under this agreement can
+# obtain a commercial license to use DCC by contacting Rhyolite Software
+# at sales@rhyolite.com.
+#
+# A commercial license would be for Distributed Checksum and Reputation
+# Clearinghouse software.  That software includes additional features.  This
+# free license for Distributed ChecksumClearinghouse Software does not in any
+# way grant permision to use Distributed Checksum and Reputation Clearinghouse
+# software
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE, LLC DISCLAIMS ALL
+# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE, LLC
+# BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES
+# OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+#	Rhyolite Software DCC 1.3.103-1.58 $Revision$
+#	@configure_input@
+
+# This file must protected with an equivalent to httpd.conf lines
+#   in the README file.
+
+use strict 'subs';
+
+my($main_whiteclnt);		# path to the main whiteclnt file
+
+my(@file);			# list representation of the file
+my(%dict);			# dictionary of checksums and options
+my(%def_options);		# option settings from main whiteclnt file
+
+my($have_entry_form, $form_marked,
+   $cur_pos, $cur_key, $cur_entry, $cur_index);
+
+my $form_num = 0;
+
+
+# get DCC parameters
+local($whiteclnt,		# path to the per-user whitelist file
+      %query,
+      $hostname,
+      $thold_cks,		# checksums that can have thresholds
+      $user,
+      $edit_url,
+      $list_msg_link,
+      $edit_url, $edit_link,
+      $url_ques,
+      $sub_white,		# 'subsitute' headers from dcc_conf
+      $form_hidden,		# state for main form
+      $whiteclnt_version,	#webuser version ...
+      $whiteclnt_notify,	#webuser mail-notify=X mailbox=Y
+      $whiteclnt_notify_pat,	#regex for #webuser mail-notify=X mailbox=Y
+      $whiteclnt_lock,		#webuser (un)locked
+      $whiteclnt_change_log,	#list of dates when file was changed
+      $whiteclnt_cur_key);	#editing position in the file
+
+do('@cgibin@/common') || die("could not get DCC configuration: $!\n");
+
+
+# display the file literally
+if ($query{literal}) {
+    my($buf);
+
+    open(WHITECLNT, "< $whiteclnt") or html_whine("open($whiteclnt): $!");
+
+    print "Content-type: text/plain\n";
+    print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n";
+    print "pragma: no-cache\n\n";
+    print $buf
+	while (read(WHITECLNT, $buf, 4*1024));
+    print "\n";
+
+    close(WHITECLNT);
+    exit;
+}
+
+# lock, read and parse the whiteclnt file
+read_whiteclnt(\@file, \%dict);
+
+# get option defaults from the main whiteclnt file
+read_whitedefs(\%def_options);
+
+
+# get current position for the entry editing form
+$cur_pos = $query{pos};
+
+# find a whitecnt file entry to edit
+if ($query{key}) {
+    $cur_key = $query{key};
+} elsif ($query{auto} && $query{type} && $query{val}) {
+    my @new_entry = ck_new_white_entry("", "ok", $query{type}, $query{val});
+    $cur_key = $new_entry[0] if (defined($new_entry[1]));
+}
+$cur_entry = $dict{$cur_key} if ($cur_key);
+
+
+html_head("DCC Whitelist for $user at $hostname");
+common_buttons();
+print "<TR><TD colspan=10>return to $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n"
+    if ($query{msg});
+print <<EOF;
+<TR><TD colspan=10>$edit_link${url_ques}literal=yes"
+	     TARGET="DCC literal whiteclnt">Literal contents of whitelist</A>.
+</TABLE>
+
+EOF
+
+
+# add new entry
+if ($query{Add}) {
+    my(@new_entry, $msg, $prev, $cur, $add_pos);
+
+    @new_entry = ck_new_white_entry($query{comment}, $query{count},
+				    $query{type}, $query{val});
+    give_up($new_entry[0]) if (!defined($new_entry[1]));
+
+    # insert into the file instead of appending to the end if we have
+    #	    a valid position
+    if (defined($cur_pos)) {
+	$add_pos = next_index($cur_pos);
+    } elsif ($cur_key) {
+	($prev, $cur, $add_pos) = neighbors($cur_key);
+    }
+
+    $cur_key = $new_entry[0];
+    $cur_entry = \@new_entry;
+    give_up("entry already present") if ($dict{$cur_key});
+
+    # send the new entry to the disk with the rest of the file
+    $whiteclnt_cur_key = $cur_key;
+    $msg = chg_white_entry(\@file, \%dict, $cur_key, \@new_entry, $add_pos);
+    give_up($msg) if ($msg);
+
+    # re-prime the form with cleaned comment
+    $cur_entry = $dict{$cur_key};
+    give_up("new entry did not reach file") if (!$cur_entry);
+
+    finish("whitelist entry added");
+}
+
+
+
+# change current whitelist entry
+if ($query{Change}) {
+    my(@new_entry, $msg);
+
+    give_up("no entry selected to change") if (!$cur_key);
+    give_up("entry '$cur_key' has disappeared")
+	if (!$cur_entry || !$$cur_entry[0]);
+
+    @new_entry = ck_new_white_entry($query{comment}, $query{count},
+				    $query{type}, $query{val});
+    give_up($new_entry[0]) if (!defined($new_entry[1]));
+
+    give_up("no changes requested")
+	if ($$cur_entry[1] eq $new_entry[1]
+	    && $$cur_entry[2] eq $new_entry[2]);
+
+    # send the change to the disk with the rest of the file
+    $whiteclnt_cur_key = $cur_key;
+    $msg = chg_white_entry(\@file, \%dict, $cur_key, \@new_entry);
+    give_up($msg) if ($msg);
+
+    # re-prime the form with cleaned comment
+    $cur_entry = $dict{$cur_key};
+    give_up("changed entry did not reach file") if (!$cur_entry);
+
+    finish("whitelist entry changed");
+}
+
+
+
+# delete current entry
+if ($query{Delete}) {
+    my($prev, $cur, $next, $new_key, $msg);
+
+    give_up("no entry selected to delete") if (!$cur_key);
+    give_up("entry '$cur_key' has disappeared")
+	if (!$cur_entry || !$$cur_entry[0]);
+
+    # find a neighbor of the entry to be deleted
+    ($prev, $cur, $next) = neighbors($cur_key);
+    $new_key = ${$file[$prev]}[0] if (defined($prev));
+
+    # write everything to the new file except the deleted entry
+    $whiteclnt_cur_key = $cur_key;
+    $msg = chg_white_entry(\@file, \%dict, $cur_key, undef);
+    give_up($msg) if ($msg);
+
+    # keep the add/change/delete form in place if possible
+    $cur_key = $new_key;
+    undef($cur_entry);
+    delete $query{comment};
+    delete $query{count};
+    delete $query{type};
+    delete $query{val};
+    $cur_entry = $dict{$cur_key} if ($cur_key);
+
+    finish("whitelist entry deleted");
+}
+
+
+# move the current entry up
+if ($query{Up}) {
+    up(1);
+}
+
+if ($query{Up5}) {
+    up(5);
+}
+
+sub up {
+    my($delta) = @_;
+    my($prev, $cur, $next, $moved, @new_file, $msg);
+
+    if ($cur_entry) {
+	# move an existing entry
+	while ($delta) {
+	    --$delta;
+	    # It is inefficient but easy and clearly correct to repeated
+	    #	search the array of entries for the target and then build
+	    #	a new array.
+	    ($prev, $cur, $next) = neighbors($cur_key);
+	    if (!$prev) {
+		give_up("cannot move above the top") if (!$moved);
+		last;
+	    }
+
+	    @new_file = (@file[0 .. $prev-1],
+			 $file[$cur], $file[$prev],
+			 @file[$cur+1 .. $#file]);
+	    @file = @new_file;
+	    $moved = 1;
+	}
+	$whiteclnt_cur_key = $cur_key;
+	$msg = write_whiteclnt(@file);
+	give_up($msg) if ($msg);
+	read_whiteclnt(\@file, \%dict);
+
+    } else {
+	# move a new or proposed entry
+	$cur_pos = prev_index($cur_pos, $delta);
+    }
+    print_form_file();
+}
+
+
+# move the current entry down
+if ($query{Down}) {
+    down(1);
+}
+
+if ($query{Down5}) {
+    down(5);
+}
+
+sub down {
+    my($delta) = @_;
+    my($prev, $cur, $next, @new_file, $msg);
+
+    if ($cur_entry) {
+	# move an existing entry
+	while ($delta) {
+	    --$delta;
+	    ($prev, $cur, $next) = neighbors($cur_key);
+	    if (!$next) {
+		give_up("cannot move below the bottom")  if (!$moved);
+		last;
+	    }
+
+	    @new_file = (@file[0 .. $cur-1],
+			 $file[$next], $file[$cur],
+			 @file[$next+1 .. $#file]);
+	    @file = @new_file;
+	    $moved = 1;
+	}
+	$whiteclnt_cur_key = $cur_key;
+	$msg = write_whiteclnt(@file);
+	give_up($msg) if ($msg);
+	read_whiteclnt(\@file, \%dict);
+
+    } elsif (defined($cur_pos)) {
+	# move position of a future entry
+	$cur_pos = next_index($cur_pos, $delta);
+    }
+    print_form_file();
+}
+
+
+# undo the previous change
+if ($query{Undo}) {
+    my $msg = undo_whiteclnt();
+    give_up($msg) if ($msg);
+
+    $cur_key = $whiteclnt_cur_key;
+    read_whiteclnt(\@file, \%dict);
+    $cur_key = $whiteclnt_cur_key if ($whiteclnt_cur_key);
+
+    # put the add/change/delete form back in place
+    if ($cur_key) {
+	$cur_entry = $dict{$cur_key};
+    } else {
+	undef($cur_entry);
+	delete $query{comment};
+	delete $query{count};
+	delete $query{type};
+	delete $query{val};
+    }
+
+    finish("change undone");
+}
+
+
+# change new log file mail notifcations
+my $old_notify = $whiteclnt_notify;
+if ($query{notify}) {
+    if ($query{notify} =~ /off/) {
+	$whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}off$3$4/i;
+    } elsif ($query{notify} =~ /on/) {
+	$whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}on$3$4/i;
+    }
+}
+if (defined($query{notifybox})) {
+    my $new_box = $query{notifybox};
+    $new_box =~ s/^\s+(.*)\s*$/$1/;
+    $whiteclnt_notify =~ s/$whiteclnt_notify_pat$/$1$2$3$new_box/i;
+
+    give_up('The notification mailbox is limited to  -, _, letters, and digits')
+	if ($whiteclnt_notify !~ /^$whiteclnt_notify_pat$/);
+}
+if ($whiteclnt_notify ne $old_notify) {
+    $whiteclnt_cur_key = "";
+    my $msg = write_whiteclnt(@file);
+    give_up($msg) if ($msg);
+    read_whiteclnt(\@file, \%dict);
+}
+
+# process requests to change options
+option_form("dccenable", "On", "dcc-on", "Off", "dcc-off");
+option_form("greyfilter", "On", "greylist-on", "Off", "greylist-off");;
+option_form("greylog", "On", "greylist-log-on", "Off", "greylist-log-off");
+option_form("mtafirst", "first", "MTA-first", "last", "MTA-last");
+option_form("rep", "On", "DCC-rep-on", "Off", "DCC-rep-off");
+option_form("dnsbl1", "On", "dnsbl1-on", "Off", "dnsbl1-off");
+option_form("dnsbl2", "On", "dnsbl2-on", "Off", "dnsbl2-off");
+option_form("dnsbl3", "On", "dnsbl3-on", "Off", "dnsbl3-off");
+option_form("logall", "On", "log-all", "Off", "log-normal");
+option_form("logsubdir", "day", "log-subdirectory-day",
+	    "hour", "log-subdirectory-hour",
+	    "minute", "log-subdirectory-minute");
+option_form("discardok", "discard spam", "forced-discard-ok",
+	    "delay mail", "no-forced-discard");
+
+# process requests from the HTTP client to change the threshold
+foreach my $ck (split(/,/, $thold_cks)) {
+    my $nm = "thold-$ck";
+    foreach my $val ($query{$nm}, $query{"text-$nm"}) {
+	next if (!$val);
+	if ($val =~ /^Default/) {
+	    set_option($nm);
+	} elsif (!parse_thold_value($ck, $val)) {
+	    give_up("invalid threshold setting $nm='$val'");
+	} else {
+	    set_option($nm, "option threshold $ck,$val\n");
+	}
+	last;
+    }
+}
+
+# nothing to do?
+give_up("entry '$cur_key' has disappeared")
+    if (!$query{auto} && $cur_key && (!$cur_entry || !$$cur_entry[0]));
+print_form_file($query{result}
+		? "<P class=warn>$query{result}</STRONG>\n"
+		: "");
+
+
+
+
+#############################################################################
+
+# display the whiteclnt file with the option setting form and and quit
+sub print_form_file {
+    my($result) = @_;			# "" or some kind of error message
+
+    close(WHITECLNT);
+
+    my $locked = ($whiteclnt_lock =~ /\blocked/) ? " disabled" : "";
+
+    # display any error message from the previous action
+    print $result ? $result : "<P>&nbsp;\n";
+
+    # generate table of forms to control option lines
+    print "<P>\n<TABLE border=0>\n";
+
+    print_form_start("<TR><TD>", "", "");
+    print "\t";
+    undo_form($locked);
+    print "\t</FORM>\n";
+
+    # two HTML forms for the '#webuser...' line
+    $whiteclnt_notify =~ /$whiteclnt_notify_pat/;
+    my $notify_cur = $2;
+    my $notifybox = $4;
+    my $notify_on_locked = ($notify_cur eq "on") ? " disabled" : $locked;
+    my $notify_off_locked = ($notify_cur eq "off") ? " disabled" : $locked;
+    print_form_start("<TR><TD class=first>", "", "");
+    print <<EOF;
+	mail notifications to
+	<INPUT $notify_off_locked type=text name=notifybox value='$notifybox' size=12>
+	<STRONG>$notify_cur</STRONG>
+	</FORM>
+EOF
+    print_form_start("    <TD>", "", "");
+    print_button("\t", "notify", $notify_on_locked, "on");
+    print_button("\t", "notify", $notify_off_locked, "off");
+    print "\t</FORM>\n";
+
+    table_row_form("dccenable", "DCC", $locked, "dcc-off", "dcc-on");
+    if ($DCCM_ARGS =~ /-G/ || $DCCIFD_ARGS =~ /-G/
+	|| (defined($GREY_CLIENT_ARGS) && $GREY_CLIENT_ARGS ne "")) {
+	table_row_form("greyfilter", "greylist filter", $locked,
+		       "greylist-off", "greylist-on");
+	table_row_form("greylog", "greylist log", $locked,
+		       "greylist-log-off", "greylist-log-on");
+    }
+    table_row_form("mtafirst", "check MTA blacklist", $locked,
+		   "MTA-last", "MTA-first", "last", "first");
+    # ask about DNSBLs if they are available
+    my $args = "";
+    $args = "$DNSBL_ARGS" if (defined($DNSBL_ARGS));
+    $args .= " $DCCM_ARGS" if (defined($DCCM_ARGS));
+    $args .= " $DCCIFD_ARGS" if (defined($DCCIFD_ARGS));
+    if ($args =~ /-B/) {
+	if ($args !~ /-B\s*set:group=\d+/i) {
+	    # only one question if there are no groups
+	    table_row_form("dnsbl1", "DNS blacklist checking", $locked);
+	} else {
+	    table_row_form("dnsbl1", "DNS blacklist #1 checking", $locked);
+	    table_row_form("dnsbl2", "DNS blacklist #2 checking", $locked);
+	    table_row_form("dnsbl3", "DNS blacklist #3 checking", $locked);
+	}
+    }
+    table_row_form("logall", "debug logging", $locked,
+		   "log-normal", "log-all");
+    table_row_form("discardok",
+		   "<STRONG></STRONG> also addressed to others",
+		   $locked, "no-forced-discard", "forced-discard-ok",
+		   "delay mail", "discard spam");
+
+    # forms for checksum thresholds
+    foreach my $ck (split(/,/, $thold_cks)) {
+	my($cur_val, $sw_val, $nm, $def_label, $bydef,
+	   $dis_field, $dis_def, $dis_never);
+
+	$nm = "thold-" . $ck;
+	# construct label for the default button from default value
+	$def_label = $def_options{$nm};
+	$def_label =~ s/.*<STRONG>([^<]+)<.*/Default ($1)/;
+	if (defined($dict{$nm})) {
+	    $cur_val = $dict{$nm}[2];
+	    $cur_val =~ s/.*,([-_a-z0-9%]+)\s+$/$1/i;
+	    $bydef = '';
+	    $sw_val = $cur_val;
+	} else {
+	    $cur_val = $def_options{$nm};
+	    $cur_val =~ s@<STRONG>(.*)</STRONG>(.*)@$1@;
+	    $bydef = $2;
+	    $sw_val = 'Default';
+	}
+	$dis_field = $locked;
+	$dis_def = $locked;
+	$dis_never = $locked;
+	$dis_def = " class=selected disabled" if ($sw_val eq "Default");
+	$dis_never = " class=selected disabled" if ($sw_val eq "Never");
+	# changing reputation thresholds ought to affect tagging
+	#	even if reputation checking is turned off
+
+	print_form_start("<TR><TD class=first>", "", "");
+	print <<EOF;
+	<EM>$ck</EM> threshold$bydef
+	<INPUT type=text$dis_field name='text-$nm' value='$cur_val' size=5>
+	</FORM>
+EOF
+	print_form_start("    <TD>", "", "");
+	print_button("\t", $nm, $dis_def, $def_label);
+	print_button("\t", $nm, $dis_never, "Never");
+	# "many" makes no sense for either reputation threshold
+	print_button("\t", $nm,
+		     $sw_val eq "many" ? " disabled" : $locked,
+		     "many")
+	    if ($ck !~ /^rep/i);
+	print "\t</FORM>\n";
+    }
+
+    print "</TABLE>\n\n<P>\n<HR>\n";
+
+    # display a form for a new entry before the file if we have not
+    #	been given a position or an entry to modify
+    print_entry_form($locked) if (!$cur_key && !defined($cur_pos));
+
+    print_whiteclnt_file($result, $locked);
+}
+
+
+
+# display the common start of forms
+sub print_form_start {
+    my($before,			# HTML before start of form
+       $tag,			# tag on action
+       $after			# HTML after start of form
+       ) = @_;
+
+    print $before if ($before);
+    print "<FORM class=nopad ACTION='$edit_url";
+    print $tag if ($tag);
+    print "' method=POST>$form_hidden\n";
+    print $after if ($after);
+    print "\t<INPUT type=hidden name=msg value='$query{msg}'>\n"
+	if ($query{msg});
+    if ($cur_key) {
+	print "\t<INPUT type=hidden name=key value='";
+	print html_str_encode($cur_key);
+	print "'>\n";
+    }
+    if ($cur_pos) {
+	print "\t<INPUT type=hidden name=pos value='";
+	print html_str_encode($cur_pos);
+	print "'>\n";
+    }
+}
+
+
+
+sub undo_form {
+    my($locked) = @_;
+
+    print "<INPUT class=small";
+    print newest_whiteclnt_bak() ? $locked : " disabled";
+    print " type=submit name='Undo' value='Undo Previous Change'>\n";
+}
+
+
+
+# display the entry editing form
+sub print_entry_form {
+    my($locked, $result) = @_;
+    my($add_str, $new_val, $comment, $change_ok, $prev, $cur, $next);
+
+    return if ($have_entry_form);
+    $have_entry_form = 1;
+
+    # prime the form with the currently selected whiteclnt entry, if any
+    if ($cur_entry) {
+	$comment = $$cur_entry[1];
+	$query{comment} = html_str_encode($comment);
+
+	my $value = $$cur_entry[2];
+	$value =~ s/(\S+)\s+//;
+	$query{count} = $1;
+	($query{type}, $query{val}) = parse_type_value($value);
+	$change_ok = $locked;
+    } else {
+	# "disabled" does not work with Netscape 4.*, but we have to handle
+	#   changes without a valid key, so don't worry about it
+	$change_ok = " disabled";
+    }
+
+    # compute a comment if this came from a log file
+    if ($query{auto} && !$cur_entry) {
+	$comment = " \n#";
+	$comment .= "    added from logged message $query{msg}"
+	    if ($query{msg});
+	$comment .= strftime(" %x", localtime);
+	$comment = html_str_encode($comment);
+	$query{count} = "OK";
+    } else {
+	$comment = $query{comment};
+	if (!$comment) {
+	    $comment = "";
+	} else {
+	    $comment =~ s/\s+$//mg;
+	    # need a blank on a leading blank line to preserve it in Mozilla
+	    $comment =~ s/^\n/ \n/;
+	}
+    }
+
+    if (!$form_marked) {
+	print "<A NAME='cur_key'></A>";
+	$form_marked = 1;
+    }
+    print_form_start("", "#cur_key", "<TABLE border=0>\n<TR><TD>&nbsp;");
+    print "    <TD>";
+    undo_form($locked);
+    print_button("\t", "Add", $locked, "Add");
+    if (defined($cur_pos)) {
+	$prev = prev_index($cur_pos);
+	$next = next_index($cur_pos);
+    } elsif ($cur_key) {
+	($prev, $cur, $next) = neighbors($cur_key);
+    } else {
+	undef($prev);
+	undef($next);
+    }
+    print_button("\t", "Up", !defined($prev) ? " disabled" : $locked, "Up");
+    print_button("\t", "Up5", !defined($prev) ? " disabled" : $locked, "Up 5");
+    print_button("\t", "Down", !$next ? " disabled" : $locked, "Down");
+    print_button("\t", "Down5", !$next ? " disabled" : $locked, "Down 5");
+    if ($query{auto} && !$cur_entry) {
+	print "\tfrom $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n";
+    } else {
+	print_button("\t", "Change", $change_ok, "Change");
+	print_button("\t", "Delete", $change_ok, "Delete");
+	print "whitelist entry\n";
+    }
+    print <<EOF;
+<TR><TD>Description
+    <TD><TEXTAREA$locked name=comment rows=3 cols=70>$comment</TEXTAREA>
+<TR><TD>&nbsp;
+    <TD><SELECT class=small$locked name=count>
+EOF
+    $query{count} = "OK" if (!$query{count});
+    print_option("count", "OK");
+    print_option("count", "OK2");
+    print_option("count", "many");
+    print "\t</SELECT>\n";
+
+    print "\t<SELECT class=small$locked name=type>\n";
+    $query{type} = "env_From" if (!$query{type});
+    print_option("type", "env_From");
+    print_option("type", "env_To");
+    print_option("type", "From");
+    print_option("type", "IP");
+    print_option("type", "Message-ID");
+    # allow selection of checksums specified with -S in /var/dcc/dcc_conf
+    foreach my $hdr (split(/[|)(]+/, $sub_white)) {
+	my($label);
+	$hdr =~ s/\\s\+/ /;
+	next if ($hdr =~ /^s*$/);
+	$label = $hdr;
+	$label =~ s/^substitute\s+//i;
+	print_option("type", $label, $hdr);
+    }
+    print_option("type", "Hex Body");
+    print_option("type", "Hex Fuz1");
+    print_option("type", "Hex Fuz2");
+    print "\t</SELECT>\n";
+
+    print "\t<INPUT  type=text name=val size=40";
+    if ($query{val}) {
+	print " value='";
+	print html_str_encode($query{val});
+	print "'";
+    }
+    print ">\n";
+
+    print "<TR><TD colspan=10>return to $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n"
+	if ($query{msg});
+
+    print "<TR><TD colspan=10>\n";
+    print $result ? $result : "&nbsp;";
+    print "</TABLE>\n</FORM>\n\n";
+}
+
+
+
+# find indeces of previous, current, and next entries
+#   return a list of 3 entries of the preceding, current, and following indeces
+sub neighbors {
+    my($tgt_key) = @_;
+    my($prev, $cur, $index, $entry);
+
+    # look for the current entry while tracking predecessors
+    $index = 0;
+    foreach $entry (@file) {
+	next if (!ref($entry));
+
+	# ignore deleted lines, options, and include lines
+	next if (!$$entry[0] || !defined($$entry[1])
+		 || $$entry[2] =~ /^option/);
+
+	# stop at the first entry when there is no current position
+	return ($prev, $cur, $index) if (!$tgt_key);
+
+	if ($$entry[0] eq $tgt_key) {
+	    $cur = $index;
+	    last;
+	}
+	$prev = $index;
+    } continue { ++$index; }
+
+    do {
+	return ($prev, $cur, undef) if ($index >= $#file);
+	$entry = $file[++$index];
+    } while (!$$entry[0] || !defined($$entry[1]) || $$entry[2] =~ /^option/);
+    return ($prev, $cur, $index);
+}
+
+
+
+sub prev_index {
+    my($pos, $delta) = @_;
+    my ($entry);
+
+    $pos = $#file if (!$pos);
+
+    while (--$pos >= 0) {
+	$entry = $file[$pos];
+	# skip deleted entries
+	return $pos
+	    if ($$entry[0] && defined($$entry[1]) && $$entry[2] !~ /^option/
+		&& (!$delta || !--$delta));
+    }
+    return undef;
+}
+
+
+
+sub next_index {
+    my($pos, $delta) = @_;
+    my ($entry);
+
+    $pos = $#file if (!$pos);
+
+    while (++$pos <= $#file) {
+	$entry = $file[$pos];
+	# skip deleted entries
+	return $pos
+	    if ($$entry[0] && defined($$entry[1]) && $$entry[2] !~ /^option/
+		&& (!$delta || !--$delta));
+    }
+    return undef;
+}
+
+
+
+sub set_option {
+    my($key, $line) = @_;
+    my($msg);
+
+    # put the new value, if any, into the spare slot created when the file
+    #	was read into memory
+    $file[1] = ["", "", $line] if ($line);
+
+    # delete the old value if any
+    $whiteclnt_cur_key = "";
+
+    $msg = chg_white_entry(\@file, \%dict, $key);
+    give_up($msg) if ($msg);
+}
+
+
+
+# see if an form for an option was selected and process the result if so
+#	The first arg is the name of the option.  It is followed by
+#	(form-value,file-value) pairs
+sub option_form {
+    my($key, $new_formval, $formval, $fileval);
+
+    $key = shift @_;
+    $new_formval = $query{$key};
+    return if (!$new_formval);
+
+    if ($new_formval =~ /^Default/) {
+	set_option("$key");
+	return;
+    }
+    while ($#_ > 0) {
+	$formval = shift @_;
+	$fileval = shift @_;
+	if ($new_formval eq $formval) {
+	    set_option("$key", "option $fileval\n");
+	    return;
+	}
+    }
+    give_up("invalid setting $key='$new_formval'");
+}
+
+
+
+sub finish {
+    print_form_file("<P><STRONG>" . html_str_encode($_[0]) . "</STRONG>\n");
+}
+
+
+
+sub give_up {
+    print_form_file("<P class=warn><STRONG>"
+		    . html_str_encode($_[0]) . "</STRONG>\n");
+}
+
+
+
+# You cannot use real HTML 4 buttons because Microsoft gets them all wrong.
+#   Contrary to the standard, they return all type=submit buttons.
+#	They also return any text label instead of the value, thereby removing
+#	most or all reason to use <BUTTON> instead of <INPUT>.
+sub print_button {
+    my($lead,				# HTML text before the control
+       $nm,				# control name
+       $lock,				# "" or " disabled"
+       $val) = @_;			# value when selected
+
+    $lock = " class=small$lock" if ($lock !~ /class=/i);
+    print $lead;
+    print "<INPUT $lock type=submit name='$nm' value='$val'>\n";
+}
+
+
+
+# one line of the table of forms
+sub table_row_form {
+    my($nm,				# name of the option
+       $label,				# label; <STRONG></STRONG> gets current
+       $locked,				# "" or "disabled" when file read-only
+       $off, $on,			# replace "off" and "on" in the file
+       $off_label, $on_label,		# "off" & "on" for user
+       ) = @_;
+    my($button_cur, $dis_on, $dis_off, $dis_def, $label_cur,
+       $val_cur, $bydef);
+
+
+    $off = "$nm-off" if (!$off);
+    $on = "$nm-on" if (!$on);
+    $dis_on = $locked;
+    $dis_off = $locked;
+    $dis_def = $locked;
+    $button_cur = $locked ? $locked : " class=selected disabled";
+    if ($dict{$nm}
+	&& $dict{$nm}[2] eq "option $on\n") {
+	$label_cur = $on_label ? $on_label : "<STRONG>on</STRONG>";
+	$val_cur = $label_cur;
+	$bydef = "";
+	$dis_on = $button_cur;
+    } elsif ($dict{$nm}
+	     && $dict{$nm}[2] eq "option $off\n") {
+	$label_cur = $off_label ? $off_label : "<STRONG>off</STRONG>";
+	$val_cur = $label_cur;
+	$bydef = "";
+	$dis_off = $button_cur;
+    } else {
+	$label_cur = $def_options{$nm};
+	$val_cur = $label_cur;
+	$val_cur =~ s@(<STRONG>.*</STRONG>)(.*)@$1@;
+	$bydef = $2;
+	$dis_def = $button_cur;
+    }
+    # construct labels for "on" and "off" buttons
+    if ($on_label) {
+	$on_label =~ s/.*<STRONG>([^<]+)<.*/$1/;
+    } else {
+	$on_label = "On";
+    }
+    if ($off_label) {
+	$off_label =~ s/.*<STRONG>([^<]+)<.*/$1/;
+    } else {
+	$off_label = "Off";
+    }
+    # construct label for the default button from default value
+    $def_label = $def_options{$nm};
+    $def_label =~ s/.*<STRONG>([^<]+)<.*/Default ($1)/;
+    # construct label for the group of buttons
+    #	use it as a pattern if the provided label contains "<STRONG></STRONG>",
+    if ($label !~ s@<STRONG></STRONG>(.*)@<STRONG>$val_cur</STRONG>$1$bydef@) {
+	$label .= " $label_cur";
+    }
+
+    print "<TR><TD class=first>$label\n";
+    print_form_start("    <TD>", "", "");
+    print_button("\t", $nm, $dis_def, $def_label);
+    print_button("\t", $nm, $dis_on, $on_label);
+    print_button("\t", $nm, $dis_off, $off_label);
+    print "\t</FORM>\n";
+}
+
+
+
+sub print_str {
+    my($lineno, $leader, $str) = @_;
+
+    while ($str =~ s/(.*\n?)// && $1) {
+	my $line = $1;
+	if ($line =~ /\n/) {
+	    ++$lineno;
+	} else {
+	    $line .= "\n";
+	    $leader .= "? ";
+	}
+	print $lineno if ($query{debug});
+	print $leader;
+	print $line;
+    }
+    return $lineno;
+}
+
+
+
+sub print_option {
+    my($field, $label, $value) = @_;
+    my($s);
+
+    $s = "";
+    if ($query{$field}) {
+	if ($value && $query{$field} =~ /^$value$/i) {
+	    $s =  " selected"
+	} elsif ($query{$field} =~ /^$label$/i) {
+	    $s =  " selected";
+	}
+    }
+    if ($value) {
+	$value = " value=\"$value\"";
+    } else {
+	$value = "";
+    }
+    print "\t    <OPTION class=small$s$value>$label</OPTION>\n";
+}
+
+
+
+# display the current contents of the whiteclnt file
+#   It is represented as an array or list of references to 3-tuples.
+#   The first of the three is the whitelist entry in a canonical form
+#	as a key uniquely identifying the entry.
+#   The second is a comment string of zero or more comment lines.
+#   The third is the DCC whiteclnt entry.
+#
+#   The canonical form and the whiteclnt line of the first 3-tuple for a file
+#   are null, because it contains the comments, if any, before the file's
+#   preamble of dans when the file has been changed and flags.
+#   The file[1] is an empty slot for adding option settings.
+#   The last triple in a file may also lack a whitelist entry.
+
+sub print_whiteclnt_file {
+    my($result, $locked) = @_;
+    my($preamble, $str, $url, $entry, $lineno, $in_pre, $leader, $end_select,
+       $tgt_key, $prev_key);
+
+    $url = $edit_link . $url_ques;
+    $url .= "msg=" . $query{msg} . "&amp;" if ($query{msg});
+    $url .= "key=";
+
+    $tgt_key = defined($cur_pos) ? ${$file[$cur_pos]}[0] : $cur_key;
+
+    # try to find an entry before the current entry to start the display
+    #	in the browser's window
+    if ($tgt_key) {
+	my @prev_keys;
+
+	foreach $entry (@file) {
+	    # ignore deleted lines, options, and include lines
+	    next if (!$$entry[0] || !defined($$entry[1])
+		     || $$entry[2] =~ /^option/);
+	    shift(@prev_keys) if ($#prev_keys >= 2);
+	    push(@prev_keys, $$entry[0]);
+	    last if ($$entry[0] eq $tgt_key);
+	}
+	$prev_key = shift(@prev_keys);
+    }
+
+    $lineno = 1;
+    foreach $entry (@file) {
+	# do not list deleted entries
+	next if (!defined($$entry[1]));
+
+	# no options if not debugging
+	next if ($$entry[2] =~ /^option/ && !$query{debug});
+
+	# tell the browser that the form will be soon
+	if ($prev_key && $$entry[0] && $$entry[0] eq $prev_key) {
+	    print "<A NAME='cur_key'></A>";
+	    $form_marked = 1;
+	}
+
+	# mark the currently selected entry
+	if ($tgt_key && $$entry[0] && $$entry[0] eq $tgt_key) {
+	    print "<STRONG>";
+	    $leader = " &brvbar;\t";
+	    $end_select = 1;
+	} else {
+	    $leader = "\t";
+	    $end_select = undef;
+	}
+
+	if ($query{debug}) {
+	    if ($in_pre) {
+		$in_pre = undef;
+		print "</PRE>";
+	    }
+	    print "<HR>" if ($query{debug});
+	}
+	if (!$in_pre) {
+	    $in_pre = 1;
+	    print "<PRE class=nopad>";
+	}
+
+	# display comment lines
+	$str = $$entry[1];
+	if (!$preamble) {
+	    # Display the preamble parameters after comments in first triple
+	    #	but before the ultimate blank line in the comments, if present.
+	    $preamble = $whiteclnt_version;
+	    $preamble .= $whiteclnt_notify;
+	    $preamble .= $whiteclnt_lock;
+	    $preamble .= "#webuser cur_key $whiteclnt_cur_key\n"
+		if ($whiteclnt_cur_key);
+	    $preamble .= $whiteclnt_change_log;
+	    if ($query{debug}) {
+		$str .= $preamble if ($str !~ s/(\n?)\n$/\n$preamble$1/);
+	    }
+	}
+	$lineno = print_str($lineno, $leader, html_str_encode($str));
+
+	$str = $$entry[2];
+	if ($$entry[0] && $$entry[2] !~ /^option/) {
+	    # Display an ordinary entry as a link for editing.
+	    chomp($str);
+	    # Suppress "substitute" noise
+	    $str =~ s/^(\S*\s+)substitute\s+/$1/;
+	    # use tab for blanks between the type and value
+	    $str =~ s/^(\S+)\s+(\S+)\s+/$1\t$2\t/;
+	    # make columns
+	    $str =~ s/^(\S+\s+\S{1,7})\t/$1\t\t/;
+	    $str = $url . url_encode($$entry[0]) . "#cur_key\">"
+		    . html_str_encode($str)  . "</A>\n";
+	} else {
+	    # just display option lines
+	    $str = html_str_encode($str);
+	}
+	$lineno = print_str($lineno, $leader, $str);
+
+	# put the editing form after the selected entry
+	if ($end_select) {
+	    print "</STRONG></PRE>\n";
+	    $in_pre = undef;
+	    print_entry_form($locked, $result);
+	}
+    }
+    print "</PRE>\n" if ($in_pre);
+
+    print_entry_form($locked, $result) if (!$have_entry_form);
+
+    close(WHITECLNT);
+
+    html_footer();
+    print "</BODY>\n</HTML>\n";
+
+    exit;
+}