loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.467.2.8 and 1.492

version 1.467.2.8, 2014/06/09 16:58:22	version 1.492, 2012/04/26 19:51: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 33 use strict;	Line 34 use strict;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use LONCAPA;	use LONCAPA;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
	use LONCAPA::Lond;

use IO::Socket;	use IO::Socket;
use IO::File;	use IO::File;
Line 91 my %managers; # Ip -> manager names	Line 93 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 600 sub InstallFile {	Line 604 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:	# Supports the following file selectors:
# hosts, domain, dns_hosts, dns_domain	# hosts, domain, dns_hosts, dns_domain
#	#
#	#
# Parameters:	# Parameters:
Line 614 sub ConfigFileFromSelector {	Line 618 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 "domain") \|\|
($selector eq "dns_hosts") \|\| ($selector eq "dns_domain")) {	($selector eq "dns_hosts") \|\| ($selector eq "dns_domain")) {
$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 637 sub ConfigFileFromSelector {	Line 640 sub ConfigFileFromSelector {
# String to send to client ("ok" or "refused" if bad file).	# String to send to client ("ok" or "refused" if bad file).
#	#
sub PushFile {	sub PushFile {
my $request = shift;	my $request = shift;
my ($command, $filename, $contents) = split(":", $request, 3);	my ($command, $filename, $contents) = split(":", $request, 3);
&Debug("PushFile");	&Debug("PushFile");

Line 646 sub PushFile {	Line 649 sub PushFile {
# 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_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.	# 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 667 sub PushFile {	Line 670 sub PushFile {

if($filename eq "host") {	if($filename eq "host") {
$contents = AdjustHostContents($contents);	$contents = AdjustHostContents($contents);
} elsif ($filename eq 'dns_host' \|\| $filename eq 'dns_domain') {
if ($contents eq '') {
&logthis('<font color="red"> Pushfile: unable to install '
.$tablefile." - no data received from push. </font>");
return 'error: push had no data';
}
if (&Apache::lonnet::get_host_ip($clientname)) {
my $clienthost = &Apache::lonnet::hostname($clientname);
if ($managers{$clientip} eq $clientname) {
my $clientprotocol = $Apache::lonnet::protocol{$clientname};
$clientprotocol = 'http' if ($clientprotocol ne 'https');
my $url = '/adm/'.$filename;
$url =~ s{_}{/};
my $ua=new LWP::UserAgent;
$ua->timeout(60);
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
my $response=$ua->request($request);
if ($response->is_error()) {
&logthis('<font color="red"> Pushfile: unable to install '
.$tablefile." - error attempting to pull data. </font>");
return 'error: pull failed';
} else {
my $result = $response->content;
chomp($result);
unless ($result eq $contents) {
&logthis('<font color="red"> Pushfile: unable to install '
.$tablefile." - pushed data and pulled data differ. </font>");
my $pushleng = length($contents);
my $pullleng = length($result);
if ($pushleng != $pullleng) {
return "error: $pushleng vs $pullleng bytes";
} else {
return "error: mismatch push and pull";
}
}
}
}
}
}	}

# Install the new file:	# Install the new file:
Line 715 sub PushFile {	Line 680 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>");	." - transaction by: $clientname ($clientip)</font>");
my $adminmail = $perlvar{'lonAdmEMail'};	my $adminmail = $perlvar{'lonAdmEMail'};
my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});	my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
if ($admindom ne '') {	if ($admindom ne '') {
Line 1679 sub ls3_handler {	Line 1644 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 1874 sub authenticate_handler {	Line 1907 sub authenticate_handler {
if (ref($hostedsession) eq 'HASH') {	if (ref($hostedsession) eq 'HASH') {
$hosted = $hostedsession->{'hosted'};	$hosted = $hostedsession->{'hosted'};
}	}
my $loncaparev = $clientversion;
if ($loncaparev eq '') {
$loncaparev = $Apache::lonnet::loncaparevs{$clientname};
}
$canhost = &Apache::lonnet::can_host_session($udom,$clientname,	$canhost = &Apache::lonnet::can_host_session($udom,$clientname,
$loncaparev,	$clientversion,
$remote,$hosted);	$remote,$hosted);
}	}
}	}
Line 2041 sub add_user_handler {	Line 2070 sub add_user_handler {
."makeuser";	."makeuser";
}	}
unless ($fperror) {	unless ($fperror) {
my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);	my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename);
&Reply($client,\$result, $userinput); #BUGBUG - could be fail	&Reply($client,\$result, $userinput); #BUGBUG - could be fail
} else {	} else {
&Failure($client, \$fperror, $userinput);	&Failure($client, \$fperror, $userinput);
Line 2116 sub change_authentication_handler {	Line 2145 sub change_authentication_handler {
&Failure($client, \$result);	&Failure($client, \$result);
}	}
} else {	} else {
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);	my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename);
#	#
# If the current auth mode is internal, and the old auth mode was	# If the current auth mode is internal, and the old auth mode was
# unix, or krb*, and the user is an author for this domain,	# unix, or krb*, and the user is an author for this domain,
Line 3213 sub dump_profile_database {	Line 3242 sub dump_profile_database {
# that is matched against	# that is matched against
# database keywords to do	# database keywords to do
# selective dumps.	# selective dumps.
	# range - optional range of entries
	# e.g., 10-20 would return the
	# 10th to 19th items, etc.
# $client - Channel open on the client.	# $client - Channel open on the client.
# Returns:	# Returns:
# 1 - Continue processing.	# 1 - Continue processing.
Line 3222 sub dump_profile_database {	Line 3254 sub dump_profile_database {
sub dump_with_regexp {	sub dump_with_regexp {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

	my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion);
my $userinput = "$cmd:$tail";
	if ($res =~ /^error:/) {
my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);	Failure($client, \$res, "$cmd:$tail");
if (defined($regexp)) {
$regexp=&unescape($regexp);
} else {
$regexp='.';
}
my ($start,$end);
if (defined($range)) {
if ($range =~/^(\d+)\-(\d+)$/) {
($start,$end) = ($1,$2);
} elsif ($range =~/^(\d+)$/) {
($start,$end) = (0,$1);
} else {
undef($range);
}
}
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
my $skipcheck;
if ($hashref) {
my $qresult='';
my $count=0;
if ($extra ne '') {
$extra = &Apache::lonnet::thaw_unescape($extra);
$skipcheck = $extra->{'skipcheck'};
}
my @ids = &Apache::lonnet::current_machine_ids();
my (%homecourses,$major,$minor,$now);
if (($namespace eq 'roles') && (!$skipcheck)) {
my $loncaparev = $clientversion;
if ($loncaparev eq '') {
$loncaparev = $Apache::lonnet::loncaparevs{$clientname};
}
if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
$major = $1;
$minor = $2;
}
$now = time;
}
while (my ($key,$value) = each(%$hashref)) {
if ($namespace eq 'roles') {
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc\|co\|in\|ta\|ep\|ad\|st\|cr)$}) {
my $cdom = $1;
my $cnum = $2;
unless ($skipcheck) {
my ($role,$end,$start) = split(/\_/,$value);
if (!$end \|\| $end > $now) {
next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
$minor,\%homecourses,\@ids));
}
}
}
}
if ($regexp eq '.') {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$qresult.=$key.'='.$value.'&';
} else {
my $unescapeKey = &unescape($key);
if (eval('$unescapeKey=~/$regexp/')) {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$qresult.="$key=$value&";
}
}
}
if (&untie_user_hash($hashref)) {
if (($namespace eq 'roles') && (!$skipcheck)) {
if (keys(%homecourses) > 0) {
$qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
$range,$start,$end,$major,$minor);
}
}
chop($qresult);
&Reply($client, \$qresult, $userinput);
} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting dump\n", $userinput);
}
} else {	} else {
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".	Reply($client, \$res, "$cmd:$tail");
"while attempting dump\n", $userinput);
}	}

return 1;	return 1;
Line 5079 sub validate_course_owner_handler {	Line 5030 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 6070 if (-e $pidfile) {	Line 6021 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 6133 sub HUPSMAN { # sig	Line 6084 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)
if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {	if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
my $script = $execdir."/apachereload";	my $script = $execdir."/apachereload";
Line 6249 sub Debug {	Line 6201 sub Debug {
# reply - Text to send to client.	# reply - Text to send to client.
# request - Original request from client.	# request - Original request from client.
#	#
	#NOTE $reply must be terminated by exactly one \n. If $reply is a reference
	#this is done automatically ($$reply must not contain any \n in this case).
	#If $reply is a string the caller has to ensure this.
sub Reply {	sub Reply {
my ($fd, $reply, $request) = @_;	my ($fd, $reply, $request) = @_;
if (ref($reply)) {	if (ref($reply)) {
Line 6402 $SIG{USR2} = \&UpdateHosts;	Line 6357 $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`;	my $arch = `uname -i`;
chomp($arch);	chomp($arch);
Line 6477 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
# 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 6542 sub make_new_child {	Line 6496 sub make_new_child {
# If the remote is attempting a local init... give that a try:	# If the remote is attempting a local init... give that a try:
#	#
(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);	(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);
	# For LON-CAPA 2.9, the client session will have sent its LON-CAPA
	# version when initiating the connection. For LON-CAPA 2.8 and older,
	# the version is retrieved from the global %loncaparevs in lonnet.pm.
	$clientversion \|\|= $Apache::lonnet::loncaparevs{$clientname};

# If the connection type is ssl, but I didn't get my	# If the connection type is ssl, but I didn't get my
# certificate files yet, then I'll drop back to	# certificate files yet, then I'll drop back to
Line 6685 sub is_author {	Line 6643 sub is_author {

# Author role should show up as a key /domain/_au	# Author role should show up as a key /domain/_au

my $key = "/$domain/_au";
my $value;	my $value;
if (defined($hashref)) {	if ($hashref) {
$value = $hashref->{$key};
}

if(defined($value)) {	my $key = "/$domain/_au";
&Debug("$user @ $domain is an author");	if (defined($hashref)) {
	$value = $hashref->{$key};
	if(!untie_user_hash($hashref)) {
	return 'error: ' . ($!+0)." untie (GDBM) Failed";
	}
	}

	if(defined($value)) {
	&Debug("$user @ $domain is an author");
	}
	} else {
	return 'error: '.($!+0)." tie (GDBM) Failed";
}	}

return defined($value);	return defined($value);
}	}
#	#
# 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 6710 sub is_author {	Line 6675 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=$perlvar{'lonDocRoot'}."/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 7252 sub change_unix_password {	Line 7216 sub change_unix_password {


sub make_passwd_file {	sub make_passwd_file {
my ($uname, $umode,$npass,$passfilename)=@_;	my ($uname,$udom,$umode,$npass,$passfilename)=@_;
my $result="ok";	my $result="ok";
if ($umode eq 'krb4' or $umode eq 'krb5') {	if ($umode eq 'krb4' or $umode eq 'krb5') {
{	{
Line 7293 sub make_passwd_file {	Line 7257 sub make_passwd_file {
#	#
my $uid = getpwnam($uname);	my $uid = getpwnam($uname);
if((defined $uid) && ($uid == 0)) {	if((defined $uid) && ($uid == 0)) {
&logthis(">>>Attempted to create privilged account blocked");	&logthis(">>>Attempt to create privileged account blocked");
return "no_priv_account_error\n";	return "no_priv_account_error\n";
}	}

Line 7305 sub make_passwd_file {	Line 7269 sub make_passwd_file {
&Debug("user = ".$uname.", Password =". $npass);	&Debug("user = ".$uname.", Password =". $npass);
my $se = IO::File->new("\|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");	my $se = IO::File->new("\|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
print $se "$uname\n";	print $se "$uname\n";
	print $se "$udom\n";
print $se "$npass\n";	print $se "$npass\n";
print $se "$npass\n";	print $se "$npass\n";
print $se "$lc_error_file\n"; # Status -> unique file.	print $se "$lc_error_file\n"; # Status -> unique file.
Line 7398 sub get_usersession_config {	Line 7363 sub get_usersession_config {
return;	return;
}	}

sub releasereqd_check {
my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;	#
my $home = &Apache::lonnet::homeserver($cnum,$cdom);	# get_courseinfo_hash() is used to retrieve course information from the db
return if ($home eq 'no_host');	# file: nohist_courseids.db for a course for which the current server is not
my ($reqdmajor,$reqdminor,$displayrole);	# the home server.
if ($cnum =~ /$LONCAPA::match_community/) {	#
if ($major eq '' && $minor eq '') {	# A hash of a hash will be retrieved. The outer hash contains a single key --
return unless ((ref($ids) eq 'ARRAY') &&	# courseID -- for the course for which the data are being requested.
(grep(/^\Q$home\E$/,@{$ids})));	# The contents of the inner hash, for that single item in the outer hash
} else {	# are returned (and cached in memcache for 10 minutes).
$reqdmajor = 2;	#
$reqdminor = 9;
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}
}
my $hashid = $cdom.':'.$cnum;
my ($courseinfo,$cached) =
&Apache::lonnet::is_cached_new('courseinfo',$hashid);
if (defined($cached)) {
if (ref($courseinfo) eq 'HASH') {
if (exists($courseinfo->{'releaserequired'})) {
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}
}
} else {
if (ref($ids) eq 'ARRAY') {
if (grep(/^\Q$home\E$/,@{$ids})) {
if (ref($homecourses) eq 'HASH') {
if (ref($homecourses->{$hashid}) eq 'ARRAY') {
push(@{$homecourses->{$hashid}},{$key=>$value});
} else {
$homecourses->{$hashid} = [{$key=>$value}];
}
}
return;
}
}
my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
if (ref($courseinfo) eq 'HASH') {
if (exists($courseinfo->{'releaserequired'})) {
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}
} else {
return;
}
}
return 1;
}

sub get_courseinfo_hash {	sub get_courseinfo_hash {
my ($cnum,$cdom,$home) = @_;	my ($cnum,$cdom,$home) = @_;
Line 7474 sub get_courseinfo_hash {	Line 7400 sub get_courseinfo_hash {
return;	return;
}	}

sub check_homecourses {
my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
my ($result,%addtocache);
my $yesterday = time - 24*3600;
if (ref($homecourses) eq 'HASH') {
my (%okcourses,%courseinfo,%recent);
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {
my $unesc_key = &unescape($key);
if ($unesc_key =~ /^lasttime:(\w+)$/) {
my $cid = $1;
$cid =~ s/_/:/;
if ($value > $yesterday ) {
$recent{$cid} = 1;
}
next;
}
my $items = &Apache::lonnet::thaw_unescape($value);
if (ref($items) eq 'HASH') {
my $hashid = $unesc_key;
$hashid =~ s/_/:/;
$courseinfo{$hashid} = $items;
if (ref($homecourses->{$hashid}) eq 'ARRAY') {
my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
$okcourses{$hashid} = 1;
}
}
}
}
unless (&untie_domain_hash($hashref)) {
&logthis('Failed to untie tied hash for nohist_courseids.db');
}
} else {
&logthis('Failed to tie hash for nohist_courseids.db');
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)) {
if (ref($homecourses->{$hashid}) eq 'ARRAY') {
foreach my $role (@{$homecourses->{$hashid}}) {
if (ref($role) eq 'HASH') {
while (my ($key,$value) = each(%{$role})) {
if ($regexp eq '.') {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$result.=$key.'='.$value.'&';
} else {
my $unescapeKey = &unescape($key);
if (eval('$unescapeKey=~/$regexp/')) {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$result.="$key=$value&";
}
}
}
}
}
}
}
}
return $result;
}

sub useable_role {
my ($reqdmajor,$reqdminor,$major,$minor) = @_;
if ($reqdmajor ne '' && $reqdminor ne '') {
return if (($major eq '' && $minor eq '') \|\|
($major < $reqdmajor) \|\|
(($major == $reqdmajor) && ($minor < $reqdminor)));
}
return 1;
}

sub distro_and_arch {	sub distro_and_arch {
return $dist.':'.$arch;	return $dist.':'.$arch;
Line 7888 Authen::Krb5	Line 7729 Authen::Krb5

=head1 COREQUISITES	=head1 COREQUISITES

	none

=head1 OSNAMES	=head1 OSNAMES

linux	linux
Line 7975 or the CA's certificate in the call to l	Line 7818 or the CA's certificate in the call to l
<error> is the textual reason this failed. Usual reasons:	<error> is the textual reason this failed. Usual reasons:

=over 2	=over 2

=item Apache config file for loncapa incorrect:	=item Apache config file for loncapa incorrect:

one of the variables	one of the variables
lonCertificateDirectory, lonnetCertificateAuthority, or lonnetCertificate	lonCertificateDirectory, lonnetCertificateAuthority, or lonnetCertificate
undefined or incorrect	undefined or incorrect
Line 8096 Could not rewrite the	Line 7939 Could not rewrite the
internal password file for a user	internal password file for a user

=item Result of password change for <user> : <result>	=item Result of password change for <user> : <result>

A unix password change for <user> was attempted	A unix password change for <user> was attempted
and the pipe returned <result>	and the pipe returned <result>

Line 8125 lond has been asked to exit by its clien	Line 7968 lond has been asked to exit by its clien
client systemand <input> is the full exit command sent to the server.	client systemand <input> is the full exit command sent to the server.

=item Red CRITICAL: ABNORMAL EXIT. child <pid> for server <hostname> died through a crass with this error->[<message>].	=item Red CRITICAL: ABNORMAL EXIT. child <pid> for server <hostname> died through a crass with this error->[<message>].

A lond child terminated. NOte that this termination can also occur when the	A lond child terminated. NOte that this termination can also occur when the
child receives the QUIT or DIE signals. <pid> is the process id of the child,	child receives the QUIT or DIE signals. <pid> is the process id of the child,
<hostname> the host lond is working for, and <message> the reason the child died	<hostname> the host lond is working for, and <message> the reason the child died
Line 8209 file when sent it's USR1 signal. That p	Line 8052 file when sent it's USR1 signal. That p
assumed to be hung in some un-fixable way.	assumed to be hung in some un-fixable way.

=item Finished checking children	=item Finished checking children

Master processs's USR1 processing is cojmplete.	Master processs's USR1 processing is cojmplete.

=item (Red) CRITICAL: ------- Starting ------	=item (Red) CRITICAL: ------- Starting ------
Line 8223 Started a new child process for <client>	Line 8066 Started a new child process for <client>
connected to the child. This was as a result of a TCP/IP connection from a client.	connected to the child. This was as a result of a TCP/IP connection from a client.

=item Unable to determine who caller was, getpeername returned nothing	=item Unable to determine who caller was, getpeername returned nothing

In child process initialization. either getpeername returned undef or	In child process initialization. either getpeername returned undef or
a zero sized object was returned. Processing continues, but in my opinion,	a zero sized object was returned. Processing continues, but in my opinion,
this should be cause for the child to exit.	this should be cause for the child to exit.
Line 8234 In child process initialization. The pe	Line 8077 In child process initialization. The pe
The client address is stored as "Unavailable" and processing continues.	The client address is stored as "Unavailable" and processing continues.

=item (Yellow) INFO: Connection <ip> <name> connection type = <type>	=item (Yellow) INFO: Connection <ip> <name> connection type = <type>

In child initialization. A good connectionw as received from <ip>.	In child initialization. A good connectionw as received from <ip>.

=over 2	=over 2
Line 8284 The client (<client> is the peer's name	Line 8127 The client (<client> is the peer's name
negotiated an SSL connection with this child process.	negotiated an SSL connection with this child process.

=item (Green) Successful insecure authentication with <client>	=item (Green) Successful insecure authentication with <client>


The client has successfully negotiated an insecure connection withthe child process.	The client has successfully negotiated an insecure connection withthe child process.

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

Removed from v.1.467.2.8
changed lines
	Added in v.1.492