#! /usr/bin/perl -w

# display and edit a DCC white list file

# Copyright (c) 2003 by Rhyolite Software
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE DISCLAIMS ALL
# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE
# 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.2.7-1.3 $Revision$
#	Generated automatically from edit-whiteclnt.in by configure.

# This file must protected with an equivalent to httpd.conf lines
#   in the README file.

use strict 'subs';

my(@file, %dict, $cur_key, $cur_entry, $cur_msg);


# get DCC parameters
local($user, $edit_url, $list_msg_link, $sub_white);
do('/var/www/dcc-bin/common') || die("could not get DCC configuration: $!\n");

local($query);
get_query();


# display the file literally
if ($query{'literal'}) {
    my($buf);

    punt("open($whiteclnt) $!")
	if (!open(WHITECLNT, "< $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 file
local($whiteclnt_notify_pat, $whiteclnt_version, $whiteclnt_change_log);
read_whiteclnt(\@file, \%dict);

$cur_key = $query{'key'};
if (!defined($cur_key)) {
    $cur_entry = undef;
} else {
    $cur_entry = $dict{$cur_key};
}
$cur_msg = $query{'msg'};
$cur_msg = ""
    if (!defined($cur_msg));


html_head("White list for $user");
common_buttons();
print "<TR><TD colspan=10>Message $list_msg_link?msg=$cur_msg\">$cur_msg</A>\n"
    if ($cur_msg);
print <<EOF;
<TR><TD colspan=10>$edit_link?literal=yes"
	     TARGET="DCC literal whiteclnt">Literal contents</A>.
</TABLE>
EOF


if ($query{'action'}) {

    # add new entry
    if ($query{'action'} eq "Add") {
	my($msg, @new_entry, $comment);

	@new_entry = ck_new();

	# refuse to add a duplicate entry
	$cur_key = $new_entry[0];
	$cur_entry = $dict{$cur_key};
	give_up("checksum already present")
	    if ($cur_entry);

	# send the image to the disk
	push @file, [@{$dict{$cur_key}} = @new_entry];
	$msg = write_whiteclnt(@file);
	give_up($msg)
	    if ($msg);
	read_whiteclnt(\@file, \%dict);

	finish("checksum added");
    }


    # change current entry
    if ($query{'action'} eq "Change") {
	my($msg, @new_entry);

	give_up("no checksum selected to change")
	    if (! $cur_key);
	give_up("checksum [$cur_key] has disappeared")
	    if (! $cur_entry || ! $$cur_entry[0]);

	@new_entry = ck_new();

	# change the memory image of the file
	give_up("no changes requested")
	    if ($$cur_entry[1] eq $new_entry[1]
		&& $$cur_entry[2] eq $new_entry[2]);

	# change the old entry so it will get into the file
	#	add a new entry to the dictionary so the new form will be right
	@{$dict{$cur_key}} = @new_entry;
	$cur_key = $new_entry[0];
	@{$dict{$cur_key}} = @new_entry;

	# send the image to the disk
	$msg = write_whiteclnt(@file);
	give_up($msg)
	    if ($msg);

	finish("checksum changed");
    }


    # delete current entry
    if ($query{'action'} eq "Delete") {
	my($msg);

	give_up("no checksum selected to delete")
	    if (! $cur_key);
	give_up("checksum [$cur_key] has disappeared")
	    if (! $cur_entry || ! $$cur_entry[0]);

	@{$dict{$cur_key}} = (undef, undef, undef);
	undef_cur();

	# send the image to the disk
	$msg = write_whiteclnt(@file);
	give_up($msg)
	    if ($msg);

	finish("checksum deleted");
    }


    # undo the last change
    if ($query{'action'} eq "Undo") {
	my($msg);

	$msg = undo_whiteclnt();
	give_up($msg)
	    if ($msg);
	undef_cur();
	read_whiteclnt(\@file, \%dict);

	finish("undone");
    }
}


# change new log file notifcations
if ($query{'notify'} && defined($query{'notifybox'})) {
    my($new_sw, $new_box, $old_notify, $msg);

    $new_sw = $query{'notify'};
    $new_box = $query{'notifybox'};
    $new_box =~ s/^\s+//;
    $new_box =~ s/\s+$//;

    # change the value so that the HTML form does not change if something
    #	is wrong
    $old_notify = $whiteclnt_notify;
    $whiteclnt_notify =~ s/$whiteclnt_notify_pat/$1$new_sw$3$new_box/;

    give_up('The notification mailbox is limited to  -, _, letters, and digits')
	if ($whiteclnt_notify !~ /^$whiteclnt_notify_pat$/);

    if ($whiteclnt_notify ne $old_notify) {
	$msg = write_whiteclnt(@file);
	give_up($msg) if ($msg);
    }
    finish("notifications turned $new_sw");
}


# nothing to do?
give_up("checksum [$cur_key] has disappeared")
    if ($cur_key && (! $cur_entry || ! $$cur_entry[0]));
basic_form();


#############################################################################


sub undef_cur {
    undef($cur_key);
    undef($cur_entry);
    delete $query{'comment'};
    delete $query{'count'};
    delete $query{'type'};
    delete $query{'val'};
}



# check a proposed entry
#   quit if it is bogus
sub ck_new {
    my($comment, $line, $count, $type, $value, @parsed);

    foreach my $nm ('count', 'type', 'val', 'comment') {
	give_up("broken POST values without $nm\n")
	    if (!defined($query{$nm}));
    }

    $comment = $query{'comment'};
    $comment =~ s/[ \t\r]+\n/\n/g;
    $comment =~ s/[\s\r]+$//;
    $comment =~ s/^([^#\n])/#$1/gm;
    $comment .= "\n" if (length($comment) != 0);
    $count = $query{'count'};
    $type = $query{'type'};
    $value = $query{'val'};
    $value =~ s/[\s\r]+$//;

    $line = "$count\t$type";
    $line .= (length($type) < 8) ? "\t" : ' ';
    $line .= "$value\n";

    @parsed = parse_white_entry($line, 'strict');
    give_up($parsed[0])
	if (!defined($parsed[1]));

    return ($parsed[0], $comment, $parsed[1]);
}




sub finish {
    my($msg) = @_;

    $msg = html_str_encode($msg);
    basic_form("<P><B>$msg</B>\n");
}



sub give_up {
    my($msg) = @_;

    $msg = html_str_encode($msg);
    basic_form("<P class=warn><B>$msg</B>\n");
}



sub print_option {
    my($field, $value) = @_;
    my($s, $label);

    if ($query{$field} && $query{$field} =~ /^$value$/i) {
	$s =  " selected";
    } else { 
	$s = "";
    }
    $label = $value;
    if ($label =~ s/^substitute\s+//) {
	$value = " value=\"$value\"";
    } else {
	$value = "";
    }
    print "\t    <OPTION$s$value>$label</OPTION>\n";
}



# display the basic editing form as well as the entire file
sub basic_form {
    my($result) = @_;
    my($entry, $val, $comment, $change_ok, $undo_ok);

    close(WHITECLNT);

    $undo_ok = newest_whiteclnt_bak() ? "" : " disabled";

    if (! $result) {
	if (! $query{'auto'}) {
	    $result = "<P>&nbsp;"
	} elsif (! $cur_entry) {
	    my($str);
	    $str = ($cur_msg ? "\n#    added from logged message $cur_msg "
		    : "\n#    ");
	    $str .= strftime("%x", localtime);
	    $query{'comment'} = html_str_encode($str);
	    $query{'count'} = "OK";
	    $result = "<P><B>select &lt;Add&gt; to add this checksum to your white list<\B>\n";
	}
    }

    if ($cur_entry) {
	$comment = $$cur_entry[1];
	$comment =~ s/\s+$/\n/;
	$query{'comment'} = $comment;

	$val = $$cur_entry[2];
	$val =~ s/(\S+)\s+//;
	$query{'count'} = $1;
	$val =~ s/(\S+)\s+//
	    if ($val !~ s/((?:(substitute|hex))\s+\S+)\s+//);
	$query{'type'} = $1;
	$val =~ s/\s*$//;
	$query{'val'} = $val;
	$change_ok = "";
    } else {
	# this 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";
    }

    $comment = $query{'comment'};
    $comment = ""
	if (! $comment);
    $comment =~ s/\s+$//;
    $comment = html_str_encode($comment);

    print <<EOF;
<FORM ACTION=\"$edit_url\" method=post>
<TABLE border=0>
<TR><TD><TD>
EOF
    if ($cur_key) {
	print "\t<INPUT type=hidden name=\"key\" value=\"";
	print html_str_encode($cur_key);
	print "\">\n";
    }
    print "\t<INPUT type=hidden name=\"msg\" value=\"$cur_msg\">\n"
	if ($cur_msg);
    print "\t<INPUT type=hidden name=\"debug\" value=\"$query{'debug'}\">\n"
	if ($query{'debug'});

print <<EOF;
	<INPUT$undo_ok type=submit name="action" value="Undo">
	<INPUT type=submit name="action" value="Add">
	<INPUT$change_ok type=submit name="action" value="Change">
	<INPUT$change_ok type=submit name="action" value="Delete">
<TR><TD><TD>$result
<TR><TH>Comment<TD><TEXTAREA name=comment rows=3 cols=70>
$comment</TEXTAREA>
EOF

    print "<TR><TD>\n    <TD><SELECT name=count size=1><OPTGROUP LABEL=\"\">\n";
    $query{'count'} = "OK" if (! $query{'count'});
    print_option('count', "OK");
    print_option('count', "OK2");
    print_option('count', "many");
    print "\t</OPTGROUP></SELECT>\n";

    print "\t<SELECT name=type size=1><OPTGROUP LABEL=\"\">\n";
    $query{'type'} = "env_From" if (! $query{'type'});
    print_option('type', "env_From");
    print_option('type', "From");
    print_option('type', "Message_ID");
    print_option('type', "IP");
    foreach my $hdr (split(/[|)(]+/, $sub_white)) {
	$hdr =~ s/\\s\+/ /;
	next
	    if ($hdr =~ /^s*$/);
	print_option('type', "$hdr");
    }
    print_option('type', "Hex Body");
    print_option('type', "Hex Fuz1");
    print_option('type', "Hex Fuz2");
    print_option('type', "Hex Fuz3");
    print_option('type', "Hex Fuz4");
    print "\t</OPTGROUP></SELECT>\n";

    print "    <INPUT type=text name=\"val\" size=40";
    if ($query{'val'}) {
	print " value=\"";
	print html_str_encode($query{'val'});
	print '"';
    }
    print ">\n";

    print "<TR><TD><TD>Turn <INPUT type=submit name=\"notify\" value=\"on\">";
    print "\n\tor turn <INPUT type=submit name=\"notify\" value=\"off\">\n\t";
    $whiteclnt_notify =~ /mailbox=(.*)\s*/;
print <<EOF;
\t    notifcations of logged mesages to
\t    <INPUT type=text name=\"notifybox\" value=\"$1\" size=12>
</TABLE>
</FORM>
EOF

    display_file();
}



sub display_str {
    my($lineno, $leader, $str) = @_;

    return $lineno
	if (! $str);

    while ($str =~ s/(.*)\n//) {
	print $lineno++
	    if ($query{'debug'});
	print $leader;
	print $1;
	print "\n";
    }
    return $lineno;
}



# finish the edit web page with the current contents of the file
sub display_file {
    my($str, $url, $preamble, $lineno, $leader, $end_select);

    $url = "$edit_link?";
    $url .= "msg=$cur_msg&amp;"
	if ($cur_msg);
    $url .= "debug=1&amp;"
	if ($query{'debug'});
    $url .= "key=";

    $lineno = 1;
    $preamble = $query{'debug'} ? 0 : 1;
    print "<HR>\n<PRE>\n";
    if ($whiteclnt_notify =~ /notify=on/) {
	print "    <B>mail</B> notices of logged messages";
	print " to $1"
	    if ($whiteclnt_notify =~ /mailbox=(\S+)/);
    } else {
	print "    <B>do not mail</B> notices of logged messages";
    }
    print "\n\n\n";
    foreach my $entry (@file) {
	next if (! defined($$entry[1]));	# skip deleted entries

	if (defined($$entry[0]) && defined($cur_key)
	    && $$entry[0] eq $cur_key) {
	    print "<B>";
	    $leader = " &brvbar;\t";
	    $end_select = "</B>";
	} else {
	    $leader = "\t";
	    $end_select = "";
	}

	$lineno = display_str($lineno, $leader, html_str_encode($$entry[1]));

	if (! $preamble) {
	    $preamble = 1;
	    $str = $whiteclnt_version;
	    $str .= $whiteclnt_notify;
	    $str .= $whiteclnt_change_log;
	    $lineno = display_str($lineno, $leader, html_str_encode($str));
	}

	if ($$entry[0]) {
	    $str = $url;
	    $str .= url_encode($$entry[0]);
	    $str .= "\">";
	    $str .= html_str_encode($$entry[2]);
	    chomp($str);
	    $str .= "</A>\n";
	} else {
	    $str = html_str_encode($$entry[2]);
	}
	$lineno = display_str($lineno, $leader, $str);

	print $end_select
	    if ($end_select);
	print "<HR>" if ($query{'debug'});
    }
    print "</PRE>\n</BODY>\n</HTML>\n";

    close(WHITECLNT);
    exit;
}
