Cancelock

# !/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;