Mercurial > notdcc

comparison cgi-bin/edit-whiteclnt.in @ 0:c7f6b056b673

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First import of vendor version
author Peter Gervai <grin@grin.hu>
date Tue, 10 Mar 2009 13:49:58 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:c7f6b056b673
1 #! @PERL@ -wT
2
3 # display and edit a DCC whitelist file
4
5 # Copyright (c) 2008 by Rhyolite Software, LLC
6 #
7 # This agreement is not applicable to any entity which sells anti-spam
8 # solutions to others or provides an anti-spam solution as part of a
9 # security solution sold to other entities, or to a private network
10 # which employs the DCC or uses data provided by operation of the DCC
11 # but does not provide corresponding data to other users.
12 #
13 # Permission to use, copy, modify, and distribute this software without
14 # changes for any purpose with or without fee is hereby granted, provided
15 # that the above copyright notice and this permission notice appear in all
16 # copies and any distributed versions or copies are either unchanged
17 # or not called anything similar to "DCC" or "Distributed Checksum
18 # Clearinghouse".
19 #
20 # Parties not eligible to receive a license under this agreement can
21 # obtain a commercial license to use DCC by contacting Rhyolite Software
22 # at sales@rhyolite.com.
23 #
24 # A commercial license would be for Distributed Checksum and Reputation
25 # Clearinghouse software. That software includes additional features. This
26 # free license for Distributed ChecksumClearinghouse Software does not in any
27 # way grant permision to use Distributed Checksum and Reputation Clearinghouse
28 # software
29 #
30 # THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE, LLC DISCLAIMS ALL
31 # WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
32 # OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE, LLC
33 # BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES
34 # OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
35 # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
36 # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
37 # SOFTWARE.
38 # Rhyolite Software DCC 1.3.103-1.58 $Revision$
39 # @configure_input@
40
41 # This file must protected with an equivalent to httpd.conf lines
42 # in the README file.
43
44 use strict 'subs';
45
46 my($main_whiteclnt); # path to the main whiteclnt file
47
48 my(@file); # list representation of the file
49 my(%dict); # dictionary of checksums and options
50 my(%def_options); # option settings from main whiteclnt file
51
52 my($have_entry_form, $form_marked,
53 $cur_pos, $cur_key, $cur_entry, $cur_index);
54
55 my $form_num = 0;
56
57
58 # get DCC parameters
59 local($whiteclnt, # path to the per-user whitelist file
60 %query,
61 $hostname,
62 $thold_cks, # checksums that can have thresholds
63 $user,
64 $edit_url,
65 $list_msg_link,
66 $edit_url, $edit_link,
67 $url_ques,
68 $sub_white, # 'subsitute' headers from dcc_conf
69 $form_hidden, # state for main form
70 $whiteclnt_version, #webuser version ...
71 $whiteclnt_notify, #webuser mail-notify=X mailbox=Y
72 $whiteclnt_notify_pat, #regex for #webuser mail-notify=X mailbox=Y
73 $whiteclnt_lock, #webuser (un)locked
74 $whiteclnt_change_log, #list of dates when file was changed
75 $whiteclnt_cur_key); #editing position in the file
76
77 do('@cgibin@/common') || die("could not get DCC configuration: $!\n");
78
79
80 # display the file literally
81 if ($query{literal}) {
82 my($buf);
83
84 open(WHITECLNT, "< $whiteclnt") or html_whine("open($whiteclnt): $!");
85
86 print "Content-type: text/plain\n";
87 print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n";
88 print "pragma: no-cache\n\n";
89 print $buf
90 while (read(WHITECLNT, $buf, 4*1024));
91 print "\n";
92
93 close(WHITECLNT);
94 exit;
95 }
96
97 # lock, read and parse the whiteclnt file
98 read_whiteclnt(\@file, \%dict);
99
100 # get option defaults from the main whiteclnt file
101 read_whitedefs(\%def_options);
102
103
104 # get current position for the entry editing form
105 $cur_pos = $query{pos};
106
107 # find a whitecnt file entry to edit
108 if ($query{key}) {
109 $cur_key = $query{key};
110 } elsif ($query{auto} && $query{type} && $query{val}) {
111 my @new_entry = ck_new_white_entry("", "ok", $query{type}, $query{val});
112 $cur_key = $new_entry[0] if (defined($new_entry[1]));
113 }
114 $cur_entry = $dict{$cur_key} if ($cur_key);
115
116
117 html_head("DCC Whitelist for $user at $hostname");
118 common_buttons();
119 print "<TR><TD colspan=10>return to $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n"
120 if ($query{msg});
121 print <<EOF;
122 <TR><TD colspan=10>$edit_link${url_ques}literal=yes"
123 TARGET="DCC literal whiteclnt">Literal contents of whitelist</A>.
124 </TABLE>
125
126 EOF
127
128
129 # add new entry
130 if ($query{Add}) {
131 my(@new_entry, $msg, $prev, $cur, $add_pos);
132
133 @new_entry = ck_new_white_entry($query{comment}, $query{count},
134 $query{type}, $query{val});
135 give_up($new_entry[0]) if (!defined($new_entry[1]));
136
137 # insert into the file instead of appending to the end if we have
138 # a valid position
139 if (defined($cur_pos)) {
140 $add_pos = next_index($cur_pos);
141 } elsif ($cur_key) {
142 ($prev, $cur, $add_pos) = neighbors($cur_key);
143 }
144
145 $cur_key = $new_entry[0];
146 $cur_entry = \@new_entry;
147 give_up("entry already present") if ($dict{$cur_key});
148
149 # send the new entry to the disk with the rest of the file
150 $whiteclnt_cur_key = $cur_key;
151 $msg = chg_white_entry(\@file, \%dict, $cur_key, \@new_entry, $add_pos);
152 give_up($msg) if ($msg);
153
154 # re-prime the form with cleaned comment
155 $cur_entry = $dict{$cur_key};
156 give_up("new entry did not reach file") if (!$cur_entry);
157
158 finish("whitelist entry added");
159 }
160
161
162
163 # change current whitelist entry
164 if ($query{Change}) {
165 my(@new_entry, $msg);
166
167 give_up("no entry selected to change") if (!$cur_key);
168 give_up("entry '$cur_key' has disappeared")
169 if (!$cur_entry || !$$cur_entry[0]);
170
171 @new_entry = ck_new_white_entry($query{comment}, $query{count},
172 $query{type}, $query{val});
173 give_up($new_entry[0]) if (!defined($new_entry[1]));
174
175 give_up("no changes requested")
176 if ($$cur_entry[1] eq $new_entry[1]
177 && $$cur_entry[2] eq $new_entry[2]);
178
179 # send the change to the disk with the rest of the file
180 $whiteclnt_cur_key = $cur_key;
181 $msg = chg_white_entry(\@file, \%dict, $cur_key, \@new_entry);
182 give_up($msg) if ($msg);
183
184 # re-prime the form with cleaned comment
185 $cur_entry = $dict{$cur_key};
186 give_up("changed entry did not reach file") if (!$cur_entry);
187
188 finish("whitelist entry changed");
189 }
190
191
192
193 # delete current entry
194 if ($query{Delete}) {
195 my($prev, $cur, $next, $new_key, $msg);
196
197 give_up("no entry selected to delete") if (!$cur_key);
198 give_up("entry '$cur_key' has disappeared")
199 if (!$cur_entry || !$$cur_entry[0]);
200
201 # find a neighbor of the entry to be deleted
202 ($prev, $cur, $next) = neighbors($cur_key);
203 $new_key = ${$file[$prev]}[0] if (defined($prev));
204
205 # write everything to the new file except the deleted entry
206 $whiteclnt_cur_key = $cur_key;
207 $msg = chg_white_entry(\@file, \%dict, $cur_key, undef);
208 give_up($msg) if ($msg);
209
210 # keep the add/change/delete form in place if possible
211 $cur_key = $new_key;
212 undef($cur_entry);
213 delete $query{comment};
214 delete $query{count};
215 delete $query{type};
216 delete $query{val};
217 $cur_entry = $dict{$cur_key} if ($cur_key);
218
219 finish("whitelist entry deleted");
220 }
221
222
223 # move the current entry up
224 if ($query{Up}) {
225 up(1);
226 }
227
228 if ($query{Up5}) {
229 up(5);
230 }
231
232 sub up {
233 my($delta) = @_;
234 my($prev, $cur, $next, $moved, @new_file, $msg);
235
236 if ($cur_entry) {
237 # move an existing entry
238 while ($delta) {
239 --$delta;
240 # It is inefficient but easy and clearly correct to repeated
241 # search the array of entries for the target and then build
242 # a new array.
243 ($prev, $cur, $next) = neighbors($cur_key);
244 if (!$prev) {
245 give_up("cannot move above the top") if (!$moved);
246 last;
247 }
248
249 @new_file = (@file[0 .. $prev-1],
250 $file[$cur], $file[$prev],
251 @file[$cur+1 .. $#file]);
252 @file = @new_file;
253 $moved = 1;
254 }
255 $whiteclnt_cur_key = $cur_key;
256 $msg = write_whiteclnt(@file);
257 give_up($msg) if ($msg);
258 read_whiteclnt(\@file, \%dict);
259
260 } else {
261 # move a new or proposed entry
262 $cur_pos = prev_index($cur_pos, $delta);
263 }
264 print_form_file();
265 }
266
267
268 # move the current entry down
269 if ($query{Down}) {
270 down(1);
271 }
272
273 if ($query{Down5}) {
274 down(5);
275 }
276
277 sub down {
278 my($delta) = @_;
279 my($prev, $cur, $next, @new_file, $msg);
280
281 if ($cur_entry) {
282 # move an existing entry
283 while ($delta) {
284 --$delta;
285 ($prev, $cur, $next) = neighbors($cur_key);
286 if (!$next) {
287 give_up("cannot move below the bottom") if (!$moved);
288 last;
289 }
290
291 @new_file = (@file[0 .. $cur-1],
292 $file[$next], $file[$cur],
293 @file[$next+1 .. $#file]);
294 @file = @new_file;
295 $moved = 1;
296 }
297 $whiteclnt_cur_key = $cur_key;
298 $msg = write_whiteclnt(@file);
299 give_up($msg) if ($msg);
300 read_whiteclnt(\@file, \%dict);
301
302 } elsif (defined($cur_pos)) {
303 # move position of a future entry
304 $cur_pos = next_index($cur_pos, $delta);
305 }
306 print_form_file();
307 }
308
309
310 # undo the previous change
311 if ($query{Undo}) {
312 my $msg = undo_whiteclnt();
313 give_up($msg) if ($msg);
314
315 $cur_key = $whiteclnt_cur_key;
316 read_whiteclnt(\@file, \%dict);
317 $cur_key = $whiteclnt_cur_key if ($whiteclnt_cur_key);
318
319 # put the add/change/delete form back in place
320 if ($cur_key) {
321 $cur_entry = $dict{$cur_key};
322 } else {
323 undef($cur_entry);
324 delete $query{comment};
325 delete $query{count};
326 delete $query{type};
327 delete $query{val};
328 }
329
330 finish("change undone");
331 }
332
333
334 # change new log file mail notifcations
335 my $old_notify = $whiteclnt_notify;
336 if ($query{notify}) {
337 if ($query{notify} =~ /off/) {
338 $whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}off$3$4/i;
339 } elsif ($query{notify} =~ /on/) {
340 $whiteclnt_notify =~ s/$whiteclnt_notify_pat$/${1}on$3$4/i;
341 }
342 }
343 if (defined($query{notifybox})) {
344 my $new_box = $query{notifybox};
345 $new_box =~ s/^\s+(.*)\s*$/$1/;
346 $whiteclnt_notify =~ s/$whiteclnt_notify_pat$/$1$2$3$new_box/i;
347
348 give_up('The notification mailbox is limited to -, _, letters, and digits')
349 if ($whiteclnt_notify !~ /^$whiteclnt_notify_pat$/);
350 }
351 if ($whiteclnt_notify ne $old_notify) {
352 $whiteclnt_cur_key = "";
353 my $msg = write_whiteclnt(@file);
354 give_up($msg) if ($msg);
355 read_whiteclnt(\@file, \%dict);
356 }
357
358 # process requests to change options
359 option_form("dccenable", "On", "dcc-on", "Off", "dcc-off");
360 option_form("greyfilter", "On", "greylist-on", "Off", "greylist-off");;
361 option_form("greylog", "On", "greylist-log-on", "Off", "greylist-log-off");
362 option_form("mtafirst", "first", "MTA-first", "last", "MTA-last");
363 option_form("rep", "On", "DCC-rep-on", "Off", "DCC-rep-off");
364 option_form("dnsbl1", "On", "dnsbl1-on", "Off", "dnsbl1-off");
365 option_form("dnsbl2", "On", "dnsbl2-on", "Off", "dnsbl2-off");
366 option_form("dnsbl3", "On", "dnsbl3-on", "Off", "dnsbl3-off");
367 option_form("logall", "On", "log-all", "Off", "log-normal");
368 option_form("logsubdir", "day", "log-subdirectory-day",
369 "hour", "log-subdirectory-hour",
370 "minute", "log-subdirectory-minute");
371 option_form("discardok", "discard spam", "forced-discard-ok",
372 "delay mail", "no-forced-discard");
373
374 # process requests from the HTTP client to change the threshold
375 foreach my $ck (split(/,/, $thold_cks)) {
376 my $nm = "thold-$ck";
377 foreach my $val ($query{$nm}, $query{"text-$nm"}) {
378 next if (!$val);
379 if ($val =~ /^Default/) {
380 set_option($nm);
381 } elsif (!parse_thold_value($ck, $val)) {
382 give_up("invalid threshold setting $nm='$val'");
383 } else {
384 set_option($nm, "option threshold $ck,$val\n");
385 }
386 last;
387 }
388 }
389
390 # nothing to do?
391 give_up("entry '$cur_key' has disappeared")
392 if (!$query{auto} && $cur_key && (!$cur_entry || !$$cur_entry[0]));
393 print_form_file($query{result}
394 ? "<P class=warn>$query{result}</STRONG>\n"
395 : "");
396
397
398
399
400 #############################################################################
401
402 # display the whiteclnt file with the option setting form and and quit
403 sub print_form_file {
404 my($result) = @_; # "" or some kind of error message
405
406 close(WHITECLNT);
407
408 my $locked = ($whiteclnt_lock =~ /\blocked/) ? " disabled" : "";
409
410 # display any error message from the previous action
411 print $result ? $result : "<P>&nbsp;\n";
412
413 # generate table of forms to control option lines
414 print "<P>\n<TABLE border=0>\n";
415
416 print_form_start("<TR><TD>", "", "");
417 print "\t";
418 undo_form($locked);
419 print "\t</FORM>\n";
420
421 # two HTML forms for the '#webuser...' line
422 $whiteclnt_notify =~ /$whiteclnt_notify_pat/;
423 my $notify_cur = $2;
424 my $notifybox = $4;
425 my $notify_on_locked = ($notify_cur eq "on") ? " disabled" : $locked;
426 my $notify_off_locked = ($notify_cur eq "off") ? " disabled" : $locked;
427 print_form_start("<TR><TD class=first>", "", "");
428 print <<EOF;
429 mail notifications to
430 <INPUT $notify_off_locked type=text name=notifybox value='$notifybox' size=12>
431 <STRONG>$notify_cur</STRONG>
432 </FORM>
433 EOF
434 print_form_start(" <TD>", "", "");
435 print_button("\t", "notify", $notify_on_locked, "on");
436 print_button("\t", "notify", $notify_off_locked, "off");
437 print "\t</FORM>\n";
438
439 table_row_form("dccenable", "DCC", $locked, "dcc-off", "dcc-on");
440 if ($DCCM_ARGS =~ /-G/ || $DCCIFD_ARGS =~ /-G/
441 || (defined($GREY_CLIENT_ARGS) && $GREY_CLIENT_ARGS ne "")) {
442 table_row_form("greyfilter", "greylist filter", $locked,
443 "greylist-off", "greylist-on");
444 table_row_form("greylog", "greylist log", $locked,
445 "greylist-log-off", "greylist-log-on");
446 }
447 table_row_form("mtafirst", "check MTA blacklist", $locked,
448 "MTA-last", "MTA-first", "last", "first");
449 # ask about DNSBLs if they are available
450 my $args = "";
451 $args = "$DNSBL_ARGS" if (defined($DNSBL_ARGS));
452 $args .= " $DCCM_ARGS" if (defined($DCCM_ARGS));
453 $args .= " $DCCIFD_ARGS" if (defined($DCCIFD_ARGS));
454 if ($args =~ /-B/) {
455 if ($args !~ /-B\s*set:group=\d+/i) {
456 # only one question if there are no groups
457 table_row_form("dnsbl1", "DNS blacklist checking", $locked);
458 } else {
459 table_row_form("dnsbl1", "DNS blacklist #1 checking", $locked);
460 table_row_form("dnsbl2", "DNS blacklist #2 checking", $locked);
461 table_row_form("dnsbl3", "DNS blacklist #3 checking", $locked);
462 }
463 }
464 table_row_form("logall", "debug logging", $locked,
465 "log-normal", "log-all");
466 table_row_form("discardok",
467 "<STRONG></STRONG> also addressed to others",
468 $locked, "no-forced-discard", "forced-discard-ok",
469 "delay mail", "discard spam");
470
471 # forms for checksum thresholds
472 foreach my $ck (split(/,/, $thold_cks)) {
473 my($cur_val, $sw_val, $nm, $def_label, $bydef,
474 $dis_field, $dis_def, $dis_never);
475
476 $nm = "thold-" . $ck;
477 # construct label for the default button from default value
478 $def_label = $def_options{$nm};
479 $def_label =~ s/.*<STRONG>([^<]+)<.*/Default ($1)/;
480 if (defined($dict{$nm})) {
481 $cur_val = $dict{$nm}[2];
482 $cur_val =~ s/.*,([-_a-z0-9%]+)\s+$/$1/i;
483 $bydef = '';
484 $sw_val = $cur_val;
485 } else {
486 $cur_val = $def_options{$nm};
487 $cur_val =~ s@<STRONG>(.*)</STRONG>(.*)@$1@;
488 $bydef = $2;
489 $sw_val = 'Default';
490 }
491 $dis_field = $locked;
492 $dis_def = $locked;
493 $dis_never = $locked;
494 $dis_def = " class=selected disabled" if ($sw_val eq "Default");
495 $dis_never = " class=selected disabled" if ($sw_val eq "Never");
496 # changing reputation thresholds ought to affect tagging
497 # even if reputation checking is turned off
498
499 print_form_start("<TR><TD class=first>", "", "");
500 print <<EOF;
501 <EM>$ck</EM> threshold$bydef
502 <INPUT type=text$dis_field name='text-$nm' value='$cur_val' size=5>
503 </FORM>
504 EOF
505 print_form_start(" <TD>", "", "");
506 print_button("\t", $nm, $dis_def, $def_label);
507 print_button("\t", $nm, $dis_never, "Never");
508 # "many" makes no sense for either reputation threshold
509 print_button("\t", $nm,
510 $sw_val eq "many" ? " disabled" : $locked,
511 "many")
512 if ($ck !~ /^rep/i);
513 print "\t</FORM>\n";
514 }
515
516 print "</TABLE>\n\n<P>\n<HR>\n";
517
518 # display a form for a new entry before the file if we have not
519 # been given a position or an entry to modify
520 print_entry_form($locked) if (!$cur_key && !defined($cur_pos));
521
522 print_whiteclnt_file($result, $locked);
523 }
524
525
526
527 # display the common start of forms
528 sub print_form_start {
529 my($before, # HTML before start of form
530 $tag, # tag on action
531 $after # HTML after start of form
532 ) = @_;
533
534 print $before if ($before);
535 print "<FORM class=nopad ACTION='$edit_url";
536 print $tag if ($tag);
537 print "' method=POST>$form_hidden\n";
538 print $after if ($after);
539 print "\t<INPUT type=hidden name=msg value='$query{msg}'>\n"
540 if ($query{msg});
541 if ($cur_key) {
542 print "\t<INPUT type=hidden name=key value='";
543 print html_str_encode($cur_key);
544 print "'>\n";
545 }
546 if ($cur_pos) {
547 print "\t<INPUT type=hidden name=pos value='";
548 print html_str_encode($cur_pos);
549 print "'>\n";
550 }
551 }
552
553
554
555 sub undo_form {
556 my($locked) = @_;
557
558 print "<INPUT class=small";
559 print newest_whiteclnt_bak() ? $locked : " disabled";
560 print " type=submit name='Undo' value='Undo Previous Change'>\n";
561 }
562
563
564
565 # display the entry editing form
566 sub print_entry_form {
567 my($locked, $result) = @_;
568 my($add_str, $new_val, $comment, $change_ok, $prev, $cur, $next);
569
570 return if ($have_entry_form);
571 $have_entry_form = 1;
572
573 # prime the form with the currently selected whiteclnt entry, if any
574 if ($cur_entry) {
575 $comment = $$cur_entry[1];
576 $query{comment} = html_str_encode($comment);
577
578 my $value = $$cur_entry[2];
579 $value =~ s/(\S+)\s+//;
580 $query{count} = $1;
581 ($query{type}, $query{val}) = parse_type_value($value);
582 $change_ok = $locked;
583 } else {
584 # "disabled" does not work with Netscape 4.*, but we have to handle
585 # changes without a valid key, so don't worry about it
586 $change_ok = " disabled";
587 }
588
589 # compute a comment if this came from a log file
590 if ($query{auto} && !$cur_entry) {
591 $comment = " \n#";
592 $comment .= " added from logged message $query{msg}"
593 if ($query{msg});
594 $comment .= strftime(" %x", localtime);
595 $comment = html_str_encode($comment);
596 $query{count} = "OK";
597 } else {
598 $comment = $query{comment};
599 if (!$comment) {
600 $comment = "";
601 } else {
602 $comment =~ s/\s+$//mg;
603 # need a blank on a leading blank line to preserve it in Mozilla
604 $comment =~ s/^\n/ \n/;
605 }
606 }
607
608 if (!$form_marked) {
609 print "<A NAME='cur_key'></A>";
610 $form_marked = 1;
611 }
612 print_form_start("", "#cur_key", "<TABLE border=0>\n<TR><TD>&nbsp;");
613 print " <TD>";
614 undo_form($locked);
615 print_button("\t", "Add", $locked, "Add");
616 if (defined($cur_pos)) {
617 $prev = prev_index($cur_pos);
618 $next = next_index($cur_pos);
619 } elsif ($cur_key) {
620 ($prev, $cur, $next) = neighbors($cur_key);
621 } else {
622 undef($prev);
623 undef($next);
624 }
625 print_button("\t", "Up", !defined($prev) ? " disabled" : $locked, "Up");
626 print_button("\t", "Up5", !defined($prev) ? " disabled" : $locked, "Up 5");
627 print_button("\t", "Down", !$next ? " disabled" : $locked, "Down");
628 print_button("\t", "Down5", !$next ? " disabled" : $locked, "Down 5");
629 if ($query{auto} && !$cur_entry) {
630 print "\tfrom $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n";
631 } else {
632 print_button("\t", "Change", $change_ok, "Change");
633 print_button("\t", "Delete", $change_ok, "Delete");
634 print "whitelist entry\n";
635 }
636 print <<EOF;
637 <TR><TD>Description
638 <TD><TEXTAREA$locked name=comment rows=3 cols=70>$comment</TEXTAREA>
639 <TR><TD>&nbsp;
640 <TD><SELECT class=small$locked name=count>
641 EOF
642 $query{count} = "OK" if (!$query{count});
643 print_option("count", "OK");
644 print_option("count", "OK2");
645 print_option("count", "many");
646 print "\t</SELECT>\n";
647
648 print "\t<SELECT class=small$locked name=type>\n";
649 $query{type} = "env_From" if (!$query{type});
650 print_option("type", "env_From");
651 print_option("type", "env_To");
652 print_option("type", "From");
653 print_option("type", "IP");
654 print_option("type", "Message-ID");
655 # allow selection of checksums specified with -S in /var/dcc/dcc_conf
656 foreach my $hdr (split(/[|)(]+/, $sub_white)) {
657 my($label);
658 $hdr =~ s/\\s\+/ /;
659 next if ($hdr =~ /^s*$/);
660 $label = $hdr;
661 $label =~ s/^substitute\s+//i;
662 print_option("type", $label, $hdr);
663 }
664 print_option("type", "Hex Body");
665 print_option("type", "Hex Fuz1");
666 print_option("type", "Hex Fuz2");
667 print "\t</SELECT>\n";
668
669 print "\t<INPUT type=text name=val size=40";
670 if ($query{val}) {
671 print " value='";
672 print html_str_encode($query{val});
673 print "'";
674 }
675 print ">\n";
676
677 print "<TR><TD colspan=10>return to $list_msg_link${url_ques}msg=$query{msg}\">logged message $query{msg}</A>\n"
678 if ($query{msg});
679
680 print "<TR><TD colspan=10>\n";
681 print $result ? $result : "&nbsp;";
682 print "</TABLE>\n</FORM>\n\n";
683 }
684
685
686
687 # find indeces of previous, current, and next entries
688 # return a list of 3 entries of the preceding, current, and following indeces
689 sub neighbors {
690 my($tgt_key) = @_;
691 my($prev, $cur, $index, $entry);
692
693 # look for the current entry while tracking predecessors
694 $index = 0;
695 foreach $entry (@file) {
696 next if (!ref($entry));
697
698 # ignore deleted lines, options, and include lines
699 next if (!$$entry[0] || !defined($$entry[1])
700 || $$entry[2] =~ /^option/);
701
702 # stop at the first entry when there is no current position
703 return ($prev, $cur, $index) if (!$tgt_key);
704
705 if ($$entry[0] eq $tgt_key) {
706 $cur = $index;
707 last;
708 }
709 $prev = $index;
710 } continue { ++$index; }
711
712 do {
713 return ($prev, $cur, undef) if ($index >= $#file);
714 $entry = $file[++$index];
715 } while (!$$entry[0] || !defined($$entry[1]) || $$entry[2] =~ /^option/);
716 return ($prev, $cur, $index);
717 }
718
719
720
721 sub prev_index {
722 my($pos, $delta) = @_;
723 my ($entry);
724
725 $pos = $#file if (!$pos);
726
727 while (--$pos >= 0) {
728 $entry = $file[$pos];
729 # skip deleted entries
730 return $pos
731 if ($$entry[0] && defined($$entry[1]) && $$entry[2] !~ /^option/
732 && (!$delta || !--$delta));
733 }
734 return undef;
735 }
736
737
738
739 sub next_index {
740 my($pos, $delta) = @_;
741 my ($entry);
742
743 $pos = $#file if (!$pos);
744
745 while (++$pos <= $#file) {
746 $entry = $file[$pos];
747 # skip deleted entries
748 return $pos
749 if ($$entry[0] && defined($$entry[1]) && $$entry[2] !~ /^option/
750 && (!$delta || !--$delta));
751 }
752 return undef;
753 }
754
755
756
757 sub set_option {
758 my($key, $line) = @_;
759 my($msg);
760
761 # put the new value, if any, into the spare slot created when the file
762 # was read into memory
763 $file[1] = ["", "", $line] if ($line);
764
765 # delete the old value if any
766 $whiteclnt_cur_key = "";
767
768 $msg = chg_white_entry(\@file, \%dict, $key);
769 give_up($msg) if ($msg);
770 }
771
772
773
774 # see if an form for an option was selected and process the result if so
775 # The first arg is the name of the option. It is followed by
776 # (form-value,file-value) pairs
777 sub option_form {
778 my($key, $new_formval, $formval, $fileval);
779
780 $key = shift @_;
781 $new_formval = $query{$key};
782 return if (!$new_formval);
783
784 if ($new_formval =~ /^Default/) {
785 set_option("$key");
786 return;
787 }
788 while ($#_ > 0) {
789 $formval = shift @_;
790 $fileval = shift @_;
791 if ($new_formval eq $formval) {
792 set_option("$key", "option $fileval\n");
793 return;
794 }
795 }
796 give_up("invalid setting $key='$new_formval'");
797 }
798
799
800
801 sub finish {
802 print_form_file("<P><STRONG>" . html_str_encode($_[0]) . "</STRONG>\n");
803 }
804
805
806
807 sub give_up {
808 print_form_file("<P class=warn><STRONG>"
809 . html_str_encode($_[0]) . "</STRONG>\n");
810 }
811
812
813
814 # You cannot use real HTML 4 buttons because Microsoft gets them all wrong.
815 # Contrary to the standard, they return all type=submit buttons.
816 # They also return any text label instead of the value, thereby removing
817 # most or all reason to use <BUTTON> instead of <INPUT>.
818 sub print_button {
819 my($lead, # HTML text before the control
820 $nm, # control name
821 $lock, # "" or " disabled"
822 $val) = @_; # value when selected
823
824 $lock = " class=small$lock" if ($lock !~ /class=/i);
825 print $lead;
826 print "<INPUT $lock type=submit name='$nm' value='$val'>\n";
827 }
828
829
830
831 # one line of the table of forms
832 sub table_row_form {
833 my($nm, # name of the option
834 $label, # label; <STRONG></STRONG> gets current
835 $locked, # "" or "disabled" when file read-only
836 $off, $on, # replace "off" and "on" in the file
837 $off_label, $on_label, # "off" & "on" for user
838 ) = @_;
839 my($button_cur, $dis_on, $dis_off, $dis_def, $label_cur,
840 $val_cur, $bydef);
841
842
843 $off = "$nm-off" if (!$off);
844 $on = "$nm-on" if (!$on);
845 $dis_on = $locked;
846 $dis_off = $locked;
847 $dis_def = $locked;
848 $button_cur = $locked ? $locked : " class=selected disabled";
849 if ($dict{$nm}
850 && $dict{$nm}[2] eq "option $on\n") {
851 $label_cur = $on_label ? $on_label : "<STRONG>on</STRONG>";
852 $val_cur = $label_cur;
853 $bydef = "";
854 $dis_on = $button_cur;
855 } elsif ($dict{$nm}
856 && $dict{$nm}[2] eq "option $off\n") {
857 $label_cur = $off_label ? $off_label : "<STRONG>off</STRONG>";
858 $val_cur = $label_cur;
859 $bydef = "";
860 $dis_off = $button_cur;
861 } else {
862 $label_cur = $def_options{$nm};
863 $val_cur = $label_cur;
864 $val_cur =~ s@(<STRONG>.*</STRONG>)(.*)@$1@;
865 $bydef = $2;
866 $dis_def = $button_cur;
867 }
868 # construct labels for "on" and "off" buttons
869 if ($on_label) {
870 $on_label =~ s/.*<STRONG>([^<]+)<.*/$1/;
871 } else {
872 $on_label = "On";
873 }
874 if ($off_label) {
875 $off_label =~ s/.*<STRONG>([^<]+)<.*/$1/;
876 } else {
877 $off_label = "Off";
878 }
879 # construct label for the default button from default value
880 $def_label = $def_options{$nm};
881 $def_label =~ s/.*<STRONG>([^<]+)<.*/Default ($1)/;
882 # construct label for the group of buttons
883 # use it as a pattern if the provided label contains "<STRONG></STRONG>",
884 if ($label !~ s@<STRONG></STRONG>(.*)@<STRONG>$val_cur</STRONG>$1$bydef@) {
885 $label .= " $label_cur";
886 }
887
888 print "<TR><TD class=first>$label\n";
889 print_form_start(" <TD>", "", "");
890 print_button("\t", $nm, $dis_def, $def_label);
891 print_button("\t", $nm, $dis_on, $on_label);
892 print_button("\t", $nm, $dis_off, $off_label);
893 print "\t</FORM>\n";
894 }
895
896
897
898 sub print_str {
899 my($lineno, $leader, $str) = @_;
900
901 while ($str =~ s/(.*\n?)// && $1) {
902 my $line = $1;
903 if ($line =~ /\n/) {
904 ++$lineno;
905 } else {
906 $line .= "\n";
907 $leader .= "? ";
908 }
909 print $lineno if ($query{debug});
910 print $leader;
911 print $line;
912 }
913 return $lineno;
914 }
915
916
917
918 sub print_option {
919 my($field, $label, $value) = @_;
920 my($s);
921
922 $s = "";
923 if ($query{$field}) {
924 if ($value && $query{$field} =~ /^$value$/i) {
925 $s = " selected"
926 } elsif ($query{$field} =~ /^$label$/i) {
927 $s = " selected";
928 }
929 }
930 if ($value) {
931 $value = " value=\"$value\"";
932 } else {
933 $value = "";
934 }
935 print "\t <OPTION class=small$s$value>$label</OPTION>\n";
936 }
937
938
939
940 # display the current contents of the whiteclnt file
941 # It is represented as an array or list of references to 3-tuples.
942 # The first of the three is the whitelist entry in a canonical form
943 # as a key uniquely identifying the entry.
944 # The second is a comment string of zero or more comment lines.
945 # The third is the DCC whiteclnt entry.
946 #
947 # The canonical form and the whiteclnt line of the first 3-tuple for a file
948 # are null, because it contains the comments, if any, before the file's
949 # preamble of dans when the file has been changed and flags.
950 # The file[1] is an empty slot for adding option settings.
951 # The last triple in a file may also lack a whitelist entry.
952
953 sub print_whiteclnt_file {
954 my($result, $locked) = @_;
955 my($preamble, $str, $url, $entry, $lineno, $in_pre, $leader, $end_select,
956 $tgt_key, $prev_key);
957
958 $url = $edit_link . $url_ques;
959 $url .= "msg=" . $query{msg} . "&amp;" if ($query{msg});
960 $url .= "key=";
961
962 $tgt_key = defined($cur_pos) ? ${$file[$cur_pos]}[0] : $cur_key;
963
964 # try to find an entry before the current entry to start the display
965 # in the browser's window
966 if ($tgt_key) {
967 my @prev_keys;
968
969 foreach $entry (@file) {
970 # ignore deleted lines, options, and include lines
971 next if (!$$entry[0] || !defined($$entry[1])
972 || $$entry[2] =~ /^option/);
973 shift(@prev_keys) if ($#prev_keys >= 2);
974 push(@prev_keys, $$entry[0]);
975 last if ($$entry[0] eq $tgt_key);
976 }
977 $prev_key = shift(@prev_keys);
978 }
979
980 $lineno = 1;
981 foreach $entry (@file) {
982 # do not list deleted entries
983 next if (!defined($$entry[1]));
984
985 # no options if not debugging
986 next if ($$entry[2] =~ /^option/ && !$query{debug});
987
988 # tell the browser that the form will be soon
989 if ($prev_key && $$entry[0] && $$entry[0] eq $prev_key) {
990 print "<A NAME='cur_key'></A>";
991 $form_marked = 1;
992 }
993
994 # mark the currently selected entry
995 if ($tgt_key && $$entry[0] && $$entry[0] eq $tgt_key) {
996 print "<STRONG>";
997 $leader = " &brvbar;\t";
998 $end_select = 1;
999 } else {
1000 $leader = "\t";
1001 $end_select = undef;
1002 }
1003
1004 if ($query{debug}) {
1005 if ($in_pre) {
1006 $in_pre = undef;
1007 print "</PRE>";
1008 }
1009 print "<HR>" if ($query{debug});
1010 }
1011 if (!$in_pre) {
1012 $in_pre = 1;
1013 print "<PRE class=nopad>";
1014 }
1015
1016 # display comment lines
1017 $str = $$entry[1];
1018 if (!$preamble) {
1019 # Display the preamble parameters after comments in first triple
1020 # but before the ultimate blank line in the comments, if present.
1021 $preamble = $whiteclnt_version;
1022 $preamble .= $whiteclnt_notify;
1023 $preamble .= $whiteclnt_lock;
1024 $preamble .= "#webuser cur_key $whiteclnt_cur_key\n"
1025 if ($whiteclnt_cur_key);
1026 $preamble .= $whiteclnt_change_log;
1027 if ($query{debug}) {
1028 $str .= $preamble if ($str !~ s/(\n?)\n$/\n$preamble$1/);
1029 }
1030 }
1031 $lineno = print_str($lineno, $leader, html_str_encode($str));
1032
1033 $str = $$entry[2];
1034 if ($$entry[0] && $$entry[2] !~ /^option/) {
1035 # Display an ordinary entry as a link for editing.
1036 chomp($str);
1037 # Suppress "substitute" noise
1038 $str =~ s/^(\S*\s+)substitute\s+/$1/;
1039 # use tab for blanks between the type and value
1040 $str =~ s/^(\S+)\s+(\S+)\s+/$1\t$2\t/;
1041 # make columns
1042 $str =~ s/^(\S+\s+\S{1,7})\t/$1\t\t/;
1043 $str = $url . url_encode($$entry[0]) . "#cur_key\">"
1044 . html_str_encode($str) . "</A>\n";
1045 } else {
1046 # just display option lines
1047 $str = html_str_encode($str);
1048 }
1049 $lineno = print_str($lineno, $leader, $str);
1050
1051 # put the editing form after the selected entry
1052 if ($end_select) {
1053 print "</STRONG></PRE>\n";
1054 $in_pre = undef;
1055 print_entry_form($locked, $result);
1056 }
1057 }
1058 print "</PRE>\n" if ($in_pre);
1059
1060 print_entry_form($locked, $result) if (!$have_entry_form);
1061
1062 close(WHITECLNT);
1063
1064 html_footer();
1065 print "</BODY>\n</HTML>\n";
1066
1067 exit;
1068 }