Diff for /loncom/lond between versions 1.467.2.7 and 1.472

version 1.467.2.7, 2012/02/28 16:47:29 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 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 677  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 692  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 709  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 2278  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 3928  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 5041  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 6032  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 6095  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 6367  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 6439  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 7170  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.7  
changed lines
  Added in v.1.472


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