[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.467.2.8 and 1.472

version 1.467.2.8, 2014/06/09 16:58:22 version 1.472, 2011/05/13 02:58:02
Line 15 Line 15
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
   
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
Line 420  sub ReadManagerTable { Line 421  sub ReadManagerTable {
   
    my $tablename = $perlvar{'lonTabDir'}."/managers.tab";     my $tablename = $perlvar{'lonTabDir'}."/managers.tab";
    if (!open (MANAGERS, $tablename)) {     if (!open (MANAGERS, $tablename)) {
        my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});         if (&loncapa_dns_server()) {
        if (&Apache::lonnet::is_LC_dns($hostname)) {  
            &logthis('<font color="red">No manager table.  Nobody can manage!!</font>');             &logthis('<font color="red">No manager table.  Nobody can manage!!</font>');
        }         }
        return;         return;
Line 600  sub InstallFile { Line 600  sub InstallFile {
 #  #
 #   ConfigFileFromSelector: converts a configuration file selector  #   ConfigFileFromSelector: converts a configuration file selector
 #                 into a configuration file pathname.  #                 into a configuration file pathname.
 #                 Supports the following file selectors:  #                 Supports the following file selectors: 
 #                 hosts, domain, dns_hosts, dns_domain  #                 hosts, domain, dns_hosts, dns_domain  
 #  #
 #  #
 #  Parameters:  #  Parameters:
Line 614  sub ConfigFileFromSelector { Line 614  sub ConfigFileFromSelector {
     my $tablefile;      my $tablefile;
   
     my $tabledir = $perlvar{'lonTabDir'}.'/';      my $tabledir = $perlvar{'lonTabDir'}.'/';
     if (($selector eq "hosts") || ($selector eq "domain") ||      if (($selector eq "hosts") || ($selector eq "domain") || 
         ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {          ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {
         $tablefile =  $tabledir.$selector.'.tab';   $tablefile =  $tabledir.$selector.'.tab';
     }      }
     return $tablefile;      return $tablefile;
   
 }  }
 #  #
 #   PushFile:  Called to do an administrative push of a file.  #   PushFile:  Called to do an administrative push of a file.
Line 637  sub ConfigFileFromSelector { Line 636  sub ConfigFileFromSelector {
 #     String to send to client ("ok" or "refused" if bad file).  #     String to send to client ("ok" or "refused" if bad file).
 #  #
 sub PushFile {  sub PushFile {
     my $request = shift;      my $request = shift;    
     my ($command, $filename, $contents) = split(":", $request, 3);      my ($command, $filename, $contents) = split(":", $request, 3);
     &Debug("PushFile");      &Debug("PushFile");
           
Line 646  sub PushFile { Line 645  sub PushFile {
     #   hosts.tab  ($filename eq host).      #   hosts.tab  ($filename eq host).
     #   domain.tab ($filename eq domain).      #   domain.tab ($filename eq domain).
     #   dns_hosts.tab ($filename eq dns_host).      #   dns_hosts.tab ($filename eq dns_host).
     #   dns_domain.tab ($filename eq dns_domain).      #   dns_domain.tab ($filename eq dns_domain). 
     # Construct the destination filename or reject the request.      # Construct the destination filename or reject the request.
     #      #
     # lonManage is supposed to ensure this, however this session could be      # lonManage is supposed to ensure this, however this session could be
Line 667  sub PushFile { Line 666  sub PushFile {
   
     if($filename eq "host") {      if($filename eq "host") {
  $contents = AdjustHostContents($contents);   $contents = AdjustHostContents($contents);
     } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') {  
         if ($contents eq '') {  
             &logthis('<font color="red"> Pushfile: unable to install '  
                     .$tablefile." - no data received from push. </font>");  
             return 'error: push had no data';  
         }  
         if (&Apache::lonnet::get_host_ip($clientname)) {  
             my $clienthost = &Apache::lonnet::hostname($clientname);  
             if ($managers{$clientip} eq $clientname) {  
                 my $clientprotocol = $Apache::lonnet::protocol{$clientname};  
                 $clientprotocol = 'http' if ($clientprotocol ne 'https');  
                 my $url = '/adm/'.$filename;  
                 $url =~ s{_}{/};  
                 my $ua=new LWP::UserAgent;  
                 $ua->timeout(60);  
                 my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");  
                 my $response=$ua->request($request);  
                 if ($response->is_error()) {  
                     &logthis('<font color="red"> Pushfile: unable to install '  
                             .$tablefile." - error attempting to pull data. </font>");  
                     return 'error: pull failed';  
                 } else {  
                     my $result = $response->content;  
                     chomp($result);  
                     unless ($result eq $contents) {  
                         &logthis('<font color="red"> Pushfile: unable to install '  
                                 .$tablefile." - pushed data and pulled data differ. </font>");  
                         my $pushleng = length($contents);  
                         my $pullleng = length($result);  
                         if ($pushleng != $pullleng) {  
                             return "error: $pushleng vs $pullleng bytes";  
                         } else {  
                             return "error: mismatch push and pull";  
                         }  
                     }  
                 }  
             }  
         }  
     }      }
   
     #  Install the new file:      #  Install the new file:
Line 715  sub PushFile { Line 676  sub PushFile {
  .$tablefile." $! </font>");   .$tablefile." $! </font>");
  return "error:$!";   return "error:$!";
     } else {      } else {
         &logthis('<font color="green"> Installed new '.$tablefile   &logthis('<font color="green"> Installed new '.$tablefile
                  ." - transaction by: $clientname ($clientip)</font>");   ."</font>");
         my $adminmail = $perlvar{'lonAdmEMail'};          my $adminmail = $perlvar{'lonAdmEMail'};
         my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});          my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
         if ($admindom ne '') {          if ($admindom ne '') {
Line 730  sub PushFile { Line 691  sub PushFile {
         }          }
         if ($adminmail =~ /^[^\@]+\@[^\@]+$/) {          if ($adminmail =~ /^[^\@]+\@[^\@]+$/) {
             my $msg = new Mail::Send;              my $msg = new Mail::Send;
               my $senderaddress =  $perlvar{'lonSysEMail'};
             $msg->to($adminmail);              $msg->to($adminmail);
             $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'});              $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'});
               if ($senderaddress) {
                    $msg->add('From',$senderaddress);
               }
             $msg->add('Content-type','text/plain; charset=UTF-8');              $msg->add('Content-type','text/plain; charset=UTF-8');
             if (my $fh = $msg->open()) {              if (my $fh = $msg->open()) {
                 print $fh 'Update to '.$tablefile.' from Cluster Manager '.                  print $fh 'Update to '.$tablefile.' from Cluster Manager '.
                           "$clientname ($clientip)\n";                            $client."\n";
                 $fh->close;                  $fh->close;
             }              }
         }          }
Line 747  sub PushFile { Line 712  sub PushFile {
   
 }  }
   
   sub loncapa_dns_server {
       my $lonhost = &Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
       my $hoststable = "$perlvar{'lonTabDir'}/hosts.tab";
       my $is_dns_server;
       if (!open(HOSTS,"<$hoststable")) {
           &logthis('<font color="yellow">Could not open hosts.tab to check for LON-CAPA DNS servers.</font>');
           while (my $host = <HOSTS>) {
               chomp($host);
               $host =~ s/(^\s+|\s+$)//g;
               if ($host =~ /^\Q^$lonhost\E/) {
                   $is_dns_server = 1;
                   last;
               }
           }
           close(HOSTS);
       }
       return $is_dns_server;
   }
   
 #  #
 #  Called to re-init either lonc or lond.  #  Called to re-init either lonc or lond.
 #  #
Line 2316  sub fetch_user_file_handler { Line 2300  sub fetch_user_file_handler {
   
  my $destname=$udir.'/'.$ufile;   my $destname=$udir.'/'.$ufile;
  my $transname=$udir.'/'.$ufile.'.in.transit';   my $transname=$udir.'/'.$ufile.'.in.transit';
         my $clientprotocol=$Apache::lonnet::protocol{$clientname};   my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
         $clientprotocol = 'http' if ($clientprotocol ne 'https');  
  my $clienthost = &Apache::lonnet::hostname($clientname);  
  my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname;  
  my $response;   my $response;
  Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");   Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
  alarm(120);   alarm(120);
Line 3966  sub dump_course_id_handler { Line 3947  sub dump_course_id_handler {
         $creationcontext = '.';          $creationcontext = '.';
     }      }
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
         $typefilter eq '.') {          $typefilter eq '.') {
         $unpack = 0;          $unpack = 0;
     }      }
Line 5079  sub validate_course_owner_handler { Line 5060  sub validate_course_owner_handler {
     my ($cmd, $tail, $client)  = @_;      my ($cmd, $tail, $client)  = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail);      my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail);
       
     $owner = &unescape($owner);      $owner = &unescape($owner);
     $coowners = &unescape($coowners);      $coowners = &unescape($coowners);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners);      my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners);
Line 6070  if (-e $pidfile) { Line 6051  if (-e $pidfile) {
 $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},  $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
                                 Type      => SOCK_STREAM,                                  Type      => SOCK_STREAM,
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 ReuseAddr => 1,                                  ReuseAddr     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or die "making socket: $@\n";    or die "making socket: $@\n";
   
Line 6133  sub HUPSMAN {                      # sig Line 6114  sub HUPSMAN {                      # sig
 #  a setuid perl script that can be root for us to do this job.  #  a setuid perl script that can be root for us to do this job.
 #  #
 sub ReloadApache {  sub ReloadApache {
     if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {      my $execdir = $perlvar{'lonDaemons'};
         my $execdir = $perlvar{'lonDaemons'};      my $script  = $execdir."/apachereload";
         my $script  = $execdir."/apachereload";      system($script);
         system($script);  
         unlink('/tmp/lock_apachereload'); #  Remove the lock file.  
     }  
 }  }
   
 #  #
Line 6405  my %iphost = &Apache::lonnet::get_iphost Line 6383  my %iphost = &Apache::lonnet::get_iphost
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;  my $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
 my $arch = `uname -i`;  my $arch = `uname -i`;
 chomp($arch);  
 if ($arch eq 'unknown') {  if ($arch eq 'unknown') {
     $arch = `uname -m`;      $arch = `uname -m`;
     chomp($arch);  
 }  }
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
Line 6477  sub make_new_child { Line 6453  sub make_new_child {
                                 #don't get intercepted                                  #don't get intercepted
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;          $SIG{ALRM}= \&timeout;
    #
         #   # Block sigpipe as it gets thrownon socket disconnect and we want to 
         # Block sigpipe as it gets thrownon socket disconnect and we want to   # deal with that as a read faiure instead.
         # deal with that as a read faiure instead.   #
         #   my $blockset = POSIX::SigSet->new(SIGPIPE);
         my $blockset = POSIX::SigSet->new(SIGPIPE);   sigprocmask(SIG_BLOCK, $blockset);
         sigprocmask(SIG_BLOCK, $blockset);  
   
         $lastlog='Forked ';          $lastlog='Forked ';
         $status='Forked';          $status='Forked';
Line 7208  sub subscribe { Line 7183  sub subscribe {
                 # the metadata                  # the metadata
  unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }   unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
  $fname=~s/\/home\/httpd\/html\/res/raw/;   $fname=~s/\/home\/httpd\/html\/res/raw/;
                 my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};   $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
                 $protocol = 'http' if ($protocol ne 'https');  
  $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;  
  $result="$fname\n";   $result="$fname\n";
     }      }
  } else {   } else {
Removed from v.1.467.2.8  
changed lines
  Added in v.1.472

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