version 1.8, 2000/01/14 14:46:57
|
version 1.14, 2000/06/30 18:00:39
|
Line 4
|
Line 4
|
# 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30, |
# 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, |
# 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, |
# 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 Gerd Kortemeyer |
# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, |
|
# 03/07,05/31 Gerd Kortemeyer |
|
# 06/26 Scott Harrison |
|
# 06/29,06/30 Gerd Kortemeyer |
|
# |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# preforker - server who forks first |
# preforker - server who forks first |
# runs as a daemon |
# runs as a daemon |
Line 79 sub HUNTSMAN { # si
|
Line 83 sub HUNTSMAN { # si
|
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lond.pid"); |
unlink("$execdir/logs/lond.pid"); |
&logthis("Shutting down"); |
&logthis("<font color=red>CRITICAL: Shutting down</font>"); |
exit; # clean up with dignity |
exit; # clean up with dignity |
} |
} |
|
|
Line 87 sub HUPSMAN { # sig
|
Line 91 sub HUPSMAN { # sig
|
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
close($server); # free up socket |
close($server); # free up socket |
&logthis("Restarting"); |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
exec("$execdir/lond"); # here we go again |
exec("$execdir/lond"); # here we go again |
} |
} |
Line 103 sub logthis {
|
Line 107 sub logthis {
|
print $fh "$local ($$): $message\n"; |
print $fh "$local ($$): $message\n"; |
} |
} |
|
|
|
|
|
# -------------------------------------------------------- Escape Special Chars |
|
|
|
sub escape { |
|
my $str=shift; |
|
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
|
return $str; |
|
} |
|
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
# ----------------------------------------------------------- Send USR1 to lonc |
# ----------------------------------------------------------- Send USR1 to lonc |
|
|
sub reconlonc { |
sub reconlonc { |
Line 120 sub reconlonc {
|
Line 141 sub reconlonc {
|
&logthis("$peerfile still not there, give it another try"); |
&logthis("$peerfile still not there, give it another try"); |
sleep 5; |
sleep 5; |
if (-e "$peerfile") { return; } |
if (-e "$peerfile") { return; } |
&logthis("$peerfile still not there, giving up"); |
&logthis( |
|
"<font color=blue>WARNING: $peerfile still not there, giving up</font>"); |
} else { |
} else { |
&logthis("lonc at pid $loncpid not responding, giving up"); |
&logthis( |
|
"<font color=red>CRITICAL: " |
|
."lonc at pid $loncpid not responding, giving up</font>"); |
} |
} |
} else { |
} else { |
&logthis('lonc not running, giving up'); |
&logthis('<font color=red>CRITICAL: lonc not running, giving up</font>'); |
} |
} |
} |
} |
|
|
# -------------------------------------------------- Non-critical communication |
# -------------------------------------------------- Non-critical communication |
|
|
sub subreply { |
sub subreply { |
my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
my $peerfile="$perlvar{'lonSockDir'}/$server"; |
my $peerfile="$perlvar{'lonSockDir'}/$server"; |
Line 162 sub reply {
|
Line 187 sub reply {
|
return $answer; |
return $answer; |
} |
} |
|
|
|
# -------------------------------------------------------------- Talk to lonsql |
|
|
|
sub sqlreply { |
|
my ($cmd)=@_; |
|
my $answer=subsqlreply($cmd); |
|
if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); } |
|
return $answer; |
|
} |
|
|
|
sub subsqlreply { |
|
my ($cmd)=@_; |
|
my $unixsock="mysqlsock"; |
|
my $peerfile="$perlvar{'lonSockDir'}/$unixsock"; |
|
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", |
|
Type => SOCK_STREAM, |
|
Timeout => 10) |
|
or return "con_lost"; |
|
print $sclient "$cmd\n"; |
|
my $answer=<$sclient>; |
|
chomp($answer); |
|
if (!$answer) { $answer="con_lost"; } |
|
return $answer; |
|
} |
|
|
# -------------------------------------------- Return path to profile directory |
# -------------------------------------------- Return path to profile directory |
|
|
sub propath { |
sub propath { |
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
$udom=~s/\W//g; |
$udom=~s/\W//g; |
Line 174 sub propath {
|
Line 224 sub propath {
|
} |
} |
|
|
# --------------------------------------- Is this the home server of an author? |
# --------------------------------------- Is this the home server of an author? |
|
|
sub ishome { |
sub ishome { |
my $author=shift; |
my $author=shift; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
Line 201 $execdir=$perlvar{'lonDaemons'};
|
Line 252 $execdir=$perlvar{'lonDaemons'};
|
open (PIDSAVE,">$execdir/logs/lond.pid"); |
open (PIDSAVE,">$execdir/logs/lond.pid"); |
print PIDSAVE "$$\n"; |
print PIDSAVE "$$\n"; |
close(PIDSAVE); |
close(PIDSAVE); |
&logthis("Starting"); |
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>"); |
|
|
# ------------------------------------------------------- Now we are on our own |
# ------------------------------------------------------- Now we are on our own |
|
|
Line 250 sub make_new_child {
|
Line 301 sub make_new_child {
|
# unblock signals |
# unblock signals |
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"; |
|
|
|
$tmpsnum=0; |
|
|
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
Line 263 sub make_new_child {
|
Line 316 sub make_new_child {
|
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my $clientip=inet_ntoa($iaddr); |
my $clientip=inet_ntoa($iaddr); |
my $clientrec=($hostid{$clientip} ne undef); |
my $clientrec=($hostid{$clientip} ne undef); |
&logthis("Connect from $clientip ($hostid{$clientip})"); |
&logthis( |
|
"<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>"); |
my $clientok; |
my $clientok; |
if ($clientrec) { |
if ($clientrec) { |
my $remotereq=<$client>; |
my $remotereq=<$client>; |
Line 277 sub make_new_child {
|
Line 331 sub make_new_child {
|
$clientok=1; |
$clientok=1; |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
&logthis("$clientip did not reply challenge"); |
&logthis( |
|
"<font color=blue>WARNING: $clientip did not reply challenge</font>"); |
} |
} |
} else { |
} else { |
&logthis("$clientip failed to initialize: >$remotereq<"); |
&logthis( |
|
"<font color=blue>WARNING: " |
|
."$clientip failed to initialize: >$remotereq< </font>"); |
} |
} |
} else { |
} else { |
&logthis("Unknown client $clientip"); |
&logthis( |
|
"<font color=blue>WARNING: Unknown client $clientip</font>"); |
} |
} |
if ($clientok) { |
if ($clientok) { |
# ---------------- New known client connecting, could mean machine online again |
# ---------------- New known client connecting, could mean machine online again |
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); |
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); |
|
&logthis( |
|
"<font color=green>Established connection: $hostid{$clientip}</font>"); |
# ------------------------------------------------------------ Process requests |
# ------------------------------------------------------------ Process requests |
while (my $userinput=<$client>) { |
while (my $userinput=<$client>) { |
chomp($userinput); |
chomp($userinput); |
Line 344 sub make_new_child {
|
Line 404 sub make_new_child {
|
if ($wasenc==1) { |
if ($wasenc==1) { |
my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput); |
my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput); |
chomp($upass); |
chomp($upass); |
|
$upass=unescape($upass); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $passfilename="$proname/passwd"; |
my $passfilename="$proname/passwd"; |
if (-e $passfilename) { |
if (-e $passfilename) { |
Line 452 sub make_new_child {
|
Line 513 sub make_new_child {
|
&logthis( |
&logthis( |
"LWP GET: $message for $fname ($remoteurl)"); |
"LWP GET: $message for $fname ($remoteurl)"); |
} else { |
} else { |
|
if ($remoteurl!~/\.meta$/) { |
|
my $mrequest= |
|
new HTTP::Request('GET',$remoteurl.'.meta'); |
|
my $mresponse= |
|
$ua->request($mrequest,$fname.'.meta'); |
|
if ($mresponse->is_error()) { |
|
unlink($fname.'.meta'); |
|
} |
|
} |
rename($transname,$fname); |
rename($transname,$fname); |
} |
} |
} |
} |
Line 494 sub make_new_child {
|
Line 564 sub make_new_child {
|
} else { |
} else { |
print $client "rejected\n"; |
print $client "rejected\n"; |
} |
} |
|
# ------------------------------------------------------------------------- log |
|
} elsif ($userinput =~ /^log/) { |
|
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/activity.log")) { |
|
print $hfh "$now:$hostid{$clientip}:$what\n"; |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error:$!\n"; |
|
} |
|
} |
# ------------------------------------------------------------------------- put |
# ------------------------------------------------------------------------- put |
} elsif ($userinput =~ /^put/) { |
} elsif ($userinput =~ /^put/) { |
my ($cmd,$udom,$uname,$namespace,$what) |
my ($cmd,$udom,$uname,$namespace,$what) |
Line 763 sub make_new_child {
|
Line 848 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
|
# ------------------------------------------------------------------- querysend |
|
} elsif ($userinput =~ /^querysend/) { |
|
my ($cmd,$query)=split(/:/,$userinput); |
|
$query=~s/\n*$//g; |
|
print $client sqlreply("$hostid{$clientip}\&$query")."\n"; |
|
# ------------------------------------------------------------------ queryreply |
|
} elsif ($userinput =~ /^queryreply/) { |
|
my ($cmd,$id,$reply)=split(/:/,$userinput); |
|
my $store; |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
|
print $store $reply; |
|
close $store; |
|
print $client "ok\n"; |
|
} |
|
else { |
|
print $client "error:$!\n"; |
|
} |
# ----------------------------------------------------------------------- idput |
# ----------------------------------------------------------------------- idput |
} elsif ($userinput =~ /^idput/) { |
} elsif ($userinput =~ /^idput/) { |
my ($cmd,$udom,$what)=split(/:/,$userinput); |
my ($cmd,$udom,$what)=split(/:/,$userinput); |
Line 811 sub make_new_child {
|
Line 914 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
|
# ---------------------------------------------------------------------- tmpput |
|
} elsif ($userinput =~ /^tmpput/) { |
|
my ($cmd,$what)=split(/:/,$userinput); |
|
my $store; |
|
$tmpsnum++; |
|
my $id=$$.'_'.$clientip.'_'.$tmpsnum; |
|
$id=~s/\W/\_/g; |
|
$what=~s/\n//g; |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { |
|
print $store $what; |
|
close $store; |
|
print $client "$id\n"; |
|
} |
|
else { |
|
print $client "error:$!\n"; |
|
} |
|
|
|
# ---------------------------------------------------------------------- tmpget |
|
} elsif ($userinput =~ /^tmpget/) { |
|
my ($cmd,$id)=split(/:/,$userinput); |
|
chomp($id); |
|
$id=~s/\W/\_/g; |
|
my $store; |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
if ($store=IO::File->new("$execdir/tmp/$id.tmp")) { |
|
my $reply=<$store>; |
|
print $client "$reply\n"; |
|
close $store; |
|
} |
|
else { |
|
print $client "error:$!\n"; |
|
} |
|
|
# -------------------------------------------------------------------------- ls |
# -------------------------------------------------------------------------- ls |
} elsif ($userinput =~ /^ls/) { |
} elsif ($userinput =~ /^ls/) { |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
Line 834 sub make_new_child {
|
Line 971 sub make_new_child {
|
} |
} |
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
&logthis("Rejected client $clientip, closing connection"); |
&logthis("<font color=blue>WARNING: " |
|
."Rejected client $clientip, closing connection</font>"); |
} |
} |
&logthis("Disconnect from $clientip ($hostid{$clientip})"); |
&logthis("<font color=red>CRITICAL: " |
|
."Disconnect from $clientip ($hostid{$clientip})</font>"); |
# ============================================================================= |
# ============================================================================= |
} |
} |
|
|