loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.368 and 1.382

version 1.368, 2007/04/03 00:49:55	version 1.382, 2007/09/29 04:03:39
Line 69 my $clientip; # IP address of client.	Line 69 my $clientip; # IP address of client.
my $clientname; # LonCAPA name of client.	my $clientname; # LonCAPA name of client.

my $server;	my $server;
my $thisserver; # DNS of us.

my $keymode;	my $keymode;

Line 136 my @adderrors = ("ok",	Line 135 my @adderrors = ("ok",
"lcuseradd Unable to make www member of users's group",	"lcuseradd Unable to make www member of users's group",
"lcuseradd Unable to su to root",	"lcuseradd Unable to su to root",
"lcuseradd Unable to set password",	"lcuseradd Unable to set password",
"lcuseradd Usrname has invalid characters",	"lcuseradd Username has invalid characters",
"lcuseradd Password has an invalid character",	"lcuseradd Password has an invalid character",
"lcuseradd User already exists",	"lcuseradd User already exists",
"lcuseradd Could not add user.",	"lcuseradd Could not add user.",
Line 172 sub ResetStatistics {	Line 171 sub ResetStatistics {
# $Socket - Socket open on client.	# $Socket - Socket open on client.
# $initcmd - The full text of the init command.	# $initcmd - The full text of the init command.
#	#
# Implicit inputs:
# $thisserver - Our DNS name.
#
# Returns:	# Returns:
# IDEA session key on success.	# IDEA session key on success.
# undef on failure.	# undef on failure.
#	#
sub LocalConnection {	sub LocalConnection {
my ($Socket, $initcmd) = @_;	my ($Socket, $initcmd) = @_;
Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver");	Debug("Attempting local connection: $initcmd client: $clientip");
if($clientip ne "127.0.0.1") {	if($clientip ne "127.0.0.1") {
&logthis('<font color="red"> LocalConnection rejecting non local: '	&logthis('<font color="red"> LocalConnection rejecting non local: '
."$clientip ne $thisserver </font>");	."$clientip ne 127.0.0.1 </font>");
close $Socket;	close $Socket;
return undef;	return undef;
} else {	} else {
Line 2099 sub rename_user_file_handler {	Line 2095 sub rename_user_file_handler {
&register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);	&register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);

#	#
	# Checks if the specified user has an active session on the server
	# return ok if so, not_found if not
	#
	# Parameters:
	# cmd - The request keyword that dispatched to tus.
	# tail - The tail of the request (colon separated parameters).
	# client - Filehandle open on the client.
	# Return:
	# 1.
	sub user_has_session_handler {
	my ($cmd, $tail, $client) = @_;

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

	&logthis("Looking for $udom $uname");
	opendir(DIR,$perlvar{'lonIDsDir'});
	my $filename;
	while ($filename=readdir(DIR)) {
	last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/);
	}
	if ($filename) {
	&Reply($client, "ok\n", "$cmd:$tail");
	} else {
	&Failure($client, "not_found\n", "$cmd:$tail");
	}
	return 1;

	}
	&register_handler("userhassession", \&user_has_session_handler, 0,1,0);

	#
# Authenticate access to a user file by checking that the token the user's	# Authenticate access to a user file by checking that the token the user's
# passed also exists in their session file	# passed also exists in their session file
#	#
Line 2191 sub subscribe_handler {	Line 2218 sub subscribe_handler {
&register_handler("sub", \&subscribe_handler, 0, 1, 0);	&register_handler("sub", \&subscribe_handler, 0, 1, 0);

#	#
# Determine the version of a resource (?) Or is it return	# Determine the latest version of a resource (it looks for the highest
# the top version of the resource? Not yet clear from the	# past version and then returns that +1)
# code in currentversion.
#	#
# Parameters:	# Parameters:
# $cmd - The command that got us here.	# $cmd - The command that got us here.
# $tail - Tail of the command (remaining parameters).	# $tail - Tail of the command (remaining parameters).
	# (Should consist of an absolute path to a file)
# $client - File descriptor connected to client.	# $client - File descriptor connected to client.
# Returns	# Returns
# 0 - Requested to exit, caller should shut down.	# 0 - Requested to exit, caller should shut down.
Line 4487 sub get_institutional_defaults_handler {	Line 4514 sub get_institutional_defaults_handler {
&register_handler("autoinstcodedefaults",	&register_handler("autoinstcodedefaults",
\&get_institutional_defaults_handler,0,1,0);	\&get_institutional_defaults_handler,0,1,0);

	sub get_institutional_user_rules {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my $dom = &unescape($tail);
	my (%rules_hash,@rules_order);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result;
	foreach my $key (keys(%rules_hash)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
	}
	$result =~ s/\&$//;
	$result .= ':';
	if (@rules_order > 0) {
	foreach my $item (@rules_order) {
	$result .= &escape($item).'&';
	}
	}
	$result =~ s/\&$//;
	&Reply($client,$result."\n",$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instuserrules",\&get_institutional_user_rules,0,1,0);


	sub institutional_username_check {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my %rulecheck;
	my $outcome;
	my ($udom,$uname,@rules) = split(/:/,$tail);
	$udom = &unescape($udom);
	$uname = &unescape($uname);
	@rules = map {&unescape($_);} (@rules);
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result='';
	foreach my $key (keys(%rulecheck)) {
	$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
	}
	&Reply($client,$result."\n",$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instrulecheck",\&institutional_username_check,0,1,0);


# Get domain specific conditions for import of student photographs to a course	# Get domain specific conditions for import of student photographs to a course
#	#
Line 4619 sub inst_usertypes_handler {	Line 4710 sub inst_usertypes_handler {
my ($cmd, $domain, $client) = @_;	my ($cmd, $domain, $client) = @_;
my $res;	my $res;
my $userinput = $cmd.":".$domain; # For logging purposes.	my $userinput = $cmd.":".$domain; # For logging purposes.
my (%typeshash,@order);	my (%typeshash,@order,$result);
if (&localenroll::inst_usertypes($domain,\%typeshash,\@order) eq 'ok') {	eval {
	local($SIG{__DIE__})='DEFAULT';
	$result=&localenroll::inst_usertypes($domain,\%typeshash,\@order);
	};
	if ($result eq 'ok') {
if (keys(%typeshash) > 0) {	if (keys(%typeshash) > 0) {
foreach my $key (keys(%typeshash)) {	foreach my $key (keys(%typeshash)) {
$res.=&escape($key).'='.&escape($typeshash{$key}).'&';	$res.=&escape($key).'='.&escape($typeshash{$key}).'&';
Line 4903 sub catchexception {	Line 4998 sub catchexception {
$SIG{__DIE__}='DEFAULT';	$SIG{__DIE__}='DEFAULT';
&status("Catching exception");	&status("Catching exception");
&logthis("<font color='red'>CRITICAL: "	&logthis("<font color='red'>CRITICAL: "
."ABNORMAL EXIT. Child $$ for server $thisserver died through "	."ABNORMAL EXIT. Child $$ for server ".$perlvar{'lonHostID'}." died through "
."a crash with this error msg->[$error]</font>");	."a crash with this error msg->[$error]</font>");
&logthis('Famous last words: '.$status.' - '.$lastlog);	&logthis('Famous last words: '.$status.' - '.$lastlog);
if ($client) { print $client "error: $error\n"; }	if ($client) { print $client "error: $error\n"; }
Line 5044 sub UpdateHosts {	Line 5139 sub UpdateHosts {
# either dropped or changed hosts. Note that the re-read of the table	# either dropped or changed hosts. Note that the re-read of the table
# will take care of new and changed hosts as connections come into being.	# will take care of new and changed hosts as connections come into being.

#FIXME need a way to tell lonnet that it needs to reset host	&Apache::lonnet::reset_hosts_info();
#cached host info

foreach my $child (keys(%children)) {	foreach my $child (keys(%children)) {
my $childip = $children{$child};	my $childip = $children{$child};
if (defined(&Apache::lonnet::get_hosts_from_ip($childip))) {	if ($childip ne '127.0.0.1'
	&& !defined(&Apache::lonnet::get_hosts_from_ip($childip))) {
logthis('<font color="blue"> UpdateHosts killing child '	logthis('<font color="blue"> UpdateHosts killing child '
." $child for ip $childip </font>");	." $child for ip $childip </font>");
kill('INT', $child);	kill('INT', $child);
Line 5367 sub make_new_child {	Line 5462 sub make_new_child {
# -----------------------------------------------------------------------------	# -----------------------------------------------------------------------------
# see if we know client and 'check' for spoof IP by ineffective challenge	# see if we know client and 'check' for spoof IP by ineffective challenge

ReadManagerTable; # May also be a manager!!

my $outsideip=$clientip;	my $outsideip=$clientip;
if ($clientip eq '127.0.0.1') {	if ($clientip eq '127.0.0.1') {
$outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});	$outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
Line 5488 sub make_new_child {	Line 5581 sub make_new_child {
# ---------------- New known client connecting, could mean machine online again	# ---------------- New known client connecting, could mean machine online again
if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip	if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip
&& $clientip ne '127.0.0.1') {	&& $clientip ne '127.0.0.1') {
&Apache::lonnet::reconlonc();	&Apache::lonnet::reconlonc($clientname);
}	}
&logthis("<font color='green'>Established connection: $clientname</font>");	&logthis("<font color='green'>Established connection: $clientname</font>");
&status('Will listen to '.$clientname);	&status('Will listen to '.$clientname);
Line 5772 sub validate_user {	Line 5865 sub validate_user {
$password,	$password,
$credentials);	$credentials);
$validated = ($krbreturn == 1);	$validated = ($krbreturn == 1);
	if (!$validated) {
	&logthis('krb5: '.$user.', '.$contentpwd.', '.
	&Authen::Krb5::error());
	}
} else {	} else {
$validated = 0;	$validated = 0;
}	}
Line 6017 sub subscribe {	Line 6114 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://$thisserver/".$fname;	$fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
$result="$fname\n";	$result="$fname\n";
}	}
} else {	} else {
Line 6174 sub sethost {	Line 6271 sub sethost {
if (&Apache::lonnet::get_host_ip($perlvar{'lonHostID'})	if (&Apache::lonnet::get_host_ip($perlvar{'lonHostID'})
eq &Apache::lonnet::get_host_ip($hostid)) {	eq &Apache::lonnet::get_host_ip($hostid)) {
$currenthostid =$hostid;	$currenthostid =$hostid;
$currentdomainid=&Apache::lonnet::domain($hostid);	$currentdomainid=&Apache::lonnet::host_domain($hostid);
&logthis("Setting hostid to $hostid, and domain to $currentdomainid");	&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
} else {	} else {
&logthis("Requested host id $hostid not an alias of ".	&logthis("Requested host id $hostid not an alias of ".

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

Removed from v.1.368
changed lines
	Added in v.1.382