--- loncom/lond 2003/08/12 03:28:31 1.134
+++ loncom/lond 2003/09/09 20:47:46 1.142
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.134 2003/08/12 03:28:31 albertel Exp $
+# $Id: lond,v 1.142 2003/09/09 20:47:46 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -50,7 +50,26 @@
# population). Since the time averaged connection rate is close to zero
# because lonc's purpose is to maintain near continuous connnections,
# preforking is not really needed.
-###
+# 08/xx/2003 Ron Fox: Add management requests. Management requests
+# will be validated via a call to ValidateManager. At present, this
+# is done by simple host verification. In the future we can modify
+# this function to do a certificate check.
+# 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.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/';
@@ -74,18 +93,21 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.134 $'; #' stupid emacs
+my $VERSION='$Revision: 1.142 $'; #' 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."
@@ -126,6 +148,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 {
@@ -175,7 +292,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
@@ -527,7 +644,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) {
@@ -645,7 +761,7 @@ sub make_new_child {
if ($userinput =~ /^ping/) {
print $client "$currenthostid\n";
# ------------------------------------------------------------------------ pong
- } elsif ($userinput =~ /^pong/) {
+ }elsif ($userinput =~ /^pong/) {
my $reply=&reply("ping",$hostid{$clientip});
print $client "$currenthostid:$reply\n";
# ------------------------------------------------------------------------ ekey
@@ -676,6 +792,10 @@ sub make_new_child {
} elsif ($userinput =~ /^userload/) {
my $userloadpercent=&userload();
print $client "$userloadpercent\n";
+
+#
+# Transactions requiring encryption:
+#
# ----------------------------------------------------------------- currentauth
} elsif ($userinput =~ /^currentauth/) {
if ($wasenc==1) {
@@ -690,6 +810,31 @@ sub make_new_child {
} else {
print $client "refused\n";
}
+#--------------------------------------------------------------------- pushfile
+ } elsif($userinput =~ /^pushfile/) {
+ 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/) {
+ 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) {
@@ -801,10 +946,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";
}
@@ -1726,6 +1879,19 @@ sub make_new_child {
}
if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";
+# ----------------------------------------------------------------- setannounce
+ } elsif ($userinput =~ /^setannounce/) {
+ my ($cmd,$announcement)=split(/:/,$userinput);
+ chomp($announcement);
+ $announcement=&unescape($announcement);
+ if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
+ '/announcement.txt')) {
+ print $store $announcement;
+ close $store;
+ print $client "ok\n";
+ } else {
+ print $client "error: ".($!+0)."\n";
+ }
# ------------------------------------------------------------------ Hanging up
} elsif (($userinput =~ /^exit/) ||
($userinput =~ /^init/)) {
@@ -1880,10 +2046,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';
@@ -1903,6 +2069,12 @@ sub chatadd {
}
untie %hash;
}
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
+ }
+ }
}
sub unsub {
@@ -2098,8 +2270,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);
}
@@ -2381,6 +2553,17 @@ Send along temporarily stored informatio
List part of a user's directory.
+=item pushtable
+
+Pushes a file in /home/httpd/lonTab directory. Currently limited to:
+hosts.tab and domain.tab. The old file is copied to *.tab.backup but
+must be restored manually in case of a problem with the new table file.
+pushtable requires that the request be encrypted and validated via
+ValidateManager. The form of the command is:
+enc:pushtable tablename \n
+where pushtable, tablename and will be encrypted, but \n is a
+cleartext newline.
+
=item Hanging up (exit or init)
What to do when a client tells the server that they (the client)
@@ -2391,6 +2574,7 @@ are leaving the network.
If B is sent an unknown command (not in the list above),
it replys to the client "unknown_cmd".
+
=item UNKNOWN CLIENT
If the anti-spoofing algorithm cannot verify the client,