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

version 1.10, 2017/05/18 22:13:52 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 MIME::Base64;
 use Crypt::OpenSSL::X509;  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 783  sub dump_profile_database { Line 785  sub dump_profile_database {
     return $qresult;      return $qresult;
 }  }
   
   sub is_course {
       my ($cdom,$cnum) = @_;
   
       return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
                      ($cnum =~ /^$LONCAPA::match_courseid$/));
       my $hashid = $cdom.':'.$cnum;
       my ($iscourse,$cached) =
           &Apache::lonnet::is_cached_new('iscourse',$hashid);
       unless (defined($cached)) {
           my $hashref =
               &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
           if (ref($hashref) eq 'HASH') {
               my $esc_key = &escape($cdom.'_'.$cnum);
               if (exists($hashref->{$esc_key})) {
                   $iscourse = 1;
               } else {
                   $iscourse = 0;
               }
               &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
               unless (&untie_domain_hash($hashref)) {
                   &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
               }
           } else {
               &logthis("Failed to tie hash for nohist_courseids.db for $cdom");
           }
       }
       return $iscourse;
   }
   
 sub server_certs {  sub server_certs {
     my ($perlvar) = @_;      my ($perlvar,$lonhost,$hostname) = @_;
     my %pemfiles = (      my %pemfiles = (
                      key      => 'lonnetPrivateKey',                       key      => 'lonnetPrivateKey',
                      host     => 'lonnetCertificate',                       host     => 'lonnetCertificate',
                      hostname => 'lonnetHostnameCertificate',                       hostname => 'lonnetHostnameCertificate',
                      ca       => 'lonnetCertificateAuthority',                       ca       => 'lonnetCertificateAuthority',
                        crl      => 'lonnetCertRevocationList',
                    );                     );
     my (%md5hash,%info);      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') {      if (ref($perlvar) eq 'HASH') {
           $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname};
           $expected_cn{'hostname'} = 'internal-'.$hostname;
         my $certsdir = $perlvar->{'lonCertificateDirectory'};          my $certsdir = $perlvar->{'lonCertificateDirectory'};
         if (-d $certsdir) {          if (-d $certsdir) {
             foreach my $key (keys(%pemfiles)) {              $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}};
               $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}};
               foreach my $key (@ordered) {
                 if ($perlvar->{$pemfiles{$key}}) {                  if ($perlvar->{$pemfiles{$key}}) {
                     my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};                      my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};
                     if (-e $file) {                      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 = <PIPE>;
                                        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 |")) {                              if (open(PIPE,"openssl rsa -noout -in $file -check |")) {
                                 my $check = <PIPE>;                                  my $check = <PIPE>;
                                 close(PIPE);                                  close(PIPE);
Line 809  sub server_certs { Line 901  sub server_certs {
                             if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {                              if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {
                                 $md5hash{$key} = <PIPE>;                                  $md5hash{$key} = <PIPE>;
                                 close(PIPE);                                  close(PIPE);
                                   chomp($md5hash{$key});
                             }                              }
                         } else {                          } else {
                             if ($key eq 'ca') {                              if ($key eq 'ca') {
Line 827  sub server_certs { Line 920  sub server_certs {
                                 if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {                                  if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {
                                     $md5hash{$key} = <PIPE>;                                      $md5hash{$key} = <PIPE>;
                                     close(PIPE);                                      close(PIPE);
                                       chomp($md5hash{$key});
                                 }                                  }
                             }                              }
                             my $x509 = Crypt::OpenSSL::X509->new_from_file($file);                              my $x509 = Crypt::OpenSSL::X509->new_from_file($file);
Line 842  sub server_certs { Line 936  sub server_certs {
                             $info{$key}{'alg'} = $x509->sig_alg_name();                              $info{$key}{'alg'} = $x509->sig_alg_name();
                             $info{$key}{'size'} = $x509->bit_length();                              $info{$key}{'size'} = $x509->bit_length();
                             $info{$key}{'email'} = $x509->email();                              $info{$key}{'email'} = $x509->email();
                               $info{$key}{'serial'} = uc($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 (($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;
                                           }
                                       }
                                   }
                               }
                         }                          }
                     }                      }
                 }                  }
Line 851  sub server_certs { Line 988  sub server_certs {
     foreach my $key ('host','hostname') {      foreach my $key ('host','hostname') {
         if ($md5hash{$key}) {          if ($md5hash{$key}) {
             if ($md5hash{$key} eq $md5hash{'key'}) {              if ($md5hash{$key} eq $md5hash{'key'}) {
                 $info{$key}{'status'} = 'ok';                  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/) {              } elsif ($info{'key'}{'status'} =~ /ok/) {
                 $info{$key}{'status'} = 'otherkey';                  $info{$key}{'status'} = 'otherkey';
             } else {              } else {
                 $info{$key}{'status'} = 'nokey';                  $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;      my $result;
     foreach my $key (keys(%info)) {      foreach my $key (keys(%info)) {

Removed from v.1.10  
changed lines
  Added in v.1.15


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