[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.470

version 1.467.2.8, 2014/06/09 16:58:22 version 1.470, 2011/01/22 21:10:18
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 52  use LONCAPA::lonlocal; Line 53  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 420  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 446  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 508  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 596  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 613  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 637  sub ConfigFileFromSelector { Line 639  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 645  sub PushFile { Line 647  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 667  sub PushFile { Line 667  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 677  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 1727  sub server_homeID_handler { Line 1669  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 2316  sub fetch_user_file_handler { Line 2249  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 3896  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 5009  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 6000  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 6063  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 6404  my %iphost = &Apache::lonnet::get_iphost Line 6331  my %iphost = &Apache::lonnet::get_iphost
   
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;  my $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
 my $arch = `uname -i`;  
 chomp($arch);  
 if ($arch eq 'unknown') {  
     $arch = `uname -m`;  
     chomp($arch);  
 }  
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
 #   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 6477  sub make_new_child { Line 6397  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 7127  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 {
Line 7560  sub useable_role { Line 7477  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.8  
changed lines
  Added in v.1.470

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