You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1261 lines
33 KiB
1261 lines
33 KiB
# Copyright (c) Stephan Martin <sm@sm-zone.net>
|
|
#
|
|
# $Id: OpenSSL.pm,v 1.14 2006/07/13 22:36:13 sm Exp $
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111, USA.
|
|
|
|
use strict;
|
|
|
|
package OpenSSL;
|
|
|
|
use POSIX;
|
|
use IPC::Open3;
|
|
use IO::Select;
|
|
use Time::Local;
|
|
|
|
sub new {
|
|
my $self = {};
|
|
my ($that, $opensslbin, $tmpdir) = @_;
|
|
my $class = ref($that) || $that;
|
|
|
|
$self->{'bin'} = $opensslbin;
|
|
my $t = sprintf("Can't execute OpenSSL: %s", $self->{'bin'});
|
|
GUI::HELPERS::print_error($t)
|
|
if (! -x $self->{'bin'});
|
|
|
|
$self->{'tmp'} = $tmpdir;
|
|
|
|
open(TEST, "$self->{'bin'} version|");
|
|
my $v = <TEST>;
|
|
close(TEST);
|
|
|
|
# set version (format: e.g. 0.9.7 or 0.9.7a)
|
|
if($v =~ /\b(\d\.\d\.\d[a-z]?)\b/) {
|
|
$self->{'version'} = $1;
|
|
} else {
|
|
chomp $v;
|
|
print STDERR "Can't get OpenSSL version from '$v'\n";
|
|
$self->{'version'} = '*unknown*';
|
|
}
|
|
|
|
# CRL output was broken before openssl 0.9.7f
|
|
if($v =~ /\b0\.9\.[0-6][a-z]?\b/ || $v =~ /\b0\.9\.7[a-e]?\b/) {
|
|
$self->{'broken'} = 1;
|
|
} else {
|
|
$self->{'broken'} = 0;
|
|
}
|
|
|
|
bless($self, $class);
|
|
}
|
|
|
|
sub newkey {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($cmd, $ext, $c, $i, $box, $bar, $t, $param, $pid, $ret);
|
|
|
|
if(defined($opts->{'algo'}) && $opts->{'algo'} eq "dsa") {
|
|
$param = HELPERS::mktmp($self->{'tmp'}."/param");
|
|
|
|
$cmd = "$self->{'bin'} dsaparam";
|
|
$cmd .= " -out $param";
|
|
$cmd .= " $opts->{'bits'}";
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
$t = _("Creating DSA key in progress...");
|
|
($box, $bar) = GUI::HELPERS::create_activity_bar($t);
|
|
$i = 0;
|
|
while(defined($c = getc($rdfh))) {
|
|
$ext .= $c;
|
|
$bar->pulse();
|
|
while(Gtk2->events_pending) {
|
|
Gtk2->main_iteration;
|
|
}
|
|
}
|
|
$box->destroy();
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
return($ret, $ext) if($ret);
|
|
|
|
$cmd = "$self->{'bin'} gendsa";
|
|
$cmd .= " -des3";
|
|
$cmd .= " -passout env:SSLPASS";
|
|
$cmd .= " -out \"$opts->{'outfile'}\"";
|
|
$cmd .= " $param";
|
|
} else {
|
|
$cmd = "$self->{'bin'} genrsa";
|
|
$cmd .= " -des3";
|
|
$cmd .= " -passout env:SSLPASS";
|
|
|
|
$cmd .= " -out \"$opts->{'outfile'}\"";
|
|
|
|
$cmd .= " $opts->{'bits'}";
|
|
}
|
|
|
|
$ENV{'SSLPASS'} = $opts->{'pass'};
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
$t = _("Creating RSA key in progress...");
|
|
($box, $bar) = GUI::HELPERS::create_activity_bar($t);
|
|
$i = 0;
|
|
while(defined($c = getc($rdfh))) {
|
|
$ext .= $c;
|
|
#$bar->update(($i++%100)/100);
|
|
$bar->pulse();
|
|
while(Gtk2->events_pending) {
|
|
Gtk2->main_iteration;
|
|
}
|
|
}
|
|
$box->destroy();
|
|
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
if(defined($param) && $param ne '') {
|
|
unlink($param);
|
|
}
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub signreq {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($ext, $cmd, $pid, $ret);
|
|
|
|
$cmd = "$self->{'bin'} ca -batch";
|
|
$cmd .= " -passin env:SSLPASS -notext";
|
|
$cmd .= " -config $opts->{'config'}";
|
|
$cmd .= " -name $opts->{'caname'}" if($opts->{'caname'} ne "");
|
|
$cmd .= " -in \"$opts->{'reqfile'}\"";
|
|
$cmd .= " -days $opts->{'days'}";
|
|
$cmd .= " -preserveDN";
|
|
if($opts->{'digest'}){
|
|
if (lc $opts->{'digest'} eq 'sha1') {
|
|
# force sha256 instead of deprecated sha1
|
|
$opts->{'digest'} = "sha256";
|
|
}
|
|
$cmd .= " -md $opts->{'digest'}";
|
|
};
|
|
|
|
if(defined($opts->{'mode'}) && $opts->{'mode'} eq "sub") {
|
|
$cmd .= " -keyfile \"$opts->{'keyfile'}\"";
|
|
$cmd .= " -cert \"$opts->{'cacertfile'}\"";
|
|
$cmd .= " -outdir \"$opts->{'outdir'}\"";
|
|
$ENV{'SSLPASS'} = $opts->{'parentpw'};
|
|
} else {
|
|
$ENV{'SSLPASS'} = $opts->{'pass'};
|
|
}
|
|
|
|
if(defined($opts->{'sslservername'}) && $opts->{'sslservername'} ne 'none') {
|
|
$ENV{'NSSSLSERVERNAME'} = $opts->{'sslservername'};
|
|
}
|
|
if(defined($opts->{'revocationurl'}) && $opts->{'revocationurl'} ne 'none') {
|
|
$ENV{'NSREVOCATIONURL'} = $opts->{'revocationurl'};
|
|
}
|
|
if(defined($opts->{'renewalurl'}) && $opts->{'renewalurl'} ne 'none') {
|
|
$ENV{'NSRENEWALURL'} = $opts->{'renewalurl'};
|
|
}
|
|
if($opts->{'subjaltname'} ne 'none' &&
|
|
$opts->{'subjaltname'} ne 'emailcopy') {
|
|
if($opts->{'subjaltnametype'} eq 'ip') {
|
|
$ENV{'SUBJECTALTNAMEIP'} = HELPERS::gen_subjectaltname_contents('IP:', $opts->{'subjaltname'});
|
|
}elsif($opts->{'subjaltnametype'} eq 'dns') {
|
|
$ENV{'SUBJECTALTNAMEDNS'} = HELPERS::gen_subjectaltname_contents('DNS:', $opts->{'subjaltname'});
|
|
}elsif($opts->{'subjaltnametype'} eq 'mail') {
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = HELPERS::gen_subjectaltname_contents('email:', $opts->{'subjaltname'});
|
|
}elsif($opts->{'subjaltnametype'} eq 'raw') {
|
|
$ENV{'SUBJECTALTNAMERAW'} = HELPERS::gen_subjectaltname_contents(undef, $opts->{'subjaltname'});
|
|
}
|
|
}
|
|
if($opts->{'extendedkeyusage'} ne 'none') {
|
|
$ENV{'EXTENDEDKEYUSAGE'} = $opts->{'extendedkeyusage'};
|
|
}
|
|
|
|
if(defined($opts->{'noemaildn'}) && $opts->{'noemaildn'}) {
|
|
$cmd .= " -noemailDN";
|
|
}
|
|
|
|
# print STDERR "DEBUG call cmd: $cmd\n";
|
|
|
|
my($rdfh, $wtfh);
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
$ext = "$cmd\n\n";
|
|
while(<$rdfh>) {
|
|
# print STDERR "DEBUG cmd returns: $_\n";
|
|
$ext .= $_;
|
|
if($_ =~ /unable to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
$ENV{'NSSSLSERVERNAME'} = 'dummy';
|
|
$ENV{'NSREVOCATIONURL'} = 'dummy';
|
|
$ENV{'NSRENEWALURL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEIP'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEDNS'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMERAW'} = 'dummy';
|
|
$ENV{'EXTENDEDKEYUSAGE'} = 'dummy';
|
|
waitpid($pid, 0);
|
|
return(1, $ext);
|
|
} elsif($_ =~ /trying to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
$ENV{'NSSSLSERVERNAME'} = 'dummy';
|
|
$ENV{'NSREVOCATIONURL'} = 'dummy';
|
|
$ENV{'NSRENEWALURL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEIP'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEDNS'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMERAW'} = 'dummy';
|
|
$ENV{'EXTENDEDKEYUSAGE'} = 'dummy';
|
|
waitpid($pid, 0);
|
|
return(2, $ext);
|
|
} elsif($_ =~ /There is already a certificate for/) {
|
|
delete($ENV{'SSLPASS'});
|
|
$ENV{'NSSSLSERVERNAME'} = 'dummy';
|
|
$ENV{'NSREVOCATIONURL'} = 'dummy';
|
|
$ENV{'NSRENEWALURL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEIP'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEDNS'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMERAW'} = 'dummy';
|
|
$ENV{'EXTENDEDKEYUSAGE'} = 'dummy';
|
|
waitpid($pid, 0);
|
|
return(3, $ext);
|
|
} elsif($_ =~ /bad ip address/) {
|
|
delete($ENV{'SSLPASS'});
|
|
$ENV{'NSSSLSERVERNAME'} = 'dummy';
|
|
$ENV{'NSREVOCATIONURL'} = 'dummy';
|
|
$ENV{'NSRENEWALURL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEIP'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEDNS'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMERAW'} = 'dummy';
|
|
$ENV{'EXTENDEDKEYUSAGE'} = 'dummy';
|
|
waitpid($pid, 0);
|
|
return(4, $ext);
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
$ENV{'NSSSLSERVERNAME'} = 'dummy';
|
|
$ENV{'NSREVOCATIONURL'} = 'dummy';
|
|
$ENV{'NSRENEWALURL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEIP'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEDNS'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMEEMAIL'} = 'dummy';
|
|
$ENV{'SUBJECTALTNAMERAW'} = 'dummy';
|
|
$ENV{'EXTENDEDKEYUSAGE'} = 'dummy';
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub revoke {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($ext, $cmd, $ret, $pid);
|
|
|
|
$cmd = "$self->{'bin'} ca";
|
|
$cmd .= " -passin env:SSLPASS";
|
|
|
|
$cmd .= " -config $opts->{'config'}";
|
|
$cmd .= " -revoke $opts->{'infile'}";
|
|
|
|
if($opts->{'reason'} ne 'none') {
|
|
$cmd .= " -crl_reason $opts->{'reason'}";
|
|
}
|
|
|
|
$ENV{'SSLPASS'} = $opts->{'pass'};
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
if($_ =~ /unable to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
waitpid($pid, 0);
|
|
return(1, $ext);
|
|
} elsif($_ =~ /trying to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
waitpid($pid, 0);
|
|
return(2, $ext);
|
|
} elsif($_ =~ /^ERROR:/) {
|
|
delete($ENV{'SSLPASS'});
|
|
waitpid($pid, 0);
|
|
return(3, $ext);
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub newreq {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($ext, $ret, $cmd, $pid);
|
|
|
|
$cmd = "$self->{'bin'} req -new";
|
|
$cmd .= " -keyform PEM";
|
|
$cmd .= " -outform PEM";
|
|
$cmd .= " -passin env:SSLPASS";
|
|
|
|
$cmd .= " -config $opts->{'config'}";
|
|
$cmd .= " -out $opts->{'outfile'}";
|
|
$cmd .= " -key $opts->{'keyfile'}";
|
|
$cmd .= " -"."$opts->{'digest'}";
|
|
|
|
$ENV{'SSLPASS'} = $opts->{'pass'};
|
|
print "DEBUG call: $cmd\n";
|
|
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
|
|
foreach(@{$opts->{'dn'}}) {
|
|
print "DEBUG: add to dn: $_\n";
|
|
if(defined($_)) {
|
|
print $wtfh "$_\n";
|
|
} else {
|
|
print $wtfh ".\n";
|
|
}
|
|
}
|
|
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
print "DEBUG return: $ext\n";
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub newcert {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($ext, $cmd, $ret, $pid);
|
|
|
|
$cmd = "$self->{'bin'} req -x509";
|
|
$cmd .= " -keyform PEM";
|
|
$cmd .= " -outform PEM";
|
|
$cmd .= " -passin env:SSLPASS";
|
|
|
|
$cmd .= " -config $opts->{'config'}";
|
|
$cmd .= " -out \"$opts->{'outfile'}\"";
|
|
$cmd .= " -key \"$opts->{'keyfile'}\"";
|
|
$cmd .= " -in \"$opts->{'reqfile'}\"";
|
|
$cmd .= " -days $opts->{'days'}";
|
|
$cmd .= " -"."$opts->{'digest'}";
|
|
|
|
$ENV{'SSLPASS'} = $opts->{'pass'};
|
|
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub newcrl {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($out, $ext, $tmpfile, $cmd, $ret, $pid, $crl);
|
|
|
|
$tmpfile = HELPERS::mktmp($self->{'tmp'}."/crl");
|
|
$cmd = "$self->{'bin'} ca -gencrl";
|
|
$cmd .= " -passin env:SSLPASS";
|
|
$cmd .= " -config $opts->{'config'}";
|
|
|
|
$cmd .= " -out $tmpfile";
|
|
$cmd .= " -crldays $opts->{'crldays'}";
|
|
|
|
$ENV{'SSLPASS'} = $opts->{ 'pass'};
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
#print STDERR "DEBUG: cmd: $cmd";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
#print STDERR "DEBUG: cmd return: $_";
|
|
if($_ =~ /unable to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
waitpid($pid, 0);
|
|
return(1, $ext);
|
|
} elsif($_ =~ /trying to load CA private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
waitpid($pid, 0);
|
|
return(2, $ext);
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $?>>8;
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext) if($ret);
|
|
|
|
$crl = $self->parsecrl($tmpfile, 1);
|
|
unlink( $tmpfile);
|
|
|
|
$opts->{'format'} = 'PEM' if ( !defined( $opts->{ 'format'}));
|
|
if($opts->{'format'} eq 'PEM') {
|
|
$out = $crl->{'PEM'};
|
|
} elsif ($opts->{'format'} eq 'DER') {
|
|
$out = $crl->{'DER'};
|
|
} elsif ($opts->{'format'} eq 'TXT') {
|
|
$out = $crl->{'TXT'};
|
|
} else {
|
|
$out = $crl->{'PEM'};
|
|
}
|
|
|
|
unlink( $opts->{'outfile'});
|
|
open(OUT, ">$opts->{'outfile'}") or return;
|
|
print OUT $out;
|
|
close OUT;
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub parsecrl {
|
|
my ($self, $file, $force) = @_;
|
|
|
|
my $tmp = {};
|
|
my (@lines, $i, $t, $ext, $ret);
|
|
|
|
# check if crl is cached
|
|
if($self->{'CACHE'}->{$file} && not $force) {
|
|
return($self->{'CACHE'}->{$file});
|
|
}
|
|
delete($self->{'CACHE'}->{$file});
|
|
|
|
open(IN, $file) || do {
|
|
$t = sprintf(_("Can't open CRL '%s': %s"), $file, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
|
|
# convert crl to PEM, DER and TEXT
|
|
$tmp->{'PEM'} .= $_ while(<IN>);
|
|
($ret, $tmp->{'TXT'}, $ext) = $self->convdata(
|
|
'cmd' => 'crl',
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'TEXT'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting CRL");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
($ret, $tmp->{'DER'}, $ext) = $self->convdata(
|
|
'cmd' => 'crl',
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'DER'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting CRL");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
# get "normal infos"
|
|
if ($tmp->{'TXT'}) {
|
|
@lines = split(/\n/, $tmp->{'TXT'});
|
|
} else {
|
|
@lines = ();
|
|
}
|
|
foreach(@lines) {
|
|
if ($_ =~ /Signature Algorithm.*: (\w+)/i) {
|
|
$tmp->{'SIG_ALGORITHM'} = $1;
|
|
} elsif ($_ =~ /Issuer: (.+)/i) {
|
|
$tmp->{'ISSUER'} = $1;
|
|
$tmp->{'ISSUER'} =~ s/,/\//g;
|
|
$tmp->{'ISSUER'} =~ s/\/ /\//g;
|
|
$tmp->{'ISSUER'} =~ s/^\///;
|
|
} elsif ($_ =~ /Last Update.*: (.+)/i) {
|
|
$tmp->{'LAST_UPDATE'} = $1;
|
|
} elsif ($_ =~ /Next Update.*: (.+)/i) {
|
|
$tmp->{'NEXT_UPDATE'} = $1;
|
|
}
|
|
}
|
|
|
|
# get revoked certs
|
|
$tmp->{'LIST'} = [];
|
|
for($i = 0;
|
|
($i < scalar(@lines)) &&
|
|
($lines[$i] !~ /^[\s\t]*Revoked Certificates:$/i);
|
|
$i++) {
|
|
$self->{'CACHE'}->{$file} = $tmp;
|
|
return($tmp) if ($lines[$i] =~ /No Revoked Certificates/i);
|
|
}
|
|
$i++;
|
|
|
|
while($i < @lines) {
|
|
if($lines[$i] =~ /Serial Number.*: (.+)/i) {
|
|
my $t= {};
|
|
$t->{'SERIAL'} = length($1)%2?"0".uc($1):uc($1);
|
|
$i++;
|
|
if($lines[$i] =~ /Revocation Date: (.*)/i ) {
|
|
$t->{'DATE'} = $1;
|
|
$i++;
|
|
#print STDERR "read CRL: $t->{'SERIAL'}\n";
|
|
push(@{$tmp->{'LIST'}}, $t);
|
|
} else {
|
|
$t = sprintf("CRL seems to be corrupt: %s\n", $file);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
}
|
|
|
|
} else {
|
|
$i++;
|
|
}
|
|
}
|
|
|
|
$self->{'CACHE'}->{$file} = $tmp;
|
|
|
|
return($tmp);
|
|
}
|
|
|
|
sub parsecert {
|
|
my ($self, $crlfile, $indexfile, $file, $force) = @_;
|
|
|
|
my $tmp = {};
|
|
my (@lines, $dn, $i, $c, $v, $k, $cmd, $crl, $time, $t, $ext, $ret, $pid);
|
|
|
|
my($rdfh, $wtfh);
|
|
|
|
$time = time();
|
|
|
|
$force && delete($self->{'CACHE'}->{$file});
|
|
|
|
#print STDERR "DEBUG: got force $force\n";
|
|
|
|
# check if certificate is cached
|
|
if($self->{'CACHE'}->{$file}) {
|
|
# print "DEBUG: use cached certificate $file\n";
|
|
return($self->{'CACHE'}->{$file});
|
|
}
|
|
# print "DEBUG: parse certificate $file\n";
|
|
|
|
open(IN, $file) || do {
|
|
$t = sprintf("Can't open Certificate '%s': %s", $file, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
|
|
# convert certificate to PEM, DER and TEXT
|
|
$tmp->{'PEM'} .= $_ while(<IN>);
|
|
($ret, $tmp->{'TEXT'}, $ext) = $self->convdata(
|
|
'cmd' => 'x509',
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'TEXT'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
($ret, $tmp->{'DER'}, $ext) = $self->convdata(
|
|
'cmd' => 'x509',
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'DER'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
# get "normal infos"
|
|
@lines = split(/\n/, $tmp->{'TEXT'});
|
|
foreach(@lines) {
|
|
if($_ =~ /Serial Number.*: (.+) /i) {
|
|
# shit, -text shows serial as decimal number :(
|
|
# dirty fix (incompleted) --curly
|
|
$i = sprintf( "%x", $1);
|
|
$tmp->{'SERIAL'} = length($i)%2?"0".uc($i):uc($i);
|
|
} elsif ($_ =~ /Signature Algorithm.*: (\w+)/i) {
|
|
$tmp->{'SIG_ALGORITHM'} = $1;
|
|
} elsif ($_ =~ /Issuer: (.+)/i) {
|
|
$tmp->{'ISSUER'} = $1;
|
|
$tmp->{'ISSUER'} =~ s/,/\//g;
|
|
$tmp->{'ISSUER'} =~ s/\/ /\//g;
|
|
$tmp->{'ISSUER'} =~ s/^\///;
|
|
} elsif ($_ =~ /Not Before.*: (.+)/i) {
|
|
$tmp->{'NOTBEFORE'} = $1;
|
|
} elsif ($_ =~ /Not After.*: (.+)/i) {
|
|
$tmp->{'NOTAFTER'} = $1;
|
|
} elsif ($_ =~ /Public Key Algorithm.*: (.+)/i) {
|
|
$tmp->{'PK_ALGORITHM'} = $1;
|
|
} elsif ($_ =~ /Modulus \((\d+) .*\)/i) {
|
|
$tmp->{'KEYSIZE'} = $1;
|
|
} elsif ($_ =~ /Subject.*: (.+)/i) {
|
|
$tmp->{'DN'} = $1;
|
|
}
|
|
}
|
|
|
|
# no serial yet? get it now the direct way
|
|
if(!defined $tmp->{'SERIAL'}){
|
|
$cmd = "$self->{'bin'} x509 -noout -serial -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'SERIAL'} = $v if($k =~ /serial/i);
|
|
chomp($tmp->{'SERIAL'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
}
|
|
|
|
# parse subject DN
|
|
$dn = HELPERS::parse_dn($tmp->{'DN'});
|
|
foreach(keys(%$dn)) {
|
|
$tmp->{$_} = $dn->{$_};
|
|
}
|
|
|
|
# parse issuer DN
|
|
$tmp->{'ISSUERDN'} = HELPERS::parse_dn($tmp->{'ISSUER'});
|
|
|
|
# get extensions
|
|
$tmp->{'EXT'} = HELPERS::parse_extensions(\@lines, "cert");
|
|
|
|
# get fingerprint
|
|
$cmd = "$self->{'bin'} x509 -noout -fingerprint -md5 -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'FINGERPRINTMD5'} = $v if($k =~ /MD5 Fingerprint/i);
|
|
chomp($tmp->{'FINGERPRINTMD5'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
if($ret) {
|
|
$t = _("Error reading fingerprint from Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
}
|
|
|
|
$cmd = "$self->{'bin'} x509 -noout -fingerprint -sha1 -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'FINGERPRINTSHA1'} = $v if($k =~ /SHA1 Fingerprint/i);
|
|
chomp($tmp->{'FINGERPRINTSHA1'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
if($ret) {
|
|
$t = _("Error reading fingerprint from Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
}
|
|
|
|
$cmd = "$self->{'bin'} x509 -noout -fingerprint -sha256 -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'FINGERPRINTSHA256'} = $v if($k =~ /SHA256 Fingerprint/i);
|
|
chomp($tmp->{'FINGERPRINTSHA256'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
$cmd = "$self->{'bin'} x509 -noout -fingerprint -sha384 -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'FINGERPRINTSHA384'} = $v if($k =~ /SHA384 Fingerprint/i);
|
|
chomp($tmp->{'FINGERPRINTSHA384'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
$cmd = "$self->{'bin'} x509 -noout -fingerprint -sha512 -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
($k, $v) = split(/=/);
|
|
$tmp->{'FINGERPRINTSHA512'} = $v if($k =~ /SHA512 Fingerprint/i);
|
|
chomp($tmp->{'FINGERPRINTSHA512'});
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
if($ret) {
|
|
$t = _("Error reading fingerprint from Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
}
|
|
|
|
# get subject in openssl format
|
|
$cmd = "$self->{'bin'} x509 -noout -subject -in $file";
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>){
|
|
$ext .= $_;
|
|
if($_ =~ /subject= (.*)/) {
|
|
$tmp->{'SUBJECT'} = $1;
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
if($ret) {
|
|
$t = _("Error reading subject from Certificate");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
}
|
|
|
|
$tmp->{'EXPDATE'} = _get_date( $tmp->{'NOTAFTER'});
|
|
|
|
if(defined($crlfile) && defined($indexfile)) {
|
|
$crl = $self->parsecrl($crlfile, 1);
|
|
#print STDERR "DEBUG: parsed crl $crlfile : $crl\n";
|
|
|
|
defined($crl) || GUI::HELPERS::print_error(_("Can't read CRL"));
|
|
|
|
$tmp->{'STATUS'} = _("VALID");
|
|
|
|
if($tmp->{'EXPDATE'} < $time) {
|
|
$tmp->{'STATUS'} = _("EXPIRED");
|
|
# keep database up to date
|
|
if($crl->{'ISSUER'} eq $tmp->{'ISSUER'}) {
|
|
_set_expired($tmp->{'SERIAL'}, $indexfile);
|
|
}
|
|
} elsif ($tmp->{'EXPDATE'} - $time < 608400) {
|
|
# cert expires in less than 7 days
|
|
$tmp->{'STATUS'} = _("EXPIRING");
|
|
}
|
|
|
|
if (defined($tmp->{'SERIAL'})) {
|
|
foreach my $revoked (@{$crl->{'LIST'}}) {
|
|
#print STDERR "DEBUG: check tmp: $tmp->{'SERIAL'}\n";
|
|
#print STDERR "DEBUG: check revoked: $revoked->{'SERIAL'}\n";
|
|
next if ($tmp->{'SERIAL'} ne $revoked->{'SERIAL'});
|
|
if ($tmp->{'SERIAL'} eq $revoked->{'SERIAL'}) {
|
|
$tmp->{'STATUS'} = _("REVOKED");
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
$tmp->{'STATUS'} = _("UNDEFINED");
|
|
}
|
|
|
|
$self->{'CACHE'}->{$file} = $tmp;
|
|
|
|
return($tmp);
|
|
}
|
|
|
|
sub parsereq {
|
|
my ($self, $config, $file, $force) = @_;
|
|
|
|
my $tmp = {};
|
|
|
|
my (@lines, $dn, $i, $c, $v, $k, $cmd, $t, $ext, $ret);
|
|
|
|
# check if request is cached
|
|
if($self->{'CACHE'}->{$file} && !$force) {
|
|
# print STDERR "DEBUG return from CACHE $file\n";
|
|
return($self->{'CACHE'}->{$file});
|
|
} elsif($force) {
|
|
# print STDERR "DEBUG delete from CACHE $file\n";
|
|
delete($self->{'CACHE'}->{$file});
|
|
} else {
|
|
# print STDERR "DEBUG parse into CACHE $file\n";
|
|
}
|
|
|
|
open(IN, $file) || do {
|
|
$t = sprintf(_("Can't open Request file %s: %s"), $file, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
|
|
# convert request to PEM, DER and TEXT
|
|
$tmp->{'PEM'} .= $_ while(<IN>);
|
|
|
|
($ret, $tmp->{'TEXT'}, $ext) = $self->convdata(
|
|
'cmd' => 'req',
|
|
'config' => $config,
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'TEXT'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting Request");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
($ret, $tmp->{'DER'}, $ext) = $self->convdata(
|
|
'cmd' => 'req',
|
|
'config' => $config,
|
|
'data' => $tmp->{'PEM'},
|
|
'inform' => 'PEM',
|
|
'outform' => 'DER'
|
|
);
|
|
|
|
if($ret) {
|
|
$t = _("Error converting Request");
|
|
GUI::HELPERS::print_warning($t, $ext);
|
|
return;
|
|
}
|
|
|
|
# get "normal infos"
|
|
@lines = split(/\n/, $tmp->{'TEXT'});
|
|
foreach(@lines) {
|
|
if ($_ =~ /Signature Algorithm.*: (\w+)/i) {
|
|
$tmp->{'SIG_ALGORITHM'} = $1;
|
|
} elsif ($_ =~ /Public Key Algorithm.*: (.+)/i) {
|
|
$tmp->{'PK_ALGORITHM'} = $1;
|
|
} elsif ($_ =~ /Modulus \((\d+) .*\)/i) {
|
|
$tmp->{'KEYSIZE'} = $1;
|
|
# print STDERR "read keysize: $tmp->{'KEYSIZE'}\n";
|
|
} elsif ($_ =~ /Subject.*: (.+)/i) {
|
|
$tmp->{'DN'} = $1;
|
|
} elsif ($_ =~ /Version: \d.*/i) {
|
|
$tmp->{'TYPE'} = 'PKCS#10';
|
|
}
|
|
}
|
|
|
|
$dn = HELPERS::parse_dn($tmp->{'DN'});
|
|
foreach(keys(%$dn)) {
|
|
$tmp->{$_} = $dn->{$_};
|
|
}
|
|
|
|
# get extensions
|
|
$tmp->{'EXT'} = HELPERS::parse_extensions(\@lines, "req");
|
|
|
|
$self->{'CACHE'}->{$file} = $tmp;
|
|
|
|
return($tmp);
|
|
}
|
|
|
|
sub convdata {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($tmp, $ext, $ret, $file, $pid, $cmd, $cmdout, $cmderr);
|
|
$file = HELPERS::mktmp($self->{'tmp'}."/data");
|
|
|
|
$cmd = "$self->{'bin'} $opts->{'cmd'}";
|
|
$cmd .= " -config $opts->{'config'}" if(defined($opts->{'config'}));
|
|
$cmd .= " -inform $opts->{'inform'}";
|
|
$cmd .= " -out \"$file\"";
|
|
if($opts->{'outform'} eq 'TEXT') {
|
|
$cmd .= " -text -noout";
|
|
} else {
|
|
$cmd .= " -outform $opts->{'outform'}";
|
|
}
|
|
|
|
($ret, $tmp, $ext) = _run_with_fixed_input($cmd, $opts->{'data'});
|
|
|
|
if($self->{'broken'}) {
|
|
if(($ret != 0 && $opts->{'cmd'} ne 'crl') ||
|
|
($ret != 0 && $opts->{'outform'} ne 'TEXT' && $opts->{'cmd'} eq 'crl') ||
|
|
($ret != 1 && $opts->{'outform'} eq 'TEXT' && $opts->{'cmd'} eq 'crl')) {
|
|
unlink($file);
|
|
return($ret, undef, $ext);
|
|
} else {
|
|
$ret = 0;
|
|
}
|
|
} else { # wow, they fixed it :-)
|
|
if($ret != 0) {
|
|
unlink($file);
|
|
return($ret, undef, $ext);
|
|
} else {
|
|
$ret = 0;
|
|
}
|
|
}
|
|
|
|
if (-s $file) { # If the file is empty, the payload is in $tmp (via STDOUT of the called process).
|
|
open(IN, $file) || do {
|
|
my $t = sprintf(_("Can't open file %s: %s"), $file, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
$tmp .= $_ while(<IN>);
|
|
close(IN);
|
|
}
|
|
unlink($file);
|
|
|
|
return($ret, $tmp, $ext);
|
|
}
|
|
|
|
sub convkey {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my ($tmp, $ext, $pid, $ret);
|
|
my $file = HELPERS::mktmp($self->{'tmp'}."/key");
|
|
|
|
my $cmd = "$self->{'bin'}";
|
|
|
|
# print STDERR "DEBUG: got type: $opts->{'type'}\n";
|
|
|
|
if($opts->{'type'} eq "RSA") {
|
|
$cmd .= " rsa";
|
|
} elsif($opts->{'type'} eq "DSA") {
|
|
$cmd .= " dsa";
|
|
}
|
|
|
|
$cmd .= " -inform $opts->{'inform'}";
|
|
$cmd .= " -outform $opts->{'outform'}";
|
|
$cmd .= " -in \"$opts->{'keyfile'}\"";
|
|
$cmd .= " -out \"$file\"";
|
|
|
|
$cmd .= " -passin env:SSLPASS";
|
|
$cmd .= " -passout env:SSLPASSOUT -des3" if(not $opts->{'nopass'});
|
|
|
|
$ENV{'SSLPASS'} = defined($opts->{'oldpass'}) ? $opts->{'oldpass'} :
|
|
$opts->{'pass'};
|
|
$ENV{'SSLPASSOUT'} = $opts->{'pass'} if(not $opts->{'nopass'});
|
|
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
if($_ =~ /unable to load key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
delete($ENV{'SSLPASSOUT'});
|
|
return(1, $ext);
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
delete($ENV{'SSLPASS'});
|
|
delete($ENV{'SSLPASSOUT'});
|
|
|
|
return(1, $ext) if($ret);
|
|
|
|
open(IN, $file) || return(undef);
|
|
$tmp .= $_ while(<IN>);
|
|
close(IN);
|
|
|
|
unlink($file);
|
|
|
|
return($tmp);
|
|
}
|
|
|
|
sub checkpass {
|
|
my ($self, $keyfile, $passwd) = @_;
|
|
|
|
my ($cmd, $ext, $ret, $pid, $type);
|
|
|
|
# Check type: RSA or DSA
|
|
open(KEY, "<$keyfile") || do {
|
|
GUI::HELPERS::print_warning(sprintf(_("Can't open Key file:\n%s"), $keyfile));
|
|
return(1);
|
|
};
|
|
$type = "UNKNOWN";
|
|
while(<KEY>) {
|
|
if(/BEGIN RSA PRIVATE KEY/) {
|
|
$type = "rsa";
|
|
last;
|
|
} elsif(/BEGIN DSA PRIVATE KEY/){
|
|
$type = "dsa";
|
|
last;
|
|
}
|
|
}
|
|
if($type eq "UNKNOWN") {
|
|
GUI::HELPERS::print_warning(_("Invalid key encryption type"));
|
|
return(1);
|
|
}
|
|
|
|
$cmd = "$self->{'bin'} $type -noout";
|
|
$cmd .= " -in \"$keyfile\"";
|
|
$cmd .= " -passin env:SSLPASS";
|
|
|
|
$ENV{'SSLPASS'} = $passwd;
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret);
|
|
}
|
|
|
|
sub genp12 {
|
|
my $self = shift;
|
|
my $opts = { @_ };
|
|
|
|
my($cmd, $ext, $ret, $pid);
|
|
|
|
$cmd = "$self->{'bin'} pkcs12 -export";
|
|
$cmd .= " -out \"$opts->{'outfile'}\"";
|
|
$cmd .= " -in \"$opts->{'certfile'}\"";
|
|
$cmd .= " -inkey \"$opts->{'keyfile'}\"";
|
|
if(not $opts->{'nopass'}) {
|
|
$cmd .= " -passout env:P12PASS";
|
|
} else {
|
|
$cmd .= " -passout pass:";
|
|
}
|
|
$cmd .= " -passin env:SSLPASS";
|
|
$cmd .= " -certfile $opts->{'cafile'}" if($opts->{'includeca'});
|
|
$cmd .= " -nodes " if($opts->{'nopass'});
|
|
$cmd .= " -name \"$opts->{'friendly'}\"" if($opts->{'friendly'} ne "");
|
|
|
|
|
|
$ENV{'P12PASS'} = $opts->{'p12passwd'} if(not $opts->{'nopass'});
|
|
$ENV{'SSLPASS'} = $opts->{'passwd'};
|
|
my($rdfh, $wtfh);
|
|
$ext = "$cmd\n\n";
|
|
$pid = open3($wtfh, $rdfh, $rdfh, $cmd);
|
|
while(<$rdfh>) {
|
|
$ext .= $_;
|
|
if($_ =~ /Error loading private key/) {
|
|
delete($ENV{'SSLPASS'});
|
|
delete($ENV{'P12PASS'});
|
|
return(1, $ext);
|
|
}
|
|
}
|
|
waitpid($pid, 0);
|
|
$ret = $? >> 8;
|
|
|
|
delete($ENV{'P12PASS'});
|
|
delete($ENV{'SSLPASS'});
|
|
|
|
return($ret, $ext);
|
|
}
|
|
|
|
sub read_index {
|
|
my ($self, $index) = @_;
|
|
|
|
my (@lines, @index);
|
|
|
|
open(IN, "<$index") || do {
|
|
my $t = sprintf(_("Can't read index %s: %s"), $index, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
@lines = <IN>;
|
|
close(IN);
|
|
foreach my $l (@lines) {
|
|
my $tmp = {};
|
|
($tmp->{'STATUS'},
|
|
$tmp->{'EXPDATE'},
|
|
$tmp->{'REVDATE'},
|
|
$tmp->{'SERIAL'},
|
|
$tmp->{'xxx'},
|
|
$tmp->{'DN'}) = split(/\t/, $l);
|
|
|
|
($tmp->{'REVDATE'}, $tmp->{'REVREASON'}) = split(/,/, $tmp->{'REVDATE'});
|
|
|
|
$tmp->{'EXPDATE'} = _get_index_date($tmp->{'EXPDATE'});
|
|
if(defined($tmp->{'REVDATE'}) && ($tmp->{'REVDATE'} ne '')) {
|
|
$tmp->{'REVDATE'} = _get_index_date( $tmp->{'REVDATE'});
|
|
}
|
|
|
|
push(@index, $tmp);
|
|
}
|
|
|
|
return(@index);
|
|
}
|
|
|
|
sub get_version {
|
|
my $self = shift;
|
|
return($self->{'version'});
|
|
}
|
|
|
|
sub _set_expired {
|
|
my ($serial, $index) =@_;
|
|
|
|
open(IN, "<$index") || do {
|
|
my $t = sprintf(_("Can't read index %s: %s"), $index, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
|
|
my @lines = <IN>;
|
|
|
|
close IN;
|
|
|
|
# Format of OpenSSl index db
|
|
# E|R|V<tab>Expiry<tab>[RevocationDate]<tab>Serial<tab>unknown<tab>SubjectDN
|
|
|
|
open(OUT, ">$index") || do {
|
|
my $t = sprintf(_("Can't write index %s: %s"), $index, $!);
|
|
GUI::HELPERS::print_warning($t);
|
|
return;
|
|
};
|
|
|
|
foreach my $l (@lines) {
|
|
if($l =~ /\t$serial\t/) {
|
|
$l =~ s/^V/E/;
|
|
}
|
|
print OUT $l;
|
|
}
|
|
|
|
close OUT;
|
|
|
|
return;
|
|
}
|
|
|
|
sub _get_date {
|
|
my $string = shift;
|
|
|
|
$string =~ s/ / /g;
|
|
|
|
my @t1 = split(/ /, $string);
|
|
my @t2 = split(/:/, $t1[2]);
|
|
|
|
$t1[0] = _get_index($t1[0]);
|
|
|
|
my $ret = Time::Local::timelocal($t2[2],$t2[1],$t2[0],$t1[1],$t1[0],$t1[3]);
|
|
|
|
return($ret);
|
|
}
|
|
|
|
sub _get_index_date {
|
|
my $string = shift;
|
|
|
|
my ($y, $m, $d);
|
|
|
|
$y = substr($string, 0, 2) + 2000;
|
|
$m = substr($string, 2, 2) - 1;
|
|
$d = substr($string, 4, 2);
|
|
|
|
my $ret = Time::Local::timelocal(0, 0, 0, $d, $m, $y);
|
|
|
|
return($ret);
|
|
}
|
|
|
|
sub _get_index {
|
|
my $m = shift;
|
|
|
|
my @a = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
|
|
|
|
for(my $i = 0; $a[$i]; $i++) {
|
|
return $i if($a[$i] eq $m);
|
|
}
|
|
}
|
|
|
|
|
|
=over
|
|
|
|
=item _run_with_fixed_input($cmd, $input)
|
|
|
|
This function runs C<$cmd> and writes the C<$input> to STDIN of the
|
|
new process (all at once).
|
|
|
|
While the command runs, all of its output to STDOUT and STDERR is
|
|
collected.
|
|
|
|
After the command terminates (closes both STDOUT and STDIN) the
|
|
function returns the command's return value as well as everything it
|
|
wrote to its STDOUT and STDERR in a list.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
sub _run_with_fixed_input {
|
|
my $cmd = shift;
|
|
my $input = shift;
|
|
|
|
my ($wtfh, $rdfh, $erfh, $pid, $sel, $ret, $stdout, $stderr);
|
|
$erfh = Symbol::gensym; # Must not be false, otherwise it is lumped together with rdfh
|
|
|
|
# Run the command
|
|
$pid = open3($wtfh, $rdfh, $erfh, $cmd);
|
|
print $wtfh $input, "\n";
|
|
|
|
$stdout = '';
|
|
$stderr = '';
|
|
$sel = new IO::Select($rdfh, $erfh);
|
|
while (my @fhs = $sel->can_read()) {
|
|
foreach my $fh (@fhs) {
|
|
if ($fh == $rdfh) { # STDOUT
|
|
my $bytes_read = sysread($fh, my $buf='', 1024);
|
|
if ($bytes_read == -1) {
|
|
warn("Error reading from child's STDOUT: $!\n");
|
|
$sel->remove($fh);
|
|
} elsif ($bytes_read == 0) {
|
|
# print("Child's STDOUT closed.\n");
|
|
$sel->remove($fh);
|
|
} else {
|
|
$stdout .= $buf;
|
|
}
|
|
}
|
|
elsif ($fh == $erfh) { # STDERR
|
|
my $bytes_read = sysread($fh, my $buf='', 1024);
|
|
if ($bytes_read == -1) {
|
|
warn("Error reading from child's STDERR: $!\n");
|
|
$sel->remove($fh);
|
|
} elsif ($bytes_read == 0) {
|
|
# print("Child's STDERR closed.\n");
|
|
$sel->remove($fh);
|
|
} else {
|
|
$stderr .= $buf;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
waitpid($pid, 0);
|
|
$ret = $?>>8;
|
|
|
|
return ($ret, $stdout, $stderr)
|
|
}
|
|
|
|
1
|
|
|