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.09';

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

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);
  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 {
  my ($data)=@_;
  return encodeCert($data,"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 Puplic Key file: $file";
  while (<CERT>) {
    my $line=$_;
    if ( $line =~ /^-----BEGIN $type-----$/ ) {$read=1; $Certnum++; next;}
    if ( $line =~ /^-----END $type-----$/ ) {$read=0;  wantarray ? next : last; }
    if ( $read==1 ) {
      if ( $line =~ /^([A-Za-z0-9+\/=]+)$/ ) {$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 ) { die "Can't umask 0077\n"; }
  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 ) { die "Can't umask 0077\n"; }
  if ( -e $file ) { move($file,"$file.old"); } #move old file away ######FIXME use Tempfile

  open(KEY,">$file") || die "Can't create file to save cert and key to.";
  my $OpenSSLCompat=encode_base64($pri,'');
  $OpenSSLCompat=~s/(.{64})/$&\n/g;
  $OpenSSLCompat=~s/([^\x0a])$/$&\n/s;
  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/(.{64})/$&\n/g; 
  $OpenSSLCompat=~s/([^\x0a])$/$&\n/s;
  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 (<KEY>) {
    my $line=$_;
    if ( $line =~ /^-----BEGIN RSA PRIVATE KEY-----$/ ) {$read=1; next;}
    if ( $line =~ /^-----END RSA 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;}
    }
  }
  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);
  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-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__

=head1 NAME

VOMS::Lite::PEMHelper - Perl extension for decoding and encoding PEM X.509 certificates and keys.

=head1 SYNOPSIS

  use VOMS::Lite::PEMHelper qw( writeAC encodeCert encodeAC readAC readCert decodeCert writeCertKey readPrivateKey writeCert writeKey);

  # write DER AC $data as a PEM AC to file $file
  writeAC($file,$data);

  # encode DER Certificate $data as a PEM Certificate
  $cert=encodeCert($data); 

  # encode DER AC $data as a PEM AC
  $ac=encodeAC($data); 

  # read PEM AC in file $file and return DER AC 
  $data=readAC($file);

  # read PEM Certificates in file $file and return DER Certificates 
  # in array
  @certs=readCert($file);

  # read PEM Certificates in file $file and return the first as a DER 
  # Certificate
  $cert=readCert($file);

  # takes a string and/or array of PEMs followsd by a type as arguments 
  # and decodes them into an array of DERs
  @DERs=decodeCert(@PEMs,"CERTIFICATE"); 

  # take DER certificate, private key and (optionally) a chain of
  # signers and write them in PEM format to file $file
  writeCert($file, $cert);

  # take DERprivate key and write it in PEM format to file $file, 
  # encrypting with $password. If $password is undefined it will prompt 
  # for a password, if password is "" no encryption will be used.
  writeKey($file, $privateKey, $password);

  # take DER certificate, private key and (optionally) a chain of 
  # signers and write them in PEM format to file $file
  writeCertKey($file, $cert, $privateKey, @chain);

  # read in a PEM private key, prompt for a password if encrypted and 
  # return unencrypted DER private key.
  $key=readPrivateKey($file);

=head1 DESCRIPTION

VOMS::Lite::PEMHelper is primarily for internal use.  But frankly I don't mind if you use this package directly :-)

=head2 EXPORT

None by default.

By EXPORT_OK the following functions:
  writeAC
  encodeAC
  readAC
  readCert
  decodeCert
  writeCertKey
  readPrivateKey
  writeCert
  writeKey

=head1 SEE ALSO

RFC 1421 
RFC 3447

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
