--- loncom/Lond.pm 2022/02/07 12:07:55 1.8.2.3.2.1 +++ loncom/Lond.pm 2018/12/22 17:06:02 1.14 @@ -1,6 +1,6 @@ # The LearningOnline Network # -# $Id: Lond.pm,v 1.8.2.3.2.1 2022/02/07 12:07:55 raeburn Exp $ +# $Id: Lond.pm,v 1.14 2018/12/22 17:06:02 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 Net::OAuth; +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,186 +803,177 @@ 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]}&"; - } - $qresult=~s/\&$//; - } - &untie_user_hash($hashref) or - return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd"; - return $qresult; -} - -sub crslti_itemid { - my ($cdom,$cnum,$url,$method,$params,$loncaparev) = @_; - unless (ref($params) eq 'HASH') { - return; - } - if (($cdom eq '') || ($cnum eq '')) { - return; - } - my ($itemid,$consumer_key,$secret); - - if (exists($params->{'oauth_callback'})) { - $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; - } else { - $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0; - } - - my $consumer_key = $params->{'oauth_consumer_key'}; - return if ($consumer_key eq ''); - - my (%crslti,%crslti_by_key); - my $hashid=$cdom.'_'.$cnum; - my ($result,$cached)=&Apache::lonnet::is_cached_new('courseltienc',$hashid); - if (defined($cached)) { - if (ref($result) eq 'HASH') { - %crslti = %{$result}; - } - } else { - my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_ltienc','','')),$loncaparev); - %crslti = %{&Apache::lonnet::unserialize($reply)}; - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('courseltienc',$hashid,\%crslti,$cachetime); - } - - return if (!keys(%crslti)); - - foreach my $id (keys(%crslti)) { - if (ref($crslti{$id}) eq 'HASH') { - my $key = $crslti{$id}{'key'}; - if (($key ne '') && ($crslti{$id}{'secret'} ne '')) { - push(@{$crslti_by_key{$key}},$id); - } - } - } - - return if (!keys(%crslti_by_key)); - - if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') { - foreach my $id (@{$crslti_by_key{$consumer_key}}) { - my $secret = $crslti{$id}{'secret'}; - my $request = Net::OAuth->request('request token')->from_hash($params, - request_url => $url, - request_method => $method, - consumer_secret => $secret,); - if ($request->verify()) { - $itemid = $id; - last; - } - } - } - return $itemid; -} - -sub domlti_itemid { - my ($dom,$context,$url,$method,$params,$loncaparev) = @_; - unless (ref($params) eq 'HASH') { - return; - } - if ($dom eq '') { - return; - } - my ($itemid,$consumer_key,$secret); - - if (exists($params->{'oauth_callback'})) { - $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; - } else { - $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0; - } - - my $consumer_key = $params->{'oauth_consumer_key'}; - return if ($consumer_key eq ''); - - my %ltienc; - my ($encresult,$enccached)=&Apache::lonnet::is_cached_new('ltienc',$dom); - if (defined($enccached)) { - if (ref($encresult) eq 'HASH') { - %ltienc = %{$encresult}; - } - } else { - my $reply = &get_dom("getdom:$dom:encconfig:lti"); - my $ltiencref = &Apache::lonnet::thaw_unescape($reply); - if (ref($ltiencref) eq 'HASH') { - %ltienc = %{$ltiencref}; - } - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('ltienc',$dom,\%ltienc,$cachetime); - } - - return if (!keys(%ltienc)); - - my %lti; - if ($context eq 'deeplink') { - my ($result,$cached)=&Apache::lonnet::is_cached_new('lti',$dom); - if (defined($cached)) { - if (ref($result) eq 'HASH') { - %lti = %{$result}; - } - } - } else { - my $reply = &get_dom("getdom:$dom:configuration:lti"); - my $ltiref = &Apache::lonnet::thaw_unescape($reply); - if (ref($ltiref) eq 'HASH') { - %lti = %{$ltiref}; +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); + %info = ( + 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)) { + 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(); + $info{$key}{'issuerhash'} = $x509->issuer_hash(); + 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; + } + } + } + } + } + } + } } - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('lti',$dom,\%lti,$cachetime); } } - return if (!keys(%lti)); - - my %lti_by_key; - foreach my $id (keys(%ltienc)) { - if (ref($ltienc{$id}) eq 'HASH') { - my $key = $ltienc{$id}{'key'}; - if (($key ne '') && ($ltienc{$id}{'secret'} ne '')) { - if ($context eq 'deeplink') { - if (ref($lti{$id}) eq 'HASH') { - if (!$lti{$id}{'requser'}) { - push(@{$lti_by_key{$key}},$id); - } - } + 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'; + } elsif ((exists($info{'ca'}{'issuerhash'})) && + ($info{'ca'}{'issuerhash'} ne $info{$key}{'issuerhash'})) { + $info{$key}{'status'} = 'mismatch'; } else { - push(@{$lti_by_key{$key}},$id); + $info{$key}{'status'} = 'ok'; } + } elsif ($info{'key'}{'status'} =~ /ok/) { + $info{$key}{'status'} = 'otherkey'; + } else { + $info{$key}{'status'} = 'nokey'; } } - } - return if (!keys(%lti_by_key)); - - if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') { - foreach my $id (@{$lti_by_key{$consumer_key}}) { - my $secret = $ltienc{$id}{'secret'}; - my $request = Net::OAuth->request('request token')->from_hash($params, - request_url => $url, - request_method => $method, - consumer_secret => $secret,); - if ($request->verify()) { - $itemid = $id; - last; + 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'; } } } - return $itemid; + my $result; + foreach my $key (keys(%info)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&'; + } + $result =~ s/\&$//; + return $result; } 1; @@ -1106,18 +1098,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