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

Diff for /loncom/lond between versions 1.467.2.3 and 1.468

version 1.467.2.3, 2011/05/14 17:14:29 version 1.468, 2011/01/11 10:32:00
Line 52  use LONCAPA::lonlocal; Line 52  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonnet;  use Apache::lonnet;
 use Mail::Send;  
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 420  sub ReadManagerTable { Line 419  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'});        logthis('<font color="red">No manager table.  Nobody can manage!!</font>');
        if (&Apache::lonnet::is_LC_dns($hostname)) {        return;
            &logthis('<font color="red">No manager table.  Nobody can manage!!</font>');  
        }  
        return;  
    }     }
    while(my $host = <MANAGERS>) {     while(my $host = <MANAGERS>) {
       chomp($host);        chomp($host);
Line 449  sub ReadManagerTable { Line 445  sub ReadManagerTable {
          }           }
       } else {        } else {
          logthis('<font color="green"> existing host'." $host</font>\n");           logthis('<font color="green"> existing host'." $host</font>\n");
          $managers{&Apache::lonnet::get_host_ip($host)} = $host;  # Use info from cluster tab if cluster memeber           $managers{&Apache::lonnet::get_host_ip($host)} = $host;  # Use info from cluster tab if clumemeber
       }        }
    }     }
 }  }
Line 511  sub AdjustHostContents { Line 507  sub AdjustHostContents {
     my $me        = $perlvar{'lonHostID'};      my $me        = $perlvar{'lonHostID'};
   
     foreach my $line (split(/\n/,$contents)) {      foreach my $line (split(/\n/,$contents)) {
  if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/) ||   if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) {
              ($line =~ /^\s*\^/))) {  
     chomp($line);      chomp($line);
     my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);      my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);
     if ($id eq $me) {      if ($id eq $me) {
Line 600  sub InstallFile { Line 595  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:  #                 It's probably no longer necessary to preserve
 #                 hosts, domain, dns_hosts, dns_domain  #                 special handling of hosts or domain as those
   #                 files have been superceded by dns_hosts, dns_domain.
   #                 The default action is just to prepend the directory
   #                 and append .tab
 #  #
 #  #
 #  Parameters:  #  Parameters:
Line 614  sub ConfigFileFromSelector { Line 612  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 "dns_hosts") || ($selector eq "dns_domain")) {   $tablefile = $tabledir."hosts.tab";
         $tablefile =  $tabledir.$selector.'.tab';      } elsif ($selector eq "domain") {
    $tablefile = $tabledir."domain.tab";
       } else {
    $tablefile =  $tabledir.$selector.'.tab';
     }      }
     return $tablefile;      return $tablefile;
   
Line 645  sub PushFile { Line 646  sub PushFile {
     #  supported:      #  supported:
     #   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_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 $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});  
         if ($admindom ne '') {  
             my %domconfig =  
                 &Apache::lonnet::get_dom('configuration',['contacts'],$admindom);  
             if (ref($domconfig{'contacts'}) eq 'HASH') {  
                 if ($domconfig{'contacts'}{'adminemail'} ne '') {  
                     $adminmail = $domconfig{'contacts'}{'adminemail'};  
                 }  
             }  
         }  
         if ($adminmail =~ /^[^\@]+\@[^\@]+$/) {  
             my $msg = new Mail::Send;  
             $msg->to($adminmail);  
             $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'});  
             $msg->add('Content-type','text/plain; charset=UTF-8');  
             if (my $fh = $msg->open()) {  
                 print $fh 'Update to '.$tablefile.' from Cluster Manager '.  
                           "$clientname ($clientip)\n";  
                 $fh->close;  
             }  
         }  
     }      }
   
   
     #  Indicate success:      #  Indicate success:
     
     return "ok";      return "ok";
Line 1689  sub server_homeID_handler { Line 1668  sub server_homeID_handler {
 }  }
 &register_handler("serverhomeID", \&server_homeID_handler, 0, 1, 0);  &register_handler("serverhomeID", \&server_homeID_handler, 0, 1, 0);
   
 sub server_distarch_handler {  
     my ($cmd,$tail,$client) = @_;  
     my $userinput = "$cmd:$tail";  
     my $reply = &distro_and_arch();  
     &Reply($client,\$reply,$userinput);  
     return 1;  
 }  
 &register_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0);  
   
 #   Process a reinit request.  Reinit requests that either  #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated   #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.  #   host.tab or domain.tab can be processed.
Line 5037  sub get_sections_handler { Line 5007  sub get_sections_handler {
 sub validate_course_owner_handler {  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) = split(/:/, $tail);
   
     $owner = &unescape($owner);      $owner = &unescape($owner);
     $coowners = &unescape($coowners);      my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners);  
     &Reply($client, \$outcome, $userinput);      &Reply($client, \$outcome, $userinput);
   
   
Line 6029  if (-e $pidfile) { Line 5998  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,                                  Reuse     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or die "making socket: $@\n";    or die "making socket: $@\n";
   
Line 6092  sub HUPSMAN {                      # sig Line 6061  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 6363  my %iphost = &Apache::lonnet::get_iphost Line 6329  my %iphost = &Apache::lonnet::get_iphost
   
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;  my $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
 my $arch = `uname -i`;  
 if ($arch eq 'unknown') {  
     $arch = `uname -m`;  
 }  
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
 #   Accept connections.  When a connection comes in, it is validated  #   Accept connections.  When a connection comes in, it is validated
 #   and if good, a child process is created to process transactions  #   and if good, a child process is created to process transactions
Line 6434  sub make_new_child { Line 6395  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 7515  sub useable_role { Line 7475  sub useable_role {
     return 1;      return 1;
 }  }
   
 sub distro_and_arch {  
     return $dist.':'.$arch;  
 }  
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Removed from v.1.467.2.3  
changed lines
  Added in v.1.468

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