--- loncom/lond 2000/12/05 18:02:14 1.24 +++ loncom/lond 2000/12/13 22:45:56 1.33 @@ -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 @@ -27,23 +29,14 @@ use Authen::Krb4; # grabs exception and records it to log before exiting sub catchexception { - my ($signal)=@_; + my ($error)=@_; + $SIG{'QUIT'}='DEFAULT'; + $SIG{__DIE__}='DEFAULT'; &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); + ."a crash with this error msg->[$error]"); + if ($client) { print $client "error: $error\n"; } + die($error); } # -------------------------------- Set signal handlers to record abnormal exits @@ -53,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/) { @@ -73,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); @@ -98,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 @@ -131,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 } @@ -281,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 @@ -322,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; @@ -339,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; @@ -485,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) { @@ -499,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"; @@ -513,6 +507,64 @@ 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 'none') { + } elsif ($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); @@ -556,6 +608,7 @@ sub make_new_child { "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= @@ -597,8 +650,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;