version 1.407, 2008/07/07 15:23:41
|
version 1.422, 2009/08/18 20:08:13
|
Line 142 my @adderrors = ("ok",
|
Line 142 my @adderrors = ("ok",
|
"lcuseradd Password mismatch"); |
"lcuseradd Password mismatch"); |
|
|
|
|
|
# This array are the errors from lcinstallfile: |
|
|
|
my @installerrors = ("ok", |
|
"Initial user id of client not that of www", |
|
"Usage error, not enough command line arguments", |
|
"Source file name does not exist", |
|
"Destination file name does not exist", |
|
"Some file operation failed", |
|
"Invalid table filename." |
|
); |
|
|
# |
# |
# Statistics that are maintained and dislayed in the status line. |
# Statistics that are maintained and dislayed in the status line. |
Line 398 sub isClient {
|
Line 408 sub isClient {
|
# |
# |
sub ReadManagerTable { |
sub ReadManagerTable { |
|
|
|
&Debug("Reading manager table"); |
# Clean out the old table first.. |
# Clean out the old table first.. |
|
|
foreach my $key (keys %managers) { |
foreach my $key (keys %managers) { |
Line 520 sub AdjustHostContents {
|
Line 531 sub AdjustHostContents {
|
} |
} |
# |
# |
# InstallFile: Called to install an administrative file: |
# InstallFile: Called to install an administrative file: |
# - The file is created with <name>.tmp |
# - The file is created int a temp directory called <name>.tmp |
# - The <name>.tmp file is then mv'd to <name> |
# - lcinstall file is called to install the file. |
# This lugubrious procedure is done to ensure that we are never without |
# since the web app has no direct write access to the table directory |
# a valid, even if dated, version of the file regardless of who crashes |
|
# and when the crash occurs. |
|
# |
# |
# Parameters: |
# Parameters: |
# Name of the file |
# Name of the file |
Line 532 sub AdjustHostContents {
|
Line 541 sub AdjustHostContents {
|
# Return: |
# Return: |
# nonzero - success. |
# nonzero - success. |
# 0 - failure and $! has an errno. |
# 0 - failure and $! has an errno. |
|
# Assumptions: |
|
# File installtion is a relatively infrequent |
# |
# |
sub InstallFile { |
sub InstallFile { |
|
|
my ($Filename, $Contents) = @_; |
my ($Filename, $Contents) = @_; |
my $TempFile = $Filename.".tmp"; |
# my $TempFile = $Filename.".tmp"; |
|
my $exedir = $perlvar{'lonDaemons'}; |
|
my $tmpdir = $exedir.'/tmp/'; |
|
my $TempFile = $tmpdir."TempTableFile.tmp"; |
|
|
# Open the file for write: |
# Open the file for write: |
|
|
Line 550 sub InstallFile {
|
Line 564 sub InstallFile {
|
print $fh ($Contents); |
print $fh ($Contents); |
$fh->close; # In case we ever have a filesystem w. locking |
$fh->close; # In case we ever have a filesystem w. locking |
|
|
chmod(0660, $TempFile); |
chmod(0664, $TempFile); # Everyone can write it. |
|
|
# Now we can move install the file in position. |
# Use lcinstall file to put the file in the table directory... |
|
|
move($TempFile, $Filename); |
&Debug("Opening pipe to $exedir/lcinstallfile $TempFile $Filename"); |
|
my $pf = IO::File->new("| $exedir/lcinstallfile $TempFile $Filename > $exedir/logs/lcinstallfile.log"); |
|
close $pf; |
|
my $err = $?; |
|
&Debug("Status is $err"); |
|
if ($err != 0) { |
|
my $msg = $err; |
|
if ($err < @installerrors) { |
|
$msg = $installerrors[$err]; |
|
} |
|
&logthis("Install failed for table file $Filename : $msg"); |
|
return 0; |
|
} |
|
|
|
# Remove the temp file: |
|
|
|
unlink($TempFile); |
|
|
return 1; |
return 1; |
} |
} |
Line 562 sub InstallFile {
|
Line 592 sub InstallFile {
|
|
|
# |
# |
# ConfigFileFromSelector: converts a configuration file selector |
# ConfigFileFromSelector: converts a configuration file selector |
# (one of host or domain at this point) into a |
# into a configuration file pathname. |
# configuration file pathname. |
# It's probably no longer necessary to preserve |
|
# 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: |
# selector - Configuration file selector. |
# selector - Configuration file selector. |
Line 580 sub ConfigFileFromSelector {
|
Line 615 sub ConfigFileFromSelector {
|
} elsif ($selector eq "domain") { |
} elsif ($selector eq "domain") { |
$tablefile = $tabledir."domain.tab"; |
$tablefile = $tabledir."domain.tab"; |
} else { |
} else { |
return undef; |
$tablefile = $tabledir.$selector.'.tab'; |
} |
} |
return $tablefile; |
return $tablefile; |
|
|
Line 603 sub ConfigFileFromSelector {
|
Line 638 sub ConfigFileFromSelector {
|
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"); |
|
|
# At this point in time, pushes for only the following tables are |
# At this point in time, pushes for only the following tables are |
# supported: |
# supported: |
Line 619 sub PushFile {
|
Line 655 sub PushFile {
|
if(! (defined $tablefile)) { |
if(! (defined $tablefile)) { |
return "refused"; |
return "refused"; |
} |
} |
# |
|
# >copy< the old table to the backup table |
|
# don't rename in case system crashes/reboots etc. in the time |
|
# window between a rename and write. |
|
# |
|
my $backupfile = $tablefile; |
|
$backupfile =~ s/\.tab$/.old/; |
|
if(!CopyFile($tablefile, $backupfile)) { |
|
&logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>"); |
|
return "error:$!"; |
|
} |
|
&logthis('<font color="green"> Pushfile: backed up ' |
|
.$tablefile." to $backupfile</font>"); |
|
|
|
# If the file being pushed is the host file, we adjust the entry for ourself so that the |
# If the file being pushed is the host file, we adjust the entry for ourself so that the |
# IP will be our current IP as looked up in dns. Note this is only 99% good as it's possible |
# IP will be our current IP as looked up in dns. Note this is only 99% good as it's possible |
# to conceive of conditions where we don't have a DNS entry locally. This is possible in a |
# to conceive of conditions where we don't have a DNS entry locally. This is possible in a |
Line 645 sub PushFile {
|
Line 668 sub PushFile {
|
|
|
# Install the new file: |
# Install the new file: |
|
|
|
&logthis("Installing new $tablefile contents:\n$contents"); |
if(!InstallFile($tablefile, $contents)) { |
if(!InstallFile($tablefile, $contents)) { |
&logthis('<font color="red"> Pushfile: unable to install ' |
&logthis('<font color="red"> Pushfile: unable to install ' |
.$tablefile." $! </font>"); |
.$tablefile." $! </font>"); |
Line 1198 sub user_authorization_type {
|
Line 1222 sub user_authorization_type {
|
# a reply is written to the client. |
# a reply is written to the client. |
sub push_file_handler { |
sub push_file_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
&Debug("In push file handler"); |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
# At this time we only know that the IP of our partner is a valid manager |
# At this time we only know that the IP of our partner is a valid manager |
Line 1206 sub push_file_handler {
|
Line 1230 sub push_file_handler {
|
# spoofing). |
# spoofing). |
|
|
my $cert = &GetCertificate($userinput); |
my $cert = &GetCertificate($userinput); |
if(&ValidManager($cert)) { |
if(&ValidManager($cert)) { |
|
&Debug("Valid manager: $client"); |
|
|
# Now presumably we have the bona fides of both the peer host and the |
# Now presumably we have the bona fides of both the peer host and the |
# process making the request. |
# process making the request. |
Line 1215 sub push_file_handler {
|
Line 1240 sub push_file_handler {
|
&Reply($client, \$reply, $userinput); |
&Reply($client, \$reply, $userinput); |
|
|
} else { |
} else { |
|
&logthis("push_file_handler $client is not valid"); |
&Failure( $client, "refused\n", $userinput); |
&Failure( $client, "refused\n", $userinput); |
} |
} |
return 1; |
return 1; |
Line 1538 sub ls3_handler {
|
Line 1564 sub ls3_handler {
|
} elsif ($alternate_root ne '') { |
} elsif ($alternate_root ne '') { |
$dir_root = $alternate_root; |
$dir_root = $alternate_root; |
} |
} |
if ($dir_root ne '') { |
if (($dir_root ne '') && ($dir_root ne '/')) { |
if ($ulsdir =~ /^\//) { |
if ($ulsdir =~ /^\//) { |
$ulsdir = $dir_root.$ulsdir; |
$ulsdir = $dir_root.$ulsdir; |
} else { |
} else { |
Line 1587 sub ls3_handler {
|
Line 1613 sub ls3_handler {
|
} |
} |
®ister_handler("ls3", \&ls3_handler, 0, 1, 0); |
®ister_handler("ls3", \&ls3_handler, 0, 1, 0); |
|
|
|
sub server_timezone_handler { |
|
my ($cmd,$tail,$client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my $timezone; |
|
my $clockfile = '/etc/sysconfig/clock'; # Fedora/CentOS/SuSE |
|
my $tzfile = '/etc/timezone'; # Debian/Ubuntu |
|
if (-e $clockfile) { |
|
if (open(my $fh,"<$clockfile")) { |
|
while (<$fh>) { |
|
next if (/^[\#\s]/); |
|
if (/^(?:TIME)?ZONE\s*=\s*['"]?\s*([\w\/]+)/) { |
|
$timezone = $1; |
|
last; |
|
} |
|
} |
|
close($fh); |
|
} |
|
} elsif (-e $tzfile) { |
|
if (open(my $fh,"<$tzfile")) { |
|
$timezone = <$fh>; |
|
close($fh); |
|
chomp($timezone); |
|
if ($timezone =~ m{^Etc/(\w+)$}) { |
|
$timezone = $1; |
|
} |
|
} |
|
} |
|
&Reply($client,\$timezone,$userinput); # This supports debug logging. |
|
return 1; |
|
} |
|
®ister_handler("servertimezone", \&server_timezone_handler, 0, 1, 0); |
|
|
|
sub server_loncaparev_handler { |
|
my ($cmd,$tail,$client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
&Reply($client,\$perlvar{'lonVersion'},$userinput); |
|
return 1; |
|
} |
|
®ister_handler("serverloncaparev", \&server_loncaparev_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 3608 sub put_course_id_hash_handler {
|
Line 3674 sub put_course_id_hash_handler {
|
# will be returned. Pre-2.2.0 legacy entries from |
# will be returned. Pre-2.2.0 legacy entries from |
# nohist_courseiddump will only contain usernames. |
# nohist_courseiddump will only contain usernames. |
# type - optional parameter for selection |
# type - optional parameter for selection |
# regexp_ok - if true, allow the supplied institutional code |
# regexp_ok - if 1 or -1 allow the supplied institutional code |
# filter to behave as a regular expression. |
# filter to behave as a regular expression: |
|
# 1 will not exclude the course if the instcode matches the RE |
|
# -1 will exclude the course if the instcode matches the RE |
# rtn_as_hash - whether to return the information available for |
# rtn_as_hash - whether to return the information available for |
# each matched item as a frozen hash of all |
# each matched item as a frozen hash of all |
# key, value pairs in the item's hash, or as a |
# key, value pairs in the item's hash, or as a |
Line 3625 sub put_course_id_hash_handler {
|
Line 3693 sub put_course_id_hash_handler {
|
# caller - if set to 'coursecatalog', courses set to be hidden |
# caller - if set to 'coursecatalog', courses set to be hidden |
# from course catalog will be excluded from results (unless |
# from course catalog will be excluded from results (unless |
# overridden by "showhidden". |
# overridden by "showhidden". |
|
# cloner - escaped username:domain of course cloner (if picking course to# |
|
# clone). |
|
# cc_clone_list - escaped comma separated list of courses for which |
|
# course cloner has active CC role (and so can clone |
|
# automatically). |
|
# cloneonly - filter by courses for which cloner has rights to clone. |
# |
# |
# $client - The socket open on the client. |
# $client - The socket open on the client. |
# Returns: |
# Returns: |
Line 3637 sub dump_course_id_handler {
|
Line 3711 sub dump_course_id_handler {
|
|
|
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, |
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, |
$caller) =split(/:/,$tail); |
$caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail); |
my $now = time; |
my $now = time; |
|
my ($cloneruname,$clonerudom,%cc_clone); |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
Line 3681 sub dump_course_id_handler {
|
Line 3756 sub dump_course_id_handler {
|
if (defined($catfilter)) { |
if (defined($catfilter)) { |
$catfilter=&unescape($catfilter); |
$catfilter=&unescape($catfilter); |
} |
} |
|
if (defined($cloner)) { |
|
$cloner = &unescape($cloner); |
|
($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/); |
|
} |
|
if (defined($cc_clone_list)) { |
|
$cc_clone_list = &unescape($cc_clone_list); |
|
my @cc_cloners = split('&',$cc_clone_list); |
|
foreach my $cid (@cc_cloners) { |
|
my ($clonedom,$clonenum) = split(':',$cid); |
|
next if ($clonedom ne $udom); |
|
$cc_clone{$clonedom.'_'.$clonenum} = 1; |
|
} |
|
} |
|
|
my $unpack = 1; |
my $unpack = 1; |
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && |
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && |
$typefilter eq '.') { |
$typefilter eq '.') { |
Line 3703 sub dump_course_id_handler {
|
Line 3792 sub dump_course_id_handler {
|
$lasttime = $hashref->{$lasttime_key}; |
$lasttime = $hashref->{$lasttime_key}; |
next if ($lasttime<$since); |
next if ($lasttime<$since); |
} |
} |
|
my ($canclone,$valchange); |
my $items = &Apache::lonnet::thaw_unescape($value); |
my $items = &Apache::lonnet::thaw_unescape($value); |
if (ref($items) eq 'HASH') { |
if (ref($items) eq 'HASH') { |
$is_hash = 1; |
$is_hash = 1; |
|
if (defined($clonerudom)) { |
|
if ($items->{'cloners'}) { |
|
my @cloneable = split(',',$items->{'cloners'}); |
|
if (@cloneable) { |
|
if (grep(/^\*$/,@cloneable)) { |
|
$canclone = 1; |
|
} elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) { |
|
$canclone = 1; |
|
} elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) { |
|
$canclone = 1; |
|
} |
|
} |
|
unless ($canclone) { |
|
if ($cloneruname ne '' && $clonerudom ne '') { |
|
if ($cc_clone{$unesc_key}) { |
|
$canclone = 1; |
|
$items->{'cloners'} .= ','.$cloneruname.':'. |
|
$clonerudom; |
|
$valchange = 1; |
|
} |
|
} |
|
} |
|
} elsif (defined($cloneruname)) { |
|
if ($cc_clone{$unesc_key}) { |
|
$canclone = 1; |
|
$items->{'cloners'} = $cloneruname.':'.$clonerudom; |
|
$valchange = 1; |
|
} |
|
} |
|
} |
if ($unpack || !$rtn_as_hash) { |
if ($unpack || !$rtn_as_hash) { |
$unesc_val{'descr'} = $items->{'description'}; |
$unesc_val{'descr'} = $items->{'description'}; |
$unesc_val{'inst_code'} = $items->{'inst_code'}; |
$unesc_val{'inst_code'} = $items->{'inst_code'}; |
$unesc_val{'owner'} = $items->{'owner'}; |
$unesc_val{'owner'} = $items->{'owner'}; |
$unesc_val{'type'} = $items->{'type'}; |
$unesc_val{'type'} = $items->{'type'}; |
|
$unesc_val{'cloners'} = $items->{'cloners'}; |
} |
} |
$selfenroll_types = $items->{'selfenroll_types'}; |
$selfenroll_types = $items->{'selfenroll_types'}; |
$selfenroll_end = $items->{'selfenroll_end_date'}; |
$selfenroll_end = $items->{'selfenroll_end_date'}; |
Line 3741 sub dump_course_id_handler {
|
Line 3862 sub dump_course_id_handler {
|
} |
} |
} else { |
} else { |
next if ($catfilter ne ''); |
next if ($catfilter ne ''); |
next if ($selfenrollonly); |
next if ($selfenrollonly); |
|
if ((defined($clonerudom)) && (defined($cloneruname))) { |
|
if ($cc_clone{$unesc_key}) { |
|
$canclone = 1; |
|
$val{'cloners'} = &escape($cloneruname.':'.$clonerudom); |
|
} |
|
} |
$is_hash = 0; |
$is_hash = 0; |
my @courseitems = split(/:/,$value); |
my @courseitems = split(/:/,$value); |
$lasttime = pop(@courseitems); |
$lasttime = pop(@courseitems); |
Line 3750 sub dump_course_id_handler {
|
Line 3877 sub dump_course_id_handler {
|
} |
} |
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems; |
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems; |
} |
} |
|
if ($cloneonly) { |
|
next unless ($canclone); |
|
} |
my $match = 1; |
my $match = 1; |
if ($description ne '.') { |
if ($description ne '.') { |
if (!$is_hash) { |
if (!$is_hash) { |
Line 3763 sub dump_course_id_handler {
|
Line 3893 sub dump_course_id_handler {
|
if (!$is_hash) { |
if (!$is_hash) { |
$unesc_val{'inst_code'} = &unescape($val{'inst_code'}); |
$unesc_val{'inst_code'} = &unescape($val{'inst_code'}); |
} |
} |
if ($regexp_ok) { |
if ($regexp_ok == 1) { |
if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) { |
if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) { |
$match = 0; |
$match = 0; |
} |
} |
|
} elsif ($regexp_ok == -1) { |
|
if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) { |
|
$match = 0; |
|
} |
} else { |
} else { |
if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) { |
if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) { |
$match = 0; |
$match = 0; |
Line 3832 sub dump_course_id_handler {
|
Line 3966 sub dump_course_id_handler {
|
if ($match == 1) { |
if ($match == 1) { |
if ($rtn_as_hash) { |
if ($rtn_as_hash) { |
if ($is_hash) { |
if ($is_hash) { |
$qresult.=$key.'='.$value.'&'; |
if ($valchange) { |
|
my $newvalue = &Apache::lonnet::freeze_escape($items); |
|
$qresult.=$key.'='.$newvalue.'&'; |
|
} else { |
|
$qresult.=$key.'='.$value.'&'; |
|
} |
} else { |
} else { |
my %rtnhash = ( 'description' => &unescape($val{'descr'}), |
my %rtnhash = ( 'description' => &unescape($val{'descr'}), |
'inst_code' => &unescape($val{'inst_code'}), |
'inst_code' => &unescape($val{'inst_code'}), |
'owner' => &unescape($val{'owner'}), |
'owner' => &unescape($val{'owner'}), |
'type' => &unescape($val{'type'}), |
'type' => &unescape($val{'type'}), |
|
'cloners' => &unescape($val{'cloners'}), |
); |
); |
my $items = &Apache::lonnet::freeze_escape(\%rtnhash); |
my $items = &Apache::lonnet::freeze_escape(\%rtnhash); |
$qresult.=$key.'='.$items.'&'; |
$qresult.=$key.'='.$items.'&'; |
Line 3912 sub put_domain_handler {
|
Line 4052 sub put_domain_handler {
|
} |
} |
®ister_handler("putdom", \&put_domain_handler, 0, 1, 0); |
®ister_handler("putdom", \&put_domain_handler, 0, 1, 0); |
|
|
|
# |
|
# Puts a piece of new data in a namespace db file at the domain level |
|
# returns error if key already exists |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# Side effects: |
|
# reply is written to $client. |
|
# |
|
sub newput_domain_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ($udom,$namespace,$what) =split(/:/,$tail,3); |
|
chomp($what); |
|
my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(), |
|
"N", $what); |
|
if(!$hashref) { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting newputdom\n", $userinput); |
|
return 1; |
|
} |
|
|
|
my @pairs=split(/\&/,$what); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
if (exists($hashref->{$key})) { |
|
&Failure($client, "key_exists: ".$key."\n",$userinput); |
|
return 1; |
|
} |
|
} |
|
|
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
$hashref->{$key}=$value; |
|
} |
|
|
|
if (&untie_domain_hash($hashref)) { |
|
&Reply( $client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
|
"while attempting newputdom\n", |
|
$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("newputdom", \&newput_domain_handler, 0, 1, 0); |
|
|
# Unencrypted get from the namespace database file at the domain level. |
# Unencrypted get from the namespace database file at the domain level. |
# This function retrieves a keyed item from a specific named database in the |
# This function retrieves a keyed item from a specific named database in the |
# domain directory. |
# domain directory. |
Line 3961 sub get_domain_handler {
|
Line 4155 sub get_domain_handler {
|
} |
} |
®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); |
®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); |
|
|
|
# |
|
# Deletes a key in a user profile database. |
|
# |
|
# Parameters: |
|
# $cmd - Command keyword (deldom). |
|
# $tail - Command tail. IN this case a colon |
|
# separated list containing: |
|
# the domain to which the database file belongs; |
|
# the namespace (name of the database file); |
|
# & separated list of keys to delete. |
|
# $client - File open on client socket. |
|
# Returns: |
|
# 1 - Continue processing |
|
# 0 - Exit server. |
|
# |
|
# |
|
sub delete_domain_entry { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "cmd:$tail"; |
|
|
|
my ($udom,$namespace,$what) = split(/:/,$tail); |
|
chomp($what); |
|
my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_WRCREAT(), |
|
"D",$what); |
|
if ($hashref) { |
|
my @keys=split(/\&/,$what); |
|
foreach my $key (@keys) { |
|
delete($hashref->{$key}); |
|
} |
|
if (&untie_user_hash($hashref)) { |
|
&Reply($client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting deldom\n", $userinput); |
|
} |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting deldom\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("deldom", \&delete_domain_entry, 0, 1, 0); |
|
|
# |
# |
# Puts an id to a domains id database. |
# Puts an id to a domains id database. |
Line 4059 sub get_id_handler {
|
Line 4296 sub get_id_handler {
|
} |
} |
®ister_handler("idget", \&get_id_handler, 0, 1, 0); |
®ister_handler("idget", \&get_id_handler, 0, 1, 0); |
|
|
|
sub dump_dom_with_regexp { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($udom,$namespace,$regexp,$range)=split(/:/,$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_domain_hash($udom, $namespace, &GDBM_READER()); |
|
if ($hashref) { |
|
my $qresult=''; |
|
my $count=0; |
|
while (my ($key,$value) = each(%$hashref)) { |
|
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)) { |
|
chop($qresult); |
|
&Reply($client, \$qresult, $userinput); |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting dump\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting dump\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("dumpdom", \&dump_dom_with_regexp, 0, 1, 0); |
|
|
# |
# |
# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database |
# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database |
# |
# |
Line 4268 sub dump_domainroles_handler {
|
Line 4559 sub dump_domainroles_handler {
|
$rolesfilter=&unescape($rolesfilter); |
$rolesfilter=&unescape($rolesfilter); |
@roles = split(/\&/,$rolesfilter); |
@roles = split(/\&/,$rolesfilter); |
} |
} |
|
|
my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
my $qresult = ''; |
my $qresult = ''; |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my $match = 1; |
my $match = 1; |
my ($start,$end) = split(/:/,&unescape($value)); |
my ($end,$start) = split(/:/,&unescape($value)); |
my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key)); |
my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key)); |
unless ($startfilter eq '.' || !defined($startfilter)) { |
unless (@roles < 1) { |
if ($start >= $startfilter) { |
unless (grep/^\Q$trole\E$/,@roles) { |
$match = 0; |
$match = 0; |
|
next; |
} |
} |
} |
} |
unless ($endfilter eq '.' || !defined($endfilter)) { |
unless ($startfilter eq '.' || !defined($startfilter)) { |
if ($end <= $endfilter) { |
if ((defined($start)) && ($start >= $startfilter)) { |
$match = 0; |
$match = 0; |
|
next; |
} |
} |
} |
} |
unless (@roles < 1) { |
unless ($endfilter eq '.' || !defined($endfilter)) { |
unless (grep/^\Q$trole\E$/,@roles) { |
if ((defined($end)) && (($end > 0) && ($end <= $endfilter))) { |
$match = 0; |
$match = 0; |
|
next; |
} |
} |
} |
} |
if ($match == 1) { |
if ($match == 1) { |
Line 4575 sub enrollment_enabled_handler {
|
Line 4869 sub enrollment_enabled_handler {
|
} |
} |
®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0); |
®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0); |
|
|
|
# |
|
# Validate an institutional code use for a LON-CAPA course. |
|
# |
|
# Formal Parameters: |
|
# $cmd - The command request that got us dispatched. |
|
# $tail - The tail of the command. In this case, |
|
# this is a colon separated set of words that will be split |
|
# into: |
|
# $inst_course_id - The institutional cod3 from the |
|
# institutions point of view. |
|
# $cdom - The domain from the institutions |
|
# point of view. |
|
# $client - Socket open on the client. |
|
# Returns: |
|
# 1 - Indicating processing should continue. |
|
# |
|
sub validate_instcode_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($dom,$instcode,$owner,$inststatus,$instseclist) = split(/:/, $tail); |
|
$instcode = &unescape($instcode); |
|
$owner = &unescape($owner); |
|
$inststatus = &unescape($inststatus); |
|
$instseclist = &unescape($instseclist); |
|
my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner, |
|
$inststatus,$instseclist); |
|
&Reply($client, \$outcome, $userinput); |
|
|
|
return 1; |
|
} |
|
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0); |
|
|
# Get the official sections for which auto-enrollment is possible. |
# Get the official sections for which auto-enrollment is possible. |
# Since the admin people won't know about 'unofficial sections' |
# Since the admin people won't know about 'unofficial sections' |
# we cannot auto-enroll on them. |
# we cannot auto-enroll on them. |
Line 4862 sub get_institutional_defaults_handler {
|
Line 5188 sub get_institutional_defaults_handler {
|
®ister_handler("autoinstcodedefaults", |
®ister_handler("autoinstcodedefaults", |
\&get_institutional_defaults_handler,0,1,0); |
\&get_institutional_defaults_handler,0,1,0); |
|
|
|
sub get_possible_instcodes_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
|
|
my $reply; |
|
my $cdom = $tail; |
|
my (@codetitles,%cat_titles,%cat_order,@code_order); |
|
my $formatreply = &localenroll::possible_instcodes($cdom, |
|
\@codetitles, |
|
\%cat_titles, |
|
\%cat_order, |
|
\@code_order); |
|
if ($formatreply eq 'ok') { |
|
my $result = join('&',map {&escape($_);} (@codetitles)).':'; |
|
$result .= join('&',map {&escape($_);} (@code_order)).':'; |
|
foreach my $key (keys(%cat_titles)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_titles{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
$result .= ':'; |
|
foreach my $key (keys(%cat_order)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_order{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
&Reply($client,\$result,$userinput); |
|
} else { |
|
&Reply($client, "format_error\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("autopossibleinstcodes", |
|
\&get_possible_instcodes_handler,0,1,0); |
|
|
sub get_institutional_user_rules { |
sub get_institutional_user_rules { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
Line 5944 sub make_new_child {
|
Line 6303 sub make_new_child {
|
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'}); |
} |
} |
|
&ReadManagerTable(); |
my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip)); |
my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip)); |
my $ismanager=($managers{$outsideip} ne undef); |
my $ismanager=($managers{$outsideip} ne undef); |
$clientname = "[unknonwn]"; |
$clientname = "[unknonwn]"; |
Line 7118 linux
|
Line 7477 linux
|
Server/Process |
Server/Process |
|
|
=cut |
=cut |
|
|
|
|
|
=pod |
|
|
|
=head1 LOG MESSAGES |
|
|
|
The messages below can be emitted in the lond log. This log is located |
|
in ~httpd/perl/logs/lond.log Many log messages have HTML encapsulation |
|
to provide coloring if examined from inside a web page. Some do not. |
|
Where color is used, the colors are; Red for sometihhng to get excited |
|
about and to follow up on. Yellow for something to keep an eye on to |
|
be sure it does not get worse, Green,and Blue for informational items. |
|
|
|
In the discussions below, sometimes reference is made to ~httpd |
|
when describing file locations. There isn't really an httpd |
|
user, however there is an httpd directory that gets installed in the |
|
place that user home directories go. On linux, this is usually |
|
(always?) /home/httpd. |
|
|
|
|
|
Some messages are colorless. These are usually (not always) |
|
Green/Blue color level messages. |
|
|
|
=over 2 |
|
|
|
=item (Red) LocalConnection rejecting non local: <ip> ne 127.0.0.1 |
|
|
|
A local connection negotiation was attempted by |
|
a host whose IP address was not 127.0.0.1. |
|
The socket is closed and the child will exit. |
|
lond has three ways to establish an encyrption |
|
key with a client: |
|
|
|
=over 2 |
|
|
|
=item local |
|
|
|
The key is written and read from a file. |
|
This is only valid for connections from localhost. |
|
|
|
=item insecure |
|
|
|
The key is generated by the server and |
|
transmitted to the client. |
|
|
|
=item ssl (secure) |
|
|
|
An ssl connection is negotiated with the client, |
|
the key is generated by the server and sent to the |
|
client across this ssl connection before the |
|
ssl connectionis terminated and clear text |
|
transmission resumes. |
|
|
|
=back |
|
|
|
=item (Red) LocalConnection: caller is insane! init = <init> and type = <type> |
|
|
|
The client is local but has not sent an initialization |
|
string that is the literal "init:local" The connection |
|
is closed and the child exits. |
|
|
|
=item Red CRITICAL Can't get key file <error> |
|
|
|
SSL key negotiation is being attempted but the call to |
|
lonssl::KeyFile failed. This usually means that the |
|
configuration file is not correctly defining or protecting |
|
the directories/files lonCertificateDirectory or |
|
lonnetPrivateKey |
|
<error> is a string that describes the reason that |
|
the key file could not be located. |
|
|
|
=item (Red) CRITICAL Can't get certificates <error> |
|
|
|
SSL key negotiation failed because we were not able to retrives our certificate |
|
or the CA's certificate in the call to lonssl::CertificateFile |
|
<error> is the textual reason this failed. Usual reasons: |
|
|
|
=over 2 |
|
|
|
=item Apache config file for loncapa incorrect: |
|
|
|
one of the variables |
|
lonCertificateDirectory, lonnetCertificateAuthority, or lonnetCertificate |
|
undefined or incorrect |
|
|
|
=item Permission error: |
|
|
|
The directory pointed to by lonCertificateDirectory is not readable by lond |
|
|
|
=item Permission error: |
|
|
|
Files in the directory pointed to by lonCertificateDirectory are not readable by lond. |
|
|
|
=item Installation error: |
|
|
|
Either the certificate authority file or the certificate have not |
|
been installed in lonCertificateDirectory. |
|
|
|
=item (Red) CRITICAL SSL Socket promotion failed: <err> |
|
|
|
The promotion of the connection from plaintext to SSL failed |
|
<err> is the reason for the failure. There are two |
|
system calls involved in the promotion (one of which failed), |
|
a dup to produce |
|
a second fd on the raw socket over which the encrypted data |
|
will flow and IO::SOcket::SSL->new_from_fd which creates |
|
the SSL connection on the duped fd. |
|
|
|
=item (Blue) WARNING client did not respond to challenge |
|
|
|
This occurs on an insecure (non SSL) connection negotiation request. |
|
lond generates some number from the time, the PID and sends it to |
|
the client. The client must respond by echoing this information back. |
|
If the client does not do so, that's a violation of the challenge |
|
protocols and the connection will be failed. |
|
|
|
=item (Red) No manager table. Nobody can manage!! |
|
|
|
lond has the concept of privileged hosts that |
|
can perform remote management function such |
|
as update the hosts.tab. The manager hosts |
|
are described in the |
|
~httpd/lonTabs/managers.tab file. |
|
this message is logged if this file is missing. |
|
|
|
|
|
=item (Green) Registering manager <dnsname> as <cluster_name> with <ipaddress> |
|
|
|
Reports the successful parse and registration |
|
of a specific manager. |
|
|
|
=item Green existing host <clustername:dnsname> |
|
|
|
The manager host is already defined in the hosts.tab |
|
the information in that table, rather than the info in the |
|
manager table will be used to determine the manager's ip. |
|
|
|
=item (Red) Unable to craete <filename> |
|
|
|
lond has been asked to create new versions of an administrative |
|
file (by a manager). When this is done, the new file is created |
|
in a temp file and then renamed into place so that there are always |
|
usable administrative files, even if the update fails. This failure |
|
message means that the temp file could not be created. |
|
The update is abandoned, and the old file is available for use. |
|
|
|
=item (Green) CopyFile from <oldname> to <newname> failed |
|
|
|
In an update of administrative files, the copy of the existing file to a |
|
backup file failed. The installation of the new file may still succeed, |
|
but there will not be a back up file to rever to (this should probably |
|
be yellow). |
|
|
|
=item (Green) Pushfile: backed up <oldname> to <newname> |
|
|
|
See above, the backup of the old administrative file succeeded. |
|
|
|
=item (Red) Pushfile: Unable to install <filename> <reason> |
|
|
|
The new administrative file could not be installed. In this case, |
|
the old administrative file is still in use. |
|
|
|
=item (Green) Installed new < filename>. |
|
|
|
The new administrative file was successfullly installed. |
|
|
|
=item (Red) Reinitializing lond pid=<pid> |
|
|
|
The lonc child process <pid> will be sent a USR2 |
|
signal. |
|
|
|
=item (Red) Reinitializing self |
|
|
|
We've been asked to re-read our administrative files,and |
|
are doing so. |
|
|
|
=item (Yellow) error:Invalid process identifier <ident> |
|
|
|
A reinit command was received, but the target part of the |
|
command was not valid. It must be either |
|
'lond' or 'lonc' but was <ident> |
|
|
|
=item (Green) isValideditCommand checking: Command = <command> Key = <key> newline = <newline> |
|
|
|
Checking to see if lond has been handed a valid edit |
|
command. It is possible the edit command is not valid |
|
in that case there are no log messages to indicate that. |
|
|
|
=item Result of password change for <username> pwchange_success |
|
|
|
The password for <username> was |
|
successfully changed. |
|
|
|
=item Unable to open <user> passwd to change password |
|
|
|
Could not rewrite the |
|
internal password file for a user |
|
|
|
=item Result of password change for <user> : <result> |
|
|
|
A unix password change for <user> was attempted |
|
and the pipe returned <result> |
|
|
|
=item LWP GET: <message> for <fname> (<remoteurl>) |
|
|
|
The lightweight process fetch for a resource failed |
|
with <message> the local filename that should |
|
have existed/been created was <fname> the |
|
corresponding URI: <remoteurl> This is emitted in several |
|
places. |
|
|
|
=item Unable to move <transname> to <destname> |
|
|
|
From fetch_user_file_handler - the user file was replicated but could not |
|
be mv'd to its final location. |
|
|
|
=item Looking for <domain> <username> |
|
|
|
From user_has_session_handler - This should be a Debug call instead |
|
it indicates lond is about to check whether the specified user has a |
|
session active on the specified domain on the local host. |
|
|
|
=item Client <ip> (<name>) hanging up: <input> |
|
|
|
lond has been asked to exit by its client. The <ip> and <name> identify the |
|
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>]. |
|
|
|
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, |
|
<hostname> the host lond is working for, and <message> the reason the child died |
|
to the best of our ability to get it (I would guess that any numeric value |
|
represents and errno value). This is immediately followed by |
|
|
|
=item Famous last words: Catching exception - <log> |
|
|
|
Where log is some recent information about the state of the child. |
|
|
|
=item Red CRITICAL: TIME OUT <pid> |
|
|
|
Some timeout occured for server <pid>. THis is normally a timeout on an LWP |
|
doing an HTTP::GET. |
|
|
|
=item child <pid> died |
|
|
|
The reaper caught a SIGCHILD for the lond child process <pid> |
|
This should be modified to also display the IP of the dying child |
|
$children{$pid} |
|
|
|
=item Unknown child 0 died |
|
A child died but the wait for it returned a pid of zero which really should not |
|
ever happen. |
|
|
|
=item Child <which> - <pid> looks like we missed it's death |
|
|
|
When a sigchild is received, the reaper process checks all children to see if they are |
|
alive. If children are dying quite quickly, the lack of signal queuing can mean |
|
that a signal hearalds the death of more than one child. If so this message indicates |
|
which other one died. <which> is the ip of a dead child |
|
|
|
=item Free socket: <shutdownretval> |
|
|
|
The HUNTSMAN sub was called due to a SIGINT in a child process. The socket is being shutdown. |
|
for whatever reason, <shutdownretval> is printed but in fact shutdown() is not documented |
|
to return anything. This is followed by: |
|
|
|
=item Red CRITICAL: Shutting down |
|
|
|
Just prior to exit. |
|
|
|
=item Free socket: <shutdownretval> |
|
|
|
The HUPSMAN sub was called due to a SIGHUP. all children get killsed, and lond execs itself. |
|
This is followed by: |
|
|
|
=item (Red) CRITICAL: Restarting |
|
|
|
lond is about to exec itself to restart. |
|
|
|
=item (Blue) Updating connections |
|
|
|
(In response to a USR2). All the children (except the one for localhost) |
|
are about to be killed, the hosts tab reread, and Apache reloaded via apachereload. |
|
|
|
=item (Blue) UpdateHosts killing child <pid> for ip <ip> |
|
|
|
Due to USR2 as above. |
|
|
|
=item (Green) keeping child for ip <ip> (pid = <pid>) |
|
|
|
In response to USR2 as above, the child indicated is not being restarted because |
|
it's assumed that we'll always need a child for the localhost. |
|
|
|
|
|
=item Going to check on the children |
|
|
|
Parent is about to check on the health of the child processes. |
|
Note that this is in response to a USR1 sent to the parent lond. |
|
there may be one or more of the next two messages: |
|
|
|
=item <pid> is dead |
|
|
|
A child that we have in our child hash as alive has evidently died. |
|
|
|
=item Child <pid> did not respond |
|
|
|
In the health check the child <pid> did not update/produce a pid_.txt |
|
file when sent it's USR1 signal. That process is killed with a 9 signal, as it's |
|
assumed to be hung in some un-fixable way. |
|
|
|
=item Finished checking children |
|
|
|
Master processs's USR1 processing is cojmplete. |
|
|
|
=item (Red) CRITICAL: ------- Starting ------ |
|
|
|
(There are more '-'s on either side). Lond has forked itself off to |
|
form a new session and is about to start actual initialization. |
|
|
|
=item (Green) Attempting to start child (<client>) |
|
|
|
Started a new child process for <client>. Client is IO::Socket object |
|
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 |
|
|
|
In child process initialization. either getpeername returned undef or |
|
a zero sized object was returned. Processing continues, but in my opinion, |
|
this should be cause for the child to exit. |
|
|
|
=item Unable to determine clientip |
|
|
|
In child process initialization. The peer address from getpeername was not defined. |
|
The client address is stored as "Unavailable" and processing continues. |
|
|
|
=item (Yellow) INFO: Connection <ip> <name> connection type = <type> |
|
|
|
In child initialization. A good connectionw as received from <ip>. |
|
|
|
=over 2 |
|
|
|
=item <name> |
|
|
|
is the name of the client from hosts.tab. |
|
|
|
=item <type> |
|
|
|
Is the connection type which is either |
|
|
|
=over 2 |
|
|
|
=item manager |
|
|
|
The connection is from a manager node, not in hosts.tab |
|
|
|
=item client |
|
|
|
the connection is from a non-manager in the hosts.tab |
|
|
|
=item both |
|
|
|
The connection is from a manager in the hosts.tab. |
|
|
|
=back |
|
|
|
=back |
|
|
|
=item (Blue) Certificates not installed -- trying insecure auth |
|
|
|
One of the certificate file, key file or |
|
certificate authority file could not be found for a client attempting |
|
SSL connection intiation. COnnection will be attemptied in in-secure mode. |
|
(this would be a system with an up to date lond that has not gotten a |
|
certificate from us). |
|
|
|
=item (Green) Successful local authentication |
|
|
|
A local connection successfully negotiated the encryption key. |
|
In this case the IDEA key is in a file (that is hopefully well protected). |
|
|
|
=item (Green) Successful ssl authentication with <client> |
|
|
|
The client (<client> is the peer's name in hosts.tab), has successfully |
|
negotiated an SSL connection with this child process. |
|
|
|
=item (Green) Successful insecure authentication with <client> |
|
|
|
|
|
The client has successfully negotiated an insecure connection withthe child process. |
|
|
|
=item (Yellow) Attempted insecure connection disallowed |
|
|
|
The client attempted and failed to successfully negotiate a successful insecure |
|
connection. This can happen either because the variable londAllowInsecure is false |
|
or undefined, or becuse the child did not successfully echo back the challenge |
|
string. |
|
|
|
|
|
=back |
|
|
|
|
|
=cut |