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