[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.447 and 1.448

version 1.447, 2003/11/11 20:10:32 version 1.448, 2003/11/12 19:51:43
Line 30 Line 30
 package Apache::lonnet;  package Apache::lonnet;
   
 use strict;  use strict;
 use Apache::File;  
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
Line 56  my $readit; Line 55  my $readit;
   
 sub logtouch {  sub logtouch {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unless (-e "$execdir/logs/lonnet.log") {      unless (-e "$execdir/logs/lonnet.log") {
  my $fh=Apache::File->new(">>$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 69  sub logthis { Line 68  sub logthis {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");      if (open(my $fh,">>$execdir/logs/lonnet.log")) {
     print $fh "$local ($$): $message\n";   print $fh "$local ($$): $message\n";
    close($fh);
       }
     return 1;      return 1;
 }  }
   
Line 79  sub logperm { Line 80  sub logperm {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     my $fh=Apache::File->new(">>$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);
       }
     return 1;      return 1;
 }  }
   
Line 132  sub reconlonc { Line 135  sub reconlonc {
     my $peerfile=shift;      my $peerfile=shift;
     &logthis("Trying to reconnect for $peerfile");      &logthis("Trying to reconnect for $peerfile");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (my $fh=Apache::File->new("$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 180  sub critical { Line 183  sub critical {
       "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";        "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
             $dumpcount++;              $dumpcount++;
             {              {
              my $dfh;   my $dfh;
              if ($dfh=Apache::File->new(">$dfilename")) {   if (open($dfh,">$dfilename")) {
                 print $dfh "$cmd\n";      print $dfh "$cmd\n"; 
      }      close($dfh);
    }
             }              }
             sleep 2;              sleep 2;
             my $wcmd='';              my $wcmd='';
             {              {
      my $dfh;   my $dfh;
              if ($dfh=Apache::File->new("$dfilename")) {   if (open($dfh,"<$dfilename")) {
                 $wcmd=<$dfh>;      $wcmd=<$dfh>; 
      }      close($dfh);
    }
             }              }
             chomp($wcmd);              chomp($wcmd);
             if ($wcmd eq $cmd) {              if ($wcmd eq $cmd) {
Line 230  sub transfer_profile_to_env { Line 235  sub transfer_profile_to_env {
     my ($lonidsdir,$handle)=@_;      my ($lonidsdir,$handle)=@_;
     my @profile;      my @profile;
     {      {
  my $idf=Apache::File->new("$lonidsdir/$handle.id");   open(my $idf,"$lonidsdir/$handle.id");
  flock($idf,LOCK_SH);   flock($idf,LOCK_SH);
  @profile=<$idf>;   @profile=<$idf>;
  $idf->close();   close($idf);
     }      }
     my $envi;      my $envi;
     my %Remove;      my %Remove;
Line 269  sub appenv { Line 274  sub appenv {
     }      }
   
     my $lockfh;      my $lockfh;
     unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {      unless (open($lockfh,"$ENV{'user.environment'}")) {
        return 'error: '.$!;   return 'error: '.$!;
     }      }
     unless (flock($lockfh,LOCK_EX)) {      unless (flock($lockfh,LOCK_EX)) {
          &logthis("<font color=blue>WARNING: ".           &logthis("<font color=blue>WARNING: ".
                   'Could not obtain exclusive lock in appenv: '.$!);                    'Could not obtain exclusive lock in appenv: '.$!);
          $lockfh->close();           close($lockfh);
          return 'error: '.$!;           return 'error: '.$!;
     }      }
   
     my @oldenv;      my @oldenv;
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {   unless (open($fh,"$ENV{'user.environment'}")) {
  return 'error: '.$!;      return 'error: '.$!;
      }   }
      @oldenv=<$fh>;   @oldenv=<$fh>;
      $fh->close();   close($fh);
     }      }
     for (my $i=0; $i<=$#oldenv; $i++) {      for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);          chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {          if ($oldenv[$i] ne '') {
            my ($name,$value)=split(/=/,$oldenv[$i]);      my ($name,$value)=split(/=/,$oldenv[$i]);
            unless (defined($newenv{$name})) {      unless (defined($newenv{$name})) {
       $newenv{$name}=$value;   $newenv{$name}=$value;
    }      }
         }          }
     }      }
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {   unless (open($fh,">$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      my $newname;   my $newname;
      foreach $newname (keys %newenv) {   foreach $newname (keys %newenv) {
  print $fh "$newname=$newenv{$newname}\n";      print $fh "$newname=$newenv{$newname}\n";
      }   }
      $fh->close();   close($fh);
     }      }
   
     $lockfh->close();      close($lockfh);
     return 'ok';      return 'ok';
 }  }
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
Line 324  sub delenv { Line 329  sub delenv {
     }      }
     my @oldenv;      my @oldenv;
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {   unless (open($fh,"$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      unless (flock($fh,LOCK_SH)) {   unless (flock($fh,LOCK_SH)) {
          &logthis("<font color=blue>WARNING: ".      &logthis("<font color=blue>WARNING: ".
                   'Could not obtain shared lock in delenv: '.$!);       'Could not obtain shared lock in delenv: '.$!);
          $fh->close();      close($fh);
          return 'error: '.$!;      return 'error: '.$!;
      }   }
      @oldenv=<$fh>;   @oldenv=<$fh>;
      $fh->close();   close($fh);
     }      }
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {   unless (open($fh,">$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      unless (flock($fh,LOCK_EX)) {   unless (flock($fh,LOCK_EX)) {
          &logthis("<font color=blue>WARNING: ".      &logthis("<font color=blue>WARNING: ".
                   'Could not obtain exclusive lock in delenv: '.$!);       'Could not obtain exclusive lock in delenv: '.$!);
          $fh->close();      close($fh);
          return 'error: '.$!;      return 'error: '.$!;
      }   }
      foreach (@oldenv) {   foreach (@oldenv) {
  unless ($_=~/^$delthis/) { print $fh $_; }      unless ($_=~/^$delthis/) { print $fh $_; }
      }   }
      $fh->close();   close($fh);
     }      }
     return 'ok';      return 'ok';
 }  }
Line 387  sub overloaderror { Line 392  sub overloaderror {
     unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }      unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
     my $loadavg;      my $loadavg;
     if ($checkserver eq $perlvar{'lonHostID'}) {      if ($checkserver eq $perlvar{'lonHostID'}) {
        my $loadfile=Apache::File->new('/proc/loadavg');         open(my $loadfile,'/proc/loadavg');
        $loadavg=<$loadfile>;         $loadavg=<$loadfile>;
        $loadavg =~ s/\s.*//g;         $loadavg =~ s/\s.*//g;
        $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};         $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
          close($loadfile);
     } else {      } else {
        $loadavg=&reply('load',$checkserver);         $loadavg=&reply('load',$checkserver);
     }      }
Line 1229  sub finishuserfileupload { Line 1235  sub finishuserfileupload {
     }      }
 # Save the file  # Save the file
     {      {
        my $fh=Apache::File->new('>'.$filepath.'/'.$fname);         open(my $fh,'>'.$filepath.'/'.$fname);
        print $fh $ENV{'form.'.$formname};         print $fh $ENV{'form.'.$formname};
          close($fh);
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
Line 1454  sub postannounce { Line 1461  sub postannounce {
 }  }
   
 sub getannounce {  sub getannounce {
     if (my $fh=Apache::File->new($perlvar{'lonDocRoot'}.'/announcement.txt')) {  
       if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
  my $announcement='';   my $announcement='';
  while (<$fh>) { $announcement .=$_; }   while (<$fh>) { $announcement .=$_; }
  $fh->close();   close($fh);
  if ($announcement=~/\w/) {    if ($announcement=~/\w/) { 
     return       return 
    '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.     '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
Line 2844  sub get_query_reply { Line 2852  sub get_query_reply {
     for (1..100) {      for (1..100) {
  sleep 2;   sleep 2;
         if (-e $replyfile.'.end') {          if (-e $replyfile.'.end') {
     if (my $fh=Apache::File->new($replyfile)) {      if (open(my $fh,$replyfile)) {
                $reply.=<$fh>;                 $reply.=<$fh>;
                $fh->close;                 close($fh);
    } else { return 'error: reply_file_error'; }     } else { return 'error: reply_file_error'; }
            return &unescape($reply);             return &unescape($reply);
  }   }
Line 4337  sub getfile { Line 4345  sub getfile {
  } else { # normal file from res space   } else { # normal file from res space
   &repcopy($file);    &repcopy($file);
   if (! -e $file ) { return -1; };    if (! -e $file ) { return -1; };
   my $fh=Apache::File->new($file);    my $fh;
     open($fh,"<$file");
   my $a='';    my $a='';
   while (<$fh>) { $a .=$_; }    while (<$fh>) { $a .=$_; }
   return $a;    return $a;
Line 4453  BEGIN { Line 4462  BEGIN {
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf  # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {      unless ($readit) {
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");      open(my $config,"</etc/httpd/conf/loncapa.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4462  BEGIN { Line 4471  BEGIN {
            $perlvar{$varname}=$varvalue;             $perlvar{$varname}=$varvalue;
         }          }
     }      }
       close($config);
 }  }
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");      open(my $config,"</etc/httpd/conf/loncapa_apache.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4473  BEGIN { Line 4483  BEGIN {
            $perlvar{$varname}=$varvalue;             $perlvar{$varname}=$varvalue;
         }          }
     }      }
       close($config);
 }  }
   
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
 {  {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.  
                             '/domain.tab');  
     %domaindescription = ();      %domaindescription = ();
     %domain_auth_def = ();      %domain_auth_def = ();
     %domain_auth_arg_def = ();      %domain_auth_arg_def = ();
     if ($fh) {      my $fh;
       if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
        while (<$fh>) {         while (<$fh>) {
            next if (/^(\#|\s*$)/);             next if (/^(\#|\s*$)/);
 #           next if /^\#/;  #           next if /^\#/;
Line 4497  BEGIN { Line 4507  BEGIN {
    $domain_longi{$domain}=$longi;     $domain_longi{$domain}=$longi;
    $domain_lati{$domain}=$lati;     $domain_lati{$domain}=$lati;
   
 #          &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");   #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
 #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );  #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
        }   }
     }      }
       close ($fh);
 }  }
   
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        next if ($configline =~ /^(\#|\s*$)/);         next if ($configline =~ /^(\#|\s*$)/);
Line 4524  BEGIN { Line 4535  BEGIN {
  }   }
        }         }
     }      }
       close($config);
 }  }
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");      open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);         chomp($configline);
Line 4536  BEGIN { Line 4548  BEGIN {
           $spareid{$configline}=1;            $spareid{$configline}=1;
        }         }
     }      }
       close($config);
 }  }
 # ------------------------------------------------------------ Read permissions  # ------------------------------------------------------------ Read permissions
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");      open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
       if ($configline) {   if ($configline) {
        my ($role,$perm)=split(/ /,$configline);      my ($role,$perm)=split(/ /,$configline);
        if ($perm ne '') { $pr{$role}=$perm; }      if ($perm ne '') { $pr{$role}=$perm; }
       }   }
     }      }
       close($config);
 }  }
   
 # -------------------------------------------- Read plain texts for permissions  # -------------------------------------------- Read plain texts for permissions
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab");      open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
       if ($configline) {   if ($configline) {
        my ($short,$plain)=split(/:/,$configline);      my ($short,$plain)=split(/:/,$configline);
        if ($plain ne '') { $prp{$short}=$plain; }      if ($plain ne '') { $prp{$short}=$plain; }
       }   }
     }      }
       close($config);
 }  }
   
 # ---------------------------------------------------------- Read package table  # ---------------------------------------------------------- Read package table
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");      open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
        my ($short,$plain)=split(/:/,$configline);   my ($short,$plain)=split(/:/,$configline);
        my ($pack,$name)=split(/\&/,$short);   my ($pack,$name)=split(/\&/,$short);
        if ($plain ne '') {   if ($plain ne '') {
           $packagetab{$pack.'&'.$name.'&name'}=$name;       $packagetab{$pack.'&'.$name.'&name'}=$name; 
           $packagetab{$short}=$plain;       $packagetab{$short}=$plain; 
        }   }
     }      }
       close($config);
 }  }
   
 # ------------- set up temporary directory  # ------------- set up temporary directory
Removed from v.1.447  
changed lines
  Added in v.1.448

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