[BACK]Return to Lond.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Lond.pm between versions 1.8.2.3.2.2 and 1.15

version 1.8.2.3.2.2, 2022/02/07 18:32:34 version 1.15, 2019/07/11 18:12:01
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 Net::OAuth;  use MIME::Base64;
   use Crypt::OpenSSL::X509;
   use Crypt::X509::CRL;
   use Crypt::PKCS10;
   
 sub dump_with_regexp {  sub dump_with_regexp {
     my ( $tail, $clientversion ) = @_;      my ( $tail, $clientversion ) = @_;
Line 239  sub check_homecourses { Line 242  sub check_homecourses {
                     }                      }
                 }                  }
                 unless (&untie_domain_hash($hashref)) {                  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 {              } 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)) {          foreach my $hashid (keys(%recent)) {
Line 314  sub get_courseinfo_hash { Line 317  sub get_courseinfo_hash {
     };      };
     if ($@) {      if ($@) {
         if ($@ eq "timeout\n") {          if ($@ eq "timeout\n") {
             &Apache::lonnet::logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");              &logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
         } else {          } else {
             &Apache::lonnet::logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");              &logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
         }          }
     } else {      } else {
         if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {          if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
Line 802  sub is_course { Line 805  sub is_course {
             }              }
             &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);              &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
             unless (&untie_domain_hash($hashref)) {              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 {          } 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;      return $iscourse;
 }  }
   
 sub get_dom {  sub server_certs {
     my ($userinput) = @_;      my ($perlvar,$lonhost,$hostname) = @_;
     my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4);      my %pemfiles = (
     my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or                       key      => 'lonnetPrivateKey',
         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";                       host     => 'lonnetCertificate',
     my $qresult='';                       hostname => 'lonnetHostnameCertificate',
     if (ref($hashref)) {                       ca       => 'lonnetCertificateAuthority',
         chomp($what);                       crl      => 'lonnetCertRevocationList',
         my @queries=split(/\&/,$what);                     );
         for (my $i=0;$i<=$#queries;$i++) {      my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile,$cafile,
             $qresult.="$hashref->{$queries[$i]}&";          %rvkcerts,$numrvk);
         }      %info = (
         $qresult=~s/\&$//;                  key => {},
     }                  ca  => {},
     &untie_user_hash($hashref) or                  host => {},
         return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";                  hostname => {},
     return $qresult;                  crl => {},
 }              );
       my @ordered = ('crl','key','ca','host','hostname');
 sub crslti_itemid {      if (ref($perlvar) eq 'HASH') {
     my ($cdom,$cnum,$url,$method,$params,$loncaparev) = @_;          $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname};
     unless (ref($params) eq 'HASH') {          $expected_cn{'hostname'} = 'internal-'.$hostname;
         return;          my $certsdir = $perlvar->{'lonCertificateDirectory'};
     }          if (-d $certsdir) {
     if (($cdom eq '') || ($cnum eq '')) {              $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}};
         return;              $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}};
     }              foreach my $key (@ordered) {
     my ($itemid,$consumer_key,$secret);                  if ($perlvar->{$pemfiles{$key}}) {
                       my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};
     if (exists($params->{'oauth_callback'})) {                      if (-e $file) {
         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;                          if ($key eq 'crl') {
     } else {                               if ((-e $crlfile) && (-e $cafile)) {
         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;                                   if (open(PIPE,"openssl crl -in $crlfile -inform pem -CAfile $cafile -noout 2>&1 |")) {
     }                                       my $crlstatus = <PIPE>;
                                        close(PIPE);
     my $consumer_key = $params->{'oauth_consumer_key'};                                       chomp($crlstatus);
     return if ($consumer_key eq '');                                       if ($crlstatus =~ /OK/) {
                                            $info{$key}{'status'} = 'ok';
     my (%crslti,%crslti_by_key);                                           $info{$key}{'details'} = 'CRL valid for CA';
     my $hashid=$cdom.'_'.$cnum;                                       }
     my ($result,$cached)=&Apache::lonnet::is_cached_new('courseltienc',$hashid);                                   }
     if (defined($cached)) {                               }
         if (ref($result) eq 'HASH') {                               if (open(my $fh,'<',$crlfile)) {
             %crslti = %{$result};                                   my $pem_crl = '';
         }                                   while (my $line=<$fh>) {
     } else {                                       chomp($line);
         my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_ltienc','','')),$loncaparev);                                       next if ($line eq '-----BEGIN X509 CRL-----');
         %crslti = %{&Apache::lonnet::unserialize($reply)};                                       next if ($line eq '-----END X509 CRL-----');
         my $cachetime = 24*60*60;                                       $pem_crl .= $line;
         &Apache::lonnet::do_cache_new('courseltienc',$hashid,\%crslti,$cachetime);                                   }
     }                                   close($fh);
                                    my $der_crl = MIME::Base64::decode_base64($pem_crl);
     return if (!keys(%crslti));                                   if ($der_crl ne '') {
                                        my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
     foreach my $id (keys(%crslti)) {                                       if ($decoded->error) {
         if (ref($crslti{$id}) eq 'HASH') {                                           $info{$key}{'status'} = 'error';
             my $key = $crslti{$id}{'key'};                                       } elsif (ref($decoded)) {
             if (($key ne '') && ($crslti{$id}{'secret'} ne '')) {                                           $info{$key}{'start'} = $decoded->this_update;
                 push(@{$crslti_by_key{$key}},$id);                                           $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;
     return if (!keys(%crslti_by_key));                                           my $rlref = $decoded->revocation_list;
                                            if (ref($rlref) eq 'HASH') {
     if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') {                                               foreach my $key (keys(%{$rlref})) {
         foreach my $id (@{$crslti_by_key{$consumer_key}}) {                                                   my $hkey = sprintf("%X",$key);
             my $secret = $crslti{$id}{'secret'};                                                   $rvkcerts{$hkey} = 1;
             my $request = Net::OAuth->request('request token')->from_hash($params,                                               }
                                               request_url => $url,                                               $numrvk = scalar(keys(%{$rlref}));
                                               request_method => $method,                                               if ($numrvk) {
                                               consumer_secret => $secret,);                                                   $info{$key}{'details'} .= " ($numrvk revoked)"; 
             if ($request->verify()) {                                               }
                 $itemid = $id;                                           }
                 last;                                       }
             }                                   }
         }                              }
     }                          } elsif ($key eq 'key') {
     return $itemid;                              if (open(PIPE,"openssl rsa -noout -in $file -check |")) {
 }                                  my $check = <PIPE>;
                                   close(PIPE);
 sub domlti_itemid {                                  chomp($check);
     my ($dom,$context,$url,$method,$params,$loncaparev) = @_;                                  $info{$key}{'status'} = $check;
     unless (ref($params) eq 'HASH') {                              }
         return;                              if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {
     }                                  $md5hash{$key} = <PIPE>;
     if ($dom eq '') {                                  close(PIPE);
         return;                                  chomp($md5hash{$key});
     }                              }
     my ($itemid,$consumer_key,$secret);                          } else {
                               if ($key eq 'ca') {
     if (exists($params->{'oauth_callback'})) {                                  if (open(PIPE,"openssl verify -CAfile $file $file |")) {
         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;                                      my $check = <PIPE>;
     } else {                                      close(PIPE);
         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;                                      chomp($check);
     }                                      if ($check eq "$file: OK") {
                                           $info{$key}{'status'} = 'ok';
     my $consumer_key = $params->{'oauth_consumer_key'};                                      } else {
     return if ($consumer_key eq '');                                          $check =~ s/^\Q$file\E\:?\s*//;
                                           $info{$key}{'status'} = $check;
     my %ltienc;                                      }
     my ($encresult,$enccached)=&Apache::lonnet::is_cached_new('ltienc',$dom);                                  }
     if (defined($enccached)) {                              } else {
         if (ref($encresult) eq 'HASH') {                                  if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {
             %ltienc = %{$encresult};                                      $md5hash{$key} = <PIPE>;
         }                                      close(PIPE);
     } else {                                      chomp($md5hash{$key});
         my $reply = &get_dom("getdom:$dom:encconfig:lti");                                  }
         my $ltiencref = &Apache::lonnet::thaw_unescape($reply);                              }
         if (ref($ltiencref) eq 'HASH') {                              my $x509 = Crypt::OpenSSL::X509->new_from_file($file);
             %ltienc = %{$ltiencref};                              my @items = split(/,\s+/,$x509->subject());
         }                              foreach my $item (@items) {
         my $cachetime = 24*60*60;                                  my ($name,$value) = split(/=/,$item);
         &Apache::lonnet::do_cache_new('ltienc',$dom,\%ltienc,$cachetime);                                  if ($name eq 'CN') {
     }                                      $info{$key}{'cn'} = $value;
                                   }
     return if (!keys(%ltienc));                              }
                               $info{$key}{'start'} = $x509->notBefore();
     my %lti;                              $info{$key}{'end'} = $x509->notAfter();
     if ($context eq 'deeplink') {                              $info{$key}{'alg'} = $x509->sig_alg_name();
         my ($result,$cached)=&Apache::lonnet::is_cached_new('lti',$dom);                              $info{$key}{'size'} = $x509->bit_length();
         if (defined($cached)) {                              $info{$key}{'email'} = $x509->email();
             if (ref($result) eq 'HASH') {                              $info{$key}{'serial'} = uc($x509->serial());
                 %lti = %{$result};                              $info{$key}{'issuerhash'} = $x509->issuer_hash();
             }                              if ($x509->checkend(0)) {
         } else {                                  $expired{$key} = 1;
             my $reply = &get_dom("getdom:$dom:configuration:lti");                              }
             my $ltiref = &Apache::lonnet::thaw_unescape($reply);                              if (($key eq 'host') || ($key eq 'hostname')) {
             if (ref($ltiref) eq 'HASH') {                                  if ($info{$key}{'cn'} ne $expected_cn{$key}) {
                 %lti = %{$ltiref};                                      $wrongcn{$key} = 1;
                                   }
                                   if (($numrvk) && ($info{$key}{'serial'})) {
                                       if ($rvkcerts{$info{$key}{'serial'}}) {
                                           $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 = <PIPE>;
                                   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));      foreach my $key ('host','hostname') {
           if ($md5hash{$key}) {
     my %lti_by_key;              if ($md5hash{$key} eq $md5hash{'key'}) {
     foreach my $id (keys(%ltienc)) {                  if ($revoked{$key}) {
         if (ref($ltienc{$id}) eq 'HASH') {                      $info{$key}{'status'} = 'revoked';
             my $key = $ltienc{$id}{'key'};                  } elsif ($expired{$key}) {
             if (($key ne '') && ($ltienc{$id}{'secret'} ne '')) {                      $info{$key}{'status'} = 'expired';
                 if ($context eq 'deeplink') {                  } elsif ($wrongcn{$key}) {
                     if (ref($lti{$id}) eq 'HASH') {                      $info{$key}{'status'} = 'wrongcn';
                         if (!$lti{$id}{'requser'}) {                  } elsif ((exists($info{'ca'}{'issuerhash'})) &&
                             push(@{$lti_by_key{$key}},$id);                           ($info{'ca'}{'issuerhash'} ne $info{$key}{'issuerhash'})) {
                         }                      $info{$key}{'status'} = 'mismatch';
                     }  
                 } else {                  } 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';
             }              }
         }          }
     }          if ($md5hash{$key.'-csr'}) {
     return if (!keys(%lti_by_key));              if ($md5hash{$key.'-csr'} eq $md5hash{'key'}) {
                   $info{$key.'-csr'}{'status'} = 'ok';
     if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') {              } elsif ($info{'key'}{'status'} =~ /ok/) {
         foreach my $id (@{$lti_by_key{$consumer_key}}) {                  $info{$key.'-csr'}{'status'} = 'otherkey';
             my $secret = $ltienc{$id}{'secret'};              } else {
             my $request = Net::OAuth->request('request token')->from_hash($params,                  $info{$key.'-csr'}{'status'} = 'nokey';
                                               request_url => $url,  
                                               request_method => $method,  
                                               consumer_secret => $secret,);  
             if ($request->verify()) {  
                 $itemid = $id;  
                 last;  
             }              }
         }          }
     }      }
     return $itemid;      my $result;
       foreach my $key (keys(%info)) {
           $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&';
       }
       $result =~ s/\&$//;
       return $result;
 }  }
   
 1;  1;
Line 1105  courseID -- for the course for which the Line 1146  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
   
Removed from v.1.8.2.3.2.2  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>