--- loncom/lond 2000/01/12 19:30:43 1.7
+++ loncom/lond 2000/02/08 17:39:23 1.10
@@ -4,7 +4,7 @@
# 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 Gerd Kortemeyer
+# 12/7,12/15,01/06,01/11,01/12,01/14,2/8 Gerd Kortemeyer
# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first
# runs as a daemon
@@ -79,7 +79,7 @@ sub HUNTSMAN { # si
kill 'INT' => keys %children;
my $execdir=$perlvar{'lonDaemons'};
unlink("$execdir/logs/lond.pid");
- &logthis("Shutting down");
+ &logthis("CRITICAL: Shutting down");
exit; # clean up with dignity
}
@@ -87,7 +87,7 @@ sub HUPSMAN { # sig
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
kill 'INT' => keys %children;
close($server); # free up socket
- &logthis("Restarting");
+ &logthis("CRITICAL: Restarting");
my $execdir=$perlvar{'lonDaemons'};
exec("$execdir/lond"); # here we go again
}
@@ -120,12 +120,15 @@ sub reconlonc {
&logthis("$peerfile still not there, give it another try");
sleep 5;
if (-e "$peerfile") { return; }
- &logthis("$peerfile still not there, giving up");
+ &logthis(
+ "WARNING: $peerfile still not there, giving up");
} else {
- &logthis("lonc at pid $loncpid not responding, giving up");
+ &logthis(
+ "CRITICAL: "
+ ."lonc at pid $loncpid not responding, giving up");
}
} else {
- &logthis('lonc not running, giving up');
+ &logthis('CRITICAL: lonc not running, giving up');
}
}
@@ -201,7 +204,7 @@ $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lond.pid");
print PIDSAVE "$$\n";
close(PIDSAVE);
-&logthis("Starting");
+&logthis("CRITICAL: ---------- Starting ----------");
# ------------------------------------------------------- Now we are on our own
@@ -263,7 +266,8 @@ sub make_new_child {
my ($port,$iaddr)=unpack_sockaddr_in($caller);
my $clientip=inet_ntoa($iaddr);
my $clientrec=($hostid{$clientip} ne undef);
- &logthis("Connect from $clientip ($hostid{$clientip})");
+ &logthis(
+"INFO: Connect from $clientip ($hostid{$clientip})");
my $clientok;
if ($clientrec) {
my $remotereq=<$client>;
@@ -277,17 +281,23 @@ sub make_new_child {
$clientok=1;
print $client "ok\n";
} else {
- &logthis("$clientip did not reply challenge");
+ &logthis(
+ "WARNING: $clientip did not reply challenge");
}
} else {
- &logthis("$clientip failed to initialize: >$remotereq<");
+ &logthis(
+ "WARNING: "
+ ."$clientip failed to initialize: >$remotereq< ");
}
} else {
- &logthis("Unknown client $clientip");
+ &logthis(
+ "WARNING: Unknown client $clientip");
}
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
+ &logthis(
+ "Established connection: $hostid{$clientip}");
# ------------------------------------------------------------ Process requests
while (my $userinput=<$client>) {
chomp($userinput);
@@ -498,6 +508,7 @@ sub make_new_child {
} elsif ($userinput =~ /^put/) {
my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
if ($namespace ne 'roles') {
chomp($what);
@@ -564,6 +575,7 @@ sub make_new_child {
} elsif ($userinput =~ /^get/) {
my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
chomp($what);
my @queries=split(/\&/,$what);
@@ -586,6 +598,7 @@ sub make_new_child {
} elsif ($userinput =~ /^eget/) {
my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
chomp($what);
my @queries=split(/\&/,$what);
@@ -621,6 +634,7 @@ sub make_new_child {
} elsif ($userinput =~ /^del/) {
my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
chomp($what);
my $proname=propath($udom,$uname);
@@ -648,8 +662,8 @@ sub make_new_child {
} elsif ($userinput =~ /^keys/) {
my ($cmd,$udom,$uname,$namespace)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
- chomp($namespace);
my $proname=propath($udom,$uname);
my $qresult='';
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
@@ -669,8 +683,8 @@ sub make_new_child {
} elsif ($userinput =~ /^dump/) {
my ($cmd,$udom,$uname,$namespace)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
- chomp($namespace);
my $proname=propath($udom,$uname);
my $qresult='';
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
@@ -690,6 +704,7 @@ sub make_new_child {
} elsif ($userinput =~ /^store/) {
my ($cmd,$udom,$uname,$namespace,$rid,$what)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
if ($namespace ne 'roles') {
chomp($what);
@@ -731,6 +746,7 @@ sub make_new_child {
} elsif ($userinput =~ /^restore/) {
my ($cmd,$udom,$uname,$namespace,$rid)
=split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
$namespace=~s/\W//g;
chomp($rid);
my $proname=propath($udom,$uname);
@@ -828,9 +844,11 @@ sub make_new_child {
}
} else {
print $client "refused\n";
- &logthis("Rejected client $clientip, closing connection");
+ &logthis("WARNING: "
+ ."Rejected client $clientip, closing connection");
}
- &logthis("Disconnect from $clientip ($hostid{$clientip})");
+ &logthis("CRITICAL: "
+ ."Disconnect from $clientip ($hostid{$clientip})");
# =============================================================================
}