--- loncom/lond 2003/08/19 10:46:14 1.137 +++ loncom/lond 2003/09/08 10:32:07 1.141 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.137 2003/08/19 10:46:14 foxr Exp $ +# $Id: lond,v 1.141 2003/09/08 10:32:07 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -57,7 +57,16 @@ # Management functions supported include: # - pushing /home/httpd/lonTabs/hosts.tab # - pushing /home/httpd/lonTabs/domain.tab -### +# 09/08/2003 Ron Fox: Told lond to take care of change logging so we +# don't have to remember it: +# $Log: lond,v $ +# Revision 1.141 2003/09/08 10:32:07 foxr +# Added PushFile sub This sub oversees the push of a new configuration table file +# Currently supported files are: +# - hosts.tab (transaction pushfile:hosts:contents) +# - domain.tab (transaction pushfile:domain:contents) +# + use strict; use lib '/home/httpd/lib/perl/'; @@ -81,18 +90,21 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.137 $'; #' stupid emacs +my $VERSION='$Revision: 1.141 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; my $client; +my $clientip; + my $server; my $thisserver; my %hostid; my %hostdom; my %hostip; +my %perlvar; # Will have the apache conf defined perl vars. # # The array below are password error strings." @@ -133,6 +145,101 @@ my @adderrors = ("ok", # +# GetCertificate: Given a transaction that requires a certificate, +# this function will extract the certificate from the transaction +# request. Note that at this point, the only concept of a certificate +# is the hostname to which we are connected. +# +# Parameter: +# request - The request sent by our client (this parameterization may +# need to change when we really use a certificate granting +# authority. +# +sub GetCertificate { + my $request = shift; + + return $clientip; +} + + +# +# ValidManager: Determines if a given certificate represents a valid manager. +# in this primitive implementation, the 'certificate' is +# just the connecting loncapa client name. This is checked +# against a valid client list in the configuration. +# +# +sub ValidManager { + my $certificate = shift; + + my $hostentry = $hostid{$certificate}; + if ($hostentry ne undef) { + &logthis('Authenticating manager'. + " $hostentry"); + return 1; + } else { + &logthis(' Failed manager authentication '. + "$certificate "); + } +} +# +# PushFile: Called to do an administrative push of a file. +# - Ensure the file being pushed is one we support. +# - Backup the old file to +# - Separate the contents of the new file out from the +# rest of the request. +# - Write the new file. +# Parameter: +# Request - The entire user request. This consists of a : separated +# string pushfile:tablename:contents. +# NOTE: The contents may have :'s in it as well making things a bit +# more interesting... but not much. +# Returns: +# String to send to client ("ok" or "refused" if bad file). +# +sub PushFile { + my $request = shift; + my ($command, $filename, $contents) = split(":", $request, 3); + + # At this point in time, pushes for only the following tables are + # supported: + # hosts.tab ($filename eq host). + # domain.tab ($filename eq domain). + # Construct the destination filename or reject the request. + # + # lonManage is supposed to ensure this, however this session could be + # part of some elaborate spoof that managed somehow to authenticate. + # + + my $tablefile = $perlvar{'lonTabDir'}.'/'; # need to precede with dir. + if ($filename eq "host") { + $tablefile .= "hosts.tab"; + } elsif ($filename eq "domain") { + $tablefile .= "domain.tab"; + } else { + 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/; + # CopyFile($tablefile, $backupfile); + &logthis(' Pushfile: backed up ' + .$tablefile." to $backupfile"); + + # Install the new file: + + # InstallFile($tablefile, $contents); + + # Indicate success: + + return "ok"; + +} +# # Convert an error return code from lcpasswd to a string value. # sub lcpasswdstrerror { @@ -182,7 +289,7 @@ $SIG{__DIE__}=\&catchexception; # ---------------------------------- Read loncapa_apache.conf and loncapa.conf &status("Read loncapa.conf and loncapa_apache.conf"); my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar=%{$perlvarref}; +%perlvar=%{$perlvarref}; undef $perlvarref; # ----------------------------- Make sure this process is running from user=www @@ -534,7 +641,6 @@ sub make_new_child { sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n"; - my $clientip; die "fork: $!" unless defined ($pid = fork); if ($pid) { @@ -703,10 +809,29 @@ sub make_new_child { } #--------------------------------------------------------------------- pushfile } elsif($userinput =~ /^pushfile/) { - print $client "ok\n"; + if($wasenc == 1) { + my $cert = GetCertificate($userinput); + if(ValidManager($cert)) { + my $reply = PushFile($userinput); + print $client "$reply\n"; + } else { + print $client "refused\n"; + } + } else { + print $client "refused\n"; + } #--------------------------------------------------------------------- reinit } elsif($userinput =~ /^reinit/) { - print $client "ok\n"; + if ($wasenc == 1) { + my $cert = GetCertificate($userinput); + if(ValidManager($cert)) { + print $client "ok\n"; + } else { + print $client "refused\n"; + } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------ auth } elsif ($userinput =~ /^auth/) { if ($wasenc==1) { @@ -818,10 +943,18 @@ sub make_new_child { my $salt=time; $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); - { my $pf = IO::File->new(">$passfilename"); - print $pf "internal:$ncpass\n"; } - &logthis("Result of password change for $uname: pwchange_success"); - print $client "ok\n"; + { + my $pf; + if ($pf = IO::File->new(">$passfilename")) { + print $pf "internal:$ncpass\n"; + &logthis("Result of password change for $uname: pwchange_success"); + print $client "ok\n"; + } else { + &logthis("Unable to open $uname passwd to change password"); + print $client "non_authorized\n"; + } + } + } else { print $client "non_authorized\n"; } @@ -2128,8 +2261,8 @@ sub userload { my $curtime=time; while ($filename=readdir(LONIDS)) { if ($filename eq '.' || $filename eq '..') {next;} - my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; - if ($curtime-$atime < 3600) { $numusers++; } + my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; + if ($curtime-$mtime < 3600) { $numusers++; } } closedir(LONIDS); }