File Coverage

blib/lib/VOMS/Lite/PEMHelper.pm

Criterion	Covered	Total	%
statement	159	226	70.3
branch	41	90	45.5
condition	0	3	0.0
subroutine	13	15	86.6
pod	0	10	0.0
total	213	344	61.9

package VOMS::Lite::PEMHelper;

use 5.004;
use strict;
use MIME::Base64 qw(encode_base64 decode_base64);
use File::Copy qw(move);

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw( encodeCert writeAC encodeAC readAC readCert decodeCert writeKey writeCert writeCertKey readPrivateKey );
@EXPORT = ( );
$VERSION = '0.20';

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

sub writeAC {  #writes a PEM formatted AC
# Two arguments (Path to store AC and AC data as a string of chars)
  my ($file,$data)=@_;
#  my $umasksave=umask(0022);  #ACs are not private key material
#  if ( umask() != 0022 ) { die "Can't umask 0022\n"; }
  if ( -e $file ) { move($file,"$file.old"); } #move old file away
  open(AC,">$file") || die "Can't create AC file";
  print AC &encodeAC($data);
  close(AC);
#  umask($umasksave);
  return;
}

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

sub encodeAC {
  return encodeCert(@_,"ATTRIBUTE CERTIFICATE");
}

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

sub readAC {  #Returns BER with AC in it
  my $file=shift;
  return readCert($file,"ATTRIBUTE CERTIFICATE");
}

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

sub readCert {  #Returns BERs with CERTs in them
# One arguement (path to cert file);
  my $file=shift;

  my $type=shift;
  if ( ! defined($type) ) { $type="CERTIFICATE"; }
  $type =~ y/a-z/A-Z/;
  $type =~ s/[^A-Z0-9 ]//g;

# Load and parse cert file
  my @myCertData=();
  my $Certnum=-1;
  my $read=0;
  open(CERT,"<$file") || die "Can't access Public Key file: '$file'";
  while () {
    my $line=$_;
    if ( $line =~ /^-----BEGIN $type-----\r?$/ ) {$read=1; $Certnum++; next;}
    if ( $line =~ /^-----END $type-----\r?$/ ) {$read=0;  wantarray ? next : last; }
    if ( $read==1 ) {
      if ( $line =~ /^([A-Za-z0-9+\/=]+)\r?$/ ) {$myCertData[$Certnum].=$1;}
    }
  }
  close(CERT);

  if ( $myCertData[0] eq "" ) { die "I didn't understand the format of your $type file:\n$file";}
  my @decoded=();
  foreach (@myCertData) { push(@decoded,decode_base64($_)); }
  return wantarray?@decoded:$decoded[0];
}

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

sub decodeCert {
  my $type = pop;
  my $pems = join "\n",@_;
  my @ders;
  $pems =~ s|^-----BEGIN $type-----$([a-zA-Z0-9/+=\r\n]+)^-----END $type-----$|push @ders,decode_base64($1)|mge;
  return @ders;
}

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

sub encodeCert {
  #my $certstr=shift;
  my $certstr="";
  my $type="CERTIFICATE";
  if ( $_[-1] !~ /^\x30/ ) { $type=pop; }

  $type =~ y/a-z/A-Z/;
  $type =~ s/[^A-Z0-9 ]//g;
  foreach (@_) {
    my $OpenSSLCompat=encode_base64($_,'');
    $OpenSSLCompat=~s/(.{1,64})/$&\n/g;
    $certstr .= "-----BEGIN $type-----\n".$OpenSSLCompat."-----END $type-----\n";
  }
  return $certstr;
}

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

sub writeCertKey {
# At least 3 arguements (file, public key, private key, [chain of signing certificates]);
  my $file=shift;
  my $pub=shift;
  my $pri=shift;

# Place file
  my $umasksave=umask(0077);

  if ( umask() != 0077 ) {
    if ( $^O =~ /^MSWin/ ) { print STDERR "WARNING: Can't umask 0077 when writing $file\n"; }
    else                   { die "Can't umask 0077 when writing $file"; }
  }
  if ( -e $file ) { move($file,"$file.old"); } #move old file away

  open(CERTKEY,">$file") || die "Can't create file to save cert and key to.";
  print CERTKEY encodeCert($pub,"CERTIFICATE");
  print CERTKEY encodeCert($pri,"RSA PRIVATE KEY");
  foreach ( @_ ) { print CERTKEY encodeCert($_,"CERTIFICATE"); }
  close(CERTKEY);
  umask($umasksave);
  return;
}

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

sub writeKey {
# At least 3 arguements (file, public key, private key, [chain of signing certificates]);
  my $file=shift;
  my $pri=shift;
  my $passwd=shift;
  my $ENCRYPTION="";

  if ( ! defined $passwd ) {
# Prompt for password
    require Term::ReadKey;
    print "I need the passphrase used to encrypt the key in \n$file\nPassphrase: ";
    my $dummy=Term::ReadKey::ReadMode('noecho');
    $passwd = Term::ReadKey::ReadLine(),
    $dummy=Term::ReadKey::ReadMode('normal');
    chomp $passwd;
    print "\n";
  }

# To encrypt or not to encrypt
  if ( $passwd ne "" ) {

# Spin up the Crypto stuff
    require Digest::MD5;
    require Crypt::DES_EDE3;

# Make Initialisation vector
    my $iv="";
    while (length($iv)<8 ) {$iv.=chr((rand(255)+1));}

# Construct DES Key from password (Munge)
    my $keysize=24;
    my $SALT=$iv;
    my $key=Digest::MD5::md5($passwd,$SALT);
    while (length($key) < $keysize) { $key .= Digest::MD5::md5($key, $passwd, $SALT);}
    $key=substr($key,0,$keysize);

# DES Padding Data as per RFC 1423 (not 1851 which adds message payload info)
    my $pad = ( 8 - (length($pri)%8) );
    my $padding=chr($pad) x $pad;
    $pri.=$padding;

# Encode Data
    my $DES = Crypt::DES_EDE3->new($key);
    my $cyphertextout="";
    while ( my $len=length($pri) ) {
      my $block=substr($pri,0,8);
      $pri=substr($pri,8);
      $block = $SALT ^ $block;
      my $cyphertext=$DES->encrypt($block);
      $SALT=$cyphertext;
      $cyphertextout.=$cyphertext;
    }

# Set PEM encryprion header
    $iv=unpack('H*',$iv);
    $iv =~ y/[a-f]/[A-F]/;
    $ENCRYPTION="Proc-Type: 4,ENCRYPTED\nDEK-Info: DES-EDE3-CBC,$iv\n\n";
    $pri=$cyphertextout;
  }

# Place file
  my $umasksave=umask(0077);

  if ( umask() != 0077 ) {
    if ( $^O =~ /^MSWin/ ) { print STDERR "WARNING: Can't umask 0077 when writing $file\n"; }
    else                   { die "Can't umask 0077 when writing $file"; }
  }
  if ( -e $file ) { move($file,"$file.old"); } #move old file away

  open(KEY,">$file") || die "Can't create file to save cert and key to.";
  my $OpenSSLCompat=encode_base64($pri,'');
  $OpenSSLCompat=~s/(.{1,64})/$&\n/g;
  print KEY "-----BEGIN RSA PRIVATE KEY-----\n$ENCRYPTION".$OpenSSLCompat."-----END RSA PRIVATE KEY-----\n";
  close(KEY);
  umask($umasksave);
  return;
}

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

sub writeCert {
# At least 3 arguements (file, public key, private key, [chain of signing certificates]);
  my $file=shift;
  my $pub=shift;
  my $type=shift;
  if ( ! defined($type) ) { $type="CERTIFICATE"; }
  $type =~ y/a-z/A-Z/;
  $type =~ s/[^A-Z0-9 ]//g;

# Place file
  if ( -e $file ) { move($file,"$file.old"); } #move old file away
  open(CERT,">$file") || die "Can't create file to save cert and key to.";
  my $OpenSSLCompat=encode_base64($pub,'');
  $OpenSSLCompat=~s/(.{1,64})/$&\n/g;
  print CERT "-----BEGIN $type-----\n".$OpenSSLCompat."-----END $type-----\n";
  close(CERT);
  return;
}


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

sub readPrivateKey {  #Returns BER with Private key in it
# Two arguements (path to private key, and optional password);
  my $file=shift;
  my $passwd=shift;

# Load and parse private key file
  my ($myKeyData,$PEMV,$PEMType,$PEMEnc,$SALT)=("","","","","");
  my $read=0;
  open(KEY,"<$file") || die "Can't access Private Key file $file";
  while () {
    my $line=$_;
    if ( $line =~ /^-----BEGIN RSA PRIVATE KEY-----$/ ) {$read=1; next;}
    if ( $line =~ /^-----BEGIN PRIVATE KEY-----$/ ) {$read=2; next;}
    if ( $line =~ /^-----END RSA PRIVATE KEY-----$/ ) {last;}
    if ( $line =~ /^-----END PRIVATE KEY-----$/ ) {last;}
    if ( $read==1 ) {
      if ( $line =~ /^Proc-Type: ([0-9]+),(ENCRYPTED)$/ ) {$PEMV=$1; $PEMType=$2}
      elsif ( $line =~ /^DEK-Info: (.*),(.*)$/ ) {$PEMEnc=$1; $SALT=$2}
      elsif ( $line =~ /^([A-Za-z0-9+\/=]+)$/ ) {$myKeyData.=$1;}
    }
    if ( $read==2 ) {
      if ( $line =~ /^([A-Za-z0-9+\/=]+)$/ ) {$myKeyData.=$1;}
    }
  }
  close(KEY);

# Return data if it's not encrypted
  if ( $myKeyData eq "" ) { die "I didn't understand the format of your key file:\n$file";}

# Obtain and check Encryption values
  my $cyphertext=decode_base64($myKeyData);

# If "PRIVATE KEY" but not "RSA PRIVATE KEY" Parse into it
  if ( $read == 2 ) { # Unencrypted pkcs #8
    die "I didn't understand the format of your key file:\n$file";
  }

  return $cyphertext if ( $PEMType ne "ENCRYPTED" ); # Because actually it's not encrypted.
  if ( $PEMEnc ne "DES-EDE3-CBC" ) { die "I don't know how to unencrypt your key\n";}
  if ( $SALT !~ /^[a-fA-F0-9]{16}$/ ) { die "Bad Initilisation Vector (salt)'; I can't unencrypt your key!\n";}
  if ( $PEMV ne "4" ) { print STDERR "Warning: I was expecting a version 4 PEM encrypted file you gave me a Version $PEMV\nFunny things may happen!\n"; }


# Check/get password
  if ( defined $passwd && $passwd eq "" ) { return undef; } #was expecting no password so abort
  elsif ( ! defined $passwd ) {
    require Term::ReadKey;
    require Digest::MD5;
    print "I need the passphrase used to encrypt the key in \n$file\nPassphrase: ";
    my $dummy=Term::ReadKey::ReadMode('noecho');
    $passwd = Term::ReadKey::ReadLine(),
    $dummy=Term::ReadKey::ReadMode('normal');
    chomp $passwd;
    print "\n";
  }

# Reconstruct DES Key from password (Munge)
  my $keysize=24;
  $SALT=pack('H*', $SALT);
  my $key=Digest::MD5::md5($passwd,$SALT);
  while (length($key) < $keysize) { $key .= Digest::MD5::md5($key, $passwd, $SALT);}
  $key=substr($key,0,$keysize);

# Decode Data
  require Crypt::DES_EDE3;
  my $DES = Crypt::DES_EDE3->new($key);
  my $dataout="";
  while ( my $len=length($cyphertext) ) {
    my $block=substr($cyphertext,0,8);
    $cyphertext=substr($cyphertext,8);
    my $data=$SALT ^ $DES->decrypt($block);
    $SALT=$block;
    $dataout.=$data;
  }

# Remove DES Padding
  my $unpad=substr ($dataout,-1);
  if ( "$unpad" =~ /[\001-\010]/  ) { $dataout=substr($dataout,0,-ord($unpad));}
  else { die "Your passphrase didn't do it for me!\n";}

  return $dataout;
}

1;
__END__