--- loncom/Lond.pm 2023/07/05 21:47:51 1.8.2.3.2.4 +++ 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.4 2023/07/05 21:47:51 raeburn Exp $ +# $Id: Lond.pm,v 1.14 2018/12/22 17:06:02 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,10 +37,8 @@ use lib '/home/httpd/lib/perl/'; use LONCAPA; use Apache::lonnet; use GDBM_File; -use Net::OAuth; -use Crypt::CBC; -use Digest::SHA; -use Digest::MD5 qw(md5_hex); +use Crypt::OpenSSL::X509; +use Crypt::PKCS10; sub dump_with_regexp { my ( $tail, $clientversion ) = @_; @@ -242,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)) { @@ -317,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') { @@ -805,420 +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 store_dom { - my ($userinput) = @_; - my ($cmd,$dom,$namespace,$rid,$what) =split(/:/,$userinput); - my $hashref = &tie_domain_hash($dom,$namespace,&GDBM_WRCREAT(),"S","$rid:$what") or - return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd"; - $hashref->{"version:$rid"}++; - my $version=$hashref->{"version:$rid"}; - my $allkeys=''; - my @pairs=split(/\&/,$what); - foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); - $allkeys.=$key.':'; - $hashref->{"$version:$rid:$key"}=$value; - } - my $now = time; - $hashref->{"$version:$rid:timestamp"}=$now; - $allkeys.='timestamp'; - $hashref->{"$version:keys:$rid"}=$allkeys; - &untie_user_hash($hashref) or - return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd"; - return 'ok'; -} - -sub restore_dom { - my ($userinput) = @_; - my ($cmd,$dom,$namespace,$rid) = split(/:/,$userinput); - my $hashref = &tie_domain_hash($dom,$namespace,&GDBM_READER()) or - return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd"; - my $qresult=''; - if (ref($hashref)) { - chomp($rid); - my $version=$hashref->{"version:$rid"}; - $qresult.="version=$version&"; - my $scope; - for ($scope=1;$scope<=$version;$scope++) { - my $vkeys=$hashref->{"$scope:keys:$rid"}; - my @keys=split(/:/,$vkeys); - my $key; - $qresult.="$scope:keys=$vkeys&"; - foreach $key (@keys) { - $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; - } - } - $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)); - - my %courselti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); - - if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') { - foreach my $id (@{$crslti_by_key{$consumer_key}}) { - my $secret = $crslti{$id}{'secret'}; - if (ref($courselti{$id}) eq 'HASH') { - if ((exists($courselti{$id}{'cipher'})) && - ($courselti{$id}{'cipher'} =~ /^\d+$/)) { - my $keynum = $courselti{$id}{'cipher'}; - my $privkey = &get_dom("getdom:$cdom:private:$keynum:lti:key"); - if ($privkey ne '') { - my $cipher = new Crypt::CBC($privkey); - $secret = $cipher->decrypt_hex($secret); +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 $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 ($name,$cachename); - if ($context eq 'linkprot') { - $name = $context; - } else { - $name = 'lti'; - if ($context eq '') { - $context = 'provider'; - } - } - $cachename = $name.'enc'; - my %ltienc; - my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$dom); - if (defined($enccached)) { - if (ref($encresult) eq 'HASH') { - %ltienc = %{$encresult}; - } - } else { - my $reply = &get_dom("getdom:$dom:encconfig:$name"); - my $ltiencref = &Apache::lonnet::thaw_unescape($reply); - if (ref($ltiencref) eq 'HASH') { - %ltienc = %{$ltiencref}; - } - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new($cachename,$dom,\%ltienc,$cachetime); - } - - return if (!keys(%ltienc)); - - 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 '')) { - push(@{$lti_by_key{$key}},$id); - } - } - } - return if (!keys(%lti_by_key)); - - my %lti = &Apache::lonnet::get_domain_lti($dom,$context); - - if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') { - foreach my $id (@{$lti_by_key{$consumer_key}}) { - my $secret = $ltienc{$id}{'secret'}; - if (ref($lti{$id}) eq 'HASH') { - if ((exists($lti{$id}{'cipher'})) && - ($lti{$id}{'cipher'} =~ /^\d+$/)) { - my $keynum = $lti{$id}{'cipher'}; - my $privkey = &get_dom("getdom:$dom:private:$keynum:lti:key"); - if ($privkey ne '') { - my $cipher = new Crypt::CBC($privkey); - $secret = $cipher->decrypt_hex($secret); - } + 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 { + $info{$key}{'status'} = 'ok'; } + } elsif ($info{'key'}{'status'} =~ /ok/) { + $info{$key}{'status'} = 'otherkey'; + } else { + $info{$key}{'status'} = 'nokey'; } - 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 sign_lti_payload { - my ($cdom,$cnum,$crsdef,$type,$context,$url,$idx,$keynum,$loncaparev,$paramsref,$inforef) = @_; - return unless (ref($paramsref) eq 'HASH'); - my ($sigmethod,$callback,$reqtype,$reqmethod,$respfmt,$bodyhash); - if (ref($inforef) eq 'HASH') { - if (exists($inforef->{'method'})) { - $sigmethod = $inforef->{'method'}; - } - if (exists($inforef->{'cb'})) { - $callback = $inforef->{'cb'}; - } - if (exists($inforef->{'reqtype'})) { - $reqtype = $inforef->{'reqtype'}; - } - if (exists($inforef->{'reqmethod'})) { - $reqmethod = $inforef->{'reqmethod'}; } - if (exists($inforef->{'body_hash'})) { - $bodyhash = $inforef->{'body_hash'}; - } - if (exists($inforef->{'respfmt'})) { - $respfmt = $inforef->{'respfmt'}; - } - } - my ($key,$secret) = &get_lti_credentials($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev); - return if (($key eq '') || ($secret eq '')); - if ($sigmethod eq '') { - $sigmethod = 'HMAC-SHA1'; - } - if ($callback eq '') { - $callback = 'about:blank', - } - if ($reqtype eq '') { - $reqtype = 'request token'; - } - if ($reqmethod eq '') { - $reqmethod = 'POST'; - } - srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. - my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); - my $request; - if (($context eq 'grade') && ($reqtype eq 'consumer') && ($bodyhash ne '')) { - $request = Net::OAuth->request($reqtype)->new( - consumer_key => $key, - consumer_secret => $secret, - request_url => $url, - request_method => $reqmethod, - signature_method => $sigmethod, - timestamp => time(), - nonce => $nonce, - body_hash => $bodyhash, - ); - $request->add_required_message_params('body_hash'); - } else { - $request = Net::OAuth->request($reqtype)->new( - consumer_key => $key, - consumer_secret => $secret, - request_url => $url, - request_method => 'POST', - signature_method => $sigmethod, - timestamp => time, - nonce => $nonce, - callback => $callback, - extra_params => $paramsref, - version => '1.0', - ); - } - $request->sign(); - if ($respfmt eq 'to_post_body') { - return $request->to_post_body(); - } elsif ($respfmt eq 'to_authorization_header') { - return $request->to_authorization_header(); - } else { - return $request->to_hash(); - } -} - -sub get_lti_credentials { - my ($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev) = @_; - my ($dbname,$name,$cachename,$hashid,$key,$secret,%ltienc); - if ($crsdef) { - $hashid = $cdom.'_'.$cnum; - } else { - $hashid = $cdom; - } - if ($type eq 'tools') { - if ($crsdef) { - $dbname = 'nohist_toolsenc'; - $cachename = 'crsltitoolsenc'; - } else { - $name = 'ltitools'; - $dbname = 'encconfig'; - $cachename = 'ltitoolsenc'; - } - } elsif ($type eq 'linkprot') { - if ($crsdef) { - $dbname = 'nohist_ltienc'; - $cachename = 'courseltienc'; - } else { - $name = 'linkprot'; - $dbname = 'encconfig'; - $cachename = 'linkprotenc'; - } - } elsif ($type eq 'lti') { - $name = 'lti'; - $dbname = 'encconfig'; - $cachename = 'ltienc'; - } - my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid); - if (defined($enccached)) { - if (ref($encresult) eq 'HASH') { - %ltienc = %{$encresult}; - } - } else { - if ($crsdef) { - my $reply = &dump_with_regexp(join(":",($cdom,$cnum,$dbname,'','')),$loncaparev); - %ltienc = %{&Apache::lonnet::unserialize($reply)}; - } else { - my $reply = &get_dom("getdom:$cdom:$dbname:$name"); - my $encref = &Apache::lonnet::thaw_unescape($reply); - if (ref($encref) eq 'HASH') { - %ltienc = %{$encref}; + 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 $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltienc,$cachetime); } - if (!keys(%ltienc)) { - return (); - } elsif (exists($ltienc{$idx})) { - if (ref($ltienc{$idx}) eq 'HASH') { - if (exists($ltienc{$idx}{'key'})) { - $key = $ltienc{$idx}{'key'}; - } - if (exists($ltienc{$idx}{'secret'})) { - $secret = $ltienc{$idx}{'secret'}; - if ($keynum =~ /^\d+$/) { - my $privhost; - my $privname = 'ltitools'; - if (($type eq 'lti') || ($type eq 'linkprot')) { - $privname = 'lti'; - } - if ($crsdef) { - my $primary = &Apache::lonnet::domain($cdom,'primary'); - my @ids = &Apache::lonnet::current_machine_ids(); - unless (grep(/^\Q$primary\E$/,@ids)) { - $privhost = $primary; - my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,$privname); - if ($result eq 'ok') { - $secret = $plainsecret; - } else { - undef($secret); - } - } - } - unless ($privhost) { - my $privkey = &get_dom("getdom:$cdom:private:$keynum:$privname:key"); - if (($privkey ne '') && ($secret ne '')) { - my $cipher = new Crypt::CBC($privkey); - $secret = $cipher->decrypt_hex($secret); - } else { - undef($secret); - } - } - } - } - } + my $result; + foreach my $key (keys(%info)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&'; } - return ($key,$secret); -} - -sub decrypt_secret { - my ($privhost,$secret,$keynum,$type) = @_; - return; + $result =~ s/\&$//; + return $result; } 1; @@ -1343,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