loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.456 and 1.473

version 1.456, 2010/09/26 01:50:28	version 1.473, 2011/05/14 15:47:01
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 419 sub ReadManagerTable {	Line 421 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 450 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 512 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 601 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 615 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 645 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 678 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 1121 sub establish_key_handler {	Line 1142 sub establish_key_handler {
sub load_handler {	sub load_handler {
my ($cmd, $tail, $replyfd) = @_;	my ($cmd, $tail, $replyfd) = @_;



# Get the load average from /proc/loadavg and calculate it as a percentage of	# Get the load average from /proc/loadavg and calculate it as a percentage of
# the allowed load limit as set by the perl global variable lonLoadLim	# the allowed load limit as set by the perl global variable lonLoadLim

Line 1666 sub server_homeID_handler {	Line 1689 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 2422 sub user_has_session_handler {	Line 2454 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 3198 sub dump_with_regexp {	Line 3229 sub dump_with_regexp {
my $cdom = $1;	my $cdom = $1;
my $cnum = $2;	my $cnum = $2;
unless ($skipcheck) {	unless ($skipcheck) {
next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,	my ($role,$end,$start) = split(/\_/,$value);
$now,\%homecourses,\@ids));	if (!$end \|\| $end > $now) {
	next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
	$minor,\%homecourses,\@ids));
	}
}	}
}	}
}	}
Line 4275 sub put_domain_handler {	Line 4309 sub put_domain_handler {
sub get_domain_handler {	sub get_domain_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;


my $userinput = "$client:$tail";	my $userinput = "$client:$tail";

my ($udom,$namespace,$what)=split(/:/,$tail,3);	my ($udom,$namespace,$what)=split(/:/,$tail,3);
Line 4419 sub get_id_handler {	Line 4454 sub get_id_handler {
sub put_dcmail_handler {	sub put_dcmail_handler {
my ($cmd,$tail,$client) = @_;	my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";


my ($udom,$what)=split(/:/,$tail);	my ($udom,$what)=split(/:/,$tail);
chomp($what);	chomp($what);
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
Line 5001 sub get_sections_handler {	Line 5037 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 5992 if (-e $pidfile) {	Line 6029 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 6055 sub HUPSMAN { # sig	Line 6092 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 {
	# --------------------------- Handle case of another apachereload process (locking)
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
my $script = $execdir."/apachereload";	my $script = $execdir."/apachereload";
system($script);	system($script);
Line 6230 sub logstatus {	Line 6268 sub logstatus {
sub initnewstatus {	sub initnewstatus {
my $docdir=$perlvar{'lonDocRoot'};	my $docdir=$perlvar{'lonDocRoot'};
my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");	my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
my $now=time;	my $now=time();
my $local=localtime($now);	my $local=localtime($now);
print $fh "LOND status $local - parent $$\n\n";	print $fh "LOND status $local - parent $$\n\n";
opendir(DIR,"$docdir/lon-status/londchld");	opendir(DIR,"$docdir/lon-status/londchld");
Line 6323 my %iphost = &Apache::lonnet::get_iphost	Line 6361 my %iphost = &Apache::lonnet::get_iphost

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

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

# --------------------------------------------------------------	# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated	# Accept connections. When a connection comes in, it is validated
# and if good, a child process is created to process transactions	# and if good, a child process is created to process transactions
Line 6380 sub make_new_child {	Line 6423 sub make_new_child {
or die "Can't unblock SIGINT for fork: $!\n";	or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = $clientip;	$children{$pid} = $clientip;
&status('Started child '.$pid);	&status('Started child '.$pid);
	close($client);
return;	return;
} else {	} else {
# Child can not return from this subroutine.	# Child can not return from this subroutine.
Line 6388 sub make_new_child {	Line 6432 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 7300 sub get_usersession_config {	Line 7351 sub get_usersession_config {
}	}

sub releasereqd_check {	sub releasereqd_check {
my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_;	my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
my $home = &Apache::lonnet::homeserver($cnum,$cdom);	my $home = &Apache::lonnet::homeserver($cnum,$cdom);
return if ($home eq 'no_host');	return if ($home eq 'no_host');
my ($reqdmajor,$reqdminor,$displayrole);	my ($reqdmajor,$reqdminor,$displayrole);
Line 7314 sub releasereqd_check {	Line 7365 sub releasereqd_check {
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));	return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}	}
}	}
my ($role,$end,$start) = split(/_/,$value);	my $hashid = $cdom.':'.$cnum;
if (!$end \|\| $end > $now) {	my ($courseinfo,$cached) =
my $hashid = $cdom.':'.$cnum;	&Apache::lonnet::is_cached_new('courseinfo',$hashid);
my ($courseinfo,$cached) =	if (defined($cached)) {
&Apache::lonnet::is_cached_new('courseinfo',$hashid);	if (ref($courseinfo) eq 'HASH') {
if (defined($cached)) {	if (exists($courseinfo->{'releaserequired'})) {
if (ref($courseinfo) eq 'HASH') {	my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
if (exists($courseinfo->{'releaserequired'})) {	return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}
}	}
} else {	}
if (ref($ids) eq 'ARRAY') {	} else {
if (grep(/^\Q$home\E$/,@{$ids})) {	if (ref($ids) eq 'ARRAY') {
if (ref($homecourses) eq 'HASH') {	if (grep(/^\Q$home\E$/,@{$ids})) {
if (ref($homecourses->{$hashid}) eq 'ARRAY') {	if (ref($homecourses) eq 'HASH') {
push(@{$homecourses->{$hashid}},{$key=>$value});	if (ref($homecourses->{$hashid}) eq 'ARRAY') {
} else {	push(@{$homecourses->{$hashid}},{$key=>$value});
$homecourses->{$hashid} = [{$key=>$value}];	} else {
}	$homecourses->{$hashid} = [{$key=>$value}];
}	}
return;
}	}
	return;
}	}
my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);	}
if (ref($courseinfo) eq 'HASH') {	my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
if (exists($courseinfo->{'releaserequired'})) {	if (ref($courseinfo) eq 'HASH') {
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});	if (exists($courseinfo->{'releaserequired'})) {
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));	my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
}	return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}	}
	} else {
	return;
}	}
}	}
return 1;	return 1;
Line 7353 sub releasereqd_check {	Line 7403 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 7364 sub get_courseinfo_hash {	Line 7429 sub get_courseinfo_hash {
sub check_homecourses {	sub check_homecourses {
my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;	my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
my ($result,%addtocache);	my ($result,%addtocache);
	my $yesterday = time - 24*3600;
if (ref($homecourses) eq 'HASH') {	if (ref($homecourses) eq 'HASH') {
my %okcourses;	my (%okcourses,%courseinfo,%recent);
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my $unesc_key = &unescape($key);	my $unesc_key = &unescape($key);
next if ($unesc_key =~ /^lasttime:/);	if ($unesc_key =~ /^lasttime:(\w+)$/) {
	my $cid = $1;
	$cid =~ s/_/:/;
	if ($value > $yesterday ) {
	$recent{$cid} = 1;
	}
	next;
	}
my $items = &Apache::lonnet::thaw_unescape($value);	my $items = &Apache::lonnet::thaw_unescape($value);
if (ref($items) eq 'HASH') {	if (ref($items) eq 'HASH') {
my $hashid = $unesc_key;	my $hashid = $unesc_key;
$hashid =~ s/_/:/;	$hashid =~ s/_/:/;
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600);	$courseinfo{$hashid} = $items;
if (ref($homecourses->{$hashid}) eq 'ARRAY') {	if (ref($homecourses->{$hashid}) eq 'ARRAY') {
my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});	my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {	if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
Line 7391 sub check_homecourses {	Line 7464 sub check_homecourses {
&logthis('Failed to tie hash for nohist_courseids.db');	&logthis('Failed to tie hash for nohist_courseids.db');
return;	return;
}	}
	foreach my $hashid (keys(%recent)) {
	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})) {
	next if ($recent{$hashid});
	&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
	}
foreach my $hashid (keys(%okcourses)) {	foreach my $hashid (keys(%okcourses)) {
if (ref($homecourses->{$hashid}) eq 'ARRAY') {	if (ref($homecourses->{$hashid}) eq 'ARRAY') {
foreach my $role (@{$homecourses->{$hashid}}) {	foreach my $role (@{$homecourses->{$hashid}}) {
Line 7429 sub useable_role {	Line 7512 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.456
changed lines
	Added in v.1.473