version 1.14, 2018/12/22 17:06:02
|
version 1.16, 2021/02/08 14:50:53
|
Line 37 use lib '/home/httpd/lib/perl/';
|
Line 37 use lib '/home/httpd/lib/perl/';
|
use LONCAPA; |
use LONCAPA; |
use Apache::lonnet; |
use Apache::lonnet; |
use GDBM_File; |
use GDBM_File; |
|
use MIME::Base64; |
use Crypt::OpenSSL::X509; |
use Crypt::OpenSSL::X509; |
|
use Crypt::X509::CRL; |
use Crypt::PKCS10; |
use Crypt::PKCS10; |
|
|
sub dump_with_regexp { |
sub dump_with_regexp { |
Line 819 sub server_certs {
|
Line 821 sub server_certs {
|
host => 'lonnetCertificate', |
host => 'lonnetCertificate', |
hostname => 'lonnetHostnameCertificate', |
hostname => 'lonnetHostnameCertificate', |
ca => 'lonnetCertificateAuthority', |
ca => 'lonnetCertificateAuthority', |
|
crl => 'lonnetCertRevocationList', |
); |
); |
my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile); |
my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile,$cafile, |
|
%rvkcerts,$numrvk); |
%info = ( |
%info = ( |
key => {}, |
key => {}, |
ca => {}, |
ca => {}, |
host => {}, |
host => {}, |
hostname => {}, |
hostname => {}, |
); |
crl => {}, |
|
); |
|
my @ordered = ('crl','key','ca','host','hostname'); |
if (ref($perlvar) eq 'HASH') { |
if (ref($perlvar) eq 'HASH') { |
$expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname}; |
$expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname}; |
$expected_cn{'hostname'} = 'internal-'.$hostname; |
$expected_cn{'hostname'} = 'internal-'.$hostname; |
my $certsdir = $perlvar->{'lonCertificateDirectory'}; |
my $certsdir = $perlvar->{'lonCertificateDirectory'}; |
if (-d $certsdir) { |
if (-d $certsdir) { |
$crlfile = $certsdir.'/'.$perlvar->{'lonnetCertRevocationList'}; |
$crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}}; |
foreach my $key (keys(%pemfiles)) { |
$cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}}; |
|
foreach my $key (@ordered) { |
if ($perlvar->{$pemfiles{$key}}) { |
if ($perlvar->{$pemfiles{$key}}) { |
my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}}; |
my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}}; |
if (-e $file) { |
if (-e $file) { |
if ($key eq 'key') { |
if ($key eq 'crl') { |
|
if ((-e $crlfile) && (-e $cafile)) { |
|
if (open(PIPE,"openssl crl -in $crlfile -inform pem -CAfile $cafile -noout 2>&1 |")) { |
|
my $crlstatus = <PIPE>; |
|
close(PIPE); |
|
chomp($crlstatus); |
|
if ($crlstatus =~ /OK/) { |
|
$info{$key}{'status'} = 'ok'; |
|
$info{$key}{'details'} = 'CRL valid for CA'; |
|
} |
|
} |
|
} |
|
if (open(my $fh,'<',$crlfile)) { |
|
my $pem_crl = ''; |
|
while (my $line=<$fh>) { |
|
chomp($line); |
|
next if ($line eq '-----BEGIN X509 CRL-----'); |
|
next if ($line eq '-----END X509 CRL-----'); |
|
$pem_crl .= $line; |
|
} |
|
close($fh); |
|
my $der_crl = MIME::Base64::decode_base64($pem_crl); |
|
if ($der_crl ne '') { |
|
my $decoded = Crypt::X509::CRL->new( crl => $der_crl ); |
|
if ($decoded->error) { |
|
$info{$key}{'status'} = 'error'; |
|
} elsif (ref($decoded)) { |
|
$info{$key}{'start'} = $decoded->this_update; |
|
$info{$key}{'end'} = $decoded->next_update; |
|
$info{$key}{'alg'} = $decoded->SigEncAlg.' '.$decoded->SigHashAlg; |
|
$info{$key}{'cn'} = $decoded->issuer_cn; |
|
$info{$key}{'email'} = $decoded->issuer_email; |
|
$info{$key}{'size'} = $decoded->signature_length; |
|
my $rlref = $decoded->revocation_list; |
|
if (ref($rlref) eq 'HASH') { |
|
foreach my $key (keys(%{$rlref})) { |
|
my $hkey = sprintf("%X",$key); |
|
$rvkcerts{$hkey} = 1; |
|
} |
|
$numrvk = scalar(keys(%{$rlref})); |
|
if ($numrvk) { |
|
$info{$key}{'details'} .= " ($numrvk revoked)"; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} elsif ($key eq 'key') { |
if (open(PIPE,"openssl rsa -noout -in $file -check |")) { |
if (open(PIPE,"openssl rsa -noout -in $file -check |")) { |
my $check = <PIPE>; |
my $check = <PIPE>; |
close(PIPE); |
close(PIPE); |
Line 882 sub server_certs {
|
Line 936 sub server_certs {
|
$info{$key}{'alg'} = $x509->sig_alg_name(); |
$info{$key}{'alg'} = $x509->sig_alg_name(); |
$info{$key}{'size'} = $x509->bit_length(); |
$info{$key}{'size'} = $x509->bit_length(); |
$info{$key}{'email'} = $x509->email(); |
$info{$key}{'email'} = $x509->email(); |
$info{$key}{'serial'} = $x509->serial(); |
$info{$key}{'serial'} = uc($x509->serial()); |
$info{$key}{'issuerhash'} = $x509->issuer_hash(); |
$info{$key}{'issuerhash'} = $x509->issuer_hash(); |
if ($x509->checkend(0)) { |
if ($x509->checkend(0)) { |
$expired{$key} = 1; |
$expired{$key} = 1; |
Line 891 sub server_certs {
|
Line 945 sub server_certs {
|
if ($info{$key}{'cn'} ne $expected_cn{$key}) { |
if ($info{$key}{'cn'} ne $expected_cn{$key}) { |
$wrongcn{$key} = 1; |
$wrongcn{$key} = 1; |
} |
} |
if ((-e $crlfile) && ($info{$key}{'serial'} =~ /^\w+$/)) { |
if (($numrvk) && ($info{$key}{'serial'})) { |
my $serial = $info{$key}{'serial'}; |
if ($rvkcerts{$info{$key}{'serial'}}) { |
if (open(PIPE,"openssl crl -inform PEM -text -in $crlfile | grep $serial |")) { |
$revoked{$key} = 1; |
my $result = <PIPE>; |
|
close(PIPE); |
|
chomp($result); |
|
if ($result ne '') { |
|
$revoked{$key} = 1; |
|
} |
|
} |
} |
} |
} |
} |
} |
Line 976 sub server_certs {
|
Line 1024 sub server_certs {
|
return $result; |
return $result; |
} |
} |
|
|
|
sub get_dom { |
|
my ($userinput) = @_; |
|
my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4); |
|
my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or |
|
return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd"; |
|
my $qresult=''; |
|
if (ref($hashref)) { |
|
chomp($what); |
|
my @queries=split(/\&/,$what); |
|
for (my $i=0;$i<=$#queries;$i++) { |
|
$qresult.="$hashref->{$queries[$i]}&"; |
|
} |
|
$qresult=~s/\&$//; |
|
} |
|
&untie_user_hash($hashref) or |
|
return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd"; |
|
return $qresult; |
|
} |
|
|
1; |
1; |
|
|
__END__ |
__END__ |
Line 1098 courseID -- for the course for which the
|
Line 1165 courseID -- for the course for which the
|
The contents of the inner hash, for that single item in the outer hash |
The contents of the inner hash, for that single item in the outer hash |
are returned (and cached in memcache for 10 minutes). |
are returned (and cached in memcache for 10 minutes). |
|
|
|
=item get_dom ( $userinput ) |
|
|
|
get_dom() will retrieve domain configuration information from a GDBM file |
|
in /home/httpd/lonUsers/$dom on the primary library server in a domain. |
|
The single argument passed is the string: $cmd:$udom:$namespace:$what |
|
where $cmd is the command historically passed to lond - i.e., getdom |
|
or egetdom, $udom is the domain, $namespace is the name of the GDBM file |
|
(encconfig or configuration), and $what is a string containing names of |
|
items to retrieve from the db file (each item name is escaped and separated |
|
from the next item name with an ampersand). The return value is either: |
|
error: followed by an error message, or a string containing the value (escaped) |
|
for each item, again separated from the next item with an ampersand. |
|
|
=back |
=back |
|
|