view release on metacpan or  search on metacpan

lib/VOMS/Lite/PEMHelper.pm  view on Meta::CPAN

  $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

lib/VOMS/Lite/PEMHelper.pm  view on Meta::CPAN

# 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 =~ /^-----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__

=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);