version 1.467.2.7, 2012/02/28 16:47:29
|
version 1.471, 2011/05/13 02:32:40
|
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 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 677 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 2278 sub fetch_user_file_handler {
|
Line 2258 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 3928 sub dump_course_id_handler {
|
Line 3905 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 5041 sub validate_course_owner_handler {
|
Line 5018 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 6032 if (-e $pidfile) {
|
Line 6009 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 6095 sub HUPSMAN { # sig
|
Line 6072 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 6367 my %iphost = &Apache::lonnet::get_iphost
|
Line 6341 my %iphost = &Apache::lonnet::get_iphost
|
my $dist=`$perlvar{'lonDaemons'}/distprobe`; |
my $dist=`$perlvar{'lonDaemons'}/distprobe`; |
|
|
my $arch = `uname -i`; |
my $arch = `uname -i`; |
chomp($arch); |
|
if ($arch eq 'unknown') { |
if ($arch eq 'unknown') { |
$arch = `uname -m`; |
$arch = `uname -m`; |
chomp($arch); |
|
} |
} |
|
|
# -------------------------------------------------------------- |
# -------------------------------------------------------------- |
Line 6439 sub make_new_child {
|
Line 6411 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 7170 sub subscribe {
|
Line 7141 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 { |