Add check for empty attributes to perl_mysql
[usenet/INN.git] / filter / cleanfeed.local
CommitLineData
8faa6b21
TH
1# vim: set syntax=perl ts=4 ai si:
2
3use MIME::Base64();
4use Digest::SHA1();
5use Digest::HMAC_SHA1();
6
7#
8# local_filter_cancel
9#
10sub local_filter_cancel {
11 unless($hdr{Control} =~ m/^cancel\s+(<[^>]+>)/i) {
12 return "Cancel with broken target ID";
13 }
14 return verify_cancel(\%hdr, $1, 'Cancel');
15}
16
17sub local_filter_after_emp {
18 if (exists( $hdr{'Supersedes'} )) {
19 #return verify_cancel(\%hdr, $hdr{'Supersedes'}, 'Supersedes');
20 # verify_cancel is called, but not returned, so the
21 # posting is unconditionally accepted
22 # verify_cancel calls INN:cancel() if verification suceeds
23 verify_cancel(\%hdr, $hdr{'Supersedes'}, 'Supersedes');
24 }
25
26 return undef;
27}
28
29sub verify_cancel($$$) {
30 my $r_hdr = shift || die;
31 my $target = shift;
32 my $descr = shift;
33
34 my $headers = INN::head($target) || return "$descr of non-existing ID $target";
35
36 my %headers;
37 for my $line(split(/\s*\n/, $headers)) {
38 if ($line =~ m/^([[:alnum:]-]+):\s+(.*)/) {
39 $headers{$1} = $2;
40 }
41 }
42
43 my $lock = $headers{'Cancel-Lock'};
44 if (defined($lock)) {
45 my $key = $r_hdr->{'Cancel-Key'} || return "$descr of $target without Cancel-Key";
46 #return verify_cancel_key($key, $lock, ' target=' . $target);
47 return verify_cancel_key($key, $lock, $target);
48 } else {
49 # -thh
50 # no cancel-lock: go ahead and cancel anyway!
51 INN::cancel($target);
52 }
53
54 return undef;
55}
56
57sub verify_cancel_key($$$) {
58 my $cancel_key = shift;
59 my $cancel_lock = shift;
60 my $msg = shift;
61
62 $msg = '' unless(defined($msg));
63 # -thh
64 my $target = $msg;
65 $msg = ' target=' . $msg;
66
67 my %lock;
68 for my $l(split(/\s+/, $cancel_lock)) {
69 next unless($l =~ m/^(sha1|md5):(\S+)/);
70 $lock{$2} = $1;
71 }
72
73 for my $k(split(/\s+/, $cancel_key)) {
74 unless($k =~ m/^(sha1|md5):(\S+)/) {
75 INN::syslog('notice', "Invalid Cancel-Key syntax '$k'.$msg");
76 next;
77 }
78
79 my $key;
80 if ($1 eq 'sha1') {
81 $key = Digest::SHA1::sha1($2); }
82 elsif ($1 eq 'md5') {
83 $key = Digest::MD5::md5($2);
84 }
85 $key = MIME::Base64::encode_base64($key, '');
86
87 if (exists($lock{$key})) {
88 # INN::syslog('notice', "Valid Cancel-Key $key found.$msg");
89 # -thh
90 # article is canceled now
91 INN::cancel($target) if ($target);
92 return undef;
93 }
94 }
95
96 INN::syslog('notice',
97 "No Cancel-Key[$cancel_key] matches Cancel-Lock[$cancel_lock]$msg"
98 );
99 return "No Cancel-Key matches Cancel-Lock.$msg";
100}
101
1021;
This page took 0.014299 seconds and 4 git commands to generate.