#! /usr/local/bin/perl -wT

# display and edit a DCC whitelist file

# Copyright (c) 2006 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 for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# Parties not eligible to receive a license under this agreement can
# obtain a commercial license to use DCC and permission to use
# U.S. Patent 6,330,590 by contacting Commtouch at http://www.commtouch.com/
# or by email to nospam@commtouch.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.50-1.45 $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($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);


# get DCC parameters
local($whiteclnt,		# path to the per-user whitelist file
      $thold_cks,		# checksums that can have thresholds
      $user, %query, $edit_url, $form_hidden,
      $list_msg_link, $sub_white);
do('/usr/local/dcc/cgi-bin/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
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${url_ques}msg=$query{msg}\">$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 = 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 whitelist 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]);

    my @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 $old_notify = $whiteclnt_notify;
    if ($query{notify} =~ /Disable/i) {
	$whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}off$3$4/i;
    } elsif ($query{notify} =~ /Enable/i) {
	$whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}on$3$4/i;
    }
    if ($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) {
	$msg = write_whiteclnt(@file);
	give_up($msg) if ($msg);
    }
}

# process requests to change options
form_option("dccenable", "On", "dcc-on", "Off", "dcc-off");
form_option("greyfilter", "On", "greylist-on", "Off", "greylist-off");;
form_option("greylog", "On", "greylist-log-on", "Off", "greylist-log-off");
form_option("mtafirst", "MTA-first", "first", "MTA-last", "last");
form_option("reps", "On", "DCC-reps-on", "Off", "DCC-reps-off");
form_option("dnsbl", "On", "dnsbl-on", "Off", "dnsbl-off");
form_option("logall", "On", "log-all", "Off", "log-normal");
form_option("logsubdir", "day", "log-subdirectory-day",
	    "hour", "log-subdirectory-hour",
	    "minute", "log-subdirectory-minute");
form_option("discardok", "forced-discard-ok", "discard spam", 
	    "forced-discard-nok", "delay mail");

# 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/) {
	    form_option_sub($nm);
	} elsif (!parse_thold_value($ck, $val)) {
	    give_up("invalid setting '$nm' '$val'");
	} else {
	    form_option_sub($nm, "option threshold $ck,$val\n");
	}
	last;
    }
}

# nothing to do?
give_up("checksum [$cur_key] has disappeared")
    if ($cur_key && (! $cur_entry || ! $$cur_entry[0]));
basic_form($query{result} ? "<P class=warn>$query{result}</B>\n" : "");


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

# display the basic editing form as well as the entire file
sub basic_form {
    my($result) = @_;			# '' or some kind of error message
    my($entry, $new_val, $comment, $locked, $form,
       $undo_ok, $change_ok);

    close(WHITECLNT);

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

    # generate an non-error message and comment if this is the first time
    if (! $result) {
	if (! $query{auto}) {
	    $result = "<P>&nbsp;\n"
	} elsif (! $cur_entry) {
	    my $str = "\n#    ";
	    $str .= "added from logged message $query{msg} " if ($query{msg});
	    $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";

    # we will 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";
    }

    $comment = $query{comment};
    if (! $comment) {
	$comment = "";
    } else {
	$comment =~ s/\s+$//mg;
	# need a blank on a leading blank line to preserve it in Mozilla form
	$comment =~ s/^\n/ \n/;
    }

    # generate common start of forms
    $form = "<FORM ACTION=\"$edit_url\" method=post>$form_hidden";
    $form .= "<INPUT type=hidden name=msg value=\"$query{msg}\">"
	if ($query{msg});
    if ($cur_key) {
	$form .= "<INPUT type=hidden name=key value=\"";
	$form .= html_str_encode($cur_key);
	$form .= "\">";
    }

    # emit any error message from the previous action and the UNDO button
    print <<EOF;
$result
$form
    <INPUT$undo_ok type=submit name=Undo value=Undo> last change
</FORM>

$form
<TABLE border=0>
EOF

    # emit the start of the "Add/Change/Delete Whitelist Entry" form
    print_button("<TR><TD>&nbsp;<TD>", 'Add', $locked, 'Add');
    print_button("\t", 'Change', $change_ok, 'Change');
    print_button("\t", 'Delete', $change_ok, 'Delete');
    print <<EOF;
	<B>Whitelist Entry</B>
<TR><TD>Comment
    <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</TABLE></FORM>\n\n";


    # generate forms to control option lines
print <<EOF;
<P>
<TABLE border=0>
<CAPTION><B>Options</B></CAPTION>
<TR><TD align=right>$form
	mail notifications mesages to
EOF
    $whiteclnt_notify =~ /$whiteclnt_notify_pat/;
    print "\t<INPUT $locked type=text name=notifybox value=\"$4\" size=12>\n";
    if ($2 eq "on") {
	$new_val = "Disable";
	print "\t<INPUT type=hidden name=notify value=On><B>on</B>\n";
    } else {
	$new_val = "Enable";
	print "\t<INPUT type=hidden name=notify value=Off><B>off</B>\n";
    }
    print "\t</FORM>\n    <TD>$form\n";
    print_button("\t", 'notify', $locked, $new_val);
    print "\t</FORM>\n";

    basic_form_line("dccenable", "DCC", $form, $locked,
		    "dcc-off", "dcc-on");
    if ($DCCM_ARGS =~ /-G/ || $DCCIFD_ARGS =~ /-G/
	|| (defined($GREY_CLIENT_ARGS) && $GREY_CLIENT_ARGS ne "")) {
	basic_form_line("greyfilter", "greylist filter", $form, $locked,
			"greylist-off", "greylist-on");
	basic_form_line("greylog", "greylist log", $form, $locked,
			"greylist-log-off", "greylist-log-on");
    }
    basic_form_line("mtafirst", "consult MTA blacklist", $form, $locked,
		    "MTA-last", "MTA-first",
		    "last", "first");
    basic_form_line("dnsbl", "DNS blacklist checking", $form, $locked)
	if ($DCCM_ARGS =~ /-B/ || $DCCIFD_ARGS =~ /-B/
	    || (defined($DNSBL_ARGS) && $DNSBL_ARGS) =~ /-B/);
    basic_form_line("logall", "debug logging", $form, $locked,
		    "log-normal", "log-all");
    basic_form_line("discardok", "<B></B> also addressed to others",
		    $form, $locked,
		    "forced-discard-nok", "forced-discard-ok",
		    "delay mail", "discard spam");

    print "\n";

    # 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/.*<B>([^<]+)<.*/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@<B>(.*)</B>(.*)@$1@;
	    $bydef = $2;
	    $sw_val = 'Default';
	}
	$dis_field = $locked;
	$dis_def = $sw_val eq 'Default' ? ' disabled' : $locked;
	$dis_never = $sw_val eq 'Never' ? ' disabled' : $locked;
	# changing reputation thresholds ought to affect tagging
	#	even if reputation checking is turned off
	print <<EOF;
<TR><TD align=right>$form
	<EM>$ck</EM> threshold$bydef
	<INPUT type=text$dis_field name='text-$nm' value='$cur_val' size=5>
	</FORM>
    <TD>$form
EOF
	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<P>\n";


    display_file();
}



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

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



# (try to) set an option for the file based on the form's results
#	The first arg is the name of the option.  It is followed by
#	(form-value,file-value) pairs
sub form_option {
    my($key, $new_formval, $formval, $fileval);

    $key = shift @_;
    $new_formval = $query{$key};
    return if (!$new_formval);

    if ($new_formval =~ /^Default/) {
	form_option_sub("$key");
	return;
    }
    while ($#_ > 0) {
	$formval = shift @_;
	$fileval = shift @_;
	if ($new_formval eq $formval) {
	    form_option_sub("$key", "option $fileval\n");
	    return;
	}
    }
    give_up("invalid setting '$key'='$new_formval'");
}



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



# You cannot use real HTML 4 buttons because Microsoft has exercised
#   its Freedom to Innovate in Internet Explorer and gets them all wrong.
#   Contrary to the standard, the idiots 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, $nm, $lock, $val) = @_;

    print $lead;
    print "<INPUT class=small$lock type=submit name='$nm' value='$val'>\n";
}



sub basic_form_line {
    my($nm,				# name of the option
       $label,				# label form--"<B></B>" gets current
       $form,				# common bits for the form
       $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($lock_on, $lock_off, $lock_def, $label_cur, $val_cur, $bydef);


    $off = "$nm-off" if (!$off);
    $on = "$nm-on" if (!$on);
    if ($dict{$nm}
	&& $dict{$nm}[2] eq "option $on\n") {
	$label_cur = $on_label ? $on_label : "<B>on</B>";
	$val_cur = $label_cur;
	$bydef = "";
	$lock_on = " disabled";
	$lock_off = $locked;
	$lock_def = $locked;
    } elsif ($dict{$nm}
	     && $dict{$nm}[2] eq "option $off\n") {
	$label_cur = $off_label ? $off_label : "<B>off</B>";
	$val_cur = $label_cur;
	$bydef = "";
	$lock_on = $locked;
	$lock_off = " disabled";
	$lock_def = $locked;
    } else {
	$label_cur = $def_options{$nm};
	$val_cur = $label_cur;
	$val_cur =~ s@(<B>.*</B>)(.*)@$1@;
	$bydef = $2;
	$lock_on = $locked;
	$lock_off = $locked;
	$lock_def = " disabled";
    }
    # construct labels for "on" and "off" buttons
    if ($on_label) {
	$on_label =~ s/.*<B>([^<]+)<.*/$1/;
    } else {
	$on_label = "On";
    }
    if ($off_label) {
	$off_label =~ s/.*<B>([^<]+)<.*/$1/;
    } else {
	$off_label = "Off";
    }
    # construct label for the default button from default value
    $def_label = $def_options{$nm};
    $def_label =~ s/.*<B>([^<]+)<.*/Default ($1)/;
    # construct label for the group of buttons
    #	use it as a pattern if the provided label contains "<B></B>",
    if ($label !~ /<B><\/B>/) {
	$label .= " $label_cur";
    } else {
	$label =~ s@(.*)<B></B>(.*)@$1<B>$val_cur</B>$2$bydef@;
    }

    # specify vertical alignment because otherwise Internet Explorer
    # won't align the left and right cells of the table
    print "<TR><TD valign=top align=right>$label\n";
    print "    <TD>$form\n";
    print_button("\t", $nm, $lock_def, $def_label);
    print_button("\t", $nm, $lock_on, $on_label);
    print_button("\t", $nm, $lock_off, $off_label);
    print "\t</FORM>\n";
}



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 class=small$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_ques";
    $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";

    foreach my $entry (@file) {
	# do not list deleted entries and options
	next if (! defined($$entry[1]));

	# recognize and suppress options if not debugging
	next if (defined($$entry[0]) && $$entry[2] =~ /^option/
		 && !$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[2] !~ /^option/) {
	    $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";

    close(WHITECLNT);

    html_footer();
    print "</BODY>\n</HTML>\n";

    exit;
}