version 1.139, 2003/08/25 15:33:47
|
version 1.151, 2003/10/03 15:11:03
|
Line 57
|
Line 57
|
# Management functions supported include: |
# Management functions supported include: |
# - pushing /home/httpd/lonTabs/hosts.tab |
# - pushing /home/httpd/lonTabs/hosts.tab |
# - pushing /home/httpd/lonTabs/domain.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$ |
|
# Revision 1.151 2003/10/03 15:11:03 albertel |
|
# - if we fail to fetch an update to the file, don't blow away the old one |
|
# (this was the BUG that blew away that one default.sequence that Matthew |
|
# ended up restoring from data.) |
|
# |
|
# Revision 1.150 2003/09/30 10:16:06 foxr |
|
# Added invocation of apachereload in ReloadApache sub. |
|
# This completes the addtion of the reinit functionality. |
|
# |
|
# Revision 1.149 2003/09/30 09:44:13 foxr |
|
# Tested UpdateHosts ability to |
|
# - Remove live children for hosts that are no longer in the hosts.tab |
|
# - Remove live children for hosts whose IPs have changed in the hosts.tab |
|
# |
|
# Revision 1.148 2003/09/29 10:09:18 foxr |
|
# Put in logic to reinit lond itself (except for apache reload). I don't believe |
|
# this logic works correctly yet, however lond still does everything it used to doso I'll do the commit anyway. |
|
# |
|
# Revision 1.147 2003/09/23 11:23:31 foxr |
|
# Comlplete implementation of reinit functionality. Must still implement |
|
# the actual initialization functionality, but the process can now |
|
# receive the request and either invoke the appropriate internal function or |
|
# signal the correct lonc. |
|
# |
|
# Revision 1.146 2003/09/16 10:28:14 foxr |
|
# ReinitProcess - decode the process selector and produce the associated pid |
|
# filename. Note: While it is possible to test that valid process selectors are |
|
# handled properly I am not able to test that invalid process selectors produce |
|
# the appropriate error as lonManage also blocks the use of invalid process selectors. |
|
# |
|
# Revision 1.145 2003/09/16 10:13:20 foxr |
|
# Added ReinitProcess function to oversee the parsing and processing of the |
|
# reinit:<process> client request. |
|
# |
|
# Revision 1.144 2003/09/16 09:47:01 foxr |
|
# Added skeletal support for SIGUSR2 (update hosts.tab) |
|
# |
|
# 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 strict; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
Line 75 use Authen::Krb4;
|
Line 127 use Authen::Krb4;
|
use Authen::Krb5; |
use Authen::Krb5; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use localauth; |
use localauth; |
|
use File::Copy; |
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 87 my $currenthostid;
|
Line 140 my $currenthostid;
|
my $currentdomainid; |
my $currentdomainid; |
|
|
my $client; |
my $client; |
|
my $clientip; |
|
|
my $server; |
my $server; |
my $thisserver; |
my $thisserver; |
|
|
my %hostid; |
my %hostid; |
my %hostdom; |
my %hostdom; |
my %hostip; |
my %hostip; |
|
my %perlvar; # Will have the apache conf defined perl vars. |
|
|
# |
# |
# The array below are password error strings." |
# The array below are password error strings." |
Line 133 my @adderrors = ("ok",
|
Line 189 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('<font color="yellow">Authenticating manager'. |
|
" $hostentry</font>"); |
|
return 1; |
|
} else { |
|
&logthis('<font color="red"> Failed manager authentication '. |
|
"$certificate </font>"); |
|
} |
|
} |
|
# |
|
# 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 <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>"); |
|
|
|
# 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. |
# Convert an error return code from lcpasswd to a string value. |
# |
# |
sub lcpasswdstrerror { |
sub lcpasswdstrerror { |
Line 182 $SIG{__DIE__}=\&catchexception;
|
Line 484 $SIG{__DIE__}=\&catchexception;
|
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
&status("Read loncapa.conf and loncapa_apache.conf"); |
&status("Read loncapa.conf and loncapa_apache.conf"); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my %perlvar=%{$perlvarref}; |
%perlvar=%{$perlvarref}; |
undef $perlvarref; |
undef $perlvarref; |
|
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
Line 208 if (-e $pidfile) {
|
Line 510 if (-e $pidfile) {
|
|
|
# ------------------------------------------------------------- Read hosts file |
# ------------------------------------------------------------- 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. |
# establish SERVER socket, bind and listen. |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
Line 267 sub HUPSMAN { # sig
|
Line 559 sub HUPSMAN { # sig
|
exec("$execdir/lond"); # here we go again |
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 { |
sub checkchildren { |
&initnewstatus(); |
&initnewstatus(); |
&logstatus(); |
&logstatus(); |
Line 509 $SIG{CHLD} = \&REAPER;
|
Line 886 $SIG{CHLD} = \&REAPER;
|
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{USR1} = \&checkchildren; |
$SIG{USR1} = \&checkchildren; |
|
$SIG{USR2} = \&UpdateHosts; |
|
|
|
# Read the host hashes: |
|
|
|
ReadHostTable; |
|
|
# -------------------------------------------------------------- |
# -------------------------------------------------------------- |
# Accept connections. When a connection comes in, it is validated |
# Accept connections. When a connection comes in, it is validated |
Line 534 sub make_new_child {
|
Line 914 sub make_new_child {
|
sigprocmask(SIG_BLOCK, $sigset) |
sigprocmask(SIG_BLOCK, $sigset) |
or die "Can't block SIGINT for fork: $!\n"; |
or die "Can't block SIGINT for fork: $!\n"; |
|
|
my $clientip; |
|
die "fork: $!" unless defined ($pid = fork); |
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) { |
if ($pid) { |
# Parent records the child's birth and returns. |
# Parent records the child's birth and returns. |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
$children{$pid} = 1; |
$children{$pid} = $clientip; |
$children++; |
$children++; |
&status('Started child '.$pid); |
&status('Started child '.$pid); |
return; |
return; |
Line 568 sub make_new_child {
|
Line 958 sub make_new_child {
|
# ============================================================================= |
# ============================================================================= |
# do something with the connection |
# do something with the connection |
# ----------------------------------------------------------------------------- |
# ----------------------------------------------------------------------------- |
$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of |
# see if we know client and check for spoof IP by challenge |
# 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); |
|
my $clientrec=($hostid{$clientip} ne undef); |
my $clientrec=($hostid{$clientip} ne undef); |
&logthis( |
&logthis( |
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>" |
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>" |
Line 703 sub make_new_child {
|
Line 1089 sub make_new_child {
|
} |
} |
#--------------------------------------------------------------------- pushfile |
#--------------------------------------------------------------------- pushfile |
} elsif($userinput =~ /^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 |
#--------------------------------------------------------------------- reinit |
} elsif($userinput =~ /^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 |
# ------------------------------------------------------------------------ auth |
} elsif ($userinput =~ /^auth/) { |
} elsif ($userinput =~ /^auth/) { |
if ($wasenc==1) { |
if ($wasenc==1) { |
Line 1008 sub make_new_child {
|
Line 1415 sub make_new_child {
|
} |
} |
# -------------------------------------- fetch a user file from a remote server |
# -------------------------------------- fetch a user file from a remote server |
} elsif ($userinput =~ /^fetchuserfile/) { |
} elsif ($userinput =~ /^fetchuserfile/) { |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my $udir=propath($udom,$uname).'/userfiles'; |
my $udir=propath($udom,$uname).'/userfiles'; |
unless (-e $udir) { mkdir($udir,0770); } |
unless (-e $udir) { mkdir($udir,0770); } |
if (-e $udir) { |
if (-e $udir) { |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/\///g; |
$ufile=~s/\///g; |
my $transname=$udir.'/'.$ufile; |
my $destname=$udir.'/'.$ufile; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $response; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
{ |
my $response; |
my $ua=new LWP::UserAgent; |
{ |
my $request=new HTTP::Request('GET',"$remoteurl"); |
my $ua=new LWP::UserAgent; |
$response=$ua->request($request,$transname); |
my $request=new HTTP::Request('GET',"$remoteurl"); |
} |
$response=$ua->request($request,$transname); |
if ($response->is_error()) { |
} |
unlink($transname); |
if ($response->is_error()) { |
my $message=$response->status_line; |
unlink($transname); |
&logthis( |
my $message=$response->status_line; |
"LWP GET: $message for $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
print $client "failed\n"; |
print $client "failed\n"; |
} else { |
} else { |
print $client "ok\n"; |
if (!rename($transname,$destname)) { |
} |
&logthis("Unable to move $transname to $destname"); |
} else { |
unlink($transname); |
print $client "not_home\n"; |
print $client "failed\n"; |
} |
} else { |
|
print $client "ok\n"; |
|
} |
|
} |
|
} else { |
|
print $client "not_home\n"; |
|
} |
# ------------------------------------------ authenticate access to a user file |
# ------------------------------------------ authenticate access to a user file |
} elsif ($userinput =~ /^tokenauthuserfile/) { |
} elsif ($userinput =~ /^tokenauthuserfile/) { |
my ($cmd,$fname,$session)=split(/:/,$userinput); |
my ($cmd,$fname,$session)=split(/:/,$userinput); |
Line 1918 sub chatadd {
|
Line 2331 sub chatadd {
|
my %hash; |
my %hash; |
my $proname=&propath($cdom,$cname); |
my $proname=&propath($cdom,$cname); |
my @entries=(); |
my @entries=(); |
|
my $time=time; |
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", |
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", |
&GDBM_WRCREAT(),0640)) { |
&GDBM_WRCREAT(),0640)) { |
@entries=map { $_.':'.$hash{$_} } sort keys %hash; |
@entries=map { $_.':'.$hash{$_} } sort keys %hash; |
my $time=time; |
|
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); |
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); |
my ($thentime,$idnum)=split(/\_/,$lastid); |
my ($thentime,$idnum)=split(/\_/,$lastid); |
my $newid=$time.'_000000'; |
my $newid=$time.'_000000'; |
Line 1941 sub chatadd {
|
Line 2354 sub chatadd {
|
} |
} |
untie %hash; |
untie %hash; |
} |
} |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/chatroom.log")) { |
|
print $hfh "$time:".&unescape($newchat)."\n"; |
|
} |
|
} |
} |
} |
|
|
sub unsub { |
sub unsub { |
Line 2259 each connection is logged.
|
Line 2678 each connection is logged.
|
|
|
=item * |
=item * |
|
|
|
SIGUSR2 |
|
|
|
Parent Signal assignment: |
|
$SIG{USR2} = \&UpdateHosts |
|
|
|
Child signal assignment: |
|
NONE |
|
|
|
|
|
=item * |
|
|
SIGCHLD |
SIGCHLD |
|
|
Parent signal assignment: |
Parent signal assignment: |