Commit | Line | Data |
---|---|---|
0ed9a816 | 1 | # vim: set tabstop=4 shiftwidth=4 expandtab syntax=perl: |
8faa6b21 TH |
2 | |
3 | use MIME::Base64(); | |
121fcbc1 | 4 | use Digest::SHA(); |
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; | |
0ed9a816 TH |
39 | $lastkey = $1; |
40 | } elsif ($line =~ m/^\s+(.*)/ and defined($lastkey)) { | |
41 | $headers{$lastkey} .= ' ' . $1; | |
8faa6b21 TH |
42 | } |
43 | } | |
8faa6b21 | 44 | my $lock = $headers{'Cancel-Lock'}; |
0ed9a816 | 45 | |
8faa6b21 TH |
46 | if (defined($lock)) { |
47 | my $key = $r_hdr->{'Cancel-Key'} || return "$descr of $target without Cancel-Key"; | |
48 | #return verify_cancel_key($key, $lock, ' target=' . $target); | |
49 | return verify_cancel_key($key, $lock, $target); | |
50 | } else { | |
51 | # -thh | |
52 | # no cancel-lock: go ahead and cancel anyway! | |
53 | INN::cancel($target); | |
54 | } | |
55 | ||
56 | return undef; | |
57 | } | |
58 | ||
59 | sub verify_cancel_key($$$) { | |
60 | my $cancel_key = shift; | |
61 | my $cancel_lock = shift; | |
62 | my $msg = shift; | |
63 | ||
64 | $msg = '' unless(defined($msg)); | |
65 | # -thh | |
66 | my $target = $msg; | |
67 | $msg = ' target=' . $msg; | |
68 | ||
69 | my %lock; | |
70 | for my $l(split(/\s+/, $cancel_lock)) { | |
71 | next unless($l =~ m/^(sha1|md5):(\S+)/); | |
72 | $lock{$2} = $1; | |
73 | } | |
74 | ||
75 | for my $k(split(/\s+/, $cancel_key)) { | |
76 | unless($k =~ m/^(sha1|md5):(\S+)/) { | |
77 | INN::syslog('notice', "Invalid Cancel-Key syntax '$k'.$msg"); | |
78 | next; | |
79 | } | |
80 | ||
81 | my $key; | |
82 | if ($1 eq 'sha1') { | |
121fcbc1 | 83 | $key = Digest::SHA::sha1($2); } |
8faa6b21 TH |
84 | elsif ($1 eq 'md5') { |
85 | $key = Digest::MD5::md5($2); | |
86 | } | |
87 | $key = MIME::Base64::encode_base64($key, ''); | |
88 | ||
89 | if (exists($lock{$key})) { | |
90 | # INN::syslog('notice', "Valid Cancel-Key $key found.$msg"); | |
91 | # -thh | |
92 | # article is canceled now | |
93 | INN::cancel($target) if ($target); | |
94 | return undef; | |
95 | } | |
96 | } | |
97 | ||
98 | INN::syslog('notice', | |
99 | "No Cancel-Key[$cancel_key] matches Cancel-Lock[$cancel_lock]$msg" | |
100 | ); | |
101 | return "No Cancel-Key matches Cancel-Lock.$msg"; | |
102 | } | |
103 | ||
104 | 1; |