--- loncom/lond 2003/08/19 10:46:14 1.137 +++ loncom/lond 2003/10/30 22:52:24 1.159 @@ -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.159 2003/10/30 22:52:24 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,38 +26,6 @@ # # http://www.lon-capa.org/ # -# 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30, -# 7/8,7/9,7/10,7/12,7/17,7/19,9/21, -# 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16, -# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, -# 03/07,05/31 Gerd Kortemeyer -# 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer -# 12/05,12/13,12/29 Gerd Kortemeyer -# YEAR=2001 -# 02/12 Gerd Kortemeyer -# 03/24 Gerd Kortemeyer -# 05/11,05/28,08/30 Gerd Kortemeyer -# 11/26,11/27 Gerd Kortemeyer -# 12/22 Gerd Kortemeyer -# YEAR=2002 -# 01/20/02,02/05 Gerd Kortemeyer -# 02/05 Guy Albertelli -# 02/12 Gerd Kortemeyer -# 02/19 Matthew Hall -# 02/25 Gerd Kortemeyer -# 01/xx/2003 Ron Fox.. Remove preforking. This makes the general daemon -# logic simpler (and there were problems maintaining the preforked -# 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 -### use strict; use lib '/home/httpd/lib/perl/'; @@ -75,24 +43,29 @@ 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.159 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; my $client; +my $clientip; + my $server; my $thisserver; my %hostid; my %hostdom; my %hostip; +my %managers; # If defined $managers{hostname} is a manager +my %perlvar; # Will have the apache conf defined perl vars. # # The array below are password error strings." @@ -122,10 +95,10 @@ my @adderrors = ("ok", "lcuseradd Incorrect number of stdinput lines, must be 3", "lcuseradd Too many other simultaneous pwd changes in progress", "lcuseradd User does not exist", - "lcuseradd Unabel to mak ewww member of users's group", + "lcuseradd Unable to make www member of users's group", "lcuseradd Unable to su to root", "lcuseradd Unable to set password", - "lcuseradd Usrname has invbalid charcters", + "lcuseradd Usrname has invalid characters", "lcuseradd Password has an invalid character", "lcuseradd User already exists", "lcuseradd Could not add user.", @@ -133,6 +106,362 @@ 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; +} +# +# ReadManagerTable: Reads in the current manager table. For now this is +# done on each manager authentication because: +# - These authentications are not frequent +# - This allows dynamic changes to the manager table +# without the need to signal to the lond. +# + +sub ReadManagerTable { + + # Clean out the old table first.. + + foreach my $key (keys %managers) { + delete $managers{$key}; + } + + my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; + if (!open (MANAGERS, $tablename)) { + logthis('No manager table. Nobody can manage!!'); + return; + } + while(my $host = ) { + chomp($host); + if (!defined $hostip{$host}) { + logthis(' manager '.$host. + " not in hosts.tab, rejected as manager"); + } else { + $managers{$host} = $hostip{$host}; # Whatever for now. + } + } +} + +# +# 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; + + ReadManagerTable; + + my $hostname = $hostid{$certificate}; + + + if ($hostname ne undef) { + if($managers{$hostname} ne undef) { + &logthis('Authenticating manager'. + " $hostname"); + return 1; + } else { + &logthis('"); + return 0; + } + } else { + &logthis(' Failed manager authentication '. + "$certificate "); + return 0; + } +} +# +# 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; + } +} +# +# Host files are passed out with externally visible host IPs. +# If, for example, we are behind a fire-wall or NAT host, our +# internally visible IP may be different than the externally +# visible IP. Therefore, we always adjust the contents of the +# host file so that the entry for ME is the IP that we believe +# we have. At present, this is defined as the entry that +# DNS has for us. If by some chance we are not able to get a +# DNS translation for us, then we assume that the host.tab file +# is correct. +# BUGBUGBUG - in the future, we really should see if we can +# easily query the interface(s) instead. +# Parameter(s): +# contents - The contents of the host.tab to check. +# Returns: +# newcontents - The adjusted contents. +# +# +sub AdjustHostContents { + my $contents = shift; + my $adjusted; + my $me = $perlvar{'lonHostID'}; + + foreach my $line (split(/\n/,$contents)) { + if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { + chomp($line); + my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); + if ($id eq $me) { + open(PIPE, " /usr/bin/host $name |") || die "Cant' make host pipeline"; + my $hostinfo = ; + close PIPE; + + my ($hostname, $has, $address, $ipnew) = split(/ /,$hostinfo); + &logthis(''. + "hostname = $hostname me = $me, name = $name actual ip = $ipnew "); + + if ($hostname eq $name) { # Lookup succeeded.. + &logthis(' look up ok '); + $ip = $ipnew; + } else { + &logthis(' Lookup failed: ' + .$hostname." ne $name "); + } + # Reconstruct the host line and append to adjusted: + + my $newline = "$id:$domain:$role:$name:$ip"; + if($maxcon ne "") { # Not all hosts have loncnew tuning params + $newline .= ":$maxcon:$idleto:$mincon"; + } + $adjusted .= $newline."\n"; + + } else { # Not me, pass unmodified. + $adjusted .= $line."\n"; + } + } else { # Blank or comment never re-written. + $adjusted .= $line."\n"; # Pass blanks and comments as is. + } + } + return $adjusted; +} +# +# 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"); + + # 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 + # to conceive of conditions where we don't have a DNS entry locally. This is possible in a + # network sense but it doesn't make much sense in a LonCAPA sense so we ignore (for now) + # that possibilty. + + if($filename eq "host") { + $contents = AdjustHostContents($contents); + } + + # 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"; + +} + +# +# Called to re-init either lonc or lond. +# +# Parameters: +# request - The full request by the client. This is of the form +# reinit: +# where is allowed to be either of +# lonc or lond +# +# Returns: +# The string to be sent back to the client either: +# ok - Everything worked just fine. +# error:why - There was a failure and why describes the reason. +# +# +sub ReinitProcess { + my $request = shift; + + + # separate the request (reinit) from the process identifier and + # validate it producing the name of the .pid file for the process. + # + # + my ($junk, $process) = split(":", $request); + my $processpidfile = $perlvar{'lonDaemons'}.'/logs/'; + if($process eq 'lonc') { + $processpidfile = $processpidfile."lonc.pid"; + if (!open(PIDFILE, "< $processpidfile")) { + return "error:Open failed for $processpidfile"; + } + my $loncpid = ; + close(PIDFILE); + logthis(' Reinitializing lonc pid='.$loncpid + .""); + kill("USR2", $loncpid); + } elsif ($process eq 'lond') { + logthis(' Reinitializing self (lond) '); + &UpdateHosts; # Lond is us!! + } else { + &logthis('"); + return "error:Invalid process identifier $process"; + } + return 'ok'; +} + +# # Convert an error return code from lcpasswd to a string value. # sub lcpasswdstrerror { @@ -182,7 +511,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 @@ -208,17 +537,7 @@ if (-e $pidfile) { # ------------------------------------------------------------- Read hosts file -open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; -while (my $configline=) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); $ip=~s/\D+$//; - $hostid{$ip}=$id; - $hostdom{$id}=$domain; - $hostip{$id}=$ip; - if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } -} -close(CONFIG); # establish SERVER socket, bind and listen. $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, @@ -267,6 +586,91 @@ sub HUPSMAN { # sig exec("$execdir/lond"); # here we go again } +# +# Kill off hashes that describe the host table prior to re-reading it. +# Hashes affected are: +# %hostid, %hostdom %hostip +# +sub KillHostHashes { + foreach my $key (keys %hostid) { + delete $hostid{$key}; + } + foreach my $key (keys %hostdom) { + delete $hostdom{$key}; + } + foreach my $key (keys %hostip) { + delete $hostip{$key}; + } +} +# +# Read in the host table from file and distribute it into the various hashes: +# +# - %hostid - Indexed by IP, the loncapa hostname. +# - %hostdom - Indexed by loncapa hostname, the domain. +# - %hostip - Indexed by hostid, the Ip address of the host. +sub ReadHostTable { + + open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; + + while (my $configline=) { + my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); + chomp($ip); $ip=~s/\D+$//; + $hostid{$ip}=$id; + $hostdom{$id}=$domain; + $hostip{$id}=$ip; + if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } + } + close(CONFIG); +} +# +# Reload the Apache daemon's state. +# This is done by invoking /home/httpd/perl/apachereload +# a setuid perl script that can be root for us to do this job. +# +sub ReloadApache { + my $execdir = $perlvar{'lonDaemons'}; + my $script = $execdir."/apachereload"; + system($script); +} + +# +# Called in response to a USR2 signal. +# - Reread hosts.tab +# - All children connected to hosts that were removed from hosts.tab +# are killed via SIGINT +# - All children connected to previously existing hosts are sent SIGUSR1 +# - Our internal hosts hash is updated to reflect the new contents of +# hosts.tab causing connections from hosts added to hosts.tab to +# now be honored. +# +sub UpdateHosts { + logthis(' Updating connections '); + # + # The %children hash has the set of IP's we currently have children + # on. These need to be matched against records in the hosts.tab + # Any ip's no longer in the table get killed off they correspond to + # either dropped or changed hosts. Note that the re-read of the table + # will take care of new and changed hosts as connections come into being. + + + KillHostHashes; + ReadHostTable; + + foreach my $child (keys %children) { + my $childip = $children{$child}; + if(!$hostid{$childip}) { + logthis(' UpdateHosts killing child ' + ." $child for ip $childip "); + kill('INT', $child); + } else { + logthis(' keeping child for ip ' + ." $childip (pid=$child) "); + } + } + ReloadApache; +} + + sub checkchildren { &initnewstatus(); &logstatus(); @@ -298,7 +702,7 @@ sub checkchildren { } } $SIG{ALRM} = 'DEFAULT'; - $SIG{__DIE__} = \&cathcexception; + $SIG{__DIE__} = \&catchexception; } # --------------------------------------------------------------------- Logging @@ -509,8 +913,11 @@ $SIG{CHLD} = \&REAPER; $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; $SIG{HUP} = \&HUPSMAN; $SIG{USR1} = \&checkchildren; +$SIG{USR2} = \&UpdateHosts; +# Read the host hashes: +ReadHostTable; # -------------------------------------------------------------- # Accept connections. When a connection comes in, it is validated @@ -534,14 +941,24 @@ 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); + + $client->sockopt(SO_KEEPALIVE, 1); # Enable monitoring of + # connection liveness. + + # + # Figure out who we're talking to so we can record the peer in + # the pid hash. + # + my $caller = getpeername($client); + my ($port,$iaddr)=unpack_sockaddr_in($caller); + $clientip=inet_ntoa($iaddr); if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; - $children{$pid} = 1; + $children{$pid} = $clientip; $children++; &status('Started child '.$pid); return; @@ -568,12 +985,8 @@ sub make_new_child { # ============================================================================= # do something with the connection # ----------------------------------------------------------------------------- - $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of - # connection liveness. - # see if we know client and check for spoof IP by challenge - my $caller = getpeername($client); - my ($port,$iaddr)=unpack_sockaddr_in($caller); - $clientip=inet_ntoa($iaddr); + # see if we know client and check for spoof IP by challenge + my $clientrec=($hostid{$clientip} ne undef); &logthis( "INFO: Connection, $clientip ($hostid{$clientip})" @@ -703,10 +1116,31 @@ 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)) { + chomp($userinput); + my $reply = ReinitProcess($userinput); + print $client "$reply\n"; + } else { + print $client "refused\n"; + } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------ auth } elsif ($userinput =~ /^auth/) { if ($wasenc==1) { @@ -818,10 +1252,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"; } @@ -1000,33 +1442,39 @@ sub make_new_child { } # -------------------------------------- fetch a user file from a remote server } elsif ($userinput =~ /^fetchuserfile/) { - my ($cmd,$fname)=split(/:/,$userinput); - my ($udom,$uname,$ufile)=split(/\//,$fname); - my $udir=propath($udom,$uname).'/userfiles'; - unless (-e $udir) { mkdir($udir,0770); } + my ($cmd,$fname)=split(/:/,$userinput); + my ($udom,$uname,$ufile)=split(/\//,$fname); + my $udir=propath($udom,$uname).'/userfiles'; + unless (-e $udir) { mkdir($udir,0770); } if (-e $udir) { - $ufile=~s/^[\.\~]+//; - $ufile=~s/\///g; - my $transname=$udir.'/'.$ufile; - my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; - my $response; - { - my $ua=new LWP::UserAgent; - my $request=new HTTP::Request('GET',"$remoteurl"); - $response=$ua->request($request,$transname); - } - if ($response->is_error()) { - unlink($transname); - my $message=$response->status_line; - &logthis( - "LWP GET: $message for $fname ($remoteurl)"); - print $client "failed\n"; - } else { - print $client "ok\n"; - } - } else { - print $client "not_home\n"; - } + $ufile=~s/^[\.\~]+//; + $ufile=~s/\///g; + my $destname=$udir.'/'.$ufile; + my $transname=$udir.'/'.$ufile.'.in.transit'; + my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; + my $response; + { + my $ua=new LWP::UserAgent; + my $request=new HTTP::Request('GET',"$remoteurl"); + $response=$ua->request($request,$transname); + } + if ($response->is_error()) { + unlink($transname); + my $message=$response->status_line; + &logthis("LWP GET: $message for $fname ($remoteurl)"); + print $client "failed\n"; + } else { + if (!rename($transname,$destname)) { + &logthis("Unable to move $transname to $destname"); + unlink($transname); + print $client "failed\n"; + } else { + print $client "ok\n"; + } + } + } else { + print $client "not_home\n"; + } # ------------------------------------------ authenticate access to a user file } elsif ($userinput =~ /^tokenauthuserfile/) { my ($cmd,$fname,$session)=split(/:/,$userinput); @@ -1910,10 +2358,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 +2381,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 +2582,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 < 1800) { $numusers++; } } closedir(LONIDS); } @@ -2251,6 +2705,17 @@ each connection is logged. =item * +SIGUSR2 + +Parent Signal assignment: + $SIG{USR2} = \&UpdateHosts + +Child signal assignment: + NONE + + +=item * + SIGCHLD Parent signal assignment: