--- loncom/lond 2000/07/14 07:43:15 1.15
+++ loncom/lond 2001/03/22 15:14:42 1.40
@@ -7,7 +7,12 @@
# 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,07/14 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,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
# preforker - server who forks first
@@ -25,6 +30,23 @@ use LWP::UserAgent();
use GDBM_File;
use Authen::Krb4;
+# grabs exception and records it to log before exiting
+sub catchexception {
+ my ($error)=@_;
+ $SIG{'QUIT'}='DEFAULT';
+ $SIG{__DIE__}='DEFAULT';
+ &logthis("CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+ ."a crash with this error msg->[$error]");
+ 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
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
@@ -38,6 +60,27 @@ while ($configline=) {
}
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
# ------------------------------------------------------------- Read hosts file
@@ -92,6 +135,7 @@ sub HUPSMAN { # sig
kill 'INT' => keys %children;
close($server); # free up socket
&logthis("CRITICAL: Restarting");
+ unlink("$execdir/logs/lond.pid");
my $execdir=$perlvar{'lonDaemons'};
exec("$execdir/lond"); # here we go again
}
@@ -217,7 +261,7 @@ sub propath {
my ($udom,$uname)=@_;
$udom=~s/\W//g;
$uname=~s/\W//g;
- my $subdir=$uname.'___';
+ my $subdir=$uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
return $proname;
@@ -333,15 +377,18 @@ sub make_new_child {
} else {
&logthis(
"WARNING: $clientip did not reply challenge");
+ print $client "bye\n";
}
} else {
&logthis(
"WARNING: "
."$clientip failed to initialize: >$remotereq< ");
+ print $client "bye\n";
}
} else {
&logthis(
"WARNING: Unknown client $clientip");
+ print $client "bye\n";
}
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
@@ -443,6 +490,8 @@ sub make_new_child {
my
($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
chomp($npass);
+ $upass=&unescape($upass);
+ $npass=&unescape($npass);
my $proname=propath($udom,$uname);
my $passfilename="$proname/passwd";
if (-e $passfilename) {
@@ -457,7 +506,7 @@ sub make_new_child {
$salt=substr($salt,6,2);
my $ncpass=crypt($npass,$salt);
{ my $pf = IO::File->new(">$passfilename");
- print $pf "internal:$ncpass\n";; }
+ print $pf "internal:$ncpass\n"; }
print $client "ok\n";
} else {
print $client "non_authorized\n";
@@ -471,6 +520,63 @@ sub make_new_child {
} else {
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
} elsif ($userinput =~ /^home/) {
my ($cmd,$udom,$uname)=split(/:/,$userinput);
@@ -508,12 +614,13 @@ sub make_new_child {
$response=$ua->request($request,$transname);
}
if ($response->is_error()) {
- unline($transname);
+ unlink($transname);
my $message=$response->status_line;
&logthis(
"LWP GET: $message for $fname ($remoteurl)");
} else {
if ($remoteurl!~/\.meta$/) {
+ my $ua=new LWP::UserAgent;
my $mrequest=
new HTTP::Request('GET',$remoteurl.'.meta');
my $mresponse=
@@ -550,14 +657,21 @@ sub make_new_child {
my $ownership=ishome($fname);
if ($ownership eq 'owner') {
if (-e $fname) {
+ if (-d $fname) {
+ print $client "directory\n";
+ } else {
$now=time;
{
- my $sh=IO::File->new(">$fname.$hostid{$clientip}");
- print $sh "$clientip:$now\n";
+ my $sh;
+ if ($sh=
+ IO::File->new(">$fname.$hostid{$clientip}")) {
+ print $sh "$clientip:$now\n";
+ }
}
$fname=~s/\/home\/httpd\/html\/res/raw/;
$fname="http://$thisserver/".$fname;
print $client "$fname\n";
+ }
} else {
print $client "not_found\n";
}
@@ -656,7 +770,7 @@ sub make_new_child {
my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);
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++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -679,7 +793,7 @@ sub make_new_child {
my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);
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++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -741,7 +855,7 @@ sub make_new_child {
$namespace=~s/\W//g;
my $proname=propath($udom,$uname);
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) {
$qresult.="$key&";
}
@@ -762,7 +876,7 @@ sub make_new_child {
$namespace=~s/\W//g;
my $proname=propath($udom,$uname);
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) {
$qresult.="$key=$hash{$key}&";
}
@@ -804,7 +918,8 @@ sub make_new_child {
$allkeys.=$key.':';
$hash{"$version:$rid:$key"}=$value;
}
- $allkeys=~s/:$//;
+ $hash{"$version:$rid:timestamp"}=$now;
+ $allkeys.='timestamp';
$hash{"$version:keys:$rid"}=$allkeys;
if (untie(%hash)) {
print $client "ok\n";
@@ -826,7 +941,7 @@ sub make_new_child {
chomp($rid);
my $proname=propath($udom,$uname);
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"};
$qresult.="version=$version&";
my $scope;
@@ -836,7 +951,7 @@ sub make_new_child {
my $key;
$qresult.="$scope:keys=$vkeys&";
foreach $key (@keys) {
- $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";
+ $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
}
}
if (untie(%hash)) {
@@ -850,9 +965,17 @@ sub make_new_child {
}
# ------------------------------------------------------------------- querysend
} elsif ($userinput =~ /^querysend/) {
- my ($cmd,$query)=split(/:/,$userinput);
+ my ($cmd,$query,$custom)=split(/:/,$userinput);
$query=~s/\n*$//g;
- print $client sqlreply("$hostid{$clientip}\&$query")."\n";
+ unless ($custom) {
+ print $client "".
+ sqlreply("$hostid{$clientip}\&$query")."\n";
+ }
+ else {
+ print $client "".
+ sqlreply("$hostid{$clientip}\&$query".
+ "\&$custom")."\n";
+ }
# ------------------------------------------------------------------ queryreply
} elsif ($userinput =~ /^queryreply/) {
my ($cmd,$id,$reply)=split(/:/,$userinput);
@@ -901,7 +1024,7 @@ sub make_new_child {
my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
my @queries=split(/\&/,$what);
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++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -961,6 +1084,7 @@ sub make_new_child {
} else {
$ulsout='no_such_dir';
}
+ if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";
# ------------------------------------------------------------- unknown command
} else {