#! @PERL@ -w

# display and edit a DCC whitelist file

# Copyright (c) 2005 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.74-1.16 $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($cur_key, $cur_entry, $msg, @new_entry);


# get DCC parameters
local($whiteclnt);		# path to the per-user whitelist file
local($user, $edit_url, $list_msg_link, $sub_white);
do('@cgibin@/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_version, $whiteclnt_notify_pat, $whiteclnt_notify,
      $whiteclnt_lock, $whiteclnt_change_log);
read_whiteclnt(\@file, \%dict);

# get option defaults from the main whiteclnt file
read_whitedefs(\%def_options);


$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("Whitelist for $user");
common_buttons();
print "<TR><TD colspan=10>Message $list_msg_link?msg=$query{msg}\">$query{msg}</A>\n"
    if ($query{msg});
print <<EOF;
<TR><TD colspan=10>$edit_link?literal=yes"
	     TARGET="DCC literal whiteclnt">Literal contents of whitelist</A>.
</TABLE>
EOF


# add new entry
if ($query{Add}) {
    @new_entry = ck_new_white_entry($query{comment}, $query{count},
				    $query{type}, $query{val});
    give_up($new_entry[0]) if (!defined($new_entry[1]));

    $new_key = $new_entry[0];
    give_up("checksum already present") if ($dict{$new_key});

    # send the entry to the disk with the rest of the file
    $msg = chg_white_entry(\@file, \%dict, $new_key, \@new_entry);
    give_up($msg) if ($msg);

    $cur_key = $new_key;
    $cur_entry = \@new_entry;
    finish("checksum added");
}


# change current entry
if ($query{Change}) {
    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_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
    $msg = chg_white_entry(\@file, \%dict, $cur_key, \@new_entry);
    give_up($msg) if ($msg);
    $cur_key = $new_entry[0];

    finish("checksum changed");
}


# delete current entry
if ($query{Delete}) {
    give_up("no checksum selected to delete") if (! $cur_key);
    give_up("checksum [$cur_key] has disappeared")
	if (! $cur_entry || ! $$cur_entry[0]);

    # write everything to the new file except the deleted entry
    $msg = chg_white_entry(\@file, \%dict, $cur_key);
    give_up($msg) if ($msg);
    undef_cur();

    finish("checksum deleted");
}


# undo the last change
if ($query{Undo}) {
    $msg = undo_whiteclnt();
    give_up($msg) if ($msg);
    undef_cur();
    read_whiteclnt(\@file, \%dict);

    finish("undone");
}


# change new log file mail notifcations
if ($query{notify}) {
    my($new_sw, $new_box, $old_notify);

    if ($query{notify} eq "Disable") {
	$new_sw = "off";
	$new_box = "";
    } else {
	$new_sw = "on";
	$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);
    }
}

if ($query{dccenable}) {
    if ($query{dccenable} eq "Default") {
	set_option("dccenable");
    } elsif ($query{dccenable} eq "Enable") {
	set_option("dccenable", "option dcc-on\n");
    } elsif ($query{dccenable} eq "Disable") {
	set_option("dccenable", "option dcc-off\n");
    }
}

if ($query{greyfilter}) {
    if ($query{greyfilter} eq "Default") {
	set_option("greyfilter");
    } elsif ($query{greyfilter} eq "Enable") {
	set_option("greyfilter", "option greylist-on\n");
    } elsif ($query{greyfilter} eq "Disable") {
	set_option("greyfilter", "option greylist-off\n");
    }
}

if ($query{greylog}) {
    if ($query{greylog} eq "Default") {
	set_option("greylog");
    } elsif ($query{greylog} eq "Enable") {
	set_option("greylog", "option greylist-log-on\n");
    } elsif ($query{greylog} eq "Disable") {
	set_option("greylog", "option greylist-log-off\n");
    }
}

if ($query{dnsbl}) {
    if ($query{dnsbl} eq "Default") {
	set_option("dnsbl");
    } elsif ($query{dnsbl} eq "Enable") {
	set_option("dnsbl", "option dnsbl-on\n");
    } elsif ($query{dnsbl} eq "Disable") {
	set_option("dnsbl", "option dnsbl-off\n");
    }
}

if ($query{dbglog}) {
    if ($query{dbglog} eq "Default") {
	set_option("logall");
    } elsif ($query{dbglog} eq "Enable") {
	set_option("logall", "option log-all\n");
    } elsif ($query{dbglog} eq "Disable") {
	set_option("logall", "option log-normal\n");
    }
}


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


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


sub set_option {
    my($key, $line, $result) = @_;
	my($msg);

    # insert the new value
    $file[1] = ["", "", $line] if ($line);
    # delete the old value if any
    $msg = chg_white_entry(\@file, \%dict, $key);
    give_up($msg) if ($msg);
}



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



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");
}



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

    close(WHITECLNT);

    $locked = ($whiteclnt_lock =~ / locked/) ? " disabled" : "";

    if (! $result) {
	if (! $query{auto}) {
	    $result = "<P>&nbsp;"
	} elsif (! $cur_entry) {
	    my($str);
	    $str = ($query{msg} ? "\n#    added from logged message $query{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 whitelist<\B>\n";
	}
    }

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

    if ($cur_entry) {
	$comment = $$cur_entry[1];
	$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 = $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";
    }

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

    $form = "<FORM ACTION=\"$edit_url\" method=post>";
    $form .= "\n<INPUT type=hidden name=msg value=\"$query{msg}\">"
	if ($query{msg});
    $form .= "\n<INPUT type=hidden name=debug value=on>"
	if ($query{debug});
    if ($cur_key) {
	$form .= "\n<INPUT type=hidden name=key value=\"";
	$form .= html_str_encode($cur_key);
	$form .= "\">";
    }

print <<EOF;
$result
$form
    <INPUT$undo_ok type=submit name=Undo value=Undo>
</FORM>
$form
<TABLE border=0>
<TR><TD colspan=2><INPUT$locked type=submit name=Add value=Add>
	<INPUT$change_ok type=submit name=Change value=Change>
	<INPUT$change_ok type=submit name=Delete value=Delete>
<TR><TH>Comment
	<TD><TEXTAREA$locked name=comment rows=3 cols=70>$comment</TEXTAREA>
<TR><TD>
    <TD><SELECT$locked name=count size=1><OPTGROUP LABEL="">
EOF
    $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$locked 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)) {
	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</OPTGROUP></SELECT>\n";

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

    $whiteclnt_notify =~ /$whiteclnt_notify_pat/;
    if ($2 eq "on") {
	$val = "<B>enabled</B>";
	# cannot disable first button without making the text area
	# do nothing with carriage return in Mozilla
	$lock_sw2 = $locked;
    } else {
	$lock_sw2 = " disabled";
	$val = "<B>disabled</B>";
    }
    print <<EOF;
<P>
$form
    <INPUT$locked type=submit name=notify value=Enable>
    <INPUT$lock_sw2 type=submit name=notify value=Disable>
    mail notifications of logged mesages to
    <INPUT$locked type=text name=notifybox value=\"$4\" size=12> $val
</FORM>
EOF

    if ($dict{dccenable}
	&& $dict{dccenable}[2] eq "option dcc-on\n") {
	$val = "<B>enabled</B>";
	$lock_sw1 = " disabled";
	$lock_sw2 = $locked;
	$lock_sw3 = $locked;
    } elsif ($dict{dccenable}
	     && $dict{dccenable}[2] eq "option dcc-off\n") {
	$val = "<B>disabled</B>";
	$lock_sw1 = $locked;
	$lock_sw2 = " disabled";
	$lock_sw3 = $locked;
    } else {
	$val = $def_options{dccenable};
	$lock_sw1 = $locked;
	$lock_sw2 = $locked;
	$lock_sw3 = " disabled";
    }
    print <<EOF;
<P>
$form
    <INPUT$lock_sw1 type=submit name=dccenable value=Enable>
    <INPUT$lock_sw2 type=submit name=dccenable value=Disable>
    <INPUT$lock_sw3 type=submit name=dccenable value=Default>
    DCC $val
</FORM>
EOF

    if ($dict{greyfilter}
	&& $dict{greyfilter}[2] eq "option greylist-on\n") {
	$val = "<B>on</B>";
	$lock_sw1 = " disabled";
	$lock_sw2 = $locked;
	$lock_sw3 = $locked;
    } elsif ($dict{greyfilter}
	     && $dict{greyfilter}[2] eq "option greylist-off\n") {
	$val = "<B>off</B>";
	$lock_sw1 = $locked;
	$lock_sw2 = " disabled";
	$lock_sw3 = $locked;
    } else {
	$val = $def_options{greyfilter};
	$lock_sw1 = $locked;
	$lock_sw2 = $locked;
	$lock_sw3 = " disabled";
    }
    print <<EOF;
<P>
$form
    <INPUT$lock_sw1 type=submit name=greyfilter value=Enable>
    <INPUT$lock_sw2 type=submit name=greyfilter value=Disable>
    <INPUT$lock_sw3 type=submit name=greyfilter value=Default>
    greylist filter $val
</FORM>
EOF

    if ($dict{greylog}
	&& $dict{greylog}[2] eq "option greylist-log-on\n") {
	$val = "<B>on</B>";
	$lock_sw1 = " disabled";
	$lock_sw2 = $locked;
	$lock_sw3 = $locked;
    } elsif ($dict{greylog}
	     && $dict{greylog}[2] eq "option greylist-log-off\n") {
	$val = "<B>off</B>";
	$lock_sw1 = $locked;
	$lock_sw2 = " disabled";
	$lock_sw3 = $locked;
    } else {
	$val = $def_options{greylog};
	$lock_sw1 = $locked;
	$lock_sw2 = $locked;
	$lock_sw3 = " disabled";
    }
    print <<EOF;
<P>
$form
    <INPUT$lock_sw1 type=submit name=greylog value=Enable>
    <INPUT$lock_sw2 type=submit name=greylog value=Disable>
    <INPUT$lock_sw3 type=submit name=greylog value=Default>
    greylist log $val
</FORM>
EOF

    if ($dict{dnsbl}
	&& $dict{dnsbl}[2] eq "option DNSBL-on\n") {
	$val = "<B>on</B>";
	$lock_sw1 = " disabled";
	$lock_sw2 = $locked;
	$lock_sw3 = $locked;
    } elsif ($dict{dnsbl}
	     && $dict{dnsbl}[2] eq "option DNSBL-off\n") {
	$val = "<B>off</B>";
	$lock_sw1 = $locked;
	$lock_sw2 = " disabled";
	$lock_sw3 = $locked;
    } else {
	$val = $def_options{dnsbl};
	$lock_sw1 = $locked;
	$lock_sw2 = $locked;
	$lock_sw3 = " disabled";
    }
    print <<EOF;
<P>
$form
    <INPUT$lock_sw1 type=submit name=dnsbl value=Enable>
    <INPUT$lock_sw2 type=submit name=dnsbl value=Disable>
    <INPUT$lock_sw3 type=submit name=dnsbl value=Default>
    DNS blacklist checking $val
</FORM>
EOF

    if ($dict{logall}
	&& $dict{logall}[2] eq "option log-all\n") {
	$val = "<B>on</B>";
	$lock_sw1 = " disabled";
	$lock_sw2 = $locked;
	$lock_sw3 = $locked;
    } elsif ($dict{logall}
	&& $dict{logall}[2] eq "option log-normal\n") {
	$val = "<B>off</B>";
	$lock_sw1 = $locked;
	$lock_sw2 = " disabled";
	$lock_sw3 = $locked;
    } else {
	$val = $def_options{logall};
	$lock_sw1 = $locked;
	$lock_sw2 = $locked;
	$lock_sw3 = " disabled";
    }
print <<EOF;
<P>
$form
    <INPUT$lock_sw1 type=submit name=dbglog value=Enable>
    <INPUT$lock_sw2 type=submit name=dbglog value=Disable>
    <INPUT$lock_sw3 type=submit name=dbglog value=Default>
    debug logging $val
</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;
}



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$s$value>$label</OPTION>\n";
}



# 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=$query{msg}&amp;"
	if ($query{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";

    if ($dict{dccenable}) {
	if (${$dict{dccenable}}[2] eq "option dcc-on\n") {
	    print "    <B>DCC on</B>\n";
	} elsif (${$dict{dccenable}}[2] eq "option dcc-off\n") {
	    print "    <B>DCC off</B>\n";
	}
    }
    if ($dict{greyfilter}) {
	if (${$dict{greyfilter}}[2] eq "option greylist-on\n") {
	    print "    <B>greylisting on</B>\n";
	} elsif (${$dict{greyfilter}}[2] eq "option greylist-off\n") {
	    print "    <B>greylisting off</B>\n";
	}
    }
    if ($dict{greylog}) {
	if (${$dict{greylog}}[2] eq "option greylist-log-on\n") {
	    print "    <B>log greylisted</B> messages\n";
	} elsif (${$dict{greylog}}[2] eq "option greylist-log-off\n") {
	    print "    <B>do not log greylisted</B> messages\n";
	}
    }
    if ($dict{dnsbl}) {
	if (${$dict{dnsbl}}[2] eq "option DNSBL-on\n") {
	    print "    <B>check DNS blacklists</B>\n";
	} elsif (${$dict{dnsbl}}[2] eq "option DNSBL-off\n") {
	    print "    <B>do not check DNS blacklists</B>\n";
	}
    }
    if ($dict{logall}) {
	if (${$dict{logall}}[2] eq "option log-all\n") {
	    print "    <B>debug logging</B> on\n";
	} elsif (${$dict{logall}}[2] eq "option log-normal\n") {
	    print "    <B>debug logging</B> off\n";
	} else {
	    print "    <B>unknown</B> option\n";
	}
    }

    print "\n\n";
    foreach my $entry (@file) {
	# do not list deleted entries and options
	next if (! defined($$entry[1]));
	next if (defined($$entry[0])
		 && ($$entry[0] eq "dccenable"
		     || $$entry[0] eq "greyfilter"
		     || $$entry[0] eq "greylog"
		     || $$entry[0] eq "dnsbl"
		     || $$entry[0] eq "logall")
		 && !$query{debug});

	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_lock;
	    $str .= $whiteclnt_change_log;
	    $lineno = display_str($lineno, $leader, html_str_encode($str));
	}

	if ($$entry[0]
	    && $$entry[0] ne "dccenable"
	    && $$entry[0] ne "greyfilter"
	    && $$entry[0] ne "greylog"
	    && $$entry[0] ne "dnsbl"
	    && $$entry[0] ne "logall") {
	    $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;
}
