--- loncom/lond 2000/12/05 03:24:48 1.22
+++ loncom/lond 2000/12/13 16:41:43 1.31
@@ -8,6 +8,8 @@
# 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 Gerd Kortemeyer
#
# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first
@@ -25,6 +27,18 @@ 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;
@@ -32,8 +46,7 @@ $SIG{__DIE__}=\&catchexception;
# ------------------------------------ Read httpd access.conf and get variables
-open (CONFIG,"/etc/httpd/conf/access.conf")
- || catchdie "Can't read access.conf";
+open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
while ($configline=) {
if ($configline =~ /PerlSetVar/) {
@@ -52,15 +65,14 @@ if (-e $pidfile) {
my $lfh=IO::File->new("$pidfile");
my $pide=<$lfh>;
chomp($pide);
- if (kill 0 => $pide) { catchdie "already running"; }
+ if (kill 0 => $pide) { die "already running"; }
}
$PREFORK=4; # number of children to maintain, at least four spare
# ------------------------------------------------------------- Read hosts file
-open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab")
- || catchdie "Can't read host file";
+open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
while ($configline=) {
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
@@ -77,7 +89,7 @@ $server = IO::Socket::INET->new(LocalPor
Proto => 'tcp',
Reuse => 1,
Listen => 10 )
- or catchdie "making socket: $@\n";
+ or die "making socket: $@\n";
# --------------------------------------------------------- Do global variables
@@ -110,6 +122,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
}
@@ -260,9 +273,9 @@ sub ishome {
$fpid=fork;
exit if $fpid;
-catchdie "Couldn't fork: $!" unless defined ($fpid);
+die "Couldn't fork: $!" unless defined ($fpid);
-POSIX::setsid() or catchdie "Can't start new session: $!";
+POSIX::setsid() or die "Can't start new session: $!";
# ------------------------------------------------------- Write our PID on disk
@@ -301,14 +314,14 @@ sub make_new_child {
# block signal for fork
$sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset)
- or catchdie "Can't block SIGINT for fork: $!\n";
+ or die "Can't block SIGINT for fork: $!\n";
- catchdie "fork: $!" unless defined ($pid = fork);
+ die "fork: $!" unless defined ($pid = fork);
if ($pid) {
# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)
- or catchdie "Can't unblock SIGINT for fork: $!\n";
+ or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = 1;
$children++;
return;
@@ -318,7 +331,7 @@ sub make_new_child {
# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
- or catchdie "Can't unblock SIGINT for fork: $!\n";
+ or die "Can't unblock SIGINT for fork: $!\n";
$tmpsnum=0;
@@ -478,7 +491,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";
@@ -492,6 +505,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);
+ 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 'none') {
+ } elsif ($umode eq 'kerberos') {
+ {
+ my $pf = IO::File->new(">$passfilename");
+ print $pf "kerberos:$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);
@@ -529,12 +599,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=
@@ -576,8 +647,11 @@ sub make_new_child {
} 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;
@@ -1014,26 +1088,6 @@ sub make_new_child {
}
}
-# grabs exception and records it to log before exiting
-sub catchexception {
- my ($signal)=@_;
- &logthis("CRITICAL: "
- ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
- ."$signal with this parameter->[$@]");
- die($@);
-}
-
-# grabs exception and records it to log before exiting
-# NOTE: we must NOT use the regular (non-overrided) die function in
-# the code because a handler CANNOT be attached to it
-# (despite what some of the documentation says about SIG{__DIE__}.
-sub catchdie {
- my ($message)=@_;
- &logthis("CRITICAL: "
- ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
- ."\_\_DIE\_\_ with this parameter->[$message]");
- die($message);
-}