version 1.11, 2000/05/01 20:22:39
|
version 1.39, 2001/03/22 15:06:01
|
Line 5
|
Line 5
|
# 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,2/8, |
# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, |
# 03/07 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,09/18 Gerd Kortemeyer |
|
# 12/05 Scott Harrison |
|
# 12/05,12/13,12/29 Gerd Kortemeyer |
|
# Jan 01 Scott Harrison |
|
# 02/12 Gerd Kortemeyer |
|
# 03/15 Scott Harrison |
|
# |
# 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 22 use LWP::UserAgent();
|
Line 30 use LWP::UserAgent();
|
use GDBM_File; |
use GDBM_File; |
use Authen::Krb4; |
use Authen::Krb4; |
|
|
|
# grabs exception and records it to log before exiting |
|
sub catchexception { |
|
my ($error)=@_; |
|
$SIG{'QUIT'}='DEFAULT'; |
|
$SIG{__DIE__}='DEFAULT'; |
|
&logthis("<font color=red>CRITICAL: " |
|
."ABNORMAL EXIT. Child $$ for server $wasserver died through " |
|
."a crash with this error msg->[$error]</font>"); |
|
if ($client) { print $client "error: $error\n"; } |
|
die($error); |
|
} |
|
|
|
# -------------------------------- Set signal handlers to record abnormal exits |
|
|
|
$SIG{'QUIT'}=\&catchexception; |
|
$SIG{__DIE__}=\&catchexception; |
|
|
# ------------------------------------ Read httpd access.conf and get variables |
# ------------------------------------ Read httpd access.conf and get variables |
|
|
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; |
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; |
Line 35 while ($configline=<CONFIG>) {
|
Line 60 while ($configline=<CONFIG>) {
|
} |
} |
close(CONFIG); |
close(CONFIG); |
|
|
|
# ----------------------------- Make sure this process is running from user=www |
|
my $wwwid=getpwnam('www'); |
|
if ($wwwid!=$<) { |
|
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
|
$subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
|
system("echo 'User ID mismatch. lond must be run as user www.' |\ |
|
mailto $emailto -s '$subj' > /dev/null"); |
|
exit 1; |
|
} |
|
|
|
# --------------------------------------------- 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 89 sub HUPSMAN { # sig
|
Line 135 sub HUPSMAN { # sig
|
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
close($server); # free up socket |
close($server); # free up socket |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
|
unlink("$execdir/logs/lond.pid"); |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
exec("$execdir/lond"); # here we go again |
exec("$execdir/lond"); # here we go again |
} |
} |
Line 184 sub reply {
|
Line 231 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; |
$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 274 sub make_new_child {
|
Line 345 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 304 sub make_new_child {
|
Line 377 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 414 sub make_new_child {
|
Line 490 sub make_new_child {
|
my |
my |
($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput); |
($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput); |
chomp($npass); |
chomp($npass); |
|
$upass=&unescape($upass); |
|
$npass=&unescape($npass); |
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 428 sub make_new_child {
|
Line 506 sub make_new_child {
|
$salt=substr($salt,6,2); |
$salt=substr($salt,6,2); |
my $ncpass=crypt($npass,$salt); |
my $ncpass=crypt($npass,$salt); |
{ my $pf = IO::File->new(">$passfilename"); |
{ my $pf = IO::File->new(">$passfilename"); |
print $pf "internal:$ncpass\n";; } |
print $pf "internal:$ncpass\n"; } |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
print $client "non_authorized\n"; |
print $client "non_authorized\n"; |
Line 442 sub make_new_child {
|
Line 520 sub make_new_child {
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
|
# -------------------------------------------------------------------- makeuser |
|
} elsif ($userinput =~ /^makeuser/) { |
|
if ($wasenc==1) { |
|
my |
|
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
|
chomp($npass); |
|
$npass=&unescape($npass); |
|
my $proname=propath($udom,$uname); |
|
my $passfilename="$proname/passwd"; |
|
if (-e $passfilename) { |
|
print $client "already_exists\n"; |
|
} elsif ($udom ne $perlvar{'lonDefDomain'}) { |
|
print $client "not_right_domain\n"; |
|
} else { |
|
@fpparts=split(/\//,$proname); |
|
$fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; |
|
$fperror=''; |
|
for ($i=3;$i<=$#fpparts;$i++) { |
|
$fpnow.='/'.$fpparts[$i]; |
|
unless (-e $fpnow) { |
|
unless (mkdir($fpnow,0777)) { |
|
$fperror="error:$!\n"; |
|
} |
|
} |
|
} |
|
unless ($fperror) { |
|
if ($umode eq 'krb4') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "krb4:$npass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'internal') { |
|
my $salt=time; |
|
$salt=substr($salt,6,2); |
|
my $ncpass=crypt($npass,$salt); |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "internal:$ncpass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'none') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "none:\n"; |
|
} |
|
print $client "ok\n"; |
|
} else { |
|
print $client "auth_mode_error\n"; |
|
} |
|
} else { |
|
print $client "$fperror\n"; |
|
} |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
# ------------------------------------------------------------------------ home |
# ------------------------------------------------------------------------ home |
} elsif ($userinput =~ /^home/) { |
} elsif ($userinput =~ /^home/) { |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
Line 479 sub make_new_child {
|
Line 614 sub make_new_child {
|
$response=$ua->request($request,$transname); |
$response=$ua->request($request,$transname); |
} |
} |
if ($response->is_error()) { |
if ($response->is_error()) { |
unline($transname); |
unlink($transname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis( |
&logthis( |
"LWP GET: $message for $fname ($remoteurl)"); |
"LWP GET: $message for $fname ($remoteurl)"); |
} else { |
} else { |
|
if ($remoteurl!~/\.meta$/) { |
|
my $ua=new LWP::UserAgent; |
|
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 512 sub make_new_child {
|
Line 657 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; |
print $sh "$clientip:$now\n"; |
if ($sh= |
|
IO::File->new(">$fname.$hostid{$clientip}")) { |
|
print $sh "$clientip:$now\n"; |
|
} |
} |
} |
$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"; |
} |
} |
} 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 603 sub make_new_child {
|
Line 770 sub make_new_child {
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
for ($i=0;$i<=$#queries;$i++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
Line 626 sub make_new_child {
|
Line 793 sub make_new_child {
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
for ($i=0;$i<=$#queries;$i++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
Line 688 sub make_new_child {
|
Line 855 sub make_new_child {
|
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
foreach $key (keys %hash) { |
foreach $key (keys %hash) { |
$qresult.="$key&"; |
$qresult.="$key&"; |
} |
} |
Line 709 sub make_new_child {
|
Line 876 sub make_new_child {
|
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
foreach $key (keys %hash) { |
foreach $key (keys %hash) { |
$qresult.="$key=$hash{$key}&"; |
$qresult.="$key=$hash{$key}&"; |
} |
} |
Line 751 sub make_new_child {
|
Line 918 sub make_new_child {
|
$allkeys.=$key.':'; |
$allkeys.=$key.':'; |
$hash{"$version:$rid:$key"}=$value; |
$hash{"$version:$rid:$key"}=$value; |
} |
} |
$allkeys=~s/:$//; |
$hash{"$version:$rid:timestamp"}=$now; |
|
$allkeys.='timestamp'; |
$hash{"$version:keys:$rid"}=$allkeys; |
$hash{"$version:keys:$rid"}=$allkeys; |
if (untie(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
Line 773 sub make_new_child {
|
Line 941 sub make_new_child {
|
chomp($rid); |
chomp($rid); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
my $version=$hash{"version:$rid"}; |
my $version=$hash{"version:$rid"}; |
$qresult.="version=$version&"; |
$qresult.="version=$version&"; |
my $scope; |
my $scope; |
Line 783 sub make_new_child {
|
Line 951 sub make_new_child {
|
my $key; |
my $key; |
$qresult.="$scope:keys=$vkeys&"; |
$qresult.="$scope:keys=$vkeys&"; |
foreach $key (@keys) { |
foreach $key (@keys) { |
$qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&"; |
$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&"; |
} |
} |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
Line 795 sub make_new_child {
|
Line 963 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
|
# ------------------------------------------------------------------- querysend |
|
} elsif ($userinput =~ /^querysend/) { |
|
my ($cmd,$query,$custom)=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 830 sub make_new_child {
|
Line 1017 sub make_new_child {
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) { |
for ($i=0;$i<=$#queries;$i++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
Line 843 sub make_new_child {
|
Line 1030 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 856 sub make_new_child {
|
Line 1077 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 { |