--- loncom/lond 2011/06/12 00:08:01 1.467.2.4
+++ loncom/lond 2011/08/05 04:35:45 1.480
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.467.2.4 2011/06/12 00:08:01 raeburn Exp $
+# $Id: lond,v 1.480 2011/08/05 04:35:45 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.4 $'; #' stupid emacs
+my $VERSION='$Revision: 1.480 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -91,6 +92,8 @@ my %managers; # Ip -> manager names
my %perlvar; # Will have the apache conf defined perl vars.
+my $dist;
+
#
# The hash below is used for command dispatching, and is therefore keyed on the request keyword.
# Each element of the hash contains a reference to an array that contains:
@@ -600,8 +603,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 +617,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.
@@ -646,7 +648,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
@@ -677,8 +679,8 @@ sub PushFile {
.$tablefile." $! ");
return "error:$!";
} else {
- &logthis(' Installed new '.$tablefile
- ." - transaction by: $clientname ($clientip)");
+ &logthis(' Installed new '.$tablefile
+ ." - transaction by: $clientname ($clientip)");
my $adminmail = $perlvar{'lonAdmEMail'};
my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
if ($admindom ne '') {
@@ -1641,6 +1643,74 @@ sub ls3_handler {
}
®ister_handler("ls3", \&ls3_handler, 0, 1, 0);
+sub read_lonnet_global {
+ my ($cmd,$tail,$client) = @_;
+ my $userinput = "$cmd:$tail";
+ my $requested = &Apache::lonnet::thaw_unescape($tail);
+ my $result;
+ my %packagevars = (
+ spareid => \%Apache::lonnet::spareid,
+ perlvar => \%Apache::lonnet::perlvar,
+ );
+ my %limit_to = (
+ perlvar => {
+ lonOtherAuthen => 1,
+ lonBalancer => 1,
+ lonVersion => 1,
+ lonSysEMail => 1,
+ lonHostID => 1,
+ lonRole => 1,
+ lonDefDomain => 1,
+ lonLoadLim => 1,
+ lonUserLoadLim => 1,
+ }
+ );
+ if (ref($requested) eq 'HASH') {
+ foreach my $what (keys(%{$requested})) {
+ my $response;
+ my $items = {};
+ if (exists($packagevars{$what})) {
+ if (ref($limit_to{$what}) eq 'HASH') {
+ foreach my $varname (keys(%{$packagevars{$what}})) {
+ if ($limit_to{$what}{$varname}) {
+ $items->{$varname} = $packagevars{$what}{$varname};
+ }
+ }
+ } else {
+ $items = $packagevars{$what};
+ }
+ if ($what eq 'perlvar') {
+ if (!exists($packagevars{$what}{'lonBalancer'})) {
+ if ($dist =~ /^(centos|rhes|fedora|scientific)/) {
+ my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
+ if (ref($othervarref) eq 'HASH') {
+ $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
+ }
+ }
+ }
+ }
+ $response = &Apache::lonnet::freeze_escape($items);
+ }
+ $result .= &escape($what).'='.$response.'&';
+ }
+ }
+ $result =~ s/\&$//;
+ &Reply($client,\$result,$userinput);
+ return 1;
+}
+®ister_handler("readlonnetglobal", \&read_lonnet_global, 0, 1, 0);
+
+sub server_devalidatecache_handler {
+ my ($cmd,$tail,$client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($name,$id) = map { &unescape($_); } split(/:/,$tail);
+ &Apache::lonnet::devalidate_cache_new($name,$id);
+ my $result = 'ok';
+ &Reply($client,\$result,$userinput);
+ return 1;
+}
+®ister_handler("devalidatecache", \&devalidatecache_handler, 0, 1, 0);
+
sub server_timezone_handler {
my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";
@@ -2278,7 +2348,9 @@ sub fetch_user_file_handler {
my $destname=$udir.'/'.$ufile;
my $transname=$udir.'/'.$ufile.'.in.transit';
- my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+ my $clientprotocol=$Apache::lonnet::protocol{$clientname};
+ $clientprotocol = 'http' if ($clientprotocol ne 'https');
+ my $remoteurl=$clientprotocol.'://'.$clientip.'/userfiles/'.$fname;
my $response;
Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
alarm(120);
@@ -5038,7 +5110,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);
@@ -6029,7 +6101,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";
@@ -6092,6 +6164,7 @@ sub HUPSMAN { # sig
# a setuid perl script that can be root for us to do this job.
#
sub ReloadApache {
+# --------------------------- Handle case of another apachereload process (locking)
if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {
my $execdir = $perlvar{'lonDaemons'};
my $script = $execdir."/apachereload";
@@ -6361,7 +6434,7 @@ $SIG{USR2} = \&UpdateHosts;
&Apache::lonnet::load_hosts_tab();
my %iphost = &Apache::lonnet::get_iphost(1);
-my $dist=`$perlvar{'lonDaemons'}/distprobe`;
+$dist=`$perlvar{'lonDaemons'}/distprobe`;
my $arch = `uname -i`;
chomp($arch);
@@ -6436,13 +6509,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';
@@ -7167,7 +7239,9 @@ sub subscribe {
# the metadata
unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
$fname=~s/\/home\/httpd\/html\/res/raw/;
- $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
+ my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};
+ $protocol = 'http' if ($protocol ne 'https');
+ $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
$result="$fname\n";
}
} else {