|
0
|
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> \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> "); |
|
|
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> |
|
|
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 : " "; |
|
|
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} . "&" 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 = " ¦\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 } |
