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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1379 and 1.1384

version 1.1379, 2018/07/18 13:45:03 version 1.1384, 2018/09/20 14:17:11
Line 230  sub get_server_distarch { Line 230  sub get_server_distarch {
 }  }
   
 sub get_servercerts_info {  sub get_servercerts_info {
     my ($lonhost,$context) = @_;      my ($lonhost,$hostname,$context) = @_;
       return if ($lonhost eq '');
       if ($hostname eq '') {
           $hostname = &hostname($lonhost);
       }
       return if ($hostname eq '');
     my ($rep,$uselocal);      my ($rep,$uselocal);
     if (grep { $_ eq $lonhost } &current_machine_ids()) {      if (grep { $_ eq $lonhost } &current_machine_ids()) {
         $uselocal = 1;          $uselocal = 1;
Line 250  sub get_servercerts_info { Line 255  sub get_servercerts_info {
         }          }
     }      }
     if ($uselocal) {      if ($uselocal) {
         $rep = LONCAPA::Lond::server_certs(\%perlvar);          $rep = LONCAPA::Lond::server_certs(\%perlvar,$lonhost,$hostname);
     } else {      } else {
         $rep=&reply('servercerts',$lonhost);          $rep=&reply('servercerts',$lonhost);
     }      }
     my ($result,%returnhash);      my ($result,%returnhash);
     if (defined($lonhost)) {  
         if (!defined(&hostname($lonhost))) {  
             return;  
         }  
     }  
     if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||      if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
         ($rep eq 'unknown_cmd')) {          ($rep eq 'unknown_cmd')) {
         $result = $rep;          $result = $rep;
Line 3197  sub ssi { Line 3197  sub ssi {
   
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $lonhost = $perlvar{'lonHostID'};      my $lonhost = $perlvar{'lonHostID'};
     my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar);      my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
                                                   '','','',1);
   
     if (wantarray) {      if (wantarray) {
  return ($response->content, $response);   return ($response->content, $response);
Line 10041  sub is_course { Line 10042  sub is_course {
     my ($cdom, $cnum) = scalar(@_) == 1 ?       my ($cdom, $cnum) = scalar(@_) == 1 ? 
          ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;           ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
   
     return unless $cdom and $cnum;      return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
       my $uhome=&homeserver($cnum,$cdom);
     my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,      my $iscourse;
         '.');      if (grep { $_ eq $uhome } current_machine_ids()) {
           $iscourse = &LONCAPA::Lond::is_course($cdom,$cnum);
     return unless(exists($courses{$cdom.'_'.$cnum}));      } else {
           my $hashid = $cdom.':'.$cnum;
           ($iscourse,my $cached) = &is_cached_new('iscourse',$hashid);
           unless (defined($cached)) {
               my %courses = &courseiddump($cdom, '.', 1, '.', '.',
                                           $cnum,undef,undef,'.');
               $iscourse = 0;
               if (exists($courses{$cdom.'_'.$cnum})) {
                   $iscourse = 1;
               }
               &do_cache_new('iscourse',$hashid,$iscourse,3600);
           }
       }
       return unless ($iscourse);
     return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;      return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }  }
   
Line 13629  sub fetch_crl_pemfile { Line 13643  sub fetch_crl_pemfile {
   
 sub save_crl_pem {  sub save_crl_pem {
     my ($response) = @_;      my ($response) = @_;
     my $msg;      my ($msg,$hadchanges);
     if (ref($response)) {      if (ref($response)) {
         my $now = time;          my $now = time;
         my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};          my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};
Line 13644  sub save_crl_pem { Line 13658  sub save_crl_pem {
                     chomp($check);                      chomp($check);
                     if ($check eq 'verify OK') {                      if ($check eq 'verify OK') {
                         my $dest = "$perlvar{'lonCertificateDirectory'}/$perlvar{'lonnetCertRevocationList'}";                          my $dest = "$perlvar{'lonCertificateDirectory'}/$perlvar{'lonnetCertRevocationList'}";
                           my $backup;
                         if (-e $dest) {                          if (-e $dest) {
                             &File::Copy::move($dest,"$dest.bak");                              if (&File::Copy::move($dest,"$dest.bak")) {
                                   $backup = 'ok';
                               }
                         }                          }
                         if (&File::Copy::move($tmpcrl,$dest)) {                          if (&File::Copy::move($tmpcrl,$dest)) {
                             $msg = 'ok';                              $msg = 'ok';
                               if ($backup) {
                                   my (%oldnums,%newnums);
                                   if (open(PIPE, "openssl crl -inform PEM -text -noout -in $dest.bak |grep 'Serial Number' |")) {
                                       while (<PIPE>) {
                                           $oldnums{(split(/:/))[1]} = 1;
                                       }
                                       close(PIPE);
                                   }
                                   if (open(PIPE, "openssl crl -inform PEM -text -noout -in $dest |grep 'Serial Number' |")) {
                                       while(<PIPE>) {
                                           $newnums{(split(/:/))[1]} = 1;
                                       }
                                       close(PIPE);
                                   }
                                   foreach my $key (sort {$b <=> $a } (keys(%newnums))) {
                                       unless (exists($oldnums{$key})) {
                                           $hadchanges = 1;
                                           last;
                                       }
                                   }
                                   unless ($hadchanges) {
                                       foreach my $key (sort {$b <=> $a } (keys(%oldnums))) {
                                           unless (exists($newnums{$key})) {
                                               $hadchanges = 1;
                                               last;
                                           }
                                       }
                                   }
                               }
                         }                          }
                     } else {                      } else {
                         unlink($tmpcrl);                          unlink($tmpcrl);
Line 13661  sub save_crl_pem { Line 13707  sub save_crl_pem {
             }              }
         }          }
     }      }
     return $msg;      return ($msg,$hadchanges);
 }  }
   
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
Removed from v.1.1379  
changed lines
  Added in v.1.1384

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