> Projeto Final schrieb:
>
> Hello,
>
> When we tried to change the passphrase of the key, still in the
> initialization
> of the CA (phase 2 and 3 - handle the certificate), we received an
> error stating
> that we couldn�t change the passphrase of the key. The apache error
> log states
> that:
>
> no keyfile specified
> unable to load key
> General Error Trapped 700: Cannot change passphrase of key! at
> /usr/lib/perl5/5.6.0/i386-linux/misc-utils.lib line 32.
> Compilation failed in require at /usr/local/OpenCA/cgi-bin/ca/ca line
> 192
The problem is that "openssl pkcs8" cannot handle stdin but the
documentation says it can do it. I changed OpenSSL.pm in
src/modules/openca-openssl/. I attached the changed OpenSSL.pm.
Best Regards,
Michael
--
-------------------------------------------------------------------
Michael Bell Email (private): [EMAIL PROTECTED]
Rechenzentrum - Datacenter Email: [EMAIL PROTECTED]
Humboldt-University of Berlin Tel.: +49 (0)30-2093 2482
Unter den Linden 6 Fax: +49 (0)30-2093 2959
10099 Berlin
Germany http://www.openca.org
## OpenCA::OpenSSL
##
## Copyright (C) 1998-2001 Massimiliano Pala ([EMAIL PROTECTED])
## All rights reserved.
##
## This library is free for commercial and non-commercial use as long as
## the following conditions are aheared to. The following conditions
## apply to all code found in this distribution, be it the RC4, RSA,
## lhash, DES, etc., code; not just the SSL code. The documentation
## included with this distribution is covered by the same copyright terms
##
## Copyright remains Massimiliano Pala's, and as such any Copyright notices
## in the code are not to be removed.
## If this package is used in a product, Massimiliano Pala should be given
## attribution as the author of the parts of the library used.
## This can be in the form of a textual message at program startup or
## in documentation (online or textual) provided with the package.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions
## are met:
## 1. Redistributions of source code must retain the copyright
## notice, this list of conditions and the following disclaimer.
## 2. Redistributions in binary form must reproduce the above copyright
## notice, this list of conditions and the following disclaimer in the
## documentation and/or other materials provided with the distribution.
## 3. All advertising materials mentioning features or use of this software
## must display the following acknowledgement:
## "This product includes OpenCA software written by Massimiliano Pala
## ([EMAIL PROTECTED]) and the OpenCA Group (www.openca.org)"
## 4. If you include any Windows specific code (or a derivative thereof) from
## some directory (application code) you must include an acknowledgement:
## "This product includes OpenCA software (www.openca.org)"
##
## THIS SOFTWARE IS PROVIDED BY OPENCA DEVELOPERS ``AS IS'' AND
## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
##
## The licence and distribution terms for any publically available version or
## derivative of this code cannot be changed. i.e. this code cannot simply be
## copied and put under another distribution licence
## [including the GNU Public Licence.]
##
## Contributions by:
## Martin Leung <[EMAIL PROTECTED]>
## Uwe Gansert <[EMAIL PROTECTED]>
use strict;
package OpenCA::OpenSSL;
$OpenCA::OpenSSL::VERSION = '0.9.51';
($OpenCA::OpenSSL::VERSION = '$Revision: 1.25 $' )=~ s/(?:^.*:
(\d+))|(?:\s+\$$)/defined $1?"0\.9":"a"/eg;
## Global Variables Go HERE
my %params = (
shell => undef,
cnf => undef,
tmpDir => undef,
baseDir => undef,
verify => undef,
sign => undef,
errno => undef,
errval => undef
);
## Create an instance of the Class
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
%params,
};
bless $self, $class;
my $keys = { @_ };
$self->setParams( @_ );
if( not $self->{binDir} ) {
$self->{binDir} = "/usr/bin";
};
if( not $self->{shell} ) {
$self->{shell} = "$self->{binDir}/openssl";
};
if( not $self->{verify} ) {
$self->{verify} = "$self->{binDir}/verify";
};
if( not $self->{sign} ) {
$self->{sign} = "$self->{binDir}/sign";
};
if( not $self->{tmpDir} ) {
$self->{tmpDir} = '/tmp';
};
if( not -e "$self->{shell}" ) {
return;
};
$self->{errno} = 0;
$self->{errval} = "";
return $self;
}
sub setParams {
my $self = shift;
my $params = { @_ };
my $key;
foreach $key ( keys %{$params} ) {
$self->{cnf} = $params->{$key} if ( $key =~ /CONFIG/ );
$self->{shell} = $params->{$key} if ( $key =~ /SHELL/ );
$self->{tmpDir} = $params->{$key} if ( $key =~ /TMPDIR/ );
$self->{binDir} = $params->{$key} if ( $key =~ /BINDIR/ );
$self->{verify} = $params->{$key} if ( $key =~ /VERIFY/ );
$self->{sign} = $params->{$key} if ( $key =~ /SIGN/ );
open STDERR, $params->{$key} if ( $key =~ /STDERR/ );
}
return 1;
}
sub errno {
my $self = shift;
return $self->{errno};
}
sub errval {
my $self = shift;
return $self->{errval};
}
sub genKey {
## Generate a new key, arguments accepted are, in order
## ( BITS=>$bits, OUTFILE=>$outfile, ALGORITHM=>$alg, PASSWD=>$passwd )
my $self = shift;
my $keys = { @_ };
my $bits = $keys->{BITS};
my $outfile = $keys->{OUTFILE};
my $alg = $keys->{ALGORITHM};
my $passwd = $keys->{PASSWD};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my $rand = $keys->{RAND};
my $command = "$self->{shell} genrsa ";
if( $engine ) {
$command .= "-engine $engine ";
}
if( $passwd ) {
$command .= "-passout env:pwd ";
$alg = "des" if ( not(defined($alg)) or $alg eq "" );
}
if ( defined($alg) && $alg ne "" ) {
$command .= "-$alg ";
}
if ( defined($outfile) && $outfile ne "" ) {
$command .= "-out $outfile ";
}
$ENV{'pwd'} = "$passwd" if( defined($passwd) );
if ( defined($rand) && $rand ne "" ) {
$command .= "-rand \"$rand\" ";
} else {
$ENV{'RANDFILE'} = "/tmp/.rand_${$}";
}
$command .= $bits if( defined($bits) );
$ENV{'pwd'} = "$passwd" if( defined( $passwd));
open(FD, "$command|" ) or return;
## Send Password
## if( $passwd ) {
## print FD "$passwd\n";
## }
## Send Confirmation Password
## print FD "$passwd\n";
close(FD);
delete ($ENV{'pwd'}) if( defined($passwd));
delete ($ENV{'RANDFILE'}) if (defined($ENV{'RANDFILE'}));
if( not defined( $rand )) {
unlink( "/tmp/.rand_${$}" );
}
return if( $? != 0 );
return "$!";
}
sub genReq {
## Generate a Request file, parameter accepted are
## ( $outfile, $keyfile, $passwd , [email, cn, ou, o, c ] )
## To utilize null passwd simply pass a "" reference.
my $self = shift;
my $keys = { @_ };
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my $outfile = $keys->{OUTFILE};
my $outform = $keys->{OUTFORM};
my $keyfile = $keys->{KEYFILE};
my $subject = $keys->{SUBJECT};
my $passwd = $keys->{PASSWD};
my $command = "$self->{shell} req -new ";
my $tmpfile = $self->{tmpDir} . "/${$}_req.pem";
my ( $ret, $tmp, @DN );
return if( not $keyfile );
if( defined $keys->{DN} ) {
@DN = @{ $keys->{DN} };
}
if ( defined($self->{cnf}) && $self->{cnf} ne "" ) {
$command .= "-config " . $self->{cnf} . " ";
}
$command .= "-passin env:pwd " if ( defined($passwd) && $passwd ne "" );
$command .= "-subj \"$subject\" " if ( defined( $subject) && $subject ne "" );
if( $engine ) {
$command .= "-engine $engine ";
}
if( defined($outform) ) {
$outform = uc( $outform );
if ( $outform =~ /(PEM|DER)/i ) {
$command .= "-outform $outform ";
} elsif ( $outform =~ /(TXT)/ ) {
$command .= "-text -noout ";
}
}
if ( $outfile ne "" ) {
$command .= "-out $outfile ";
} else {
$command .= " >$tmpfile ";
}
$command .= "-key $keyfile ";
$ENV{'pwd'} = "$passwd" if( defined($passwd));
open( FD, "|$command" ) or return ;
if( not defined ($subject) or ( $subject eq "") ) {
foreach $tmp (@DN) {
print FD "$tmp\n";
}
}
close(FD);
delete( $ENV{'pwd'} ) if( defined($passwd) );
if( $? != 0 ) {
return;
}
if( not(defined($outfile)) || $outfile eq "" ) {
open( FD, "<$tmpfile" ) or return;
while( $tmp = <FD> ) {
$ret .= $tmp;
}
close(FD);
unlink( "$tmpfile" );
return $ret;
}
return defined;
}
sub genCert {
## Generate a new Certificate file, parameter accepted are
## (OUTFILE=>$outfile,KEYFILE=>$keyfile,REQFILE=>$reqfile,
## PASSWD=>$passwd, DN=>[ @list ] )
my $self = shift;
my $keys = { @_ };
my $outfile = $keys->{OUTFILE};
my $keyfile = $keys->{KEYFILE};
my $reqfile = $keys->{REQFILE};
my $subject = $keys->{SUBJECT};
my $noemail = $keys->{NOEMAILDN};
my $passwd = $keys->{PASSWD};
my $days = $keys->{DAYS};
my $tmpfile = $self->{tmpDir} . "/${$}_crt.tmp";
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my $command = "$self->{shell} req -x509 ";
my ( $ret, $tmp );
return if( (not $keyfile) or (not $reqfile) );
if( $engine ) {
$command .= "-engine $engine ";
}
## $command .= "-subj \"$subject\" "
## if ( defined($subject) && ($subject ne "") );
## $command .= "-noemailDN "
## if ( defined($noemail) && ($noemail ne "") );
$command .= "-passin env:pwd "
if ( defined($passwd) && $passwd ne "" );
$command .= "-config ". $self->{cnf} . " "
if ( defined($self->{'cnf'}) && $self->{cnf} ne "" );
$command .= "-days $days "
if ( defined($days) && $days =~ /\d+/ && $days > 0 );
$command .= "-in \"$reqfile\" -key \"$keyfile\" ";
if( defined($outfile) && $outfile ne "" ) {
$command .= "-out \"$outfile\" ";
} else {
$command .= "-out \"$tmpfile\" ";
}
$ENV{'pwd'} = "$passwd" if( defined($passwd) );
$ret = `$command`;
delete( $ENV{'pwd'} ) if( defined($passwd) );
return if( $? != 0 );
if( $? != 0 ) {
return;
}
## if( defined($outfile) && $outfile eq "" ) {
if( not(defined($outfile)) or $outfile eq "" ) {
open( FD, "<$tmpfile" ) or return;
while( $tmp = <FD> ) {
$ret .= $tmp;
}
close(FD);
unlink( "$tmpfile" );
}
return "$ret";
}
sub crl2pkcs7 {
my $self = shift;
my $keys = { @_ };
my $data = $keys->{DATA};
my $crlfile = $keys->{CRLFILE};
my $inform = $keys->{INFORM};
my $outfile = $keys->{OUTFILE};
my $outform = $keys->{OUTFORM};
my ( $ret, $tmp, $tmpfile, $command );
my $command = "$self->{shell} crl2pkcs7 ";
if( (not(defined($data)) or $data eq "") and
(not(defined($crlfile)) or $crlfile eq "" )) {
$command .= "-nocrl ";
}
if ( not(defined($crlfile)) || $crlfile eq "" ){
$tmpfile = $self->{tmpDir} . "/${$}_incrl.tmp";
open( FD, ">$tmpfile" ) or exit 1;
print FD "$data";
close( FD );
} else {
$tmpfile = $crlfile;
}
$command .= "-in $tmpfile ";
$command .= "-out $outfile "
if ( defined($outfile) and $outfile ne "");
$command .= "-inform $inform "
if ( defined($inform) and $inform ne "");
$command .= "-outform $outform "
if ( defined($outform) and $outform ne "");
if( defined $keys->{CERTSLIST} ) {
my @certs = @{ $keys->{CERTSLIST}};
for (@certs) {
$command .= "-certfile \"$_\" "
if( ("$_" ne "") and (-f "$_") );
}
}
$ret = `$command`;
if($? != 0) {
$self->{errno} = $?;
$self->{errval} = "Impossible converting to pkcs7 structure";
$ret = undef;
} else {
$ret = 1 if( $outfile ne "" );
}
unlink("$tmpfile") if ( $crlfile eq "" );
return $ret;
}
sub dataConvert {
## You can convert data structures to different formats
## Accepted parameters are:
##
## DATATYPE=> CRL|CERTIFICATE|REQUEST|KEY
## OUTFORM => PEM|DER|NET|TXT|PKCS12|PKCS8
## INFORM => PEM|DER|NET|TXT|PKCS12|PKCS8
## OUTFILE => $outfile
## INFILE => $infile
## DATA => $data
## KEYFILE => $keyfile
## PKCS12 encode parameter :
## INFILE or DATA (must be PEM encoded)
## KEYFILE (might be in front of the DATA or in INFILE)
## P12PASSWD = password for pkcs12 file (optional)
## PASSWD = password for KEYFILE (optional)
## INPASSWD = password for KEYFILE (optional)
## OUTPASSWD = password for KEYFILE (optional)
## OUTFILE = optional
## ALGO = optionl, default = des3
## DATATYPE must be 'CERTIFICATE'
## PKCS12 decode parameter
## INFILE or DATA (must be PKCS12 encoded)
## P12PASSWD
## PASSWD (PEM password optional)
## OUTFILE = optional
## DATATYPE must be 'CERTIFICATE'
my $self = shift;
my $keys = { @_ };
my $data = $keys->{DATA};
my $type = $keys->{DATATYPE};
my $outform = $keys->{OUTFORM};
my $inform = $keys->{INFORM};
my $outfile = $keys->{OUTFILE};
my $infile = $keys->{INFILE};
my $keyfile = $keys->{KEYFILE};
my $passwd = $keys->{'PASSWD'};
my $p12pass = $keys->{'P12PASSWD'};
my $inpwd = $keys->{'INPASSWD'};
my $outpwd = $keys->{'OUTPASSWD'};
my $algo = $keys->{'ALGO'} || 'des3';
my $nokeys = $keys->{'NOKEYS'};
my ( $command, $tmp, $ret, $tmpfile );
return if ( not $type);
return if ( (not $data) and (not $infile));
return if ( not $algo =~ /des3|des|idea/ );
return if ( defined($nokeys) and ($outform eq 'PKCS12') ); # impossible
## Return if $infile does not exists
return if( defined($infile) and ( not -e $infile ));
return if( (not $data) and (not $infile) );
if (not $infile) {
$infile = $self->{tmpDir} . "/${$}_data.tmp";
open FD, ">".$infile;
print FD $data;
close FD;
} else {
$data = 0;
}
$outform = "PEM" if( not $outform );
$inform = "PEM" if( not $inform );
$tmpfile = "$self->{tmpDir}/${$}_cnv.tmp";
$command = "$self->{shell} ";
if( $type =~ /CRL/i ) {
$command .= " crl ";
} elsif ( $type =~ /CERTIFICATE/i ) {
if( $outform eq 'PKCS12' or $inform eq 'PKCS12' ) {
$command .= ' pkcs12 ';
} else {
$command .= " x509 ";
}
} elsif ( $type =~ /REQ/i ) {
$command .= " req ";
if ( defined($self->{cnf}) && $self->{cnf} ne "" ) {
$command .= "-config " . $self->{cnf} . " ";
}
} elsif ( $type =~ /KEY/i ) {
## PKCS8 enforces PEM because the OpenSSL command req can
## only handle PEM-encoded PKCS#8 keys
if ( ($outform =~ /PKCS8/i) or ($inform =~ /PKCS8/i) ) {
$command .= " pkcs8 ";
} else {
$command .= " rsa ";
}
if (not $inpwd or not $outpwd) {
unlink ($infile) if ($data);
return undef;
}
$command .= ' -passin env:inpwd ';
$command .= ' -passout env:outpwd ';
} else {
## if no known type is given...
return;
}
$outfile = $tmpfile if ( not $outfile );
$command .= "-out $outfile ";
$command .= "-in $infile ";
$command .= "-inkey $keyfile " if( defined($keyfile) ); #PKCS12 only
# outform in PKCS12 is always PEM
if( $outform =~ /TXT/i ) {
$command .= "-text -noout ";
} elsif ( $outform =~ /(PEM|DER|NET)/i ) {
if( $inform eq 'PKCS12' ) {
$command .= '-passout env:pempwd 'if( defined($passwd) );
$command .= '-passin env:p12pwd ' if( defined($p12pass) );
$command .= '-nokeys ' if( defined($nokeys) );
if( defined($passwd) ) {
$command .= "-$algo " if( $algo eq 'des' or
$algo eq 'des3' or
$algo eq 'idea' );
} else {
$command .= '-nodes' if( not defined($passwd) );
}
} else {
$command .= "-outform " . uc($outform) . " ";
}
} elsif ( $outform eq 'PKCS12' ) {
$command .= "-export ";
} elsif ( $outform =~ /PKCS8/i ) {
$command .= " -topk8 -outform PEM ";
} else {
## no valid format received...
unlink ($infile) if ($data);
return undef;
}
if( $outform eq 'PKCS12' ) {
$command .= '-passout env:p12pwd ';
$command .= '-passin env:pempwd ' if( defined($passwd) );
} elsif( $inform =~ /(PEM|DER|NET)/i ) {
$command .= "-inform " . uc($inform) ." ";
} elsif( $inform eq 'PKCS12' ) {
# nothing to do here.
} else {
## no valid format received ...
unlink ($infile) if ($data);
return undef;
}
$ENV{'p12pwd'} = "$p12pass" if( defined($p12pass) );
$ENV{'pempwd'} = "$passwd" if( defined($passwd) );
$ENV{'inpwd'} = "$inpwd" if( defined($inpwd) );
$ENV{'outpwd'} = "$outpwd" if( defined($outpwd) );
if ($self->{DEBUG}) {
print "OpenCA::OpenSSL->dataConvert: p12pass is set<br>\n" if(
defined($p12pass) );
print "OpenCA::OpenSSL->dataConvert: passwd is set<br>\n" if(
defined($passwd) );
print "OpenCA::OpenSSL->dataConvert: inpwd is set<br>\n" if(
defined($inpwd) );
print "OpenCA::OpenSSL->dataConvert: outpwd is set<br>\n" if(
defined($outpwd) );
print "OpenCA::OpenSSL->dataConvert: command=\"".$command."\"<br>\n";
}
if( defined($infile) && $infile ne "" ) {
print "OpenCA::OpenSSL->dataConvert: using infile<br>\n" if
($self->{DEBUG});
$ret=`$command`;
} else {
print "OpenCA::OpenSSL->dataConvert: piping data<br>\n" if
($self->{DEBUG});
print "OpenCA::OpenSSL->dataConvert: data<br>\n$data<br>\n" if
($self->{DEBUG});
open( FD, "|$command" ) or return;
print FD "$data";
close( FD );
}
## return if( $? != 0 );
delete($ENV{'pwd'});
delete($ENV{'pempwd'});
delete($ENV{'inpwd'});
delete($ENV{'outpwd'});
if( exists $keys->{OUTFILE} ) {
unlink ($infile) if ($data);
return 1;
}
$ret = "";
if (not open( TMP, "<$outfile" )) {
unlink ($infile) if ($data);
return undef;
}
while( $tmp = <TMP> ) {
$ret .= $tmp;
}
close( TMP );
unlink ($infile) if ($data);
unlink ($outfile);
return $ret;
}
sub issueCert {
## Use this function to issue a certificate using the
## ca utility. Use this if you already own a valid CA
## certificate. Accepted parameters are:
## REQDATA => $data
## REQFILE => $reqfilename
## INFORM => PEM|DER|NET|SPKAC ; defaults to PEM
## PRESERVE_DN => Y/N ; defaults to Y/N
## CAKEY => $CAkeyfile
## CACERT => $CAcertfile
## DAYS => $days
## PASSWD => $passwd
## EXTS => $extentions
## REQTYPE => NETSCAPE|MSIE
my $self = shift;
my $keys = { @_ };
my $reqdata = $keys->{REQDATA};
my $reqfile = $keys->{REQFILE};
my $inform = $keys->{INFORM};
my $preserve = ( $keys->{PRESERVE_DN} or "N" );
my $cakey = $keys->{CAKEY};
my $days = $keys->{DAYS};
my $startDate= $keys->{START_DATE};
my $endDate = $keys->{END_DATE};
my $passwd = $keys->{PASSWD};
my $exts = $keys->{EXTS};
my $extFile = $keys->{EXTFILE};
my $reqtype = $keys->{REQTYPE};
my $subject = $keys->{SUBJECT};
my $noemail = $keys->{NOEMAILDN};
my $reqfiles =$keys->{REQFILES};
my $outdir =$keys->{OUTDIR};
my $caName = $keys->{CA_NAME};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret, $tmpfile );
#return if( (not $reqdata) and (not $reqfile));
# to make multi certs you need to tell openssl
# what directory to put it.
return if( (not $reqdata) and (not $reqfile) and
((not $reqfiles) and (not $outdir)) );
$inform = "PEM" if( not $inform );
$reqtype = "NETSCAPE" if( not $reqtype );
my $command = "$self->{shell} ca -batch ";
if( $engine ) {
$command .= "-engine $engine ";
}
$command .= "-config " .$self->{cnf}." " if ( $self->{cnf} );
$command .= "-keyfile $cakey " if( $cakey );
$command .= "-passin env:pwd " if ( $passwd ne "" );
$command .= "-days $days " if ( $days );
$command .= "-extfile $extFile " if ( $extFile );
$command .= "-extensions $exts " if ( $exts );
$command .= "-preserveDN " if ( $preserve =~ /Y/i );
$command .= "-startdate $startDate " if ( $startDate );
$command .= "-enddate $endDate " if ( $endDate );
$command .= "-name $caName " if ( $caName );
$command .= "-subj \"$subject\" " if ( $subject );
$command .= "-noemailDN " if ( exists $keys->{NOEMAILDN} );
# this got moved because if -infiles
# is going to be used it has to be the last
# option.
if ( $reqtype =~ /MSIE/i ) {
## $command .= "-msie_hack ";
} elsif ($reqtype =~ /NETSCAPE/i ) {
## Nothing to do...
} else {
return;
}
if( $inform =~ /(PEM|DER|NET)/i ) {
#this has to be the last option
$command .= "-outdir $outdir " if ($outdir);
$command .= "-infiles @$reqfiles" if ($reqfiles);
$command .= "-in $reqfile " if ( $reqfile );
} elsif ( $inform =~ /SPKAC/ ) {
return if ( not $reqfile );
$command .= "-spkac $reqfile ";
} else {
## no valid format received ...
return;
}
print "OpenCA::OpenSSL: openssl command is as follows\n<br>".
"\n$command<br>\n"
if ($self->{DEBUG});
if( $reqfile ne "" ) {
$ENV{'pwd'} = "$passwd";
$ret = `$command`;
$ENV{'pwd'} = "";
return if( $? != 0);
} else {
$ENV{'pwd'} = "$passwd";
open( FD, "|$command" ) or return;
print "$reqdata";
close(FD);
$ENV{'pwd'} = "";
return if( $? != 0);
}
return 1;
}
sub revoke {
## CAKEY => $CAkeyfile (Optional)
## CACERT => $CAcertfile (Optional)
## PASSWD => $passwd (Optional - if not needed)
## INFILE => $certFile (PEM Formatted certificate file);
my $self = shift;
my $keys = { @_ };
my $cakey = $keys->{CAKEY};
my $cacert = $keys->{CACERT};
my $passwd = $keys->{PASSWD};
my $certFile = $keys->{INFILE};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $tmp, $ret );
my $command = "$self->{shell} ca -revoke \"$certFile\" ";
return if (not $certFile);
if( $engine ) {
$command .= "-engine $engine ";
}
$command .= "-config " . $self->{cnf}. " " if ( defined($self->{'cnf'}) &&
$self->{cnf} ne "" );
$command .= "-keyfile $cakey " if( defined($cakey) && $cakey ne "" );
$command .= "-passin env:pwd " if ( defined($passwd) && $passwd ne "" );
## $command .= "-key $passwd " if ( $passwd ne "" );
$command .= "-cert $cacert " if ( defined($cacert) && $cacert ne "" );
$ENV{'pwd'} = "$passwd";
open( FD, "$command|" ) or return;
while( $tmp = <FD> ) {
$ret .= $tmp;
}
close(FD);
#$ENV{'pwd'} = "";
delete( $ENV{'pwd'} ) if( defined($passwd) );
if( $? != 0) {
return;
} else {
return 1;
}
}
sub issueCrl {
## CAKEY => $CAkeyfile
## CACERT => $CAcertfile
## PASSWD => $passwd
## DAYS => $days
## EXTS => $extentions
## OUTFILE => $outfile
## OUTFORM => PEM|DER|NET|TXT
my $self = shift;
my $keys = { @_ };
my $cakey = $keys->{CAKEY};
my $cacert = $keys->{CACERT};
my $days = $keys->{DAYS};
my $passwd = $keys->{PASSWD};
my $outfile = $keys->{OUTFILE};
my $outform = $keys->{OUTFORM};
my $exts = $keys->{EXTS};
my $extfile = $keys->{EXTFILE};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret, $tmp, $tmpfile );
my $command = "$self->{shell} ca -gencrl ";
if( $engine ) {
$command .= "-engine $engine ";
}
if ( not(defined($outfile)) || $outfile eq "" ){
$tmpfile = $self->{tmpDir} . "/${$}_crl.tmp";
} else {
$tmpfile = $outfile;
}
$command .= "-out $tmpfile ";
$command .= "-config " . $self->{cnf}. " " if ( defined($self->{'cnf'}) &&
$self->{cnf} ne "" );
$command .= "-keyfile $cakey " if( defined($cakey) && $cakey ne "" );
$command .= "-passin env:pwd " if ( defined($passwd) && $passwd ne "" );
$command .= "-cert $cacert " if ( defined($cacert) && $cacert ne "" );
$command .= "-crldays $days " if ( defined($days) && $days ne "" );
$command .= "-crlexts $exts " if ( defined($exts) && $exts ne "" );
$command .= "-extfile $extfile " if ( defined($extfile) && $extfile ne "" );
$ENV{'pwd'} = "$passwd";
$ret = `$command`;
delete( $ENV{'pwd'} );
return if( $? != 0);
$ret = $self->dataConvert( INFILE =>$tmpfile,
OUTFORM =>$outform,
DATATYPE=>"CRL" );
return if( not $ret );
if( defined($outfile) && $outfile ne "" ) {
open( FD, ">$outfile" ) or return;
print FD "$ret";
close( FD );
return 1;
}
unlink( $tmpfile );
return "$ret";
}
sub SPKAC {
my $self = shift;
my $keys = { @_ };
my $infile = $keys->{INFILE};
my $outfile = $keys->{OUTFILE};
my $spkac = $keys->{SPKAC};
my $command = $self->{shell} . " spkac -verify ";
my $tmpfile = $self->{tmpDir} . "/${$}_SPKAC.tmp";
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my $ret = "";
my $retVal = 0;
my $tmp;
if( defined($spkac) && $spkac ne "" ) {
$infile = $self->{tmpDir} . "/${$}_in_SPKAC.tmp";
open( FD, ">$infile" ) or return;
print FD "$spkac\n";
close ( FD );
}
if( $engine ) {
$command .= "-engine $engine ";
}
$command .= "-in $infile " if( defined($infile) && $infile ne "" );
if( defined($outfile) && $outfile ne "" ) {
$command .= "-out $outfile ";
} else {
$command .= "-out $tmpfile ";
}
open( FD, "|$command" ) or return;
close( FD );
## Store the ret value
$retVal = $?;
## Unlink the infile if it was temporary
unlink $infile if( defined($spkac) && $spkac ne "");
if( defined($outfile) && $outfile ne "" ) {
return if ( $retVal != 0 );
return 1;
}
## Get the output
open( TMP, "$tmpfile" ) or return;
while ( $tmp = <TMP> ) {
$ret .= $tmp;
}
close( TMP );
unlink $tmpfile if (not(defined($outfile)) || $outfile eq "");
return if ( $retVal != 0 );
return $ret;
}
sub getDigest {
## Returns Digest of the provided message
## DATA=>$data, ALGORITHM=>$alg
my $self = shift;
my $keys = { @_ };
my $data = $keys->{DATA};
my $alg = lc( $keys->{ALGORITHM} );
my $tmpfile = $self->{tmpDir} . "/${$}_dgst.tmp";
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $command, $ret );
$alg = "md5" if( not $alg );
return if (not $data);
open( FD, ">$tmpfile" ) or return;
print FD $data;
close( FD );
$command = "$self->{shell} dgst -$alg ";
if( defined($engine) and ($engine ne "")) {
$command .= "-engine $engine ";
}
$command .= "<\"$tmpfile\"";
$ret = `$command`;
$ret =~ s/\n//g;
unlink( $tmpfile );
if( $? != 0 ) {
return;
} else {
return $ret;
}
}
sub verify {
## Verify PKCS7 signatures (new OpenCA::verify command
## should be used )
my $self = shift;
my $keys = { @_ };
my $data = $keys->{DATA};
my $infile = $keys->{DATA_FILE};
my $sig = $keys->{SIGNATURE};
my $sigfile = $keys->{SIGNATURE_FILE};
my $cacert = $keys->{CA_CERT};
my $cadir = $keys->{CA_DIR};
my $verbose = $keys->{VERBOSE};
my $out = $keys->{OUTFILE};
my $noChain = $keys->{NOCHAIN};
my $tmpfile = $self->{tmpDir} . "/${$}_vrfy.tmp";
my $command = $self->{verify} . " ";
my ( $ret, $tmp );
return if( (not $data) and (not $infile) );
if (not $infile) {
$infile = $self->{tmpDir} . "/${$}_data.tmp";
open FD, ">".$infile;
print FD $data;
close FD;
} else {
$data = 0;
}
$command .= "-verbose " if ( $verbose );
$command .= "-cf $cacert " if ( $cacert );
$command .= "-cd $cadir " if ($cadir);
$command .= "-data $infile " if ($infile);
$command .= ">\"$out\" " if ( $out );
$command .= "-no_chain " if ( $noChain and not($cacert or $cadir));
$command .= "-in $sigfile" if ( $sigfile );
## if( $sigfile ) {
## open( SIG, "<$sigfile" ) or return;
## while( not eof( SIG ) ) {
## $sig .= <SIG>;
## }
## close( SIG );
## }
if( not $out ) {
$command .= " >\"$tmpfile\"";
}
$command .= " 2>\&1";
open( FD, "|$command" ) or return;
if( (defined($sig)) and ($sig ne "") ) {
print FD "$sig";
}
close( FD );
$self->{errno} = $?;
unlink( $infile ) if ($data);
$ret = "";
open( TMP, "<$tmpfile" ) or return;
while( not eof ( TMP ) ) {
$ret .= <TMP>;
}
close( TMP );
if ( $self->{errno} ) {
unlink( $tmpfile ) if (not $out);
( $self->{errno}, $self->{errval} ) =
( $ret =~ /Verify Error\s*(.*?)\s*:\s*(.*?)\n/ );
return;
}
if( not $out) {
unlink( $tmpfile );
return $ret;
} else {
return 1;
}
}
sub sign {
## Generate a PKCS7 signature.
my $self = shift;
my $keys = { @_ };
my $data = $keys->{DATA};
my $datafile= $keys->{DATA_FILE};
my $out = $keys->{OUT_FILE};
my $certfile= $keys->{CERT_FILE};
my $cert = $keys->{CERT};
my $keyfile = $keys->{KEY_FILE};
my $key = $keys->{KEY};
my $nonDetach = $keys->{INCLUDE_DATA};
my $pwd = ( $keys->{PWD} or $keys->{PASSWD} );
my $tmpfile = $self->{tmpDir} . "/${$}_sign.tmp";
my $command = $self->{sign} . " ";
my ( $ret );
return if( (not $data) and (not $datafile) );
return if( (not $cert) and (not $certfile) );
return if( (not $key) and (not $keyfile) );
$ENV{pwd} = "$pwd" if ( $pwd );
if ( not $datafile ) {
$datafile = $self->{tmpDir} . "/${$}_data.tmp";
open FD, ">".$datafile;
print FD $data;
close FD;
} else {
$data = 0;
}
if ( not $keyfile ) {
$keyfile = $self->{tmpDir} . "/${$}_key.tmp";
open FD, ">".$keyfile;
print FD $key;
close FD;
} else {
$key = 0;
}
if ( not $certfile ) {
$certfile = $self->{tmpDir} . "/${$}_cert.tmp";
open FD, ">".$certfile;
print FD $cert;
close FD;
} else {
$cert = 0;
}
$command .= "-in $datafile ";
$command .= "-out $out " if ( $out );
$command .= "-passin env:pwd " if ( $pwd );
$command .= "-nd " if ( $nonDetach );
$command .= "-cert $certfile ";
$command .= " -keyfile $keyfile ";
if( not $out) {
$command .= " >$tmpfile";
};
print "OpenCA::OpenSSL: the command is as follows<br>\n".
"$command<br>\n"
if ($self->{DEBUG});
$ret =`$command`;
if ( $? ) {
unlink( $tmpfile ) if (not $out);
unlink( $datafile ) if ($data);
unlink( $keyfile ) if ($key);
unlink( $certfile ) if ($cert);
return;
}
unlink( $datafile ) if ($data);
unlink( $keyfile ) if ($key);
unlink( $certfile ) if ($cert);
if( not $out ) {
open( TMP, "<$tmpfile" ) or return;
do {
$ret .= <TMP>;
} while (not eof($ret));
close(TMP);
unlink( $tmpfile );
}
## If we are here there have been no errors, so
## if $ret is empty, let's return a true value...
$ret = 1 if ( not $ret );
return $ret;
}
sub getCertAttribute {
my $self = shift;
my $keys = { @_ };
my $cert = ( $keys->{DATA} or $keys->{FILE} );
my $inform = ( $keys->{INFORM} or "PEM" );
my @attribute = ();
if( exists($keys->{ATTRIBUTE_LIST}) && ref($keys->{ATTRIBUTE_LIST}) ) {
@attribute = @{$keys->{ATTRIBUTE_LIST}};
} else {
@attribute = ( $keys->{ATTRIBUTE} );
}
my $cmd = "$self->{shell} x509 -noout ";
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret );
my $tmpfile = $self->{tmpDir} . "/${$}_ATTRIBUTE.tmp";
if( exists $keys->{FILE} ) {
$cmd .= "-in \"$cert\" ";
} elsif ( exists $keys->{DATA} ) {
$cmd .= "-in \"$tmpfile\" ";
open ( FD, ">$tmpfile" ) or return;
print FD "$cert";
close( FD );
} else {
return;
}
foreach my $attribute ( @attribute ) {
$attribute = "startdate" if( uc ($attribute) eq "NOTBEFORE" );
$attribute = "enddate" if( uc ($attribute) eq "NOTAFTER" );
$attribute = "subject" if( uc ($attribute) eq "DN" );
$attribute = "pubkey" if( uc ($attribute) eq "PUBKEY" );
$attribute = lc($attribute);
$cmd .= "-$attribute ";
}
if( defined($engine) and ($engine ne "") ) {
$cmd .= "-engine $engine ";
}
$ret = `$cmd`;
my @ret = split /\n/, $ret;
my $return = {};
my $i=0;
foreach( @attribute ) {
$_ = uc($_);
if( $_ eq 'SUBJECT' ) {
$_ = 'DN';
} elsif( $_ eq 'STARTDATE' ) {
$_ = 'NOTBEFORE';
} elsif( $_ eq 'ENDDATE' ) {
$_ = 'NOTAFTER';
} elsif($_ eq 'PUBKEY') {
do {
$return->{$_} .= $ret[$i] . "\n";
} while( $ret[$i] and $ret[++$i] !~ /^-----END PUBLIC
KEY-----/ );
}
$return->{$_} .= $ret[$i++];
}
unlink( $tmpfile );
if ( $? != 0 ) {
return;
} else {
foreach ( keys(%$return) ) {
next if ( $_ eq "PUBKEY" );
$return->{$_} =~ s/(.*?)=[\s]*//;
$return->{$_} =~ s/$(\n|\r)//;
}
return
(ref($keys->{ATTRIBUTE_LIST}))?($return):($return->{$attribute[0]});
}
}
sub getReqAttribute {
my $self = shift;
my $keys = { @_ };
my $req = ( $keys->{DATA} or $keys->{FILE} );
my $inform = ( $keys->{FORMAT} or $keys->{INFORM} or "PEM" );
my @attribute = ();
my ( $cmd );
if( exists($keys->{ATTRIBUTE_LIST}) && ref($keys->{ATTRIBUTE_LIST}) ) {
@attribute = @{$keys->{ATTRIBUTE_LIST}};
} else {
@attribute = ( $keys->{ATTRIBUTE} );
}
if( $inform =~ /SPKAC/ ) {
$cmd = "$self->{shell} spkac -noout ";
} else {
$cmd = "$self->{shell} req -noout ";
if ( defined($self->{cnf}) && $self->{cnf} ne "" ) {
$cmd .= "-config " . $self->{cnf} . " ";
}
}
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret );
my $tmpfile = $self->{tmpDir} . "/${$}_ATTRIBUTE.tmp";
if( exists $keys->{FILE} ) {
$cmd .= "-in \"$req\" ";
} elsif ( exists $keys->{DATA} ) {
$cmd .= "-in \"$tmpfile\" ";
open ( FD, ">$tmpfile" ) or return;
print FD "$req";
close( FD );
} else {
return;
}
foreach my $attribute ( @attribute ) {
$attribute = "startdate" if( uc ($attribute) eq "NOTBEFORE" );
$attribute = "enddate" if( uc ($attribute) eq "NOTAFTER" );
$attribute = "subject" if( uc ($attribute) eq "DN" );
$attribute = "pubkey" if( uc ($attribute) eq "PUBKEY");
$attribute = lc($attribute);
$cmd .= "-$attribute ";
}
if( defined($engine) and ($engine ne "") ) {
$cmd .= "-engine $engine ";
}
$ret = `$cmd`;
my $return = {};
my $i=0;
my @ret = split /\n/, $ret;
foreach( @attribute ) {
$_ = uc($_);
if( $_ eq 'SUBJECT' ) {
$_ = 'DN';
} elsif( $_ eq 'STARTDATE' ) {
$_ = 'NOTBEFORE';
} elsif( $_ eq 'ENDDATE' ) {
$_ = 'NOTAFTER';
} elsif($_ eq 'PUBKEY') {
do {
$return->{$_} .= $ret[$i] . "\n";
} while( $ret[$i] and $ret[++$i] !~ /^-----END PUBLIC
KEY-----/ );
}
$return->{$_} .= $ret[$i++];
}
# unlink( $tmpfile );
if ( $? != 0 ) {
return;
} else {
foreach ( keys(%$return) ) {
next if ( $_ eq "PUBKEY" );
$return->{$_} =~ s/(.*?)=[\s]*//;
$return->{$_} =~ s/$(\n|\r)//;
}
return
(ref($keys->{ATTRIBUTE_LIST}))?($return):($return->{$attribute[0]});
}
}
sub pkcs7Certs {
my $self = shift;
my $keys = { @_ };
my $infile = $keys->{INFILE};
my $outfile = $keys->{OUTFILE};
my $pkcs7 = $keys->{PKCS7};
my $command = $self->{shell} . " pkcs7 -print_certs ";
my $tmpfile = $self->{tmpDir} . "/${$}_SPKAC.tmp";
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my $ret = "";
my $retVal = 0;
my $tmp;
$self->{errno} = 0;
if( defined($pkcs7) && $pkcs7 ne "" ) {
$infile = $self->{tmpDir} . "/${$}_in_SPKAC.tmp";
open( FD, ">$infile" ) or return;
print FD "$pkcs7\n";
close ( FD );
}
if( defined($engine) and ($engine ne "")) {
$command .= "-engine $engine ";
}
$command .= "-in $infile " if( defined($infile) && $infile ne "" );
if( defined($outfile) && $outfile ne "" ) {
$command .= "-out $outfile ";
} else {
$command .= "-out $tmpfile ";
}
$ret = `$command 2>&1`;
if( $? > 0 ) {
$self->{errno} = "$?";
$self->{errval} = "$ret";
}
## Unlink the infile if it was temporary
unlink $infile if( defined($pkcs7) && $pkcs7 ne "");
## Get the output
open( TMP, "$tmpfile" ) or return;
while ( $tmp = <TMP> ) {
$ret .= $tmp;
}
close( TMP );
unlink $tmpfile if (not (defined($outfile)) or $outfile eq "");
if ( $self->{errno} != 0 ) {
return;
} else {
return $ret;
}
}
sub updateDB {
my $self = shift;
my $keys = { @_ };
my $cakey = $keys->{CAKEY};
my $cacert = $keys->{CACERT};
my $passwd = $keys->{PASSWD};
my $outfile = $keys->{OUTFILE};
my ( $ret, $tmp );
my $command = "$self->{shell} ca -updatedb ";
$command .= "-config " . $self->{cnf}. " " if ( defined($self->{'cnf'}) &&
$self->{cnf} ne "" );
$command .= "-keyfile $cakey " if( defined($cakey) && $cakey ne "" );
$command .= "-passin env:pwd " if ( defined($passwd) && $passwd ne "" );
$command .= "-cert $cacert " if ( defined($cacert) && $cacert ne "" );
$ENV{'pwd'} = "$passwd";
$ret = `$command`;
delete( $ENV{'pwd'} );
return if( $? != 0);
if( defined($outfile) && $outfile ne "" ) {
open( FD, ">$outfile" ) or return;
print FD "$ret";
close( FD );
return 1;
}
return "$ret";
}
sub getSMIME {
## ENCRYPT => a true value
## SIGN => a true value
## ENCRYPT_CERT => $enc_cert
## SIGN_CERT => $sign_cert
## SIGN_KEY => $sign_key
## SIGN_PASSWD => $sign_passwd
## INFILE => $infile
## OUTFILE => $outfile
## DATA => $message
## MESSAGE => $message (higher priority)
## ENGINE => openssl engine
## TO => $to
## FROM => $from
## SUBJECT => $subject
my $self = shift;
my $keys = { @_ };
my $encrypt = $keys->{ENCRYPT};
my $sign = $keys->{SIGN};
my $enc_cert = $keys->{ENCRYPT_CERT};
my $sign_cert = $keys->{SIGN_CERT};
my $sign_key = $keys->{SIGN_KEY};
my $sign_passwd = $keys->{SIGN_PASSWD};
my $infile = $keys->{INFILE};
my $outfile = $keys->{OUTFILE};
my $message = $keys->{DATA};
my $message = $keys->{MESSAGE};
my $to = $keys->{TO};
my $from = $keys->{FROM};
my $subject = $keys->{SUBJECT};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret, $tmp, $tmpfile );
## setup file with smime-message
if ($outfile) {
$tmpfile = $outfile;
} else {
$tmpfile = $self->{tmpDir}."/".$$."_SMIME.msg";
}
my $command = "$self->{shell} smime ";
if ($infile) {
$command .= " -in $infile ";
}
## 1. signing
if ($sign) {
$command .= " -sign ".
" -text ".
" -signer $sign_cert ".
" -inkey $sign_key ".
" -passin env:pwd ";
if (not $encrypt) {
$command .= " -to \"$to\" ".
" -from \"$from\" ".
" -subject \"$subject\" ";
}
if( $engine ) {
$command .= " -engine $engine ";
}
}
## 2. encrypt
if ($encrypt) {
if ($sign) {
$command .= " | $self->{shell} smime ";
}
if( $engine ) {
$command .= " -engine $engine ";
}
$command .= " -encrypt ".
" -to \"$to\" ".
" -from \"$from\" ".
" -subject \"$subject\" ".
" -des3 ";
}
# set outputfile
$command .= " -out $tmpfile ";
## 2. encrypt
if ($encrypt) {
$command .= " $enc_cert ";
}
print "OpenCA::OpenSSL: getSMIME<br>\n".
"command is as follows<br>\n".
"$command<br>\n"
if ($self->{DEBUG});
print "OpenCA::OpenSSL: getSMIME<br>\n".
"message is as follows<br>\n".
"$message<br>\n"
if ($self->{DEBUG} && not ( defined $infile && $infile ne "" ));
## execute command
$ENV{'pwd'} = "$sign_passwd";
if( defined($infile) && $infile ne "" ) {
$ret=`$command`;
} else {
open( FD, "|$command" ) or return;
print FD "$message";
close( FD );
}
print "OpenCA::OpenSSL: getSMIME: FD does not fail<br>\n"
if ($self->{DEBUG});
print "OpenCA::OpenSSL: getSMIME: last errorcode=".$?."<br>\n"
if ($self->{DEBUG});
## check the errorcode
return if( $? != 0);
## if the caller want a file then we can finish
if( defined($outfile) && $outfile ne "" ) {
return 1;
}
print "OpenCA::OpenSSL: getSMIME: load tmpfile<br>\n"
if ($self->{DEBUG});
## load the output
$ret = "";
open( TMP, "$tmpfile" ) or return;
while ( $tmp = <TMP> ) {
$ret .= $tmp;
}
close( TMP );
unlink $tmpfile;
print "OpenCA::OpenSSL: getSMIME: succeeded<br>\n"
if ($self->{DEBUG});
print "OpenCA::OpenSSL: getSMIME: ret: $ret<br>\n"
if ($self->{DEBUG});
return $ret;
}
sub getPIN {
## PIN_LENGTH => $pin_length
## RANDOM_LENGTH => $random_length
## LENGTH => $pin_length
## ENGINE => openssl engine
my $self = shift;
my $keys = { @_ };
my $pin_length = $keys->{PIN_LENGTH};
my $length = $keys->{RANDOM_LENGTH};
my $pin_length = $keys->{LENGTH};
my $engine = ( $ENV{'engine'} or $keys->{ENGINE} );
my ( $ret, $tmp, $tmpfile );
my $command = "$self->{shell} rand -base64 ";
if( $engine ) {
$command .= " -engine $engine ";
}
if ($length) {
$command .= $length;
} elsif ($pin_length) {
$command .= $pin_length;
} else {
return undef;
}
## create the PIN
my $pin;
open (FD, "$command|") or return;
if ($pin_length) {
## enforce the PIN-length
## SECURITY ADVICE: it is more secure to only set the
## number of randombytes
read FD, $pin, $pin_length;
} else {
## 2*$length is enough to encode $length randombytes in base64
read FD, $pin, 2*$length;
}
## remove trailing newline
$pin =~ s/\n//g;
if ($pin) {
return $pin;
} else {
return undef;
}
}
sub getOpenSSLDate {
my $self = shift;
my $date = $self->getNumericDate ( $_[0] );
return undef if (not defined $date);
## remove century
$date =~ s/^..//;
## add trailing Z
$date .= "Z";
return $date;
}
sub getNumericDate {
my $self = shift;
my $date = $_[0];
my %help;
my $new_date;
## remove leading days like SUN or MON
if ( $date =~ /^[^ ]+ +(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)/i ) {
$date =~ s/^[^ ]+//;
}
## Mar 10 19:36:45 2001 GMT
## Month
if ( $date =~ /^ *JAN/i ) {
## january
$help {MONTH} = "01";
} elsif ( $date =~ /^ *FEB/i ) {
## february
$help {MONTH} = "02";
} elsif ( $date =~ /^ *MAR/i ) {
## march
$help {MONTH} = "03";
} elsif ( $date =~ /^ *APR/i ) {
## april
$help {MONTH} = "04";
} elsif ( $date =~ /^ *MAY/i ) {
## may
$help {MONTH} = "05";
} elsif ( $date =~ /^ *JUN/i ) {
## june
$help {MONTH} = "06";
} elsif ( $date =~ /^ *JUL/i ) {
## july
$help {MONTH} = "07";
} elsif ( $date =~ /^ *AUG/i ) {
## august
$help {MONTH} = "08";
} elsif ( $date =~ /^ *SEP/i ) {
## september
$help {MONTH} = "09";
} elsif ( $date =~ /^ *OCT/i ) {
## october
$help {MONTH} = "10";
} elsif ( $date =~ /^ *NOV/i ) {
## november
$help {MONTH} = "11";
} elsif ( $date =~ /^ *DEC/i ) {
## december
$help {MONTH} = "12";
} else {
## return illegal
return undef;
}
## day
$date =~ s/^ *//;
$date = substr ($date, 4, length ($date)-4);
$help {DAY} = substr ($date, 0, 2);
$help {DAY} =~ s/ /0/;
## hour
$help {HOUR} = substr ($date, 3, 2);
## minute
$help {MINUTE} = substr ($date, 6, 2);
## second
$help {SECOND} = substr ($date, 9, 2);
## year
$help {YEAR} = substr ($date, 12, 4);
## build date
$new_date = $help {YEAR}.
$help {MONTH}.
$help {DAY}.
$help {HOUR}.
$help {MINUTE}.
$help {SECOND};
return $new_date;
}
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
