RFC 8315 Netnews Cancel-Lock perl implementation for Inn

Perl filters examples for Cancel-Lock/Cancel-Key

This is the Thomas Hochstein Cancel-Lock implementation for Inn adapted to be RFC8315 compliant.
We will check, with Cleanfeed (cleanfeed.local), for a matching Cancel-Key before accepting a cancel.
With filter_nnrpd.pl we will add Cancel-Lock to all postings and a matching Cancel-Key to cancel if needed.

filter_nnrpd.pl

#
# Do any initialization steps.
#
use Digest::SHA qw( sha256_base64 hmac_sha256_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 . ' sha256:' : 'sha256:';
   $r_hdr->{$name} = $prefix . $value;
}

sub calc_cancel_key($$) {
   my ( $user, $message_id ) = @_;
   return pad_b64digest(hmac_sha256_base64($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 = pad_b64digest(sha256_base64($key));
   add_cancel_item($r_hdr, 'Cancel-Lock', $lock);
}

sub pad_b64digest($) {
    my ($b64_digest) = @_;
    while (length($b64_digest) % 4) {
        $b64_digest .= '=';
    }
    return $b64_digest;
}

cleanfeed.local

# vim: set syntax=perl ts=4 ai si:

use Digest::SHA qw( sha1_base64 sha256_base64 sha512_base64 );
use Digest::MD5 qw( md5_base64 );

#
# 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/^(sha512|sha256|sha1|md5):(\S+)/);
      $lock{$2} = $1;
   }

   for my $k(split(/\s+/, $cancel_key))    {
      unless($k =~ m/^(sha512|sha256|sha1|md5):(\S+)/) { 
        INN::syslog('notice', "Invalid Cancel-Key syntax '$k'.$msg");
        next;
      }

      my $key;
      if ($1 eq 'sha512') {
        $key = sha512_base64($2);  
      }
      elsif ($1 eq 'sha256') {
        $key = sha256_base64($2);  
      }
      elsif ($1 eq 'sha1') {
         $key = sha1_base64($2);
      }
      elsif ($1 eq 'md5') {
         $key = md5_base64($2);
      }
      $key = pad_b64digest($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";
}

sub pad_b64digest($) {
    my ($b64_digest) = @_;
    while (length($b64_digest) % 4) {
        $b64_digest .= '=';
    }
    return $b64_digest;
}

1;