--- loncom/lond 2003/08/19 10:46:14 1.137
+++ loncom/lond 2003/11/01 16:32:32 1.160
@@ -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.160 2003/11/01 16:32:32 www 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.160 $'; #' 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('<font color="red">No manager table. Nobody can manage!!</font>');
+ return;
+ }
+ while(my $host = <MANAGERS>) {
+ chomp($host);
+ if (!defined $hostip{$host}) {
+ logthis('<font color="red"> manager '.$host.
+ " not in hosts.tab, rejected as manager</font>");
+ } 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('<font color="yellow">Authenticating manager'.
+ " $hostname</font>");
+ return 1;
+ } else {
+ &logthis('<font color="red" failed manager authentication '.
+ $hostname." is not a valid manager host</font>");
+ return 0;
+ }
+ } else {
+ &logthis('<font color="red"> Failed manager authentication '.
+ "$certificate </font>");
+ 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 = <PIPE>;
+ close PIPE;
+
+ my ($hostname, $has, $address, $ipnew) = split(/ /,$hostinfo);
+ &logthis('<font color="green">'.
+ "hostname = $hostname me = $me, name = $name actual ip = $ipnew </font>");
+
+ if ($hostname eq $name) { # Lookup succeeded..
+ &logthis('<font color="green"> look up ok <font>');
+ $ip = $ipnew;
+ } else {
+ &logthis('<font color="green"> Lookup failed: '
+ .$hostname." ne $name </font>");
+ }
+ # 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 <name>.tmp
+# - The <name>.tmp file is then mv'd to <name>
+# 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('<font color="red"> Unable to create '.$TempFile."</font>");
+ 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 <filename.saved>
+# - 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('<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
+ # 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('<font color="red"> Pushfile: unable to install '
+ .$tablefile." $! </font>");
+ return "error:$!";
+ }
+ else {
+ &logthis('<font color="green"> Installed new '.$tablefile
+ ."</font>");
+
+ }
+
+
+ # 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:<process>
+# where <process> 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 = <PIDFILE>;
+ close(PIDFILE);
+ logthis('<font color="red"> Reinitializing lonc pid='.$loncpid
+ ."</font>");
+ kill("USR2", $loncpid);
+ } elsif ($process eq 'lond') {
+ logthis('<font color="red"> Reinitializing self (lond) </font>');
+ &UpdateHosts; # Lond is us!!
+ } else {
+ &logthis('<font color="yellow" Invalid reinit request for '.$process
+ ."</font>");
+ 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=<CONFIG>) {
- 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=<CONFIG>) {
+ 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('<font color="blue"> Updating connections </font>');
+ #
+ # 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('<font color="blue"> UpdateHosts killing child '
+ ." $child for ip $childip </font>");
+ kill('INT', $child);
+ } else {
+ logthis('<font color="green"> keeping child for ip '
+ ." $childip (pid=$child) </font>");
+ }
+ }
+ 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(
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
@@ -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 {
@@ -1976,7 +2430,7 @@ sub currentversion {
# see if this is a regular file (ignore links produced earlier)
my $thisfile=$ulsdir.'/'.$ulsfn;
unless (-l $thisfile) {
- if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
+ if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E$/) {
if ($1>$version) { $version=$1; }
}
}
@@ -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: