version 1.410.2.2, 2009/10/09 12:36:10
|
version 1.413, 2009/04/11 14:47:46
|
Line 54 use LONCAPA::lonssl;
|
Line 54 use LONCAPA::lonssl;
|
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Apache::lonnet; |
use Apache::lonnet; |
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 1; # Non zero to enable debug log entries. |
|
|
my $status=''; |
my $status=''; |
my $lastlog=''; |
my $lastlog=''; |
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 1619 sub server_timezone_handler {
|
Line 1645 sub server_timezone_handler {
|
} |
} |
®ister_handler("servertimezone", \&server_timezone_handler, 0, 1, 0); |
®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 1781 sub change_password_handler {
|
Line 1815 sub change_password_handler {
|
# npass - New password. |
# npass - New password. |
# context - Context in which this was called |
# context - Context in which this was called |
# (preferences or reset_by_email). |
# (preferences or reset_by_email). |
# lonhost - HostID of server where request originated |
|
|
|
my ($udom,$uname,$upass,$npass,$context,$lonhost)=split(/:/,$tail); |
my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail); |
|
|
$upass=&unescape($upass); |
$upass=&unescape($upass); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
Line 1792 sub change_password_handler {
|
Line 1825 sub change_password_handler {
|
# First require that the user can be authenticated with their |
# First require that the user can be authenticated with their |
# old password unless context was 'reset_by_email': |
# old password unless context was 'reset_by_email': |
|
|
my ($validated,$failure); |
my $validated; |
if ($context eq 'reset_by_email') { |
if ($context eq 'reset_by_email') { |
if ($lonhost eq '') { |
$validated = 1; |
$failure = 'invalid_client'; |
|
} else { |
|
$validated = 1; |
|
} |
|
} else { |
} else { |
$validated = &validate_user($udom, $uname, $upass); |
$validated = &validate_user($udom, $uname, $upass); |
} |
} |
Line 1812 sub change_password_handler {
|
Line 1841 sub change_password_handler {
|
$salt=substr($salt,6,2); |
$salt=substr($salt,6,2); |
my $ncpass=crypt($npass,$salt); |
my $ncpass=crypt($npass,$salt); |
if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { |
if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { |
my $msg="Result of password change for $uname: pwchange_success"; |
&logthis("Result of password change for " |
if ($lonhost) { |
."$uname: pwchange_success"); |
$msg .= " - request originated from: $lonhost"; |
|
} |
|
&logthis($msg); |
|
&Reply($client, "ok\n", $userinput); |
&Reply($client, "ok\n", $userinput); |
} else { |
} else { |
&logthis("Unable to open $uname passwd " |
&logthis("Unable to open $uname passwd " |
Line 1837 sub change_password_handler {
|
Line 1863 sub change_password_handler {
|
} |
} |
|
|
} else { |
} else { |
if ($failure eq '') { |
&Failure( $client, "non_authorized\n", $userinput); |
$failure = 'non_authorized'; |
|
} |
|
&Failure( $client, "$failure\n", $userinput); |
|
} |
} |
|
|
return 1; |
return 1; |
Line 4320 sub dump_domainroles_handler {
|
Line 4343 sub dump_domainroles_handler {
|
my ($start,$end) = split(/:/,&unescape($value)); |
my ($start,$end) = 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 ($startfilter eq '.' || !defined($startfilter)) { |
if ((defined($start)) && ($start >= $startfilter)) { |
if ($start >= $startfilter) { |
$match = 0; |
$match = 0; |
} |
} |
} |
} |
unless ($endfilter eq '.' || !defined($endfilter)) { |
unless ($endfilter eq '.' || !defined($endfilter)) { |
if ((defined($end)) && ($end <= $endfilter)) { |
if ($end <= $endfilter) { |
$match = 0; |
$match = 0; |
} |
} |
} |
} |
Line 5987 sub make_new_child {
|
Line 6010 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]"; |