Commit | Line | Data |
---|---|---|
8faa6b21 TH |
1 | # vim: set syntax=perl ts=4 ai si: |
2 | ||
3 | use MIME::Base64(); | |
4 | use Digest::SHA1(); | |
5 | use Digest::HMAC_SHA1(); | |
6 | ||
7 | # | |
8 | # local_filter_cancel | |
9 | # | |
10 | sub 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 | ||
17 | sub 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 | ||
29 | sub 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 | ||
57 | sub 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 | ||
102 | 1; |