--- loncom/Lond.pm 2022/01/19 16:47:51 1.8.2.3 +++ loncom/Lond.pm 2018/12/10 18:56:18 1.13 @@ -1,6 +1,6 @@ # The LearningOnline Network # -# $Id: Lond.pm,v 1.8.2.3 2022/01/19 16:47:51 raeburn Exp $ +# $Id: Lond.pm,v 1.13 2018/12/10 18:56:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,8 @@ use lib '/home/httpd/lib/perl/'; use LONCAPA; use Apache::lonnet; use GDBM_File; - +use Crypt::OpenSSL::X509; +use Crypt::PKCS10; sub dump_with_regexp { my ( $tail, $clientversion ) = @_; @@ -239,10 +240,10 @@ sub check_homecourses { } } unless (&untie_domain_hash($hashref)) { - &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $domain"); + &logthis("Failed to untie tied hash for nohist_courseids.db for $domain"); } } else { - &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $domain"); + &logthis("Failed to tie hash for nohist_courseids.db for $domain"); } } foreach my $hashid (keys(%recent)) { @@ -314,9 +315,9 @@ sub get_courseinfo_hash { }; if ($@) { if ($@ eq "timeout\n") { - &Apache::lonnet::logthis("WARNING courseiddump for $cnum:$cdom from $home timedout"); + &logthis("WARNING courseiddump for $cnum:$cdom from $home timedout"); } else { - &Apache::lonnet::logthis("WARNING unexpected error during eval of call for courseiddump from $home"); + &logthis("WARNING unexpected error during eval of call for courseiddump from $home"); } } else { if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { @@ -802,32 +803,167 @@ sub is_course { } &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600); unless (&untie_domain_hash($hashref)) { - &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom"); + &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom"); } } else { - &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom"); + &logthis("Failed to tie hash for nohist_courseids.db for $cdom"); } } return $iscourse; } -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]}&"; +sub server_certs { + my ($perlvar,$lonhost,$hostname) = @_; + my %pemfiles = ( + key => 'lonnetPrivateKey', + host => 'lonnetCertificate', + hostname => 'lonnetHostnameCertificate', + ca => 'lonnetCertificateAuthority', + ); + my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile); + 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)) { + if ($perlvar->{$pemfiles{$key}}) { + my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}}; + if (-e $file) { + if ($key eq 'key') { + if (open(PIPE,"openssl rsa -noout -in $file -check |")) { + my $check = ; + close(PIPE); + chomp($check); + $info{$key}{'status'} = $check; + } + if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) { + $md5hash{$key} = ; + close(PIPE); + chomp($md5hash{$key}); + } + } else { + if ($key eq 'ca') { + if (open(PIPE,"openssl verify -CAfile $file $file |")) { + my $check = ; + close(PIPE); + chomp($check); + if ($check eq "$file: OK") { + $info{$key}{'status'} = 'ok'; + } else { + $check =~ s/^\Q$file\E\:?\s*//; + $info{$key}{'status'} = $check; + } + } + } else { + if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) { + $md5hash{$key} = ; + close(PIPE); + chomp($md5hash{$key}); + } + } + my $x509 = Crypt::OpenSSL::X509->new_from_file($file); + my @items = split(/,\s+/,$x509->subject()); + foreach my $item (@items) { + my ($name,$value) = split(/=/,$item); + if ($name eq 'CN') { + $info{$key}{'cn'} = $value; + } + } + $info{$key}{'start'} = $x509->notBefore(); + $info{$key}{'end'} = $x509->notAfter(); + $info{$key}{'alg'} = $x509->sig_alg_name(); + $info{$key}{'size'} = $x509->bit_length(); + $info{$key}{'email'} = $x509->email(); + $info{$key}{'serial'} = $x509->serial(); + if ($x509->checkend(0)) { + $expired{$key} = 1; + } + if (($key eq 'host') || ($key eq 'hostname')) { + 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 (($key eq 'host') || ($key eq 'hostname')) { + my $csrfile = $file; + $csrfile =~ s/\.pem$/.csr/; + if (-e $csrfile) { + if (open(PIPE,"openssl req -noout -modulus -in $csrfile |openssl md5 |")) { + my $csrhash = ; + close(PIPE); + chomp($csrhash); + if ((!-e $file) || ($csrhash ne $md5hash{$key}) || ($expired{$key}) || + ($wrongcn{$key}) || ($revoked{$key})) { + Crypt::PKCS10->setAPIversion(1); + my $decoded = Crypt::PKCS10->new( $csrfile,(PEMonly => 1, readFile => 1)); + if (ref($decoded)) { + if ($decoded->commonName() eq $expected_cn{$key}) { + $info{$key.'-csr'}{'cn'} = $decoded->commonName(); + $info{$key.'-csr'}{'alg'} = $decoded->pkAlgorithm(); + $info{$key.'-csr'}{'email'} = $decoded->emailAddress(); + my $params = $decoded->subjectPublicKeyParams(); + if (ref($params) eq 'HASH') { + $info{$key.'-csr'}{'size'} = $params->{keylen}; + } + $md5hash{$key.'-csr'} = $csrhash; + } + } + } + } + } + } + } + } } - $qresult=~s/\&$//; } - &untie_user_hash($hashref) or - return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd"; - return $qresult; + foreach my $key ('host','hostname') { + if ($md5hash{$key}) { + if ($md5hash{$key} eq $md5hash{'key'}) { + if ($revoked{$key}) { + $info{$key}{'status'} = 'revoked'; + } elsif ($expired{$key}) { + $info{$key}{'status'} = 'expired'; + } elsif ($wrongcn{$key}) { + $info{$key}{'status'} = 'wrongcn'; + } else { + $info{$key}{'status'} = 'ok'; + } + } elsif ($info{'key'}{'status'} =~ /ok/) { + $info{$key}{'status'} = 'otherkey'; + } else { + $info{$key}{'status'} = 'nokey'; + } + } + if ($md5hash{$key.'-csr'}) { + if ($md5hash{$key.'-csr'} eq $md5hash{'key'}) { + $info{$key.'-csr'}{'status'} = 'ok'; + } elsif ($info{'key'}{'status'} =~ /ok/) { + $info{$key.'-csr'}{'status'} = 'otherkey'; + } else { + $info{$key.'-csr'}{'status'} = 'nokey'; + } + } + } + my $result; + foreach my $key (keys(%info)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&'; + } + $result =~ s/\&$//; + return $result; } 1; @@ -952,18 +1088,7 @@ 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 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.