filter/cleanfeed.local

   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;