version 1.33, 2000/12/13 22:45:56
|
version 1.49, 2001/08/24 19:25:46
|
Line 9
|
Line 9
|
# 06/26 Scott Harrison |
# 06/26 Scott Harrison |
# 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer |
# 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer |
# 12/05 Scott Harrison |
# 12/05 Scott Harrison |
# 12/05,12/13 Gerd Kortemeyer |
# 12/05,12/13,12/29 Gerd Kortemeyer |
|
# Jan 01 Scott Harrison |
|
# 02/12 Gerd Kortemeyer |
|
# 03/15 Scott Harrison |
|
# 03/24 Gerd Kortemeyer |
|
# 04/02 Scott Harrison |
|
# 05/11,05/28 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 |
Line 26 use Crypt::IDEA;
|
Line 32 use Crypt::IDEA;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use GDBM_File; |
use GDBM_File; |
use Authen::Krb4; |
use Authen::Krb4; |
|
use lib '/home/httpd/lib/perl/'; |
|
use localauth; |
|
|
# grabs exception and records it to log before exiting |
# grabs exception and records it to log before exiting |
sub catchexception { |
sub catchexception { |
Line 57 while ($configline=<CONFIG>) {
|
Line 65 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 |
# --------------------------------------------- Check if other instance running |
|
|
my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid"; |
my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid"; |
Line 459 sub make_new_child {
|
Line 477 sub make_new_child {
|
Authen::Krb4::get_pw_in_tkt($uname,"", |
Authen::Krb4::get_pw_in_tkt($uname,"", |
$contentpwd,'krbtgt',$contentpwd,1, |
$contentpwd,'krbtgt',$contentpwd,1, |
$upass) == 0); |
$upass) == 0); |
} |
} elsif ($howpwd eq 'localauth') { |
|
$pwdcorrect=&localauth::localauth($uname,$upass, |
|
$contentpwd); |
|
} |
if ($pwdcorrect) { |
if ($pwdcorrect) { |
print $client "authorized\n"; |
print $client "authorized\n"; |
} else { |
} else { |
Line 533 sub make_new_child {
|
Line 554 sub make_new_child {
|
} |
} |
} |
} |
unless ($fperror) { |
unless ($fperror) { |
if ($umode eq 'none') { |
if ($umode eq 'krb4') { |
} elsif ($umode eq 'krb4') { |
|
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
print $pf "krb4:$npass\n"; |
print $pf "krb4:$npass\n"; |
Line 656 sub make_new_child {
|
Line 676 sub make_new_child {
|
print $sh "$clientip:$now\n"; |
print $sh "$clientip:$now\n"; |
} |
} |
} |
} |
|
unless ($fname=~/\.meta$/) { |
|
unlink("$fname.meta.$hostid{$clientip}"); |
|
} |
$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"; |
Line 691 sub make_new_child {
|
Line 714 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 816 sub make_new_child {
|
Line 839 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 887 sub make_new_child {
|
Line 910 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 906 sub make_new_child {
|
Line 929 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 952 sub make_new_child {
|
Line 976 sub make_new_child {
|
} |
} |
# ------------------------------------------------------------------- querysend |
# ------------------------------------------------------------------- querysend |
} elsif ($userinput =~ /^querysend/) { |
} elsif ($userinput =~ /^querysend/) { |
my ($cmd,$query)=split(/:/,$userinput); |
my ($cmd,$query, |
|
$custom,$customshow)=split(/:/,$userinput); |
$query=~s/\n*$//g; |
$query=~s/\n*$//g; |
print $client sqlreply("$hostid{$clientip}\&$query")."\n"; |
unless ($custom or $customshow) { |
|
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query")."\n"; |
|
} |
|
else { |
|
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query". |
|
"\&$custom"."\&$customshow")."\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; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
|
$reply=~s/\&/\n/g; |
print $store $reply; |
print $store $reply; |
close $store; |
close $store; |
|
my $store2=IO::File->new(">$execdir/tmp/$id.end"); |
|
print $store2 "done\n"; |
|
close $store2; |
print $client "ok\n"; |
print $client "ok\n"; |
} |
} |
else { |
else { |
Line 1056 sub make_new_child {
|
Line 1093 sub make_new_child {
|
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
if (-e $ulsdir) { |
if (-e $ulsdir) { |
while ($ulsfn=<$ulsdir/*>) { |
if (opendir(LSDIR,$ulsdir)) { |
my @ulsstats=stat($ulsfn); |
while ($ulsfn=readdir(LSDIR)) { |
|
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
} |
} |
|
closedir(LSDIR); |
|
} |
} else { |
} else { |
$ulsout='no_such_dir'; |
$ulsout='no_such_dir'; |
} |
} |