--- loncom/lond 2014/06/09 16:58:22 1.467.2.8 +++ 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.467.2.8 2014/06/09 16:58:22 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. # @@ -59,7 +60,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.467.2.8 $'; #' stupid emacs +my $VERSION='$Revision: 1.472 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -420,8 +421,7 @@ sub ReadManagerTable { my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; if (!open (MANAGERS, $tablename)) { - my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'}); - if (&Apache::lonnet::is_LC_dns($hostname)) { + if (&loncapa_dns_server()) { &logthis('No manager table. Nobody can manage!!'); } return; @@ -600,8 +600,8 @@ sub InstallFile { # # ConfigFileFromSelector: converts a configuration file selector # into a configuration file pathname. -# Supports the following file selectors: -# hosts, domain, dns_hosts, dns_domain +# Supports the following file selectors: +# hosts, domain, dns_hosts, dns_domain # # # Parameters: @@ -614,12 +614,11 @@ sub ConfigFileFromSelector { my $tablefile; 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")) { - $tablefile = $tabledir.$selector.'.tab'; + $tablefile = $tabledir.$selector.'.tab'; } return $tablefile; - } # # PushFile: Called to do an administrative push of a file. @@ -637,7 +636,7 @@ sub ConfigFileFromSelector { # String to send to client ("ok" or "refused" if bad file). # sub PushFile { - my $request = shift; + my $request = shift; my ($command, $filename, $contents) = split(":", $request, 3); &Debug("PushFile"); @@ -646,7 +645,7 @@ sub PushFile { # hosts.tab ($filename eq host). # domain.tab ($filename eq domain). # 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. # # lonManage is supposed to ensure this, however this session could be @@ -667,44 +666,6 @@ sub PushFile { if($filename eq "host") { $contents = AdjustHostContents($contents); - } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { - if ($contents eq '') { - &logthis(' Pushfile: unable to install ' - .$tablefile." - no data received from push. "); - 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(' Pushfile: unable to install ' - .$tablefile." - error attempting to pull data. "); - return 'error: pull failed'; - } else { - my $result = $response->content; - chomp($result); - unless ($result eq $contents) { - &logthis(' Pushfile: unable to install ' - .$tablefile." - pushed data and pulled data differ. "); - 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: @@ -715,8 +676,8 @@ sub PushFile { .$tablefile." $! "); return "error:$!"; } else { - &logthis(' Installed new '.$tablefile - ." - transaction by: $clientname ($clientip)"); + &logthis(' Installed new '.$tablefile + .""); my $adminmail = $perlvar{'lonAdmEMail'}; my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); if ($admindom ne '') { @@ -730,12 +691,16 @@ sub PushFile { } 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 '. - "$clientname ($clientip)\n"; + $client."\n"; $fh->close; } } @@ -747,6 +712,25 @@ 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('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. # @@ -2316,10 +2300,7 @@ sub fetch_user_file_handler { my $destname=$udir.'/'.$ufile; my $transname=$udir.'/'.$ufile.'.in.transit'; - my $clientprotocol=$Apache::lonnet::protocol{$clientname}; - $clientprotocol = 'http' if ($clientprotocol ne 'https'); - my $clienthost = &Apache::lonnet::hostname($clientname); - my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname; + my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; my $response; Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname"); alarm(120); @@ -3966,7 +3947,7 @@ sub dump_course_id_handler { $creationcontext = '.'; } my $unpack = 1; - if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && + if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && $typefilter eq '.') { $unpack = 0; } @@ -5079,7 +5060,7 @@ sub validate_course_owner_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail); - + $owner = &unescape($owner); $coowners = &unescape($coowners); my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); @@ -6070,7 +6051,7 @@ if (-e $pidfile) { $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, Type => SOCK_STREAM, Proto => 'tcp', - ReuseAddr => 1, + ReuseAddr => 1, Listen => 10 ) or die "making socket: $@\n"; @@ -6133,12 +6114,9 @@ sub HUPSMAN { # sig # a setuid perl script that can be root for us to do this job. # sub ReloadApache { - if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) { - my $execdir = $perlvar{'lonDaemons'}; - my $script = $execdir."/apachereload"; - system($script); - unlink('/tmp/lock_apachereload'); # Remove the lock file. - } + my $execdir = $perlvar{'lonDaemons'}; + my $script = $execdir."/apachereload"; + system($script); } # @@ -6405,10 +6383,8 @@ my %iphost = &Apache::lonnet::get_iphost my $dist=`$perlvar{'lonDaemons'}/distprobe`; my $arch = `uname -i`; -chomp($arch); if ($arch eq 'unknown') { $arch = `uname -m`; - chomp($arch); } # -------------------------------------------------------------- @@ -6477,13 +6453,12 @@ 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); + # + # 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'; @@ -7208,9 +7183,7 @@ sub subscribe { # the metadata unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); } $fname=~s/\/home\/httpd\/html\/res/raw/; - my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}}; - $protocol = 'http' if ($protocol ne 'https'); - $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname; + $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname; $result="$fname\n"; } } else {