--- loncom/Lond.pm 2018/12/10 18:56:18 1.13 +++ loncom/Lond.pm 2021/02/08 14:50:53 1.16 @@ -1,6 +1,6 @@ # The LearningOnline Network # -# $Id: Lond.pm,v 1.13 2018/12/10 18:56:18 raeburn Exp $ +# $Id: Lond.pm,v 1.16 2021/02/08 14:50:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,9 @@ use lib '/home/httpd/lib/perl/'; use LONCAPA; use Apache::lonnet; use GDBM_File; +use MIME::Base64; use Crypt::OpenSSL::X509; +use Crypt::X509::CRL; use Crypt::PKCS10; sub dump_with_regexp { @@ -819,19 +821,77 @@ sub server_certs { host => 'lonnetCertificate', hostname => 'lonnetHostnameCertificate', 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 = ( + key => {}, + ca => {}, + host => {}, + hostname => {}, + crl => {}, + ); + my @ordered = ('crl','key','ca','host','hostname'); if (ref($perlvar) eq 'HASH') { $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname}; $expected_cn{'hostname'} = 'internal-'.$hostname; my $certsdir = $perlvar->{'lonCertificateDirectory'}; if (-d $certsdir) { - $crlfile = $certsdir.'/'.$perlvar->{'lonnetCertRevocationList'}; - foreach my $key (keys(%pemfiles)) { + $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}}; + $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}}; + foreach my $key (@ordered) { if ($perlvar->{$pemfiles{$key}}) { my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}}; 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 = ; + 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 |")) { my $check = ; close(PIPE); @@ -876,7 +936,8 @@ sub server_certs { $info{$key}{'alg'} = $x509->sig_alg_name(); $info{$key}{'size'} = $x509->bit_length(); $info{$key}{'email'} = $x509->email(); - $info{$key}{'serial'} = $x509->serial(); + $info{$key}{'serial'} = uc($x509->serial()); + $info{$key}{'issuerhash'} = $x509->issuer_hash(); if ($x509->checkend(0)) { $expired{$key} = 1; } @@ -884,15 +945,9 @@ sub server_certs { if ($info{$key}{'cn'} ne $expected_cn{$key}) { $wrongcn{$key} = 1; } - if ((-e $crlfile) && ($info{$key}{'serial'} =~ /^\w+$/)) { - my $serial = $info{$key}{'serial'}; - if (open(PIPE,"openssl crl -inform PEM -text -in $crlfile | grep $serial |")) { - my $result = ; - close(PIPE); - chomp($result); - if ($result ne '') { - $revoked{$key} = 1; - } + if (($numrvk) && ($info{$key}{'serial'})) { + if ($rvkcerts{$info{$key}{'serial'}}) { + $revoked{$key} = 1; } } } @@ -939,6 +994,9 @@ sub server_certs { $info{$key}{'status'} = 'expired'; } elsif ($wrongcn{$key}) { $info{$key}{'status'} = 'wrongcn'; + } elsif ((exists($info{'ca'}{'issuerhash'})) && + ($info{'ca'}{'issuerhash'} ne $info{$key}{'issuerhash'})) { + $info{$key}{'status'} = 'mismatch'; } else { $info{$key}{'status'} = 'ok'; } @@ -966,6 +1024,25 @@ sub server_certs { 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; __END__ @@ -1088,7 +1165,18 @@ courseID -- for the course for which the The contents of the inner hash, for that single item in the outer hash 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