--- loncom/lond 2010/09/26 01:50:28 1.456 +++ loncom/lond 2011/05/13 02:58:02 1.472 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.456 2010/09/26 01:50:28 raeburn Exp $ +# $Id: lond,v 1.472 2011/05/13 02:58:02 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -15,6 +15,7 @@ # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of + # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # @@ -52,13 +53,14 @@ use LONCAPA::lonlocal; use LONCAPA::lonssl; use Fcntl qw(:flock); use Apache::lonnet; +use Mail::Send; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.456 $'; #' stupid emacs +my $VERSION='$Revision: 1.472 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -419,8 +421,10 @@ sub ReadManagerTable { my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; if (!open (MANAGERS, $tablename)) { - logthis('No manager table. Nobody can manage!!'); - return; + if (&loncapa_dns_server()) { + &logthis('No manager table. Nobody can manage!!'); + } + return; } while(my $host = ) { chomp($host); @@ -445,7 +449,7 @@ sub ReadManagerTable { } } else { logthis(' existing host'." $host\n"); - $managers{&Apache::lonnet::get_host_ip($host)} = $host; # Use info from cluster tab if clumemeber + $managers{&Apache::lonnet::get_host_ip($host)} = $host; # Use info from cluster tab if cluster memeber } } } @@ -507,7 +511,8 @@ sub AdjustHostContents { my $me = $perlvar{'lonHostID'}; foreach my $line (split(/\n/,$contents)) { - if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { + if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/) || + ($line =~ /^\s*\^/))) { chomp($line); my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); if ($id eq $me) { @@ -595,11 +600,8 @@ sub InstallFile { # # ConfigFileFromSelector: converts a configuration file selector # into a configuration file pathname. -# It's probably no longer necessary to preserve -# 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 +# Supports the following file selectors: +# hosts, domain, dns_hosts, dns_domain # # # Parameters: @@ -612,15 +614,11 @@ sub ConfigFileFromSelector { my $tablefile; my $tabledir = $perlvar{'lonTabDir'}.'/'; - if ($selector eq "hosts") { - $tablefile = $tabledir."hosts.tab"; - } elsif ($selector eq "domain") { - $tablefile = $tabledir."domain.tab"; - } else { + if (($selector eq "hosts") || ($selector eq "domain") || + ($selector eq "dns_hosts") || ($selector eq "dns_domain")) { $tablefile = $tabledir.$selector.'.tab'; } return $tablefile; - } # # PushFile: Called to do an administrative push of a file. @@ -646,6 +644,8 @@ sub PushFile { # supported: # hosts.tab ($filename eq host). # 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. # # lonManage is supposed to ensure this, however this session could be @@ -678,16 +678,59 @@ sub PushFile { } else { &logthis(' Installed new '.$tablefile .""); - + 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; + my $senderaddress = $perlvar{'lonSysEMail'}; + $msg->to($adminmail); + $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'}); + if ($senderaddress) { + $msg->add('From',$senderaddress); + } + $msg->add('Content-type','text/plain; charset=UTF-8'); + if (my $fh = $msg->open()) { + print $fh 'Update to '.$tablefile.' from Cluster Manager '. + $client."\n"; + $fh->close; + } + } } - # Indicate success: return "ok"; } +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('Could not open hosts.tab to check for LON-CAPA DNS servers.'); + while (my $host = ) { + 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. # @@ -1121,6 +1164,8 @@ sub establish_key_handler { sub load_handler { my ($cmd, $tail, $replyfd) = @_; + + # Get the load average from /proc/loadavg and calculate it as a percentage of # the allowed load limit as set by the perl global variable lonLoadLim @@ -1666,6 +1711,15 @@ sub server_homeID_handler { } ®ister_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; +} +®ister_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0); + # Process a reinit request. Reinit requests that either # lonc or lond be reinitialized so that an updated # host.tab or domain.tab can be processed. @@ -2422,7 +2476,6 @@ sub user_has_session_handler { my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); - &logthis("Looking for $udom $uname"); opendir(DIR,$perlvar{'lonIDsDir'}); my $filename; while ($filename=readdir(DIR)) { @@ -3198,8 +3251,11 @@ sub dump_with_regexp { my $cdom = $1; my $cnum = $2; unless ($skipcheck) { - next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor, - $now,\%homecourses,\@ids)); + my ($role,$end,$start) = split(/\_/,$value); + if (!$end || $end > $now) { + next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major, + $minor,\%homecourses,\@ids)); + } } } } @@ -4275,6 +4331,7 @@ sub put_domain_handler { sub get_domain_handler { my ($cmd, $tail, $client) = @_; + my $userinput = "$client:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); @@ -4419,7 +4476,8 @@ sub get_id_handler { sub put_dcmail_handler { my ($cmd,$tail,$client) = @_; my $userinput = "$cmd:$tail"; - + + my ($udom,$what)=split(/:/,$tail); chomp($what); my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT()); @@ -5001,10 +5059,11 @@ sub get_sections_handler { sub validate_course_owner_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($inst_course_id, $owner, $cdom) = split(/:/, $tail); - + my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail); + $owner = &unescape($owner); - my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom); + $coowners = &unescape($coowners); + my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); &Reply($client, \$outcome, $userinput); @@ -5992,7 +6051,7 @@ if (-e $pidfile) { $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, Type => SOCK_STREAM, Proto => 'tcp', - Reuse => 1, + ReuseAddr => 1, Listen => 10 ) or die "making socket: $@\n"; @@ -6230,7 +6289,7 @@ sub logstatus { sub initnewstatus { my $docdir=$perlvar{'lonDocRoot'}; my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt"); - my $now=time; + my $now=time(); my $local=localtime($now); print $fh "LOND status $local - parent $$\n\n"; opendir(DIR,"$docdir/lon-status/londchld"); @@ -6323,6 +6382,11 @@ my %iphost = &Apache::lonnet::get_iphost 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 # and if good, a child process is created to process transactions @@ -6380,6 +6444,7 @@ sub make_new_child { or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = $clientip; &status('Started child '.$pid); + close($client); return; } else { # Child can *not* return from this subroutine. @@ -6388,6 +6453,13 @@ sub make_new_child { #don't get intercepted $SIG{USR1}= \&logstatus; $SIG{ALRM}= \&timeout; + # + # Block sigpipe as it gets thrownon socket disconnect and we want to + # deal with that as a read faiure instead. + # + my $blockset = POSIX::SigSet->new(SIGPIPE); + sigprocmask(SIG_BLOCK, $blockset); + $lastlog='Forked '; $status='Forked'; @@ -7300,7 +7372,7 @@ sub get_usersession_config { } sub releasereqd_check { - my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_; + my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_; my $home = &Apache::lonnet::homeserver($cnum,$cdom); return if ($home eq 'no_host'); my ($reqdmajor,$reqdminor,$displayrole); @@ -7314,38 +7386,37 @@ sub releasereqd_check { return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } } - my ($role,$end,$start) = split(/_/,$value); - if (!$end || $end > $now) { - my $hashid = $cdom.':'.$cnum; - my ($courseinfo,$cached) = - &Apache::lonnet::is_cached_new('courseinfo',$hashid); - if (defined($cached)) { - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } + my $hashid = $cdom.':'.$cnum; + my ($courseinfo,$cached) = + &Apache::lonnet::is_cached_new('courseinfo',$hashid); + if (defined($cached)) { + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } - } else { - if (ref($ids) eq 'ARRAY') { - if (grep(/^\Q$home\E$/,@{$ids})) { - if (ref($homecourses) eq 'HASH') { - if (ref($homecourses->{$hashid}) eq 'ARRAY') { - push(@{$homecourses->{$hashid}},{$key=>$value}); - } else { - $homecourses->{$hashid} = [{$key=>$value}]; - } + } + } else { + if (ref($ids) eq 'ARRAY') { + if (grep(/^\Q$home\E$/,@{$ids})) { + if (ref($homecourses) eq 'HASH') { + if (ref($homecourses->{$hashid}) eq 'ARRAY') { + push(@{$homecourses->{$hashid}},{$key=>$value}); + } else { + $homecourses->{$hashid} = [{$key=>$value}]; } - return; } + return; } - my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } + } + my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } + } else { + return; } } return 1; @@ -7353,10 +7424,25 @@ sub releasereqd_check { sub get_courseinfo_hash { my ($cnum,$cdom,$home) = @_; - my $hashid = $cdom.':'.$cnum; - my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); - if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { - return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); + my %info; + eval { + local($SIG{ALRM}) = sub { die "timeout\n"; }; + local($SIG{__DIE__})='DEFAULT'; + alarm(3); + %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); + alarm(0); + }; + if ($@) { + if ($@ eq "timeout\n") { + &logthis("WARNING courseiddump for $cnum:$cdom from $home timedout"); + } else { + &logthis("WARNING unexpected error during eval of call for courseiddump from $home"); + } + } else { + if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { + my $hashid = $cdom.':'.$cnum; + return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); + } } return; } @@ -7364,18 +7450,26 @@ sub get_courseinfo_hash { sub check_homecourses { my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_; my ($result,%addtocache); + my $yesterday = time - 24*3600; if (ref($homecourses) eq 'HASH') { - my %okcourses; + my (%okcourses,%courseinfo,%recent); my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my $unesc_key = &unescape($key); - next if ($unesc_key =~ /^lasttime:/); + if ($unesc_key =~ /^lasttime:(\w+)$/) { + my $cid = $1; + $cid =~ s/_/:/; + if ($value > $yesterday ) { + $recent{$cid} = 1; + } + next; + } my $items = &Apache::lonnet::thaw_unescape($value); if (ref($items) eq 'HASH') { my $hashid = $unesc_key; $hashid =~ s/_/:/; - &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600); + $courseinfo{$hashid} = $items; if (ref($homecourses->{$hashid}) eq 'ARRAY') { my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { @@ -7391,6 +7485,16 @@ sub check_homecourses { &logthis('Failed to tie hash for nohist_courseids.db'); return; } + foreach my $hashid (keys(%recent)) { + my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid); + unless ($cached) { + &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); + } + } + foreach my $hashid (keys(%{$homecourses})) { + next if ($recent{$hashid}); + &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); + } foreach my $hashid (keys(%okcourses)) { if (ref($homecourses->{$hashid}) eq 'ARRAY') { foreach my $role (@{$homecourses->{$hashid}}) { @@ -7429,6 +7533,10 @@ sub useable_role { return 1; } +sub distro_and_arch { + return $dist.':'.$arch; +} + # ----------------------------------- POD (plain old documentation, CPAN style) =head1 NAME