--- loncom/lond	2000/09/25 20:22:58	1.21
+++ 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,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("<font color=red>CRITICAL: "
+     ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+     ."a crash with this error msg->[$error]</font>");
+    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";
@@ -103,6 +122,7 @@ sub HUPSMAN {                      # sig
     kill 'INT' => keys %children;
     close($server);                # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");
+    unlink("$execdir/logs/lond.pid");
     my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lond");         # here we go again
 }
@@ -471,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";
@@ -485,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);
@@ -522,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=
@@ -569,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;