--- loncom/lond 2011/06/12 00:08:01 1.467.2.4
+++ loncom/lond 2011/07/31 22:55:48 1.477
@@ -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.477 2011/07/31 22:55:48 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.477 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -600,8 +601,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 +615,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 +646,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 +677,8 @@ sub PushFile {
.$tablefile." $! </font>");
return "error:$!";
} else {
- &logthis('<font color="green"> Installed new '.$tablefile
- ." - transaction by: $clientname ($clientip)</font>");
+ &logthis('<font color="green"> Installed new '.$tablefile
+ ." - transaction by: $clientname ($clientip)</font>");
my $adminmail = $perlvar{'lonAdmEMail'};
my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
if ($admindom ne '') {
@@ -1641,6 +1641,35 @@ 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;
+ if (ref($requested) eq 'HASH') {
+ foreach my $what (keys(%{$requested})) {
+ my $type = $requested->{$what};
+ my $lonnetglobal = 'Apache::lonnet::'.$what;
+ my $response;
+ if ($type eq 'HASH') {
+ if (defined(%{$lonnetglobal})) {
+ my $hashref = \%{$lonnetglobal};
+ $response = &Apache::lonnet::freeze_escape($hashref);
+ }
+ } else {
+ if (defined(${$lonnetglobal})) {
+ $response = &escape(${$item});
+ }
+ }
+ }
+ $result .= &escape($what).'='.$response.'&';
+ }
+ $result =~ s/\&$//;
+ &Reply($client,\$result,$userinput);
+ return 1;
+}
+®ister_handler("readlonnetglobal", \&read_lonnet_global, 0, 1, 0);
+
sub server_timezone_handler {
my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";
@@ -2278,7 +2307,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 +5069,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 +6060,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 +6123,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";
@@ -6436,13 +6468,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 +7198,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 {