version 1.12, 2000/06/26 02:42:28
|
version 1.19, 2000/07/25 16:03:57
|
Line 6
|
Line 6
|
# 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,2/8, |
# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, |
# 03/07,05/31 Gerd Kortemeyer |
# 03/07,05/31 Gerd Kortemeyer |
|
# 06/26 Scott Harrison |
|
# 06/29,06/30,07/14,07/15,07/17,07/20,07/25 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 35 while ($configline=<CONFIG>) {
|
Line 38 while ($configline=<CONFIG>) {
|
} |
} |
close(CONFIG); |
close(CONFIG); |
|
|
|
# --------------------------------------------- Check if other instance running |
|
|
|
my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid"; |
|
|
|
if (-e $pidfile) { |
|
my $lfh=IO::File->new("$pidfile"); |
|
my $pide=<$lfh>; |
|
chomp($pide); |
|
if (kill 0 => $pide) { die "already running"; } |
|
} |
|
|
$PREFORK=4; # number of children to maintain, at least four spare |
$PREFORK=4; # number of children to maintain, at least four spare |
|
|
# ------------------------------------------------------------- Read hosts file |
# ------------------------------------------------------------- Read hosts file |
Line 184 sub reply {
|
Line 198 sub reply {
|
return $answer; |
return $answer; |
} |
} |
|
|
|
# -------------------------------------------------------------- Talk to lonsql |
|
|
sub sqlreply { |
sub sqlreply { |
my ($cmd)=@_; |
my ($cmd)=@_; |
my $answer=subsqlreply($cmd); |
my $answer=subsqlreply($cmd); |
Line 212 sub propath {
|
Line 228 sub propath {
|
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
$udom=~s/\W//g; |
$udom=~s/\W//g; |
$uname=~s/\W//g; |
$uname=~s/\W//g; |
my $subdir=$uname; |
my $subdir=$uname.'__'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
return $proname; |
return $proname; |
Line 296 sub make_new_child {
|
Line 312 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 326 sub make_new_child {
|
Line 344 sub make_new_child {
|
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: $clientip did not reply challenge</font>"); |
"<font color=blue>WARNING: $clientip did not reply challenge</font>"); |
|
print $client "bye\n"; |
} |
} |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: " |
"<font color=blue>WARNING: " |
."$clientip failed to initialize: >$remotereq< </font>"); |
."$clientip failed to initialize: >$remotereq< </font>"); |
|
print $client "bye\n"; |
} |
} |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: Unknown client $clientip</font>"); |
"<font color=blue>WARNING: Unknown client $clientip</font>"); |
|
print $client "bye\n"; |
} |
} |
if ($clientok) { |
if ($clientok) { |
# ---------------- New known client connecting, could mean machine online again |
# ---------------- New known client connecting, could mean machine online again |
Line 506 sub make_new_child {
|
Line 527 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 534 sub make_new_child {
|
Line 564 sub make_new_child {
|
my $ownership=ishome($fname); |
my $ownership=ishome($fname); |
if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
if (-e $fname) { |
if (-e $fname) { |
|
if (-d $fname) { |
|
print $client "directory\n"; |
|
} else { |
$now=time; |
$now=time; |
{ |
{ |
my $sh=IO::File->new(">$fname.$hostid{$clientip}"); |
my $sh=IO::File->new(">$fname.$hostid{$clientip}"); |
Line 542 sub make_new_child {
|
Line 575 sub make_new_child {
|
$fname=~s/\/home\/httpd\/html\/res/raw/; |
$fname=~s/\/home\/httpd\/html\/res/raw/; |
$fname="http://$thisserver/".$fname; |
$fname="http://$thisserver/".$fname; |
print $client "$fname\n"; |
print $client "$fname\n"; |
|
} |
} else { |
} else { |
print $client "not_found\n"; |
print $client "not_found\n"; |
} |
} |
Line 835 sub make_new_child {
|
Line 869 sub make_new_child {
|
# ------------------------------------------------------------------- querysend |
# ------------------------------------------------------------------- querysend |
} elsif ($userinput =~ /^querysend/) { |
} elsif ($userinput =~ /^querysend/) { |
my ($cmd,$query)=split(/:/,$userinput); |
my ($cmd,$query)=split(/:/,$userinput); |
# make sure you get one \n and only one |
|
$query=~s/\n*$//g; |
$query=~s/\n*$//g; |
print $client sqlreply("$hostid{$clientip}\&$query")."\n"; |
print $client sqlreply("$hostid{$clientip}\&$query")."\n"; |
# ------------------------------------------------------------------ queryreply |
# ------------------------------------------------------------------ queryreply |
} elsif ($userinput =~ /^queryreply/) { |
} elsif ($userinput =~ /^queryreply/) { |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
my $store; |
my $store; |
if ($store=IO::File->new(">/tmp/$id")) { |
my $execdir=$perlvar{'lonDaemons'}; |
|
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
print $store $reply; |
print $store $reply; |
close $store; |
close $store; |
print $client "ok\n"; |
print $client "ok\n"; |
Line 898 sub make_new_child {
|
Line 932 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 911 sub make_new_child {
|
Line 979 sub make_new_child {
|
} else { |
} else { |
$ulsout='no_such_dir'; |
$ulsout='no_such_dir'; |
} |
} |
|
if ($ulsout eq '') { $ulsout='empty'; } |
print $client "$ulsout\n"; |
print $client "$ulsout\n"; |
# ------------------------------------------------------------- unknown command |
# ------------------------------------------------------------- unknown command |
} else { |
} else { |