package VOMS::Lite::RSAHelper;

use 5.004;
use strict;
use Math::BigInt lib => 'GMP';

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw( rsasign rsaencrypt rsaverify rsadecrypt );
@EXPORT = ( );
$VERSION = '0.20';

###############################################

sub rsasign { # use private key to encrypt
  return &rsaenc( "01", @_);
}

###############################################

sub rsaencrypt { # use public key to encrypt
  return &rsaenc( "02", @_);
}

###############################################

sub rsaverify {
  return rsadecrypt( @_ );
}

###############################################

sub rsadecrypt {
  my ($EDhex,$chex,$nhex)=@_;

# Even up hex lengths into whole octets
  $chex=~s/^.(..)*$/0$&/;
  $nhex=~s/^.(..)*$/0$&/;
  $EDhex=~s/^.(..)*$/0$&/;
  my $khex=length($nhex);

# Length of modulus and Data in octets
  my $k=$khex/2;
  my $EDlen=length($EDhex)/2;

# Create Integer representing Data
  my $x=Math::BigInt->bzero();
  foreach (split(//,$EDhex)) {
    $x->bmul(16);
    $x->badd(hex($_));
  }

# Create Integer representing Modulus
  my $n=Math::BigInt->bzero();
  foreach (split(//,$nhex)) {
    $n->bmul(16);
    $n->badd(hex($_));
  }

# Create Integer representing Exponent
  my $c=Math::BigInt->bzero();
  foreach (split(//,$chex)) {
    $c->bmul(16);
    $c->badd(hex($_));
  }

# Do Big RSA Maths y = x^c mod n
  my $y=Math::BigInt->bzero();
  $y = $x->bmodpow($c,$n);

# Get Encrypted Data Character String
  my $Dhex=$y->as_hex();
  $Dhex=~s/^0x//;
  $Dhex=~s/^.(..)*$/0$&/; # Even up the length

  if ( length($Dhex) < ($khex-4) ) { # short string: BT must be 00 (NB RFC difference should be ($khex-2) )
    return $Dhex;
  } 
  else { # long string: BT is any one of 00, 01 and 02
    my $BT=substr($Dhex,0,2);
    $Dhex=substr($Dhex,2);
    if ( $BT eq "00" ) {
      until ( substr($Dhex,0,2) ne '00' || $Dhex eq "" ) { $Dhex=substr($Dhex,2); } 
    }
    else { # BT = 01 or 02
      until ( substr($Dhex,0,2) eq '00' || $Dhex eq "" ) { $Dhex=substr($Dhex,2); }
      $Dhex=substr($Dhex,2);
    }
  }
  return $Dhex;
}

###############################################

sub rsaenc { #RSA Algorythm as per RFC2313  (with tweak for openssl verification stuff)

# Get block type, Data, HexKey, HexModulus
  my ($BT,$Dhex,$chex,$nhex)=@_;

# Even up hex lengths into whole octets
  $chex=~s/^.(..)*$/0$&/;
  $nhex=~s/^.(..)*$/0$&/;
  $Dhex=~s/^.(..)*$/0$&/;
  my $khex=length($nhex);

# Length of modulus and Data in octets
  my $k=$khex/2;
  my $Dlen=length($Dhex)/2;

# Barf if datalen is too long for RSA
  ( $Dlen > ($k - 11) ) && die "Too much data to encrypt!";

# Padding for signing (why - 4 and not - 3 as per RFC I don't know)
  my $PS="ff" x ( $k - 4 - $Dlen);

# If encrypting alter padding to random
  if ( $BT eq "02" ) { $PS=~s/../unpack('H2',pack('i',int(rand(255)+1)))/ge; }

# Make Encryption Block. EB = 00 || BT || PS || 00 || D
  my $EB='00'.$BT.$PS.'00'.$Dhex;

# Create Integer representing Data
  my $x=Math::BigInt->bzero();
  foreach (split(//,$EB)) {
    $x->bmul(16);
    $x->badd(hex($_));
  }

# Create Integer representing Modulus
  my $n=Math::BigInt->bzero();
  foreach (split(//,$nhex)) {
    $n->bmul(16);
    $n->badd(hex($_));
  }

# Create Integer representing Exponent
  my $c=Math::BigInt->bzero();
  foreach (split(//,$chex)) {
    $c->bmul(16);
    $c->badd(hex($_));
  }

# Do Big RSA Maths y = x^c mod n
  my $y=Math::BigInt->bzero();
  $y = $x->bmodpow($c,$n);

# Get Encrypted Data Character String
  my $ED=$y->as_hex();
  $ED=~s/^0x//;
  $ED=~s/^.(..)*$/0$&/;
  
# Send Hex Data back
  return $ED;
}

1;
__END__

=head1 NAME

VOMS::Lite::RSAHelper - Perl extension implementing basic RSA encryption/decryption

=head1 SYNOPSIS

  use VOMS::Lite::RSAHelper qw( rsasign rsaencrypt );
  $HexEData=rsasign($HexData,$HexKey,$HexModulus);
  $HexEData=rsaencrypt($HexData,$HexKey,$HexModulus);

=head1 DESCRIPTION

VOMS::Lite::RSAHelper is primarily for internal use.  But frankly I don't mind if you use this package directly :-)
It takes hex encoded data string and applies RSA encryption to it using the supplied key.


=head2 EXPORT

None by default.

rsasign rsaencrypt if specified.

=head1 SEE ALSO

RFC2313 for RSA encryption/decryption

This module was originally designed for the SHEBANGS project at The University of Manchester.
http://www.mc.manchester.ac.uk/projects/shebangs/
now http://www.rcs.manchester.ac.uk/research/shebangs/

Mailing list, shebangs@listserv.manchester.ac.uk

Mailing list, voms-lite@listserv.manchester.ac.uk

=head1 AUTHOR

Mike Jones <mike.jones@manchester.ac.uk>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Mike Jones

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.

=cut