filter/cleanfeed.local

   1 # vim: set tabstop=4 shiftwidth=4 expandtab syntax=perl:
   2
   3 use MIME::Base64();
   4 use Digest::SHA();
   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          $lastkey = $1;
  40       } elsif ($line =~ m/^\s+(.*)/ and defined($lastkey)) {
  41          $headers{$lastkey} .= ' ' . $1;
  42       }
  43    }
  44    my $lock = $headers{'Cancel-Lock'};
  45
  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') {
  83          $key = Digest::SHA::sha1($2); }
  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;