Add filter examples for Cancel-Lock/-Key.

This is a possible implementation of Cancel-Lock
and Cancel-Key. cleanfeed.local will check for
a matching Cancel-Key before accepting a cancel,
filter_nnrpd.pl will add Cancel-Locks to all
postings (and a matching Cancel-Key to cancel
messages).

See also
http://th-h.de/blog/archives/1473-INN-Cancel-Lock-und-Cancel-Key.html

Signed-off-by: Thomas Hochstein <thh@inter.net>

filter/cleanfeed.local

@@ -0,0 +1,102 @@
+# vim: set syntax=perl ts=4 ai si:
+
+use MIME::Base64();
+use Digest::SHA1();
+use Digest::HMAC_SHA1();
+
+#
+# local_filter_cancel
+#
+sub local_filter_cancel {
+   unless($hdr{Control} =~ m/^cancel\s+(<[^>]+>)/i) {
+      return "Cancel with broken target ID";
+   }
+   return verify_cancel(\%hdr, $1, 'Cancel');
+}
+
+sub local_filter_after_emp {
+   if (exists( $hdr{'Supersedes'} )) {
+      #return verify_cancel(\%hdr, $hdr{'Supersedes'}, 'Supersedes');
+      # verify_cancel is called, but not returned, so the
+      # posting is unconditionally accepted
+      # verify_cancel calls INN:cancel() if verification suceeds
+      verify_cancel(\%hdr, $hdr{'Supersedes'}, 'Supersedes');
+   }
+
+   return undef;
+}
+
+sub verify_cancel($$$) {
+   my $r_hdr = shift || die;
+   my $target = shift;
+   my $descr = shift;
+
+   my $headers = INN::head($target) || return "$descr of non-existing ID $target";
+
+   my %headers;
+   for my $line(split(/\s*\n/, $headers))    {
+      if ($line =~ m/^([[:alnum:]-]+):\s+(.*)/) {
+         $headers{$1} = $2;
+      }
+   }
+
+   my $lock = $headers{'Cancel-Lock'};
+   if (defined($lock)) {
+      my $key = $r_hdr->{'Cancel-Key'} || return "$descr of $target without Cancel-Key";
+      #return verify_cancel_key($key, $lock, ' target=' . $target);
+      return verify_cancel_key($key, $lock, $target);
+   } else {
+    # -thh
+    # no cancel-lock: go ahead and cancel anyway!
+    INN::cancel($target);
+   }
+
+   return undef;
+}
+
+sub verify_cancel_key($$$) {
+   my $cancel_key = shift;
+   my $cancel_lock = shift;
+   my $msg = shift;
+
+   $msg = '' unless(defined($msg));
+   # -thh
+   my $target = $msg;
+   $msg = ' target=' . $msg;
+
+   my %lock;
+   for my $l(split(/\s+/, $cancel_lock))   {
+      next unless($l =~ m/^(sha1|md5):(\S+)/);
+      $lock{$2} = $1;
+   }
+
+   for my $k(split(/\s+/, $cancel_key))    {
+      unless($k =~ m/^(sha1|md5):(\S+)/) { 
+        INN::syslog('notice', "Invalid Cancel-Key syntax '$k'.$msg");
+        next;
+      }
+
+      my $key;
+      if ($1 eq 'sha1') {
+         $key = Digest::SHA1::sha1($2); }
+      elsif ($1 eq 'md5') {
+         $key = Digest::MD5::md5($2);
+      }
+      $key = MIME::Base64::encode_base64($key, '');
+
+      if (exists($lock{$key})) { 
+         # INN::syslog('notice', "Valid Cancel-Key $key found.$msg");
+         # -thh
+         # article is canceled now
+         INN::cancel($target) if ($target);
+         return undef;
+      }
+   }
+
+   INN::syslog('notice',
+      "No Cancel-Key[$cancel_key] matches Cancel-Lock[$cancel_lock]$msg"
+   );
+   return "No Cancel-Key matches Cancel-Lock.$msg";
+}
+
+1;

filter/filter_nnrpd.pl

@@ -0,0 +1,53 @@
+#
+# Do any initialization steps.
+#
+use Digest::MD5  qw(md5_base64);
+use Digest::SHA1();
+use Digest::HMAC_SHA1();
+use MIME::Base64();
+
+$CANCEL_LOCK = 'secretword';
+
+#
+# Filter
+#
+sub filter_post {
+   my $rval = "" ;             # assume we'll accept.
+   $modify_headers = 1;
+
+   # Cancel-Lock / Cancel-Key
+   add_cancel_lock(\%hdr, $user);
+     
+   if (exists( $hdr{"Control"} ) && $hdr{"Control"} =~ m/^cancel\s+(<[^>]+>)/i) {
+      my $key = calc_cancel_key($user, $1);
+      add_cancel_item(\%hdr, 'Cancel-Key', $key);
+   }
+   elsif (exists( $hdr{"Supersedes"} )) {
+      my $key = calc_cancel_key($user, $hdr{"Supersedes"});
+      add_cancel_item(\%hdr, 'Cancel-Key', $key);
+   }
+     
+   return $rval;
+}
+
+#
+# Cancel-Lock / Cancel-Key
+#
+sub add_cancel_item($$$) {
+   my ( $r_hdr, $name, $value ) = @_;
+   my $prefix = $r_hdr->{$name};
+   $prefix = defined($prefix) ? $prefix . ' sha1:' : 'sha1:';
+   $r_hdr->{$name} = $prefix . $value;
+}
+
+sub calc_cancel_key($$) {
+   my ( $user, $message_id ) = @_;
+   return MIME::Base64::encode(Digest::HMAC_SHA1::hmac_sha1($message_id, $user . $CANCEL_LOCK), '');
+}
+
+sub add_cancel_lock($$) {
+   my ( $r_hdr, $user ) = @_;
+   my $key = calc_cancel_key($user, $r_hdr->{'Message-ID'});
+   my $lock = MIME::Base64::encode(Digest::SHA1::sha1($key), '');
+   add_cancel_item($r_hdr, 'Cancel-Lock', $lock);
+}