--- loncom/lond 2000/12/05 03:24:48 1.22 +++ loncom/lond 2001/02/12 18:21:47 1.36 @@ -8,6 +8,10 @@ # 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,12/29 Gerd Kortemeyer +# Jan 01 Scott Harrison +# 02/12 Gerd Kortemeyer # # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first @@ -25,6 +29,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 +48,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/) { @@ -44,6 +59,16 @@ 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. loncron 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"; @@ -52,15 +77,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 +101,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 +134,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 +285,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 +326,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 +343,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; @@ -464,6 +489,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) { @@ -478,7 +505,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 +519,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); @@ -529,12 +613,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 +661,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; @@ -829,7 +917,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"; @@ -1014,26 +1103,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); -}