loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.463 and 1.482

version 1.463, 2010/11/02 10:51:46	version 1.482, 2011/10/24 20:43:51
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 90 my %managers; # Ip -> manager names	Line 92 my %managers; # Ip -> manager names

my %perlvar; # Will have the apache conf defined perl vars.	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.	# 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:	# Each element of the hash contains a reference to an array that contains:
Line 419 sub ReadManagerTable {	Line 423 sub ReadManagerTable {

my $tablename = $perlvar{'lonTabDir'}."/managers.tab";	my $tablename = $perlvar{'lonTabDir'}."/managers.tab";
if (!open (MANAGERS, $tablename)) {	if (!open (MANAGERS, $tablename)) {
logthis('<font color="red">No manager table. Nobody can manage!!</font>');	my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});
return;	if (&Apache::lonnet::is_LC_dns($hostname)) {
	&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 445 sub ReadManagerTable {	Line 452 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 clumemeber	$managers{&Apache::lonnet::get_host_ip($host)} = $host; # Use info from cluster tab if cluster memeber
}	}
}	}
}	}
Line 507 sub AdjustHostContents {	Line 514 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 595 sub InstallFile {	Line 603 sub InstallFile {
#	#
# ConfigFileFromSelector: converts a configuration file selector	# ConfigFileFromSelector: converts a configuration file selector
# into a configuration file pathname.	# into a configuration file pathname.
# It's probably no longer necessary to preserve	# Supports the following file selectors:
# special handling of hosts or domain as those	# hosts, domain, dns_hosts, dns_domain
# files have been superceded by dns_hosts, dns_domain.
# The default action is just to prepend the directory
# and append .tab
#	#
#	#
# Parameters:	# Parameters:
Line 612 sub ConfigFileFromSelector {	Line 617 sub ConfigFileFromSelector {
my $tablefile;	my $tablefile;

my $tabledir = $perlvar{'lonTabDir'}.'/';	my $tabledir = $perlvar{'lonTabDir'}.'/';
if ($selector eq "hosts") {	if (($selector eq "hosts") \|\| ($selector eq "domain") \|\|
$tablefile = $tabledir."hosts.tab";	($selector eq "dns_hosts") \|\| ($selector eq "dns_domain")) {
} elsif ($selector eq "domain") {
$tablefile = $tabledir."domain.tab";
} else {
$tablefile = $tabledir.$selector.'.tab';	$tablefile = $tabledir.$selector.'.tab';
}	}
return $tablefile;	return $tablefile;

}	}
#	#
# PushFile: Called to do an administrative push of a file.	# PushFile: Called to do an administrative push of a file.
Line 646 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 680 sub PushFile {
return "error:$!";	return "error:$!";
} else {	} else {
&logthis('<font color="green"> Installed new '.$tablefile	&logthis('<font color="green"> Installed new '.$tablefile
."</font>");	." - transaction by: $clientname ($clientip)</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 1620 sub ls3_handler {	Line 1643 sub ls3_handler {
}	}
&register_handler("ls3", \&ls3_handler, 0, 1, 0);	&register_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;
	}
	&register_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;
	}
	&register_handler("devalidatecache", \&server_devalidatecache_handler, 0, 1, 0);

sub server_timezone_handler {	sub server_timezone_handler {
my ($cmd,$tail,$client) = @_;	my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
Line 1668 sub server_homeID_handler {	Line 1759 sub server_homeID_handler {
}	}
&register_handler("serverhomeID", \&server_homeID_handler, 0, 1, 0);	&register_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;
	}
	&register_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0);

# Process a reinit request. Reinit requests that either	# Process a reinit request. Reinit requests that either
# lonc or lond be reinitialized so that an updated	# lonc or lond be reinitialized so that an updated
# host.tab or domain.tab can be processed.	# host.tab or domain.tab can be processed.
Line 2248 sub fetch_user_file_handler {	Line 2348 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 $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;	my $response;
Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");	Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
alarm(120);	alarm(120);
Line 2424 sub user_has_session_handler {	Line 2526 sub user_has_session_handler {

my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));	my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));

&logthis("Looking for $udom $uname");
opendir(DIR,$perlvar{'lonIDsDir'});	opendir(DIR,$perlvar{'lonIDsDir'});
my $filename;	my $filename;
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
Line 5008 sub get_sections_handler {	Line 5109 sub get_sections_handler {
sub validate_course_owner_handler {	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) = split(/:/, $tail);	my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail);

$owner = &unescape($owner);	$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);	&Reply($client, \$outcome, $userinput);


Line 5999 if (-e $pidfile) {	Line 6101 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',
Reuse => 1,	ReuseAddr => 1,
Listen => 10 )	Listen => 10 )
or die "making socket: $@\n";	or die "making socket: $@\n";

Line 6062 sub HUPSMAN { # sig	Line 6164 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 {
my $execdir = $perlvar{'lonDaemons'};	# --------------------------- Handle case of another apachereload process (locking)
my $script = $execdir."/apachereload";	if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {
system($script);	my $execdir = $perlvar{'lonDaemons'};
	my $script = $execdir."/apachereload";
	system($script);
	unlink('/tmp/lock_apachereload'); # Remove the lock file.
	}
}	}

#	#
Line 6328 $SIG{USR2} = \&UpdateHosts;	Line 6434 $SIG{USR2} = \&UpdateHosts;
&Apache::lonnet::load_hosts_tab();	&Apache::lonnet::load_hosts_tab();
my %iphost = &Apache::lonnet::get_iphost(1);	my %iphost = &Apache::lonnet::get_iphost(1);

my $dist=`$perlvar{'lonDaemons'}/distprobe`;	$dist=`$perlvar{'lonDaemons'}/distprobe`;

	my $arch = `uname -i`;
	chomp($arch);
	if ($arch eq 'unknown') {
	$arch = `uname -m`;
	chomp($arch);
	}

# --------------------------------------------------------------	# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated	# Accept connections. When a connection comes in, it is validated
Line 6396 sub make_new_child {	Line 6509 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
	# deal with that as a read faiure instead.
	#
	my $blockset = POSIX::SigSet->new(SIGPIPE);
	sigprocmask(SIG_BLOCK, $blockset);

$lastlog='Forked ';	$lastlog='Forked ';
$status='Forked';	$status='Forked';

Line 6610 sub is_author {	Line 6730 sub is_author {
}	}
#	#
# Checks to see if the input roleput request was to set	# Checks to see if the input roleput request was to set
# an author role. If so, invokes the lchtmldir script to set	# an author role. If so, creates construction space
# up a correct public_html
# Parameters:	# Parameters:
# request - The request sent to the rolesput subchunk.	# request - The request sent to the rolesput subchunk.
# We're looking for /domain/_au	# We're looking for /domain/_au
Line 6621 sub is_author {	Line 6740 sub is_author {
#	#
sub manage_permissions {	sub manage_permissions {
my ($request, $domain, $user, $authtype) = @_;	my ($request, $domain, $user, $authtype) = @_;

&Debug("manage_permissions: $request $domain $user $authtype");

# See if the request is of the form /$domain/_au	# See if the request is of the form /$domain/_au
if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...	if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...
my $execdir = $perlvar{'lonDaemons'};	my $path="/home/httpd/html/priv/".$domain;
my $userhome= "/home/$user" ;	unless (-e $path) {
&logthis("system $execdir/lchtmldir $userhome $user $authtype");	mkdir($path);
&Debug("Setting homedir permissions for $userhome");	}
system("$execdir/lchtmldir $userhome $user $authtype");	unless (-e $path.'/'.$user) {
	mkdir($path.'/'.$user);
	}
}	}
}	}

Line 7119 sub subscribe {	Line 7237 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/;
$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";	$result="$fname\n";
}	}
} else {	} else {
Line 7351 sub releasereqd_check {	Line 7471 sub releasereqd_check {
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});	my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));	return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}	}
	} else {
	return;
}	}
}	}
return 1;	return 1;
Line 7358 sub releasereqd_check {	Line 7480 sub releasereqd_check {

sub get_courseinfo_hash {	sub get_courseinfo_hash {
my ($cnum,$cdom,$home) = @_;	my ($cnum,$cdom,$home) = @_;
my $hashid = $cdom.':'.$cnum;	my %info;
my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');	eval {
if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {	local($SIG{ALRM}) = sub { die "timeout\n"; };
return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);	local($SIG{__DIE__})='DEFAULT';
	alarm(3);
	%info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
	alarm(0);
	};
	if ($@) {
	if ($@ eq "timeout\n") {
	&logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
	} else {
	&logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
	}
	} 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;	return;
}	}
Line 7405 sub check_homecourses {	Line 7542 sub check_homecourses {
return;	return;
}	}
foreach my $hashid (keys(%recent)) {	foreach my $hashid (keys(%recent)) {
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);	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})) {	foreach my $hashid (keys(%{$homecourses})) {
next if ($recent{$hashid});	next if ($recent{$hashid});
Line 7449 sub useable_role {	Line 7589 sub useable_role {
return 1;	return 1;
}	}

	sub distro_and_arch {
	return $dist.':'.$arch;
	}

# ----------------------------------- POD (plain old documentation, CPAN style)	# ----------------------------------- POD (plain old documentation, CPAN style)

=head1 NAME	=head1 NAME

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.463
changed lines
	Added in v.1.482