--- loncom/lond 2000/12/05 20:19:46 1.28
+++ loncom/lond 2000/12/29 21:11:03 1.34
@@ -9,7 +9,7 @@
# 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 Gerd Kortemeyer
+# 12/05,12/13,12/29 Gerd Kortemeyer
#
# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first
@@ -39,22 +39,6 @@ sub catchexception {
die($error);
}
-# 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)=@_;
- $SIG{'QUIT'}='DEFAULT';
- $SIG{__DIE__}='DEFAULT';
- &logthis("CRITICAL: "
- ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
- ."\_\_DIE\_\_ with this error msg->[$message]");
- if ($client) { print $client "error: $message\n"; }
- die($message);
-}
-
# -------------------------------- Set signal handlers to record abnormal exits
$SIG{'QUIT'}=\&catchexception;
@@ -62,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/) {
@@ -82,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);
@@ -107,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
@@ -140,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
}
@@ -290,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
@@ -331,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;
@@ -348,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;
@@ -494,6 +477,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) {
@@ -508,7 +493,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";
@@ -521,6 +506,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/) {