File:  [LON-CAPA] / loncom / lond
Revision 1.51: download - view: text, annotated - select for diffs
Thu Aug 30 20:02:28 2001 UTC (23 years, 2 months ago) by www
Branches: MAIN
CVS tags: HEAD
Attempting to officially hang up

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: # lond "LON Daemon" Server (port "LOND" 5663)
    4: # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
    5: # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
    6: # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
    7: # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
    8: # 03/07,05/31 Gerd Kortemeyer
    9: # 06/26 Scott Harrison
   10: # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
   11: # 12/05 Scott Harrison
   12: # 12/05,12/13,12/29 Gerd Kortemeyer
   13: # Jan 01 Scott Harrison
   14: # 02/12 Gerd Kortemeyer
   15: # 03/15 Scott Harrison
   16: # 03/24 Gerd Kortemeyer
   17: # 04/02 Scott Harrison
   18: # 05/11,05/28,08/30 Gerd Kortemeyer
   19: #
   20: # based on "Perl Cookbook" ISBN 1-56592-243-3
   21: # preforker - server who forks first
   22: # runs as a daemon
   23: # HUPs
   24: # uses IDEA encryption
   25: 
   26: use IO::Socket;
   27: use IO::File;
   28: use Apache::File;
   29: use Symbol;
   30: use POSIX;
   31: use Crypt::IDEA;
   32: use LWP::UserAgent();
   33: use GDBM_File;
   34: use Authen::Krb4;
   35: use lib '/home/httpd/lib/perl/';
   36: use localauth;
   37: 
   38: # grabs exception and records it to log before exiting
   39: sub catchexception {
   40:     my ($error)=@_;
   41:     $SIG{'QUIT'}='DEFAULT';
   42:     $SIG{__DIE__}='DEFAULT';
   43:     &logthis("<font color=red>CRITICAL: "
   44:      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
   45:      ."a crash with this error msg->[$error]</font>");
   46:     if ($client) { print $client "error: $error\n"; }
   47:     die($error);
   48: }
   49: 
   50: # -------------------------------- Set signal handlers to record abnormal exits
   51: 
   52: $SIG{'QUIT'}=\&catchexception;
   53: $SIG{__DIE__}=\&catchexception;
   54: 
   55: # ------------------------------------ Read httpd access.conf and get variables
   56: 
   57: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
   58: 
   59: while ($configline=<CONFIG>) {
   60:     if ($configline =~ /PerlSetVar/) {
   61: 	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
   62:         chomp($varvalue);
   63:         $perlvar{$varname}=$varvalue;
   64:     }
   65: }
   66: close(CONFIG);
   67: 
   68: # ----------------------------- Make sure this process is running from user=www
   69: my $wwwid=getpwnam('www');
   70: if ($wwwid!=$<) {
   71:    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
   72:    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
   73:    system("echo 'User ID mismatch.  lond must be run as user www.' |\
   74:  mailto $emailto -s '$subj' > /dev/null");
   75:    exit 1;
   76: }
   77: 
   78: # --------------------------------------------- Check if other instance running
   79: 
   80: my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
   81: 
   82: if (-e $pidfile) {
   83:    my $lfh=IO::File->new("$pidfile");
   84:    my $pide=<$lfh>;
   85:    chomp($pide);
   86:    if (kill 0 => $pide) { die "already running"; }
   87: }
   88: 
   89: $PREFORK=4; # number of children to maintain, at least four spare
   90: 
   91: # ------------------------------------------------------------- Read hosts file
   92: 
   93: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
   94: 
   95: while ($configline=<CONFIG>) {
   96:     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
   97:     chomp($ip);
   98:     $hostid{$ip}=$id;
   99:     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
  100:     $PREFORK++;
  101: }
  102: close(CONFIG);
  103: 
  104: # establish SERVER socket, bind and listen.
  105: $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
  106:                                 Type      => SOCK_STREAM,
  107:                                 Proto     => 'tcp',
  108:                                 Reuse     => 1,
  109:                                 Listen    => 10 )
  110:   or die "making socket: $@\n";
  111: 
  112: # --------------------------------------------------------- Do global variables
  113: 
  114: # global variables
  115: 
  116: $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should 
  117:                                     # process
  118: %children               = ();       # keys are current child process IDs
  119: $children               = 0;        # current number of children
  120: 
  121: sub REAPER {                        # takes care of dead children
  122:     $SIG{CHLD} = \&REAPER;
  123:     my $pid = wait;
  124:     $children --;
  125:     &logthis("Child $pid died");
  126:     delete $children{$pid};
  127: }
  128: 
  129: sub HUNTSMAN {                      # signal handler for SIGINT
  130:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
  131:     kill 'INT' => keys %children;
  132:     my $execdir=$perlvar{'lonDaemons'};
  133:     unlink("$execdir/logs/lond.pid");
  134:     &logthis("<font color=red>CRITICAL: Shutting down</font>");
  135:     exit;                           # clean up with dignity
  136: }
  137: 
  138: sub HUPSMAN {                      # signal handler for SIGHUP
  139:     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
  140:     kill 'INT' => keys %children;
  141:     close($server);                # free up socket
  142:     &logthis("<font color=red>CRITICAL: Restarting</font>");
  143:     unlink("$execdir/logs/lond.pid");
  144:     my $execdir=$perlvar{'lonDaemons'};
  145:     exec("$execdir/lond");         # here we go again
  146: }
  147: 
  148: # --------------------------------------------------------------------- Logging
  149: 
  150: sub logthis {
  151:     my $message=shift;
  152:     my $execdir=$perlvar{'lonDaemons'};
  153:     my $fh=IO::File->new(">>$execdir/logs/lond.log");
  154:     my $now=time;
  155:     my $local=localtime($now);
  156:     print $fh "$local ($$): $message\n";
  157: }
  158: 
  159: 
  160: # -------------------------------------------------------- Escape Special Chars
  161: 
  162: sub escape {
  163:     my $str=shift;
  164:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  165:     return $str;
  166: }
  167: 
  168: # ----------------------------------------------------- Un-Escape Special Chars
  169: 
  170: sub unescape {
  171:     my $str=shift;
  172:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  173:     return $str;
  174: }
  175: 
  176: # ----------------------------------------------------------- Send USR1 to lonc
  177: 
  178: sub reconlonc {
  179:     my $peerfile=shift;
  180:     &logthis("Trying to reconnect for $peerfile");
  181:     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
  182:     if (my $fh=IO::File->new("$loncfile")) {
  183: 	my $loncpid=<$fh>;
  184:         chomp($loncpid);
  185:         if (kill 0 => $loncpid) {
  186: 	    &logthis("lonc at pid $loncpid responding, sending USR1");
  187:             kill USR1 => $loncpid;
  188:             sleep 1;
  189:             if (-e "$peerfile") { return; }
  190:             &logthis("$peerfile still not there, give it another try");
  191:             sleep 5;
  192:             if (-e "$peerfile") { return; }
  193:             &logthis(
  194:  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
  195:         } else {
  196: 	    &logthis(
  197:               "<font color=red>CRITICAL: "
  198:              ."lonc at pid $loncpid not responding, giving up</font>");
  199:         }
  200:     } else {
  201:       &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
  202:     }
  203: }
  204: 
  205: # -------------------------------------------------- Non-critical communication
  206: 
  207: sub subreply {
  208:     my ($cmd,$server)=@_;
  209:     my $peerfile="$perlvar{'lonSockDir'}/$server";
  210:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  211:                                       Type    => SOCK_STREAM,
  212:                                       Timeout => 10)
  213:        or return "con_lost";
  214:     print $sclient "$cmd\n";
  215:     my $answer=<$sclient>;
  216:     chomp($answer);
  217:     if (!$answer) { $answer="con_lost"; }
  218:     return $answer;
  219: }
  220: 
  221: sub reply {
  222:   my ($cmd,$server)=@_;
  223:   my $answer;
  224:   if ($server ne $perlvar{'lonHostID'}) { 
  225:     $answer=subreply($cmd,$server);
  226:     if ($answer eq 'con_lost') {
  227: 	$answer=subreply("ping",$server);
  228:         if ($answer ne $server) {
  229:            &reconlonc("$perlvar{'lonSockDir'}/$server");
  230:         }
  231:         $answer=subreply($cmd,$server);
  232:     }
  233:   } else {
  234:     $answer='self_reply';
  235:   } 
  236:   return $answer;
  237: }
  238: 
  239: # -------------------------------------------------------------- Talk to lonsql
  240: 
  241: sub sqlreply {
  242:     my ($cmd)=@_;
  243:     my $answer=subsqlreply($cmd);
  244:     if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); }
  245:     return $answer;
  246: }
  247: 
  248: sub subsqlreply {
  249:     my ($cmd)=@_;
  250:     my $unixsock="mysqlsock";
  251:     my $peerfile="$perlvar{'lonSockDir'}/$unixsock";
  252:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  253:                                       Type    => SOCK_STREAM,
  254:                                       Timeout => 10)
  255:        or return "con_lost";
  256:     print $sclient "$cmd\n";
  257:     my $answer=<$sclient>;
  258:     chomp($answer);
  259:     if (!$answer) { $answer="con_lost"; }
  260:     return $answer;
  261: }
  262: 
  263: # -------------------------------------------- Return path to profile directory
  264: 
  265: sub propath {
  266:     my ($udom,$uname)=@_;
  267:     $udom=~s/\W//g;
  268:     $uname=~s/\W//g;
  269:     my $subdir=$uname.'__';
  270:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  271:     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
  272:     return $proname;
  273: } 
  274: 
  275: # --------------------------------------- Is this the home server of an author?
  276: 
  277: sub ishome {
  278:     my $author=shift;
  279:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  280:     my ($udom,$uname)=split(/\//,$author);
  281:     my $proname=propath($udom,$uname);
  282:     if (-e $proname) {
  283: 	return 'owner';
  284:     } else {
  285:         return 'not_owner';
  286:     }
  287: }
  288: 
  289: # ======================================================= Continue main program
  290: # ---------------------------------------------------- Fork once and dissociate
  291: 
  292: $fpid=fork;
  293: exit if $fpid;
  294: die "Couldn't fork: $!" unless defined ($fpid);
  295: 
  296: POSIX::setsid() or die "Can't start new session: $!";
  297: 
  298: # ------------------------------------------------------- Write our PID on disk
  299: 
  300: $execdir=$perlvar{'lonDaemons'};
  301: open (PIDSAVE,">$execdir/logs/lond.pid");
  302: print PIDSAVE "$$\n";
  303: close(PIDSAVE);
  304: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
  305: 
  306: # ------------------------------------------------------- Now we are on our own
  307:     
  308: # Fork off our children.
  309: for (1 .. $PREFORK) {
  310:     make_new_child();
  311: }
  312: 
  313: # ----------------------------------------------------- Install signal handlers
  314: 
  315: $SIG{CHLD} = \&REAPER;
  316: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
  317: $SIG{HUP}  = \&HUPSMAN;
  318: 
  319: # And maintain the population.
  320: while (1) {
  321:     sleep;                          # wait for a signal (i.e., child's death)
  322:     for ($i = $children; $i < $PREFORK; $i++) {
  323:         make_new_child();           # top up the child pool
  324:     }
  325: }
  326: 
  327: sub make_new_child {
  328:     my $pid;
  329:     my $cipher;
  330:     my $sigset;
  331:     &logthis("Attempting to start child");    
  332:     # block signal for fork
  333:     $sigset = POSIX::SigSet->new(SIGINT);
  334:     sigprocmask(SIG_BLOCK, $sigset)
  335:         or die "Can't block SIGINT for fork: $!\n";
  336:     
  337:     die "fork: $!" unless defined ($pid = fork);
  338:     
  339:     if ($pid) {
  340:         # Parent records the child's birth and returns.
  341:         sigprocmask(SIG_UNBLOCK, $sigset)
  342:             or die "Can't unblock SIGINT for fork: $!\n";
  343:         $children{$pid} = 1;
  344:         $children++;
  345:         return;
  346:     } else {
  347:         # Child can *not* return from this subroutine.
  348:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
  349:     
  350:         # unblock signals
  351:         sigprocmask(SIG_UNBLOCK, $sigset)
  352:             or die "Can't unblock SIGINT for fork: $!\n";
  353: 
  354:         $tmpsnum=0;
  355:     
  356:         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
  357:         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
  358:             $client = $server->accept()     or last;
  359: 
  360: # =============================================================================
  361:             # do something with the connection
  362: # -----------------------------------------------------------------------------
  363:             # see if we know client and check for spoof IP by challenge
  364:             my $caller=getpeername($client);
  365:             my ($port,$iaddr)=unpack_sockaddr_in($caller);
  366:             my $clientip=inet_ntoa($iaddr);
  367:             my $clientrec=($hostid{$clientip} ne undef);
  368:             &logthis(
  369: "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
  370:             );
  371:             my $clientok;
  372:             if ($clientrec) {
  373: 	      my $remotereq=<$client>;
  374:               $remotereq=~s/\W//g;
  375:               if ($remotereq eq 'init') {
  376: 		  my $challenge="$$".time;
  377:                   print $client "$challenge\n";
  378:                   $remotereq=<$client>;
  379:                   $remotereq=~s/\W//g;
  380:                   if ($challenge eq $remotereq) {
  381: 		      $clientok=1;
  382:                       print $client "ok\n";
  383:                   } else {
  384: 		      &logthis(
  385:  "<font color=blue>WARNING: $clientip did not reply challenge</font>");
  386:                       print $client "bye\n";
  387:                   }
  388:               } else {
  389: 		  &logthis(
  390:                     "<font color=blue>WARNING: "
  391:                    ."$clientip failed to initialize: >$remotereq< </font>");
  392: 		  print $client "bye\n";
  393:               }
  394: 	    } else {
  395:               &logthis(
  396:  "<font color=blue>WARNING: Unknown client $clientip</font>");
  397:               print $client "bye\n";
  398:             }
  399:             if ($clientok) {
  400: # ---------------- New known client connecting, could mean machine online again
  401: 	      &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
  402:               &logthis(
  403:        "<font color=green>Established connection: $hostid{$clientip}</font>");
  404: # ------------------------------------------------------------ Process requests
  405:               while (my $userinput=<$client>) {
  406:                 chomp($userinput);
  407:                 my $wasenc=0;
  408: # ------------------------------------------------------------ See if encrypted
  409: 		if ($userinput =~ /^enc/) {
  410: 		  if ($cipher) {
  411:                     my ($cmd,$cmdlength,$encinput)=split(/:/,$userinput);
  412: 		    $userinput='';
  413:                     for (my $encidx=0;$encidx<length($encinput);$encidx+=16) {
  414:                        $userinput.=
  415: 			   $cipher->decrypt(
  416:                             pack("H16",substr($encinput,$encidx,16))
  417:                            );
  418: 		    }
  419: 		    $userinput=substr($userinput,0,$cmdlength);
  420:                     $wasenc=1;
  421: 		  }
  422: 		}
  423: # ------------------------------------------------------------- Normal commands
  424: # ------------------------------------------------------------------------ ping
  425: 		   if ($userinput =~ /^ping/) {
  426:                        print $client "$perlvar{'lonHostID'}\n";
  427: # ------------------------------------------------------------------------ pong
  428: 		   } elsif ($userinput =~ /^pong/) {
  429:                        $reply=reply("ping",$hostid{$clientip});
  430:                        print $client "$perlvar{'lonHostID'}:$reply\n"; 
  431: # ------------------------------------------------------------------------ ekey
  432: 		   } elsif ($userinput =~ /^ekey/) {
  433:                        my $buildkey=time.$$.int(rand 100000);
  434:                        $buildkey=~tr/1-6/A-F/;
  435:                        $buildkey=int(rand 100000).$buildkey.int(rand 100000);
  436:                        my $key=$perlvar{'lonHostID'}.$hostid{$clientip};
  437:                        $key=~tr/a-z/A-Z/;
  438:                        $key=~tr/G-P/0-9/;
  439:                        $key=~tr/Q-Z/0-9/;
  440:                        $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
  441:                        $key=substr($key,0,32);
  442:                        my $cipherkey=pack("H32",$key);
  443:                        $cipher=new IDEA $cipherkey;
  444:                        print $client "$buildkey\n"; 
  445: # ------------------------------------------------------------------------ load
  446: 		   } elsif ($userinput =~ /^load/) {
  447:                        my $loadavg;
  448:                        {
  449:                           my $loadfile=IO::File->new('/proc/loadavg');
  450:                           $loadavg=<$loadfile>;
  451:                        }
  452:                        $loadavg =~ s/\s.*//g;
  453:                        my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
  454: 		       print $client "$loadpercent\n";
  455: # ------------------------------------------------------------------------ auth
  456:                    } elsif ($userinput =~ /^auth/) {
  457: 		     if ($wasenc==1) {
  458:                        my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
  459:                        chomp($upass);
  460:                        $upass=unescape($upass);
  461:                        my $proname=propath($udom,$uname);
  462:                        my $passfilename="$proname/passwd";
  463:                        if (-e $passfilename) {
  464:                           my $pf = IO::File->new($passfilename);
  465:                           my $realpasswd=<$pf>;
  466:                           chomp($realpasswd);
  467:                           my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  468:                           my $pwdcorrect=0;
  469:                           if ($howpwd eq 'internal') {
  470: 			      $pwdcorrect=
  471: 				  (crypt($upass,$contentpwd) eq $contentpwd);
  472:                           } elsif ($howpwd eq 'unix') {
  473:                               $contentpwd=(getpwnam($uname))[1];
  474:                               $pwdcorrect=
  475:                                   (crypt($upass,$contentpwd) eq $contentpwd);
  476:                           } elsif ($howpwd eq 'krb4') {
  477:                               $pwdcorrect=(
  478:                                  Authen::Krb4::get_pw_in_tkt($uname,"",
  479:                                         $contentpwd,'krbtgt',$contentpwd,1,
  480: 							     $upass) == 0);
  481:                           } elsif ($howpwd eq 'localauth') {
  482: 			    $pwdcorrect=&localauth::localauth($uname,$upass,
  483: 							      $contentpwd);
  484: 			  }
  485:                           if ($pwdcorrect) {
  486:                              print $client "authorized\n";
  487:                           } else {
  488:                              print $client "non_authorized\n";
  489:                           }  
  490: 		       } else {
  491:                           print $client "unknown_user\n";
  492:                        }
  493: 		     } else {
  494: 		       print $client "refused\n";
  495: 		     }
  496: # ---------------------------------------------------------------------- passwd
  497:                    } elsif ($userinput =~ /^passwd/) {
  498: 		     if ($wasenc==1) {
  499:                        my 
  500:                        ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
  501:                        chomp($npass);
  502:                        $upass=&unescape($upass);
  503:                        $npass=&unescape($npass);
  504:                        my $proname=propath($udom,$uname);
  505:                        my $passfilename="$proname/passwd";
  506:                        if (-e $passfilename) {
  507: 			   my $realpasswd;
  508:                           { my $pf = IO::File->new($passfilename);
  509: 			    $realpasswd=<$pf>; }
  510:                           chomp($realpasswd);
  511:                           my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  512:                           if ($howpwd eq 'internal') {
  513: 			   if (crypt($upass,$contentpwd) eq $contentpwd) {
  514: 			     my $salt=time;
  515:                              $salt=substr($salt,6,2);
  516: 			     my $ncpass=crypt($npass,$salt);
  517:                              { my $pf = IO::File->new(">$passfilename");
  518:  	  		       print $pf "internal:$ncpass\n"; }             
  519:                              print $client "ok\n";
  520:                            } else {
  521:                              print $client "non_authorized\n";
  522:                            }
  523:                           } else {
  524:                             print $client "auth_mode_error\n";
  525:                           }  
  526: 		       } else {
  527:                           print $client "unknown_user\n";
  528:                        }
  529: 		     } else {
  530: 		       print $client "refused\n";
  531: 		     }
  532: # -------------------------------------------------------------------- makeuser
  533:                    } elsif ($userinput =~ /^makeuser/) {
  534: 		     if ($wasenc==1) {
  535:                        my 
  536:                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
  537:                        chomp($npass);
  538:                        $npass=&unescape($npass);
  539:                        my $proname=propath($udom,$uname);
  540:                        my $passfilename="$proname/passwd";
  541:                        if (-e $passfilename) {
  542: 			   print $client "already_exists\n";
  543:                        } elsif ($udom ne $perlvar{'lonDefDomain'}) {
  544:                            print $client "not_right_domain\n";
  545:                        } else {
  546:                            @fpparts=split(/\//,$proname);
  547:                            $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
  548:                            $fperror='';
  549:                            for ($i=3;$i<=$#fpparts;$i++) {
  550:                                $fpnow.='/'.$fpparts[$i]; 
  551:                                unless (-e $fpnow) {
  552: 				   unless (mkdir($fpnow,0777)) {
  553:                                       $fperror="error:$!\n";
  554:                                    }
  555:                                }
  556:                            }
  557:                            unless ($fperror) {
  558: 			     if ($umode eq 'krb4') {
  559:                                { 
  560:                                  my $pf = IO::File->new(">$passfilename");
  561:  	  		         print $pf "krb4:$npass\n"; 
  562:                                }             
  563:                                print $client "ok\n";
  564:                              } elsif ($umode eq 'internal') {
  565: 			       my $salt=time;
  566:                                $salt=substr($salt,6,2);
  567: 			       my $ncpass=crypt($npass,$salt);
  568:                                { 
  569:                                  my $pf = IO::File->new(">$passfilename");
  570:  	  		         print $pf "internal:$ncpass\n"; 
  571:                                }
  572:                                print $client "ok\n";
  573: 			     } elsif ($umode eq 'localauth') {
  574: 			       {
  575: 				 my $pf = IO::File->new(">$passfilename");
  576:   	  		         print $pf "localauth:$npass\n";
  577: 			       }
  578: 			       print $client "ok\n";
  579:                              } elsif ($umode eq 'none') {
  580:                                { 
  581:                                  my $pf = IO::File->new(">$passfilename");
  582:  	  		         print $pf "none:\n"; 
  583:                                }             
  584:                                print $client "ok\n";
  585:                              } else {
  586:                                print $client "auth_mode_error\n";
  587:                              }  
  588:                            } else {
  589:                                print $client "$fperror\n";
  590:                            }
  591:                        }
  592: 		     } else {
  593: 		       print $client "refused\n";
  594: 		     }
  595: # ------------------------------------------------------------------------ home
  596:                    } elsif ($userinput =~ /^home/) {
  597:                        my ($cmd,$udom,$uname)=split(/:/,$userinput);
  598:                        chomp($uname);
  599:                        my $proname=propath($udom,$uname);
  600:                        if (-e $proname) {
  601:                           print $client "found\n";
  602:                        } else {
  603: 			  print $client "not_found\n";
  604:                        }
  605: # ---------------------------------------------------------------------- update
  606:                    } elsif ($userinput =~ /^update/) {
  607:                        my ($cmd,$fname)=split(/:/,$userinput);
  608:                        my $ownership=ishome($fname);
  609:                        if ($ownership eq 'not_owner') {
  610:                         if (-e $fname) {
  611:                           my ($dev,$ino,$mode,$nlink,
  612:                               $uid,$gid,$rdev,$size,
  613:                               $atime,$mtime,$ctime,
  614:                               $blksize,$blocks)=stat($fname);
  615:                           $now=time;
  616:                           $since=$now-$atime;
  617:                           if ($since>$perlvar{'lonExpire'}) {
  618:                               $reply=
  619:                                     reply("unsub:$fname","$hostid{$clientip}");
  620:                               unlink("$fname");
  621:                           } else {
  622: 			     my $transname="$fname.in.transfer";
  623:                              my $remoteurl=
  624:                                     reply("sub:$fname","$hostid{$clientip}");
  625:                              my $response;
  626:                               {
  627:                              my $ua=new LWP::UserAgent;
  628:                              my $request=new HTTP::Request('GET',"$remoteurl");
  629:                              $response=$ua->request($request,$transname);
  630: 			      }
  631:                              if ($response->is_error()) {
  632: 				 unlink($transname);
  633:                                  my $message=$response->status_line;
  634:                                  &logthis(
  635:                                   "LWP GET: $message for $fname ($remoteurl)");
  636:                              } else {
  637: 	                         if ($remoteurl!~/\.meta$/) {
  638:                                   my $ua=new LWP::UserAgent;
  639:                                   my $mrequest=
  640:                                    new HTTP::Request('GET',$remoteurl.'.meta');
  641:                                   my $mresponse=
  642:                                    $ua->request($mrequest,$fname.'.meta');
  643:                                   if ($mresponse->is_error()) {
  644: 		                    unlink($fname.'.meta');
  645:                                   }
  646: 	                         }
  647:                                  rename($transname,$fname);
  648: 			     }
  649:                           }
  650:                           print $client "ok\n";
  651:                         } else {
  652:                           print $client "not_found\n";
  653:                         }
  654: 		       } else {
  655: 			print $client "rejected\n";
  656:                        }
  657: # ----------------------------------------------------------------- unsubscribe
  658:                    } elsif ($userinput =~ /^unsub/) {
  659:                        my ($cmd,$fname)=split(/:/,$userinput);
  660:                        if (-e $fname) {
  661:                            if (unlink("$fname.$hostid{$clientip}")) {
  662:                               print $client "ok\n";
  663: 			   } else {
  664:                               print $client "not_subscribed\n";
  665: 			   }
  666:                        } else {
  667: 			   print $client "not_found\n";
  668:                        }
  669: # ------------------------------------------------------------------- subscribe
  670:                    } elsif ($userinput =~ /^sub/) {
  671:                        my ($cmd,$fname)=split(/:/,$userinput);
  672:                        my $ownership=ishome($fname);
  673:                        if ($ownership eq 'owner') {
  674:                         if (-e $fname) {
  675: 			 if (-d $fname) {
  676: 			   print $client "directory\n";
  677:                          } else {
  678:                            $now=time;
  679:                            { 
  680: 			    my $sh;
  681:                             if ($sh=
  682:                              IO::File->new(">$fname.$hostid{$clientip}")) {
  683:                                print $sh "$clientip:$now\n";
  684: 			    }
  685: 			   }
  686:                            unless ($fname=~/\.meta$/) {
  687: 			       unlink("$fname.meta.$hostid{$clientip}");
  688:                            }
  689:                            $fname=~s/\/home\/httpd\/html\/res/raw/;
  690:                            $fname="http://$thisserver/".$fname;
  691:                            print $client "$fname\n";
  692: 		         }
  693:                         } else {
  694: 		      	   print $client "not_found\n";
  695:                         }
  696: 		       } else {
  697:                         print $client "rejected\n";
  698: 		       }
  699: # ------------------------------------------------------------------------- log
  700:                    } elsif ($userinput =~ /^log/) {
  701:                        my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
  702:                        chomp($what);
  703:                        my $proname=propath($udom,$uname);
  704:                        my $now=time;
  705:                        {
  706: 			 my $hfh;
  707: 			 if ($hfh=IO::File->new(">>$proname/activity.log")) { 
  708:                             print $hfh "$now:$hostid{$clientip}:$what\n";
  709:                             print $client "ok\n"; 
  710: 			} else {
  711:                             print $client "error:$!\n";
  712: 		        }
  713: 		       }
  714: # ------------------------------------------------------------------------- put
  715:                    } elsif ($userinput =~ /^put/) {
  716:                       my ($cmd,$udom,$uname,$namespace,$what)
  717:                           =split(/:/,$userinput);
  718:                       $namespace=~s/\//\_/g;
  719:                       $namespace=~s/\W//g;
  720:                       if ($namespace ne 'roles') {
  721:                        chomp($what);
  722:                        my $proname=propath($udom,$uname);
  723:                        my $now=time;
  724:                        unless ($namespace=~/^nohist\_/) {
  725: 			   my $hfh;
  726: 			   if (
  727:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
  728: 			       ) { print $hfh "P:$now:$what\n"; }
  729: 		       }
  730:                        my @pairs=split(/\&/,$what);
  731:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
  732:                            foreach $pair (@pairs) {
  733: 			       ($key,$value)=split(/=/,$pair);
  734:                                $hash{$key}=$value;
  735:                            }
  736: 			   if (untie(%hash)) {
  737:                               print $client "ok\n";
  738:                            } else {
  739:                               print $client "error:$!\n";
  740:                            }
  741:                        } else {
  742:                            print $client "error:$!\n";
  743:                        }
  744: 		      } else {
  745:                           print $client "refused\n";
  746:                       }
  747: # -------------------------------------------------------------------- rolesput
  748:                    } elsif ($userinput =~ /^rolesput/) {
  749: 		    if ($wasenc==1) {
  750:                        my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
  751:                           =split(/:/,$userinput);
  752:                        my $namespace='roles';
  753:                        chomp($what);
  754:                        my $proname=propath($udom,$uname);
  755:                        my $now=time;
  756:                        {
  757: 			   my $hfh;
  758: 			   if (
  759:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
  760: 			       ) { 
  761:                                   print $hfh "P:$now:$exedom:$exeuser:$what\n";
  762:                                  }
  763: 		       }
  764:                        my @pairs=split(/\&/,$what);
  765:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
  766:                            foreach $pair (@pairs) {
  767: 			       ($key,$value)=split(/=/,$pair);
  768:                                $hash{$key}=$value;
  769:                            }
  770: 			   if (untie(%hash)) {
  771:                               print $client "ok\n";
  772:                            } else {
  773:                               print $client "error:$!\n";
  774:                            }
  775:                        } else {
  776:                            print $client "error:$!\n";
  777:                        }
  778: 		      } else {
  779:                           print $client "refused\n";
  780:                       }
  781: # ------------------------------------------------------------------------- get
  782:                    } elsif ($userinput =~ /^get/) {
  783:                        my ($cmd,$udom,$uname,$namespace,$what)
  784:                           =split(/:/,$userinput);
  785:                        $namespace=~s/\//\_/g;
  786:                        $namespace=~s/\W//g;
  787:                        chomp($what);
  788:                        my @queries=split(/\&/,$what);
  789:                        my $proname=propath($udom,$uname);
  790:                        my $qresult='';
  791:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
  792:                            for ($i=0;$i<=$#queries;$i++) {
  793:                                $qresult.="$hash{$queries[$i]}&";
  794:                            }
  795: 			   if (untie(%hash)) {
  796: 		              $qresult=~s/\&$//;
  797:                               print $client "$qresult\n";
  798:                            } else {
  799:                               print $client "error:$!\n";
  800:                            }
  801:                        } else {
  802:                            print $client "error:$!\n";
  803:                        }
  804: # ------------------------------------------------------------------------ eget
  805:                    } elsif ($userinput =~ /^eget/) {
  806:                        my ($cmd,$udom,$uname,$namespace,$what)
  807:                           =split(/:/,$userinput);
  808:                        $namespace=~s/\//\_/g;
  809:                        $namespace=~s/\W//g;
  810:                        chomp($what);
  811:                        my @queries=split(/\&/,$what);
  812:                        my $proname=propath($udom,$uname);
  813:                        my $qresult='';
  814:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
  815:                            for ($i=0;$i<=$#queries;$i++) {
  816:                                $qresult.="$hash{$queries[$i]}&";
  817:                            }
  818: 			   if (untie(%hash)) {
  819: 		              $qresult=~s/\&$//;
  820:                               if ($cipher) {
  821:                                 my $cmdlength=length($qresult);
  822:                                 $qresult.="         ";
  823:                                 my $encqresult='';
  824:                                 for 
  825: 				(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
  826:                                  $encqresult.=
  827:                                  unpack("H16",
  828:                                  $cipher->encrypt(substr($qresult,$encidx,8)));
  829:                                 }
  830:                                 print $client "enc:$cmdlength:$encqresult\n";
  831: 			      } else {
  832: 			        print $client "error:no_key\n";
  833:                               }
  834:                            } else {
  835:                               print $client "error:$!\n";
  836:                            }
  837:                        } else {
  838:                            print $client "error:$!\n";
  839:                        }
  840: # ------------------------------------------------------------------------- del
  841:                    } elsif ($userinput =~ /^del/) {
  842:                        my ($cmd,$udom,$uname,$namespace,$what)
  843:                           =split(/:/,$userinput);
  844:                        $namespace=~s/\//\_/g;
  845:                        $namespace=~s/\W//g;
  846:                        chomp($what);
  847:                        my $proname=propath($udom,$uname);
  848:                        my $now=time;
  849:                        unless ($namespace=~/^nohist\_/) {
  850: 			   my $hfh;
  851: 			   if (
  852:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
  853: 			       ) { print $hfh "D:$now:$what\n"; }
  854: 		       }
  855:                        my @keys=split(/\&/,$what);
  856:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
  857:                            foreach $key (@keys) {
  858:                                delete($hash{$key});
  859:                            }
  860: 			   if (untie(%hash)) {
  861:                               print $client "ok\n";
  862:                            } else {
  863:                               print $client "error:$!\n";
  864:                            }
  865:                        } else {
  866:                            print $client "error:$!\n";
  867:                        }
  868: # ------------------------------------------------------------------------ keys
  869:                    } elsif ($userinput =~ /^keys/) {
  870:                        my ($cmd,$udom,$uname,$namespace)
  871:                           =split(/:/,$userinput);
  872:                        $namespace=~s/\//\_/g;
  873:                        $namespace=~s/\W//g;
  874:                        my $proname=propath($udom,$uname);
  875:                        my $qresult='';
  876:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
  877:                            foreach $key (keys %hash) {
  878:                                $qresult.="$key&";
  879:                            }
  880: 			   if (untie(%hash)) {
  881: 		              $qresult=~s/\&$//;
  882:                               print $client "$qresult\n";
  883:                            } else {
  884:                               print $client "error:$!\n";
  885:                            }
  886:                        } else {
  887:                            print $client "error:$!\n";
  888:                        }
  889: # ------------------------------------------------------------------------ dump
  890:                    } elsif ($userinput =~ /^dump/) {
  891:                        my ($cmd,$udom,$uname,$namespace)
  892:                           =split(/:/,$userinput);
  893:                        $namespace=~s/\//\_/g;
  894:                        $namespace=~s/\W//g;
  895:                        my $proname=propath($udom,$uname);
  896:                        my $qresult='';
  897:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
  898:                            foreach $key (keys %hash) {
  899:                                $qresult.="$key=$hash{$key}&";
  900:                            }
  901: 			   if (untie(%hash)) {
  902: 		              $qresult=~s/\&$//;
  903:                               print $client "$qresult\n";
  904:                            } else {
  905:                               print $client "error:$!\n";
  906:                            }
  907:                        } else {
  908:                            print $client "error:$!\n";
  909:                        }
  910: # ----------------------------------------------------------------------- store
  911:                    } elsif ($userinput =~ /^store/) {
  912:                       my ($cmd,$udom,$uname,$namespace,$rid,$what)
  913:                           =split(/:/,$userinput);
  914:                       $namespace=~s/\//\_/g;
  915:                       $namespace=~s/\W//g;
  916:                       if ($namespace ne 'roles') {
  917:                        chomp($what);
  918:                        my $proname=propath($udom,$uname);
  919:                        my $now=time;
  920:                        unless ($namespace=~/^nohist\_/) {
  921: 			   my $hfh;
  922: 			   if (
  923:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
  924: 			       ) { print $hfh "P:$now:$rid:$what\n"; }
  925: 		       }
  926:                        my @pairs=split(/\&/,$what);
  927:                          
  928:     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
  929:                            my @previouskeys=split(/&/,$hash{"keys:$rid"});
  930:                            my $key;
  931:                            $hash{"version:$rid"}++;
  932:                            my $version=$hash{"version:$rid"};
  933:                            my $allkeys=''; 
  934:                            foreach $pair (@pairs) {
  935: 			       ($key,$value)=split(/=/,$pair);
  936:                                $allkeys.=$key.':';
  937:                                $hash{"$version:$rid:$key"}=$value;
  938:                            }
  939:                            $hash{"$version:$rid:timestamp"}=$now;
  940:                            $allkeys.='timestamp';
  941:                            $hash{"$version:keys:$rid"}=$allkeys;
  942: 			   if (untie(%hash)) {
  943:                               print $client "ok\n";
  944:                            } else {
  945:                               print $client "error:$!\n";
  946:                            }
  947:                        } else {
  948:                            print $client "error:$!\n";
  949:                        }
  950: 		      } else {
  951:                           print $client "refused\n";
  952:                       }
  953: # --------------------------------------------------------------------- restore
  954:                    } elsif ($userinput =~ /^restore/) {
  955:                        my ($cmd,$udom,$uname,$namespace,$rid)
  956:                           =split(/:/,$userinput);
  957:                        $namespace=~s/\//\_/g;
  958:                        $namespace=~s/\W//g;
  959:                        chomp($rid);
  960:                        my $proname=propath($udom,$uname);
  961:                        my $qresult='';
  962:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
  963:                 	   my $version=$hash{"version:$rid"};
  964:                            $qresult.="version=$version&";
  965:                            my $scope;
  966:                            for ($scope=1;$scope<=$version;$scope++) {
  967: 			      my $vkeys=$hash{"$scope:keys:$rid"};
  968:                               my @keys=split(/:/,$vkeys);
  969:                               my $key;
  970:                               $qresult.="$scope:keys=$vkeys&";
  971:                               foreach $key (@keys) {
  972: 	     $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
  973:                               }                                  
  974:                            }
  975: 			   if (untie(%hash)) {
  976: 		              $qresult=~s/\&$//;
  977:                               print $client "$qresult\n";
  978:                            } else {
  979:                               print $client "error:$!\n";
  980:                            }
  981:                        } else {
  982:                            print $client "error:$!\n";
  983:                        }
  984: # ------------------------------------------------------------------- querysend
  985:                    } elsif ($userinput =~ /^querysend/) {
  986:                        my ($cmd,$query,
  987: 			   $custom,$customshow)=split(/:/,$userinput);
  988: 		       $query=~s/\n*$//g;
  989: 		       unless ($custom or $customshow) {
  990: 			   print $client "".
  991: 			       sqlreply("$hostid{$clientip}\&$query")."\n";
  992: 		       }
  993: 		       else {
  994: 			   print $client "".
  995: 			       sqlreply("$hostid{$clientip}\&$query".
  996: 					"\&$custom"."\&$customshow")."\n";
  997: 		       }
  998: # ------------------------------------------------------------------ queryreply
  999:                    } elsif ($userinput =~ /^queryreply/) {
 1000:                        my ($cmd,$id,$reply)=split(/:/,$userinput); 
 1001: 		       my $store;
 1002:                        my $execdir=$perlvar{'lonDaemons'};
 1003:                        if ($store=IO::File->new(">$execdir/tmp/$id")) {
 1004: 			   $reply=~s/\&/\n/g;
 1005: 			   print $store $reply;
 1006: 			   close $store;
 1007: 			   my $store2=IO::File->new(">$execdir/tmp/$id.end");
 1008: 			   print $store2 "done\n";
 1009: 			   close $store2;
 1010: 			   print $client "ok\n";
 1011: 		       }
 1012: 		       else {
 1013: 			   print $client "error:$!\n";
 1014: 		       }
 1015: # ----------------------------------------------------------------------- idput
 1016:                    } elsif ($userinput =~ /^idput/) {
 1017:                        my ($cmd,$udom,$what)=split(/:/,$userinput);
 1018:                        chomp($what);
 1019:                        $udom=~s/\W//g;
 1020:                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
 1021:                        my $now=time;
 1022:                        {
 1023: 			   my $hfh;
 1024: 			   if (
 1025:                              $hfh=IO::File->new(">>$proname.hist")
 1026: 			       ) { print $hfh "P:$now:$what\n"; }
 1027: 		       }
 1028:                        my @pairs=split(/\&/,$what);
 1029:                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
 1030:                            foreach $pair (@pairs) {
 1031: 			       ($key,$value)=split(/=/,$pair);
 1032:                                $hash{$key}=$value;
 1033:                            }
 1034: 			   if (untie(%hash)) {
 1035:                               print $client "ok\n";
 1036:                            } else {
 1037:                               print $client "error:$!\n";
 1038:                            }
 1039:                        } else {
 1040:                            print $client "error:$!\n";
 1041:                        }
 1042: # ----------------------------------------------------------------------- idget
 1043:                    } elsif ($userinput =~ /^idget/) {
 1044:                        my ($cmd,$udom,$what)=split(/:/,$userinput);
 1045:                        chomp($what);
 1046:                        $udom=~s/\W//g;
 1047:                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
 1048:                        my @queries=split(/\&/,$what);
 1049:                        my $qresult='';
 1050:                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) {
 1051:                            for ($i=0;$i<=$#queries;$i++) {
 1052:                                $qresult.="$hash{$queries[$i]}&";
 1053:                            }
 1054: 			   if (untie(%hash)) {
 1055: 		              $qresult=~s/\&$//;
 1056:                               print $client "$qresult\n";
 1057:                            } else {
 1058:                               print $client "error:$!\n";
 1059:                            }
 1060:                        } else {
 1061:                            print $client "error:$!\n";
 1062:                        }
 1063: # ---------------------------------------------------------------------- tmpput
 1064:                    } elsif ($userinput =~ /^tmpput/) {
 1065:                        my ($cmd,$what)=split(/:/,$userinput);
 1066: 		       my $store;
 1067:                        $tmpsnum++;
 1068:                        my $id=$$.'_'.$clientip.'_'.$tmpsnum;
 1069:                        $id=~s/\W/\_/g;
 1070:                        $what=~s/\n//g;
 1071:                        my $execdir=$perlvar{'lonDaemons'};
 1072:                        if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
 1073: 			   print $store $what;
 1074: 			   close $store;
 1075: 			   print $client "$id\n";
 1076: 		       }
 1077: 		       else {
 1078: 			   print $client "error:$!\n";
 1079: 		       }
 1080: 
 1081: # ---------------------------------------------------------------------- tmpget
 1082:                    } elsif ($userinput =~ /^tmpget/) {
 1083:                        my ($cmd,$id)=split(/:/,$userinput);
 1084:                        chomp($id);
 1085:                        $id=~s/\W/\_/g;
 1086:                        my $store;
 1087:                        my $execdir=$perlvar{'lonDaemons'};
 1088:                        if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
 1089:                            my $reply=<$store>;
 1090: 			   print $client "$reply\n";
 1091:                            close $store;
 1092: 		       }
 1093: 		       else {
 1094: 			   print $client "error:$!\n";
 1095: 		       }
 1096: 
 1097: # -------------------------------------------------------------------------- ls
 1098:                    } elsif ($userinput =~ /^ls/) {
 1099:                        my ($cmd,$ulsdir)=split(/:/,$userinput);
 1100:                        my $ulsout='';
 1101:                        my $ulsfn;
 1102:                        if (-e $ulsdir) {
 1103: 			if (opendir(LSDIR,$ulsdir)) {
 1104:                           while ($ulsfn=readdir(LSDIR)) {
 1105: 			     my @ulsstats=stat($ulsdir.'/'.$ulsfn);
 1106:                              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
 1107:                           }
 1108:                           closedir(LSDIR);
 1109: 		        }
 1110: 		       } else {
 1111:                           $ulsout='no_such_dir';
 1112:                        }
 1113:                        if ($ulsout eq '') { $ulsout='empty'; }
 1114:                        print $client "$ulsout\n";
 1115: # ------------------------------------------------------------------ Hanging up
 1116:                    } elsif (($userinput =~ /^exit/) ||
 1117:                             ($userinput =~ /^init/)) {
 1118:                        &logthis(
 1119:       "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
 1120:                        print $client "bye\n";
 1121: 		       last;
 1122: # ------------------------------------------------------------- unknown command
 1123:                    } else {
 1124:                        # unknown command
 1125:                        print $client "unknown_cmd\n";
 1126:                    }
 1127: # ------------------------------------------------------ client unknown, refuse
 1128: 	       }
 1129:             } else {
 1130: 	        print $client "refused\n";
 1131:                 &logthis("<font color=blue>WARNING: "
 1132:                 ."Rejected client $clientip, closing connection</font>");
 1133:             }              
 1134:             &logthis("<font color=red>CRITICAL: "
 1135:                     ."Disconnect from $clientip ($hostid{$clientip})</font>");
 1136: # =============================================================================
 1137:         }
 1138:     
 1139:         # tidy up gracefully and finish
 1140:     
 1141:         # this exit is VERY important, otherwise the child will become
 1142:         # a producer of more and more children, forking yourself into
 1143:         # process death.
 1144:         exit;
 1145:     }
 1146: }
 1147: 
 1148: 
 1149: 
 1150: 
 1151: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>