--- loncom/lond 2003/08/19 10:46:14 1.137 +++ loncom/lond 2003/09/15 10:03:52 1.143 @@ -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.143 2003/09/15 10:03:52 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -57,7 +57,22 @@ # 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.143 2003/09/15 10:03:52 foxr +# Completed and tested code for pushfile. +# +# Revision 1.142 2003/09/09 20:47:46 www +# Permanently store chatroom entries in chatroom.log +# +# 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/'; @@ -75,24 +90,28 @@ use Authen::Krb4; use Authen::Krb5; use lib '/home/httpd/lib/perl/'; use localauth; +use File::Copy; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.137 $'; #' stupid emacs +my $VERSION='$Revision: 1.143 $'; #' 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 +152,205 @@ 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 "); + } +} +# +# CopyFile: Called as part of the process of installing a +# new configuration file. This function copies an existing +# file to a backup file. +# Parameters: +# oldfile - Name of the file to backup. +# newfile - Name of the backup file. +# Return: +# 0 - Failure (errno has failure reason). +# 1 - Success. +# +sub CopyFile { + my $oldfile = shift; + my $newfile = shift; + + # The file must exist: + + if(-e $oldfile) { + + # Read the old file. + + my $oldfh = IO::File->new("< $oldfile"); + if(!$oldfh) { + return 0; + } + my @contents = <$oldfh>; # Suck in the entire file. + + # write the backup file: + + my $newfh = IO::File->new("> $newfile"); + if(!(defined $newfh)){ + return 0; + } + my $lines = scalar @contents; + for (my $i =0; $i < $lines; $i++) { + print $newfh ($contents[$i]); + } + + $oldfh->close; + $newfh->close; + + chmod(0660, $newfile); + + return 1; + + } else { + return 0; + } +} + +# +# InstallFile: Called to install an administrative file: +# - The file is created with .tmp +# - The .tmp file is then mv'd to +# This lugubrious procedure is done to ensure that we are never without +# a valid, even if dated, version of the file regardless of who crashes +# and when the crash occurs. +# +# Parameters: +# Name of the file +# File Contents. +# Return: +# nonzero - success. +# 0 - failure and $! has an errno. +# +sub InstallFile { + my $Filename = shift; + my $Contents = shift; + my $TempFile = $Filename.".tmp"; + + # Open the file for write: + + my $fh = IO::File->new("> $TempFile"); # Write to temp. + if(!(defined $fh)) { + &logthis(' Unable to create '.$TempFile.""); + return 0; + } + # write the contents of the file: + + print $fh ($Contents); + $fh->close; # In case we ever have a filesystem w. locking + + chmod(0660, $TempFile); + + # Now we can move install the file in position. + + move($TempFile, $Filename); + + return 1; +} + +# +# 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/; + if(!CopyFile($tablefile, $backupfile)) { + &logthis(' CopyFile from '.$tablefile." to ".$backupfile." failed "); + return "error:$!"; + } + &logthis(' Pushfile: backed up ' + .$tablefile." to $backupfile"); + + # Install the new file: + + if(!InstallFile($tablefile, $contents)) { + &logthis(' Pushfile: unable to install ' + .$tablefile." $! "); + return "error:$!"; + } + else { + &logthis(' Installed new '.$tablefile + .""); + + } + + + # Indicate success: + + return "ok"; + +} +# # Convert an error return code from lcpasswd to a string value. # sub lcpasswdstrerror { @@ -182,7 +400,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 +752,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 +920,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 +1054,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"; } @@ -1910,10 +2154,10 @@ sub chatadd { my %hash; my $proname=&propath($cdom,$cname); my @entries=(); + my $time=time; if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", &GDBM_WRCREAT(),0640)) { @entries=map { $_.':'.$hash{$_} } sort keys %hash; - my $time=time; my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); my ($thentime,$idnum)=split(/\_/,$lastid); my $newid=$time.'_000000'; @@ -1933,6 +2177,12 @@ sub chatadd { } untie %hash; } + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/chatroom.log")) { + print $hfh "$time:".&unescape($newchat)."\n"; + } + } } sub unsub { @@ -2128,8 +2378,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); }