[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.1172.2.93.4.3 and 1.1172.2.93.4.10

version 1.1172.2.93.4.3, 2017/10/14 21:27:51 version 1.1172.2.93.4.10, 2018/04/29 00:56:53
Line 142  our @EXPORT = qw(%env); Line 142  our @EXPORT = qw(%env);
 sub logtouch {  sub logtouch {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unless (-e "$execdir/logs/lonnet.log") {      unless (-e "$execdir/logs/lonnet.log") {
  open(my $fh,">>$execdir/logs/lonnet.log");   open(my $fh,">>","$execdir/logs/lonnet.log");
  close $fh;   close $fh;
     }      }
     my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];      my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
Line 154  sub logthis { Line 154  sub logthis {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     if (open(my $fh,">>$execdir/logs/lonnet.log")) {      if (open(my $fh,">>","$execdir/logs/lonnet.log")) {
  my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.   my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.
  print $fh $logstring;   print $fh $logstring;
  close($fh);   close($fh);
Line 167  sub logperm { Line 167  sub logperm {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {      if (open(my $fh,">>","$execdir/logs/lonnet.perm.log")) {
  print $fh "$now:$message:$local\n";   print $fh "$now:$message:$local\n";
  close($fh);   close($fh);
     }      }
Line 436  sub reconlonc { Line 436  sub reconlonc {
   
     &logthis("Trying to reconnect lonc");      &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {      if (open(my $fh,"<",$loncfile)) {
  my $loncpid=<$fh>;   my $loncpid=<$fh>;
         chomp($loncpid);          chomp($loncpid);
         if (kill 0 => $loncpid) {          if (kill 0 => $loncpid) {
Line 476  sub critical { Line 476  sub critical {
             $dumpcount++;              $dumpcount++;
             {              {
  my $dfh;   my $dfh;
  if (open($dfh,">$dfilename")) {   if (open($dfh,">",$dfilename)) {
     print $dfh "$cmd\n";       print $dfh "$cmd\n"; 
     close($dfh);      close($dfh);
  }   }
Line 485  sub critical { Line 485  sub critical {
             my $wcmd='';              my $wcmd='';
             {              {
  my $dfh;   my $dfh;
  if (open($dfh,"<$dfilename")) {   if (open($dfh,"<",$dfilename)) {
     $wcmd=<$dfh>;       $wcmd=<$dfh>; 
     close($dfh);      close($dfh);
  }   }
Line 1841  sub inst_directory_query { Line 1841  sub inst_directory_query {
     my $homeserver = &domain($udom,'primary');      my $homeserver = &domain($udom,'primary');
     my $outcome;      my $outcome;
     if ($homeserver ne '') {      if ($homeserver ne '') {
           unless ($homeserver eq $perlvar{'lonHostID'}) {
               if ($srch->{'srchby'} eq 'email') {
                   my $lcrev = &get_server_loncaparev(undef,$homeserver);
                   my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);
                   if (($major eq '' && $minor eq '') || ($major < 2) ||
                       (($major == 2) && ($minor < 11)) || 
                       (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/))) {
                       return;
                   }
               }
           }
  my $queryid=&reply("querysend:instdirsearch:".   my $queryid=&reply("querysend:instdirsearch:".
    &escape($srch->{'srchby'}).':'.     &escape($srch->{'srchby'}).':'.
    &escape($srch->{'srchterm'}).':'.     &escape($srch->{'srchterm'}).':'.
Line 1882  sub usersearch { Line 1893  sub usersearch {
     my $query = 'usersearch';      my $query = 'usersearch';
     foreach my $tryserver (keys(%libserv)) {      foreach my $tryserver (keys(%libserv)) {
         if (&host_domain($tryserver) eq $dom) {          if (&host_domain($tryserver) eq $dom) {
               unless ($tryserver eq $perlvar{'lonHostID'}) {
                   if ($srch->{'srchby'} eq 'email') {
                       my $lcrev = &get_server_loncaparev(undef,$tryserver);
                       my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);
                       next if (($major eq '' && $minor eq '') || ($major < 2) ||
                                (($major == 2) && ($minor < 11)) || 
                                (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/)));
                   }
               }
             my $host=&hostname($tryserver);              my $host=&hostname($tryserver);
             my $queryid=              my $queryid=
                 &reply("querysend:".&escape($query).':'.                  &reply("querysend:".&escape($query).':'.
Line 3249  sub process_coursefile { Line 3269  sub process_coursefile {
                                  $home);                                   $home);
             }              }
         } elsif ($action eq 'uploaddoc') {          } elsif ($action eq 'uploaddoc') {
             open(my $fh,'>'.$filepath.'/'.$fname);              open(my $fh,'>',$filepath.'/'.$fname);
             print $fh $env{'form.'.$source};              print $fh $env{'form.'.$source};
             close($fh);              close($fh);
             if ($parser eq 'parse') {              if ($parser eq 'parse') {
Line 3307  sub store_edited_file { Line 3327  sub store_edited_file {
     ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);      ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
     $fpath=$docudom.'/'.$docuname.'/'.$fpath;      $fpath=$docudom.'/'.$docuname.'/'.$fpath;
     my $filepath = &build_filepath($fpath);      my $filepath = &build_filepath($fpath);
     open(my $fh,'>'.$filepath.'/'.$fname);      open(my $fh,'>',$filepath.'/'.$fname);
     print $fh $content;      print $fh $content;
     close($fh);      close($fh);
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
Line 3423  sub userfileupload { Line 3443  sub userfileupload {
                          '_'.$env{'user.domain'}.'/pending';                           '_'.$env{'user.domain'}.'/pending';
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {          } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
             my ($docuname,$docudom);              my ($docuname,$docudom);
             if ($destudom) {              if ($destudom =~ /^$match_domain$/) {
                 $docudom = $destudom;                  $docudom = $destudom;
             } else {              } else {
                 $docudom = $env{'user.domain'};                  $docudom = $env{'user.domain'};
             }              }
             if ($destuname) {              if ($destuname =~ /^$match_username$/) {
                 $docuname = $destuname;                  $docuname = $destuname;
             } else {              } else {
                 $docuname = $env{'user.name'};                  $docuname = $env{'user.name'};
Line 3458  sub userfileupload { Line 3478  sub userfileupload {
                 mkdir($fullpath,0777);                  mkdir($fullpath,0777);
             }              }
         }          }
         open(my $fh,'>'.$fullpath.'/'.$fname);          open(my $fh,'>',$fullpath.'/'.$fname);
         print $fh $env{'form.'.$formname};          print $fh $env{'form.'.$formname};
         close($fh);          close($fh);
         if ($context eq 'existingfile') {          if ($context eq 'existingfile') {
Line 3533  sub finishuserfileupload { Line 3553  sub finishuserfileupload {
   
 # Save the file  # Save the file
     {      {
  if (!open(FH,'>'.$filepath.'/'.$file)) {   if (!open(FH,'>',$filepath.'/'.$file)) {
     &logthis('Failed to create '.$filepath.'/'.$file);      &logthis('Failed to create '.$filepath.'/'.$file);
     print STDERR ('Failed to create '.$filepath.'/'.$file."\n");      print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
     return '/adm/notfound.html';      return '/adm/notfound.html';
Line 3591  sub finishuserfileupload { Line 3611  sub finishuserfileupload {
         my $input = $filepath.'/'.$file;          my $input = $filepath.'/'.$file;
         my $output = $filepath.'/'.'tn-'.$file;          my $output = $filepath.'/'.'tn-'.$file;
         my $thumbsize = $thumbwidth.'x'.$thumbheight;          my $thumbsize = $thumbwidth.'x'.$thumbheight;
         system("convert -sample $thumbsize $input $output");          my @args = ('convert','-sample',$thumbsize,$input,$output);
           system({$args[0]} @args);
         if (-e $filepath.'/'.'tn-'.$file) {          if (-e $filepath.'/'.'tn-'.$file) {
             $fetchthumb  = 1;               $fetchthumb  = 1; 
         }          }
Line 4551  sub postannounce { Line 4572  sub postannounce {
   
 sub getannounce {  sub getannounce {
   
     if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {      if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) {
  my $announcement='';   my $announcement='';
  while (my $line = <$fh>) { $announcement .= $line; }   while (my $line = <$fh>) { $announcement .= $line; }
  close($fh);   close($fh);
Line 8170  sub fetch_enrollment_query { Line 8191  sub fetch_enrollment_query {
                         if ($xml_classlist =~ /^error/) {                          if ($xml_classlist =~ /^error/) {
                             &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum);                              &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum);
                         } else {                          } else {
                             if ( open(FILE,">$destname") ) {                              if ( open(FILE,">",$destname) ) {
                                 print FILE &unescape($xml_classlist);                                  print FILE &unescape($xml_classlist);
                                 close(FILE);                                  close(FILE);
                             } else {                              } else {
Line 8199  sub get_query_reply { Line 8220  sub get_query_reply {
     for (1..$loopmax) {      for (1..$loopmax) {
  sleep($sleep);   sleep($sleep);
         if (-e $replyfile.'.end') {          if (-e $replyfile.'.end') {
     if (open(my $fh,$replyfile)) {      if (open(my $fh,"<",$replyfile)) {
  $reply = join('',<$fh>);   $reply = join('',<$fh>);
  close($fh);   close($fh);
    } else { return 'error: reply_file_error'; }     } else { return 'error: reply_file_error'; }
Line 8591  sub auto_validate_class_sec { Line 8612  sub auto_validate_class_sec {
     return $response;      return $response;
 }  }
   
   sub auto_validate_instclasses {
       my ($cdom,$cnum,$owners,$classesref) = @_;
       my ($homeserver,%validations);
       $homeserver = &homeserver($cnum,$cdom);
       unless ($homeserver eq 'no_host') {
           my $ownerlist;
           if (ref($owners) eq 'ARRAY') {
               $ownerlist = join(',',@{$owners});
           } else {
               $ownerlist = $owners;
           }
           if (ref($classesref) eq 'HASH') {
               my $classes = &freeze_escape($classesref);
               my $response=&reply('autovalidateinstclasses:'.&escape($ownerlist).
                                   ':'.$cdom.':'.$classes,$homeserver);
               unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
                   my @items = split(/&/,$response);
                   foreach my $item (@items) {
                       my ($key,$value) = split('=',$item);
                       $validations{&unescape($key)} = &thaw_unescape($value);
                   }
               }
           }
       }
       return %validations;
   }
   
 sub auto_crsreq_update {  sub auto_crsreq_update {
     my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,      my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,
         $code,$accessstart,$accessend,$inbound) = @_;          $code,$accessstart,$accessend,$inbound) = @_;
Line 9824  sub save_selected_files { Line 9872  sub save_selected_files {
     my ($user, $path, @files) = @_;      my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);      my @other_files = &files_not_in_path($user, $path);
     open (OUT, '>'.$tmpdir.$filename);      open (OUT,'>',LONCAPA::tempdir().$filename);
     foreach my $file (@files) {      foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");          print (OUT $env{'form.currentpath'}.$file."\n");
     }      }
Line 9838  sub save_selected_files { Line 9886  sub save_selected_files {
 sub clear_selected_files {  sub clear_selected_files {
     my ($user) = @_;      my ($user) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     open (OUT, '>'.LONCAPA::tempdir().$filename);      open (OUT,'>',LONCAPA::tempdir().$filename);
     print (OUT undef);      print (OUT undef);
     close (OUT);      close (OUT);
     return ("ok");          return ("ok");    
Line 9848  sub files_in_path { Line 9896  sub files_in_path {
     my ($user, $path) = @_;      my ($user, $path) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my %return_files;      my %return_files;
     open (IN, '<'.LONCAPA::tempdir().$filename);      open (IN,'<',LONCAPA::tempdir().$filename);
     while (my $line_in = <IN>) {      while (my $line_in = <IN>) {
         chomp ($line_in);          chomp ($line_in);
         my @paths_and_file = split (m!/!, $line_in);          my @paths_and_file = split (m!/!, $line_in);
Line 9870  sub files_not_in_path { Line 9918  sub files_not_in_path {
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @return_files;      my @return_files;
     my $path_part;      my $path_part;
     open(IN, '<'.LONCAPA::.$filename);      open(IN,'<',LONCAPA::tempdir().$filename);
     while (my $line = <IN>) {      while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work          #ok, I know it's clunky, but I want it to work
         my @paths_and_file = split(m|/|, $line);          my @paths_and_file = split(m|/|, $line);
Line 11035  sub add_prefix_and_part { Line 11083  sub add_prefix_and_part {
   
 my %metaentry;  my %metaentry;
 my %importedpartids;  my %importedpartids;
   my %importedrespids;
 sub metadata {  sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 11062  sub metadata { Line 11111  sub metadata {
     }      }
     {      {
 # Imported parts would go here  # Imported parts would go here
         my %importedids=();          my @origfiletagids=();
         my @origfileimportpartids=();  
         my $importedparts=0;          my $importedparts=0;
   
   # Imported responseids would go here
           my $importedresponses=0;
 #  #
 # Is this a recursive call for a library?  # Is this a recursive call for a library?
 #  #
Line 11159  sub metadata { Line 11210  sub metadata {
                         my $dir=$filename;                          my $dir=$filename;
                         $dir=~s|[^/]*$||;                          $dir=~s|[^/]*$||;
                         $location=&filelocation($dir,$location);                          $location=&filelocation($dir,$location);
                          
                           my $importid=$token->[2]->{'id'};
                         my $importmode=$token->[2]->{'importmode'};                          my $importmode=$token->[2]->{'importmode'};
   #
   # Check metadata for imported file to
   # see if it contained response items
   #
                           my %currmetaentry = %metaentry;
                           my $libresponseorder = &metadata($location,'responseorder');
                           my $origfile;
                           if ($libresponseorder ne '') {
                               if ($#origfiletagids<0) {
                                   undef(%importedrespids);
                                   undef(%importedpartids);
                               }
                               @{$importedrespids{$importid}} = split(/\s*,\s*/,$libresponseorder);
                               if (@{$importedrespids{$importid}} > 0) {
                                   $importedresponses = 1;
   # We need to get the original file and the imported file to get the response order correct
   # Load and inspect original file
                                   if ($#origfiletagids<0) {
                                       my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                       $origfile=&getfile($origfilelocation);
                                       @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                   }
                               }
                           }
   # Do not overwrite contents of %metaentry hash for resource itself with 
   # hash populated for imported library file
                           %metaentry = %currmetaentry;
                           undef(%currmetaentry);
                         if ($importmode eq 'problem') {                          if ($importmode eq 'problem') {
 # Import as problem/response  # Import as problem/response
                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});                             $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
Line 11169  sub metadata { Line 11249  sub metadata {
                            $importedparts=1;                             $importedparts=1;
 # We need to get the original file and the imported file to get the part order correct  # We need to get the original file and the imported file to get the part order correct
 # Good news: we do not need to worry about nested libraries, since parts cannot be nested  # Good news: we do not need to worry about nested libraries, since parts cannot be nested
 # Load and inspect original file  # Load and inspect original file if we didn't do that already
                            if ($#origfileimportpartids<0) {                             if ($#origfiletagids<0) {
                               undef(%importedpartids);                                 undef(%importedrespids);
                               my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);                                 undef(%importedpartids);
                               my $origfile=&getfile($origfilelocation);                                 if ($origfile eq '') {
                               @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                                     my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                      $origfile=&getfile($origfilelocation);
                                      @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                  }
                            }                             }
   
 # Load and inspect imported file  # Load and inspect imported file
Line 11288  sub metadata { Line 11371  sub metadata {
     grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));      grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
  $metaentry{':packages'} = join(',',@uniq_packages);   $metaentry{':packages'} = join(',',@uniq_packages);
   
         if ($importedparts) {          if (($importedresponses) || ($importedparts)) {
               if ($importedparts) {
 # We had imported parts and need to rebuild partorder  # We had imported parts and need to rebuild partorder
            $metaentry{':partorder'}='';                  $metaentry{':partorder'}='';
            $metathesekeys{'partorder'}=1;                  $metathesekeys{'partorder'}=1;
            for (my $index=0;$index<$#origfileimportpartids;$index+=2) {              }
                if ($origfileimportpartids[$index] eq 'part') {              if ($importedresponses) {
 # original part, part of the problem  # We had imported responses and need to rebuild responseorder
                   $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];                  $metaentry{':responseorder'}='';
                } else {                  $metathesekeys{'responseorder'}=1;
 # we have imported parts at this position              }
                   $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};              for (my $index=0;$index<$#origfiletagids;$index+=2) {
                }                  my $origid = $origfiletagids[$index+1];
            }                  if ($origfiletagids[$index] eq 'part') {
            $metaentry{':partorder'}=~s/^\,//;  # Original part, part of the problem
                       if ($importedparts) {
                           $metaentry{':partorder'}.=','.$origid;
                       }
                   } elsif ($origfiletagids[$index] eq 'import') {
                       if ($importedparts) {
   # We have imported parts at this position
                           $metaentry{':partorder'}.=','.$importedpartids{$origid};
                       }
                       if ($importedresponses) {
   # We have imported responses at this position
                           if (ref($importedrespids{$origid}) eq 'ARRAY') {
                               $metaentry{':responseorder'}.=','.join(',',map { $origid.'_'.$_ } @{$importedrespids{$origid}});
                           }
                       }
                   } else {
   # Original response item, part of the problem
                       if ($importedresponses) {
                           $metaentry{':responseorder'}.=','.$origid;
                       }
                   }
               }
               if ($importedparts) {
                   $metaentry{':partorder'}=~s/^\,//;
               }
               if ($importedresponses) {
                   $metaentry{':responseorder'}=~s/^\,//;
               }
         }          }
   
  $metaentry{':keys'} = join(',',keys(%metathesekeys));   $metaentry{':keys'} = join(',',keys(%metathesekeys));
Line 12389  sub readfile { Line 12500  sub readfile {
     my $file = shift;      my $file = shift;
     if ( (! -e $file ) || ($file eq '') ) { return -1; };      if ( (! -e $file ) || ($file eq '') ) { return -1; };
     my $fh;      my $fh;
     open($fh,"<$file");      open($fh,"<",$file);
     my $a='';      my $a='';
     while (my $line = <$fh>) { $a .= $line; }      while (my $line = <$fh>) { $a .= $line; }
     return $a;      return $a;
Line 12502  sub machine_ids { Line 12613  sub machine_ids {
   
 sub additional_machine_domains {  sub additional_machine_domains {
     my @domains;      my @domains;
     open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab");      open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");
     while( my $line = <$fh>) {      while( my $line = <$fh>) {
         $line =~ s/\s//g;          $line =~ s/\s//g;
         push(@domains,$line);          push(@domains,$line);
Line 12648  sub get_dns { Line 12759  sub get_dns {
     }      }
   
     my %alldns;      my %alldns;
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
     foreach my $dns (<$config>) {      foreach my $dns (<$config>) {
  next if ($dns !~ /^\^(\S*)/x);   next if ($dns !~ /^\^(\S*)/x);
         my $line = $1;          my $line = $1;
Line 12676  sub get_dns { Line 12787  sub get_dns {
     close($config);      close($config);
     my $which = (split('/',$url))[3];      my $which = (split('/',$url))[3];
     &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");      &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
     open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");      open($config,"<","$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;      my @content = <$config>;
     &$func(\@content,$hashref);      &$func(\@content,$hashref);
     return;      return;
Line 12769  sub fetch_dns_checksums { Line 12880  sub fetch_dns_checksums {
  my ($ignore_cache,$nocache) = @_;   my ($ignore_cache,$nocache) = @_;
  &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache);   &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache);
  my $fh;   my $fh;
  if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {   if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) {
     my @lines = <$fh>;      my @lines = <$fh>;
     &parse_domain_tab(\@lines);      &parse_domain_tab(\@lines);
  }   }
Line 12870  sub fetch_dns_checksums { Line 12981  sub fetch_dns_checksums {
     sub load_hosts_tab {      sub load_hosts_tab {
  my ($ignore_cache,$nocache) = @_;   my ($ignore_cache,$nocache) = @_;
  &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache);   &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache);
  open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");   open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
  my @config = <$config>;   my @config = <$config>;
  &parse_hosts_tab(\@config);   &parse_hosts_tab(\@config);
  close($config);   close($config);
Line 13136  sub all_loncaparevs { Line 13247  sub all_loncaparevs {
 {  {
     sub load_loncaparevs {      sub load_loncaparevs {
         if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {          if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
             if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {              if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) {
                 while (my $configline=<$config>) {                  while (my $configline=<$config>) {
                     chomp($configline);                      chomp($configline);
                     my ($hostid,$loncaparev)=split(/:/,$configline);                      my ($hostid,$loncaparev)=split(/:/,$configline);
Line 13152  sub all_loncaparevs { Line 13263  sub all_loncaparevs {
 {  {
     sub load_serverhomeIDs {      sub load_serverhomeIDs {
         if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {          if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
             if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {              if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
                 while (my $configline=<$config>) {                  while (my $configline=<$config>) {
                     chomp($configline);                      chomp($configline);
                     my ($name,$id)=split(/:/,$configline);                      my ($name,$id)=split(/:/,$configline);
Line 13177  BEGIN { Line 13288  BEGIN {
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
 {  {
     open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");      open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);         chomp($configline);
Line 13191  BEGIN { Line 13302  BEGIN {
 }  }
 # ------------------------------------------------------------ Read permissions  # ------------------------------------------------------------ Read permissions
 {  {
     open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");      open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
  chomp($configline);   chomp($configline);
Line 13205  BEGIN { Line 13316  BEGIN {
   
 # -------------------------------------------- Read plain texts for permissions  # -------------------------------------------- Read plain texts for permissions
 {  {
     open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");      open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
  chomp($configline);   chomp($configline);
Line 13225  BEGIN { Line 13336  BEGIN {
   
 # ---------------------------------------------------------- Read package table  # ---------------------------------------------------------- Read package table
 {  {
     open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");      open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
  if ($configline !~ /\S/ || $configline=~/^#/) { next; }   if ($configline !~ /\S/ || $configline=~/^#/) { next; }
Line 13271  BEGIN { Line 13382  BEGIN {
 # ---------------------------------------------------------- Read managers table  # ---------------------------------------------------------- Read managers table
 {  {
     if (-e "$perlvar{'lonTabDir'}/managers.tab") {      if (-e "$perlvar{'lonTabDir'}/managers.tab") {
         if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) {          if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) {
             while (my $configline=<$config>) {              while (my $configline=<$config>) {
                 chomp($configline);                  chomp($configline);
                 next if ($configline =~ /^\#/);                  next if ($configline =~ /^\#/);
Removed from v.1.1172.2.93.4.3  
changed lines
  Added in v.1.1172.2.93.4.10

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