Cancel-Lock

Vorrausetzung man hat einen Newsreader der eigene Header unterstützt und man kennt die Message-ID die man verwendet. Sprich man verwendet eigene Message-IDs und weiss vor dem Versenden, wie die lautet.

makecanlock.pl

#!/usr/bin/perl
#
# @AUTHOR Arnold Schiller
# @VERSION  0.3
# @DATE  2007-07-05
#
# makecanlock for usenet messages 
#
# 2007-07-07: add generate message-id 
#             change switch -C to S/s for secret
#             
use strict;
use warnings;

my $VERSION = '0.3';
my $pname = $0;
my $version = "$pname.$VERSION";


if (! eval ( "require 'Getopt/Std.pm';" ) ) {
   print "$pname: Perl module Getopt/Std.pm not found. Please update your perl ";
   print "$pname: installation!\n";
   exit 1;
}else {
   use Getopt::Std;
}

if (! eval ( "require 'MIME/Base64.pm';" ) ) {
        print "$pname: Perl module MIME/Base64.pm not found";
        exit 1;
}else{
use MIME::Base64;
}
if (! eval ( "require 'Digest/HMAC_SHA1.pm';" ) ) {
        print "$pname: Perl module Digest/HMAC_SHA1.pm not found";
        exit 1;
}else{
use Digest::HMAC_SHA1;
}
if (! eval ( "require 'Digest/SHA1.pm';" ) ) { 
        print "$pname: Perl module Digest/SHA1.pm not found";
        exit 1;
}else{
use Digest::SHA1;
}

$Getopt::Std::STANDARD_HELP_VERSION = 1;
$Getopt::Std::OUTPUT_HELP_VERSION = 1;
my $help = '
syntax: '.$pname.' [-Mm] <messageid> [-Uu] <user> [-Ss] <secret> [-V] <integer> [-Dd] <integer>

      -U/u  Userkey   sets userkey/identity
      -M/m  Message-id messeage-id 
      -S/s  Secret password for Cancelkey
      -C/c  Control 1 for print Cancelcontrol
      -V    Verify 1 for print verify
      --help
        prints this help text and exits: invoking the help
        argument causes all other arguments to be discarded by
        this utility
      --version

description:  This utility takes strings as arguments and 
produces the Cancel-Lock and the Cancel-Key from the given 
arguments as SHA1-Key-Values.

credits:  Arnold Schiller (author) 

license:  This software is licensed GPL.  See the 
webpage at http://www.gnu.org/copyleft/gpl.html for licensing details.
';



# Some variables

my $user = '';                  # -U/-u user/identy
my $CANCELLOCK = '';            # -S/-s  secret for Cancel-Key/Lock

# standard usenet header INN-style
my %hdr;
$hdr{'Message-ID'} = '';        # -M/-m Message-ID 
$hdr{'Cancel-Lock'} = '';       # sha1:$lock
$hdr{'Cancel-Key'} = '';        # sha1:digest
$hdr{'Control'} = 'cancel ';

# 
my $lock = '';         # the sha lockkey
my $data = '';         # data for key-generation
my $digest = '';       # the sha cancelkey
my $key = '';          # for verify


our($opt_U,$opt_u,$opt_M,$opt_m,$opt_S,$opt_s,$opt_C,$opt_c,$opt_V,$opt_v,$opt_H,$opt_h,$opt_D,$opt_d);
&getopts('U:u:M:m:S:s:C:c:V:v:H:h:D:d');


#############################################################
#          H e l p
#############################################################
sub HELP_MESSAGE(){
        my $h = $help;
        print $help;
        exit 0;
}

sub HELP_VERSION(){
        print $version;
        exit 0;
}

#############################################################
#         D e b u g
#############################################################

sub debug() {
        print STDERR " $_ \n";
print "\n";
       
}

#############################################################
#        Message-ID mit oder ohne Klammer ?
#############################################################
sub data_klammern{
        # my $line = $hdr{'Message-ID'};
        my $line = $_[0];
         
        if   (   $line =~ m/\s*</i  )   {
             

                        $line = "".$line."";
                        return($line);

        }else{
         $line = "<".$line.">"."";
         return($line);
                
        }
        exit 2;
}


sub make_mid(){
        
         chomp (my $hname = `hostname`);
         my ($hostname,) = gethostbyname($hname);
         my @CHARS = ('A'..'Z','a'..'z',0..9,'$');
         my $unique_value = 0;
         my $length = 5;
         $length = rand(12) until $length > 5;
         my $userpart = join '', (map $CHARS[rand $#CHARS], 0 .. $length), $unique_value++;
         my $mid = "<$userpart".time.'@'.$hostname.">";
         return $mid; 

        }


#-----------------------------------------------------
# 
#               M a i n
#
#-----------------------------------------------------
if(!$opt_v){
        $opt_v = 0;
}
if(!$opt_V){
        $opt_V = 0;
}
if (($opt_H) or ($opt_h)){
        HELP_MESSAGE;
}
if(($opt_U) or ($opt_u)){
    if($opt_u){
                $user = "$opt_u";
            }else{
                $user = "$opt_U";
        }
}



if(($opt_M) or ($opt_m)){
    if($opt_m){
                $hdr{'Message-ID'} = $opt_m;
        }else{
                $hdr{'Message-ID'} = $opt_M;
        }
    $hdr{'Message-ID'} = data_klammern($hdr{'Message-ID'});
}

if(($opt_S) or ($opt_s)){
    if($opt_s) {
    $CANCELLOCK = $opt_s;
    }else{
    $CANCELLOCK = $opt_S;
    }
}


if($user eq ''){

         print "Userkey and Message-ID needed!";
         HELP_MESSAGE();
         exit 2;


}


my $hmac = Digest::HMAC_SHA1->new("$user");
if($hdr{'Message-ID'} eq ''){
        if($opt_v > 0){
        print "No Message-ID! I make one.\n";
        }
        my $mid = make_mid;
        $hdr{'Message-ID'} = $mid;
}
if($CANCELLOCK eq ''){
        if($opt_v >= 0) {
        print "No Secret given!\n"
        }
}

if(($opt_c) or ($opt_C)){
$hdr{'Control'} = "cancel ".$hdr{'Message-ID'}; 
        if($opt_v > 2){
                print $hdr{'Control'}."\n";
        }else{  
        print "Control: ".$hdr{'Control'}."\n";
        }
}
$data = "$hdr{'Message-ID'}"."$CANCELLOCK";
if($opt_v > 2){
        print $hdr{'Message-ID'}."\n";
        }else{
        print "Message-ID: $hdr{'Message-ID'}";
        print "\n";
        }
$hmac->add("$data");
$digest = $hmac->b64digest;
$lock =  encode_base64(Digest::SHA1::sha1($digest),"");
if($opt_v > 2){
        print $lock."\n";
        }else{
        $hdr{'Cancel-Lock'} =  "sha1:".$lock."";
        print "Cancel-Lock: ";
        print $hdr{'Cancel-Lock'};
        print "\n";
        }

$hmac = Digest::HMAC_SHA1->new("$user");
$data = $hdr{'Message-ID'}."$CANCELLOCK";
$hmac->add($data);
$digest = $hmac->b64digest;
if($opt_v > 2){
        print $digest."\n";
}else{
        $hdr{'Cancel-key'} = "sha1:".$digest;
        print "Cancel-Key: ";
        print $hdr{'Cancel-key'};
        print "\n";
}
if($opt_V){
$key = $digest;
$key = Digest::SHA1::sha1($digest);
$key = encode_base64($key);
if($opt_v > 2){
        print $key."\n";
        }else{
        print "$digest match $key";
        print "\n";
        }
}
exit 0;

Cancelock (last edited 2007-07-07 06:53:46 by ArnoldSchiller)