File:  [LON-CAPA] / loncom / lond
Revision 1.77: download - view: text, annotated - select for diffs
Sat Apr 27 13:10:47 2002 UTC (22 years, 6 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Hid all the
if($DEBUG) {
   &logthis(text)
}
Behind a sub Debug... should have done this a >long< time ago.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: # lond "LON Daemon" Server (port "LOND" 5663)
    4: #
    5: # $Id: lond,v 1.77 2002/04/27 13:10:47 foxr Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
   30: # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
   31: # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
   32: # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
   33: # 03/07,05/31 Gerd Kortemeyer
   34: # 06/26 Scott Harrison
   35: # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
   36: # 12/05 Scott Harrison
   37: # 12/05,12/13,12/29 Gerd Kortemeyer
   38: # YEAR=2001
   39: # Jan 01 Scott Harrison
   40: # 02/12 Gerd Kortemeyer
   41: # 03/15 Scott Harrison
   42: # 03/24 Gerd Kortemeyer
   43: # 04/02 Scott Harrison
   44: # 05/11,05/28,08/30 Gerd Kortemeyer
   45: # 9/30,10/22,11/13,11/15,11/16 Scott Harrison
   46: # 11/26,11/27 Gerd Kortemeyer
   47: # 12/20 Scott Harrison
   48: # 12/22 Gerd Kortemeyer
   49: # YEAR=2002
   50: # 01/20/02,02/05 Gerd Kortemeyer
   51: # 02/05 Guy Albertelli
   52: # 02/07 Scott Harrison
   53: # 02/12 Gerd Kortemeyer
   54: # 02/19 Matthew Hall
   55: # 02/25 Gerd Kortemeyer
   56: ###
   57: 
   58: # based on "Perl Cookbook" ISBN 1-56592-243-3
   59: # preforker - server who forks first
   60: # runs as a daemon
   61: # HUPs
   62: # uses IDEA encryption
   63: 
   64: use IO::Socket;
   65: use IO::File;
   66: use Apache::File;
   67: use Symbol;
   68: use POSIX;
   69: use Crypt::IDEA;
   70: use LWP::UserAgent();
   71: use GDBM_File;
   72: use Authen::Krb4;
   73: use lib '/home/httpd/lib/perl/';
   74: use localauth;
   75: 
   76: my $DEBUG = 0;		       # Non zero to enable debug log entries.
   77: 
   78: my $status='';
   79: my $lastlog='';
   80: 
   81: # grabs exception and records it to log before exiting
   82: sub catchexception {
   83:     my ($error)=@_;
   84:     $SIG{'QUIT'}='DEFAULT';
   85:     $SIG{__DIE__}='DEFAULT';
   86:     &logthis("<font color=red>CRITICAL: "
   87:      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
   88:      ."a crash with this error msg->[$error]</font>");
   89:     &logthis('Famous last words: '.$status.' - '.$lastlog);
   90:     if ($client) { print $client "error: $error\n"; }
   91:     $server->close();
   92:     die($error);
   93: }
   94: 
   95: sub timeout {
   96:     &logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>");
   97:     &catchexception('Timeout');
   98: }
   99: # -------------------------------- Set signal handlers to record abnormal exits
  100: 
  101: $SIG{'QUIT'}=\&catchexception;
  102: $SIG{__DIE__}=\&catchexception;
  103: 
  104: # ------------------------------------ Read httpd access.conf and get variables
  105: 
  106: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
  107: 
  108: while ($configline=<CONFIG>) {
  109:     if ($configline =~ /PerlSetVar/) {
  110: 	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
  111:         chomp($varvalue);
  112:         $perlvar{$varname}=$varvalue;
  113:     }
  114: }
  115: close(CONFIG);
  116: 
  117: # ----------------------------- Make sure this process is running from user=www
  118: my $wwwid=getpwnam('www');
  119: if ($wwwid!=$<) {
  120:    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  121:    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
  122:    system("echo 'User ID mismatch.  lond must be run as user www.' |\
  123:  mailto $emailto -s '$subj' > /dev/null");
  124:    exit 1;
  125: }
  126: 
  127: # --------------------------------------------- Check if other instance running
  128: 
  129: my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
  130: 
  131: if (-e $pidfile) {
  132:    my $lfh=IO::File->new("$pidfile");
  133:    my $pide=<$lfh>;
  134:    chomp($pide);
  135:    if (kill 0 => $pide) { die "already running"; }
  136: }
  137: 
  138: $PREFORK=4; # number of children to maintain, at least four spare
  139: 
  140: # ------------------------------------------------------------- Read hosts file
  141: 
  142: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
  143: 
  144: while ($configline=<CONFIG>) {
  145:     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  146:     chomp($ip); $ip=~s/\D+$//;
  147:     $hostid{$ip}=$id;
  148:     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
  149:     $PREFORK++;
  150: }
  151: close(CONFIG);
  152: 
  153: # establish SERVER socket, bind and listen.
  154: $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
  155:                                 Type      => SOCK_STREAM,
  156:                                 Proto     => 'tcp',
  157:                                 Reuse     => 1,
  158:                                 Listen    => 10 )
  159:   or die "making socket: $@\n";
  160: 
  161: # --------------------------------------------------------- Do global variables
  162: 
  163: # global variables
  164: 
  165: $MAX_CLIENTS_PER_CHILD  = 50;        # number of clients each child should 
  166:                                     # process
  167: %children               = ();       # keys are current child process IDs
  168: $children               = 0;        # current number of children
  169: 
  170: sub REAPER {                        # takes care of dead children
  171:     $SIG{CHLD} = \&REAPER;
  172:     my $pid = wait;
  173:     if (defined($children{$pid})) {
  174: 	&logthis("Child $pid died");
  175: 	$children --;
  176: 	delete $children{$pid};
  177:     } else {
  178: 	&logthis("Unknown Child $pid died");
  179:     }
  180: }
  181: 
  182: sub HUNTSMAN {                      # signal handler for SIGINT
  183:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
  184:     kill 'INT' => keys %children;
  185:     &logthis("Free socket: ".shutdown($server,2)); # free up socket
  186:     my $execdir=$perlvar{'lonDaemons'};
  187:     unlink("$execdir/logs/lond.pid");
  188:     &logthis("<font color=red>CRITICAL: Shutting down</font>");
  189:     exit;                           # clean up with dignity
  190: }
  191: 
  192: sub HUPSMAN {                      # signal handler for SIGHUP
  193:     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
  194:     kill 'INT' => keys %children;
  195:     &logthis("Free socket: ".shutdown($server,2)); # free up socket
  196:     &logthis("<font color=red>CRITICAL: Restarting</font>");
  197:     unlink("$execdir/logs/lond.pid");
  198:     my $execdir=$perlvar{'lonDaemons'};
  199:     exec("$execdir/lond");         # here we go again
  200: }
  201: 
  202: sub checkchildren {
  203:     &initnewstatus();
  204:     &logstatus();
  205:     &logthis('Going to check on the children');
  206:     $docdir=$perlvar{'lonDocRoot'};
  207:     foreach (sort keys %children) {
  208: 	sleep 1;
  209:         unless (kill 'USR1' => $_) {
  210: 	    &logthis ('Child '.$_.' is dead');
  211:             &logstatus($$.' is dead');
  212:         } 
  213:     }
  214:     sleep 5;
  215:     foreach (sort keys %children) {
  216:         unless (-e "$docdir/lon-status/londchld/$_.txt") {
  217: 	    &logthis('Child '.$_.' did not respond');
  218: 	    kill 9 => $_;
  219: 	    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  220: 	    $subj="LON: $perlvar{'lonHostID'} killed lond process $_";
  221: 	    my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
  222: 	    $execdir=$perlvar{'lonDaemons'};
  223: 	    $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`
  224:         }
  225:     }
  226: }
  227: 
  228: # --------------------------------------------------------------------- Logging
  229: 
  230: sub logthis {
  231:     my $message=shift;
  232:     my $execdir=$perlvar{'lonDaemons'};
  233:     my $fh=IO::File->new(">>$execdir/logs/lond.log");
  234:     my $now=time;
  235:     my $local=localtime($now);
  236:     $lastlog=$local.': '.$message;
  237:     print $fh "$local ($$): $message\n";
  238: }
  239: 
  240: # ------------------------- Conditional log if $DEBUG true.
  241: sub Debug {
  242:     my $message = shift;
  243:     if($DEBUG) {
  244: 	&logthis($message);
  245:     }
  246: }
  247: # ------------------------------------------------------------------ Log status
  248: 
  249: sub logstatus {
  250:     my $docdir=$perlvar{'lonDocRoot'};
  251:     {
  252:     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
  253:     print $fh $$."\t".$status."\t".$lastlog."\n";
  254:     $fh->close();
  255:     }
  256:     {
  257: 	my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");
  258:         print $fh $status."\n".$lastlog."\n".time;
  259:         $fh->close();
  260:     }
  261: }
  262: 
  263: sub initnewstatus {
  264:     my $docdir=$perlvar{'lonDocRoot'};
  265:     my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
  266:     my $now=time;
  267:     my $local=localtime($now);
  268:     print $fh "LOND status $local - parent $$\n\n";
  269:     opendir(DIR,"$docdir/lon-status/londchld");
  270:     while ($filename=readdir(DIR)) {
  271:         unlink("$docdir/lon-status/londchld/$filename");
  272:     }
  273:     closedir(DIR);
  274: }
  275: 
  276: # -------------------------------------------------------------- Status setting
  277: 
  278: sub status {
  279:     my $what=shift;
  280:     my $now=time;
  281:     my $local=localtime($now);
  282:     $status=$local.': '.$what;
  283: }
  284: 
  285: # -------------------------------------------------------- Escape Special Chars
  286: 
  287: sub escape {
  288:     my $str=shift;
  289:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  290:     return $str;
  291: }
  292: 
  293: # ----------------------------------------------------- Un-Escape Special Chars
  294: 
  295: sub unescape {
  296:     my $str=shift;
  297:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  298:     return $str;
  299: }
  300: 
  301: # ----------------------------------------------------------- Send USR1 to lonc
  302: 
  303: sub reconlonc {
  304:     my $peerfile=shift;
  305:     &logthis("Trying to reconnect for $peerfile");
  306:     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
  307:     if (my $fh=IO::File->new("$loncfile")) {
  308: 	my $loncpid=<$fh>;
  309:         chomp($loncpid);
  310:         if (kill 0 => $loncpid) {
  311: 	    &logthis("lonc at pid $loncpid responding, sending USR1");
  312:             kill USR1 => $loncpid;
  313:             sleep 5;
  314:             if (-e "$peerfile") { return; }
  315:             &logthis("$peerfile still not there, give it another try");
  316:             sleep 10;
  317:             if (-e "$peerfile") { return; }
  318:             &logthis(
  319:  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
  320:         } else {
  321: 	    &logthis(
  322:               "<font color=red>CRITICAL: "
  323:              ."lonc at pid $loncpid not responding, giving up</font>");
  324:         }
  325:     } else {
  326:       &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
  327:     }
  328: }
  329: 
  330: # -------------------------------------------------- Non-critical communication
  331: 
  332: sub subreply {
  333:     my ($cmd,$server)=@_;
  334:     my $peerfile="$perlvar{'lonSockDir'}/$server";
  335:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  336:                                       Type    => SOCK_STREAM,
  337:                                       Timeout => 10)
  338:        or return "con_lost";
  339:     print $sclient "$cmd\n";
  340:     my $answer=<$sclient>;
  341:     chomp($answer);
  342:     if (!$answer) { $answer="con_lost"; }
  343:     return $answer;
  344: }
  345: 
  346: sub reply {
  347:   my ($cmd,$server)=@_;
  348:   my $answer;
  349:   if ($server ne $perlvar{'lonHostID'}) { 
  350:     $answer=subreply($cmd,$server);
  351:     if ($answer eq 'con_lost') {
  352: 	$answer=subreply("ping",$server);
  353:         if ($answer ne $server) {
  354: 	    &logthis("sub reply: answer != server");
  355:            &reconlonc("$perlvar{'lonSockDir'}/$server");
  356:         }
  357:         $answer=subreply($cmd,$server);
  358:     }
  359:   } else {
  360:     $answer='self_reply';
  361:   } 
  362:   return $answer;
  363: }
  364: 
  365: # -------------------------------------------------------------- Talk to lonsql
  366: 
  367: sub sqlreply {
  368:     my ($cmd)=@_;
  369:     my $answer=subsqlreply($cmd);
  370:     if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); }
  371:     return $answer;
  372: }
  373: 
  374: sub subsqlreply {
  375:     my ($cmd)=@_;
  376:     my $unixsock="mysqlsock";
  377:     my $peerfile="$perlvar{'lonSockDir'}/$unixsock";
  378:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  379:                                       Type    => SOCK_STREAM,
  380:                                       Timeout => 10)
  381:        or return "con_lost";
  382:     print $sclient "$cmd\n";
  383:     my $answer=<$sclient>;
  384:     chomp($answer);
  385:     if (!$answer) { $answer="con_lost"; }
  386:     return $answer;
  387: }
  388: 
  389: # -------------------------------------------- Return path to profile directory
  390: 
  391: sub propath {
  392:     my ($udom,$uname)=@_;
  393:     $udom=~s/\W//g;
  394:     $uname=~s/\W//g;
  395:     my $subdir=$uname.'__';
  396:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  397:     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
  398:     return $proname;
  399: } 
  400: 
  401: # --------------------------------------- Is this the home server of an author?
  402: 
  403: sub ishome {
  404:     my $author=shift;
  405:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  406:     my ($udom,$uname)=split(/\//,$author);
  407:     my $proname=propath($udom,$uname);
  408:     if (-e $proname) {
  409: 	return 'owner';
  410:     } else {
  411:         return 'not_owner';
  412:     }
  413: }
  414: 
  415: # ======================================================= Continue main program
  416: # ---------------------------------------------------- Fork once and dissociate
  417: 
  418: $fpid=fork;
  419: exit if $fpid;
  420: die "Couldn't fork: $!" unless defined ($fpid);
  421: 
  422: POSIX::setsid() or die "Can't start new session: $!";
  423: 
  424: # ------------------------------------------------------- Write our PID on disk
  425: 
  426: $execdir=$perlvar{'lonDaemons'};
  427: open (PIDSAVE,">$execdir/logs/lond.pid");
  428: print PIDSAVE "$$\n";
  429: close(PIDSAVE);
  430: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
  431: &status('Starting');
  432: 
  433: # ------------------------------------------------------- Now we are on our own
  434:     
  435: # Fork off our children.
  436: for (1 .. $PREFORK) {
  437:     make_new_child();
  438: }
  439: 
  440: # ----------------------------------------------------- Install signal handlers
  441: 
  442: &status('Forked children');
  443: 
  444: $SIG{CHLD} = \&REAPER;
  445: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
  446: $SIG{HUP}  = \&HUPSMAN;
  447: $SIG{USR1} = \&checkchildren;
  448: 
  449: # And maintain the population.
  450: while (1) {
  451:     &status('Sleeping');
  452:     sleep;                          # wait for a signal (i.e., child's death)
  453:     &logthis('Woke up');
  454:     &status('Woke up');
  455:     for ($i = $children; $i < $PREFORK; $i++) {
  456:         make_new_child();           # top up the child pool
  457:     }
  458: }
  459: 
  460: sub make_new_child {
  461:     my $pid;
  462:     my $cipher;
  463:     my $sigset;
  464:     &logthis("Attempting to start child");    
  465:     # block signal for fork
  466:     $sigset = POSIX::SigSet->new(SIGINT);
  467:     sigprocmask(SIG_BLOCK, $sigset)
  468:         or die "Can't block SIGINT for fork: $!\n";
  469:     
  470:     die "fork: $!" unless defined ($pid = fork);
  471:     
  472:     if ($pid) {
  473:         # Parent records the child's birth and returns.
  474:         sigprocmask(SIG_UNBLOCK, $sigset)
  475:             or die "Can't unblock SIGINT for fork: $!\n";
  476:         $children{$pid} = 1;
  477:         $children++;
  478:         &status('Started child '.$pid);
  479:         return;
  480:     } else {
  481:         # Child can *not* return from this subroutine.
  482:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
  483:         $SIG{USR1}= \&logstatus;
  484:         $SIG{ALRM}= \&timeout;
  485:         $lastlog='Forked ';
  486:         $status='Forked';
  487: 
  488:         # unblock signals
  489:         sigprocmask(SIG_UNBLOCK, $sigset)
  490:             or die "Can't unblock SIGINT for fork: $!\n";
  491: 
  492:         $tmpsnum=0;
  493:     
  494:         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
  495:         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
  496:             &status('Idle, waiting for connection');
  497:             $client = $server->accept()     or last;
  498:             &status('Accepted connection');
  499: # =============================================================================
  500:             # do something with the connection
  501: # -----------------------------------------------------------------------------
  502:             # see if we know client and check for spoof IP by challenge
  503:             my $caller=getpeername($client);
  504:             my ($port,$iaddr)=unpack_sockaddr_in($caller);
  505:             my $clientip=inet_ntoa($iaddr);
  506:             my $clientrec=($hostid{$clientip} ne undef);
  507:             &logthis(
  508: "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
  509:             );
  510:             &status("Connecting $clientip ($hostid{$clientip})"); 
  511:             my $clientok;
  512:             if ($clientrec) {
  513: 	      &status("Waiting for init from $clientip ($hostid{$clientip})");
  514: 	      my $remotereq=<$client>;
  515:               $remotereq=~s/\W//g;
  516:               if ($remotereq eq 'init') {
  517: 		  my $challenge="$$".time;
  518:                   print $client "$challenge\n";
  519:                   &status(
  520:            "Waiting for challenge reply from $clientip ($hostid{$clientip})"); 
  521:                   $remotereq=<$client>;
  522:                   $remotereq=~s/\W//g;
  523:                   if ($challenge eq $remotereq) {
  524: 		      $clientok=1;
  525:                       print $client "ok\n";
  526:                   } else {
  527: 		      &logthis(
  528:  "<font color=blue>WARNING: $clientip did not reply challenge</font>");
  529:                       &status('No challenge reply '.$clientip);
  530:                   }
  531:               } else {
  532: 		  &logthis(
  533:                     "<font color=blue>WARNING: "
  534:                    ."$clientip failed to initialize: >$remotereq< </font>");
  535:                   &status('No init '.$clientip);
  536:               }
  537: 	    } else {
  538:               &logthis(
  539:  "<font color=blue>WARNING: Unknown client $clientip</font>");
  540:               &status('Hung up on '.$clientip);
  541:             }
  542:             if ($clientok) {
  543: # ---------------- New known client connecting, could mean machine online again
  544: 
  545: 	      &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
  546:               &logthis(
  547:        "<font color=green>Established connection: $hostid{$clientip}</font>");
  548:               &status('Will listen to '.$hostid{$clientip});
  549: # ------------------------------------------------------------ Process requests
  550:               while (my $userinput=<$client>) {
  551:                 chomp($userinput);
  552:                 &status('Processing '.$hostid{$clientip}.': '.$userinput);
  553:                 my $wasenc=0;
  554:                 alarm(120);
  555: # ------------------------------------------------------------ See if encrypted
  556: 		if ($userinput =~ /^enc/) {
  557: 		  if ($cipher) {
  558:                     my ($cmd,$cmdlength,$encinput)=split(/:/,$userinput);
  559: 		    $userinput='';
  560:                     for (my $encidx=0;$encidx<length($encinput);$encidx+=16) {
  561:                        $userinput.=
  562: 			   $cipher->decrypt(
  563:                             pack("H16",substr($encinput,$encidx,16))
  564:                            );
  565: 		    }
  566: 		    $userinput=substr($userinput,0,$cmdlength);
  567:                     $wasenc=1;
  568: 		}
  569: 	      }
  570: 	  
  571: # ------------------------------------------------------------- Normal commands
  572: # ------------------------------------------------------------------------ ping
  573: 		   if ($userinput =~ /^ping/) {
  574:                        print $client "$perlvar{'lonHostID'}\n";
  575: # ------------------------------------------------------------------------ pong
  576: 		   } elsif ($userinput =~ /^pong/) {
  577:                        $reply=reply("ping",$hostid{$clientip});
  578:                        print $client "$perlvar{'lonHostID'}:$reply\n"; 
  579: # ------------------------------------------------------------------------ ekey
  580: 		   } elsif ($userinput =~ /^ekey/) {
  581:                        my $buildkey=time.$$.int(rand 100000);
  582:                        $buildkey=~tr/1-6/A-F/;
  583:                        $buildkey=int(rand 100000).$buildkey.int(rand 100000);
  584:                        my $key=$perlvar{'lonHostID'}.$hostid{$clientip};
  585:                        $key=~tr/a-z/A-Z/;
  586:                        $key=~tr/G-P/0-9/;
  587:                        $key=~tr/Q-Z/0-9/;
  588:                        $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
  589:                        $key=substr($key,0,32);
  590:                        my $cipherkey=pack("H32",$key);
  591:                        $cipher=new IDEA $cipherkey;
  592:                        print $client "$buildkey\n"; 
  593: # ------------------------------------------------------------------------ load
  594: 		   } elsif ($userinput =~ /^load/) {
  595:                        my $loadavg;
  596:                        {
  597:                           my $loadfile=IO::File->new('/proc/loadavg');
  598:                           $loadavg=<$loadfile>;
  599:                        }
  600:                        $loadavg =~ s/\s.*//g;
  601:                        my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
  602: 		       print $client "$loadpercent\n";
  603: # ----------------------------------------------------------------- currentauth
  604: 		   } elsif ($userinput =~ /^currentauth/) {
  605: 		     if ($wasenc==1) {
  606:                        my ($cmd,$udom,$uname)=split(/:/,$userinput);
  607:                        my $proname=propath($udom,$uname);
  608:                        my $passfilename="$proname/passwd";
  609:                        if (-e $passfilename) {
  610: 			   my $pf = IO::File->new($passfilename);
  611: 			   my $realpasswd=<$pf>;
  612: 			   chomp($realpasswd);
  613: 			   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  614: 			   my $availablecontent='';
  615: 			   if ($howpwd eq 'krb4') {
  616: 			       $availablecontent=$contentpwd;
  617: 			   }
  618: 			   print $client "$howpwd:$availablecontent\n";
  619: 		       } else {
  620:                           print $client "unknown_user\n";
  621:                        }
  622: 		     } else {
  623: 		       print $client "refused\n";
  624: 		     }
  625: # ------------------------------------------------------------------------ auth
  626:                    } elsif ($userinput =~ /^auth/) {
  627: 		     if ($wasenc==1) {
  628:                        my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
  629:                        chomp($upass);
  630:                        $upass=unescape($upass);
  631:                        my $proname=propath($udom,$uname);
  632:                        my $passfilename="$proname/passwd";
  633:                        if (-e $passfilename) {
  634:                           my $pf = IO::File->new($passfilename);
  635:                           my $realpasswd=<$pf>;
  636:                           chomp($realpasswd);
  637:                           my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  638:                           my $pwdcorrect=0;
  639:                           if ($howpwd eq 'internal') {
  640: 			      $pwdcorrect=
  641: 				  (crypt($upass,$contentpwd) eq $contentpwd);
  642:                           } elsif ($howpwd eq 'unix') {
  643:                               $contentpwd=(getpwnam($uname))[1];
  644: 			      my $pwauth_path="/usr/local/sbin/pwauth";
  645: 			      unless ($contentpwd eq 'x') {
  646: 				  $pwdcorrect=
  647:                                     (crypt($upass,$contentpwd) eq $contentpwd);
  648: 			      }
  649: 			      elsif (-e $pwauth_path) {
  650: 				  open PWAUTH, "|$pwauth_path" or
  651: 				      die "Cannot invoke authentication";
  652: 				  print PWAUTH "$uname\n$upass\n";
  653: 				  close PWAUTH;
  654: 				  $pwdcorrect=!$?;
  655: 			      }
  656:                           } elsif ($howpwd eq 'krb4') {
  657:                              $null=pack("C",0);
  658: 			     unless ($upass=~/$null/) {
  659:                               $pwdcorrect=(
  660:                                  Authen::Krb4::get_pw_in_tkt($uname,"",
  661:                                         $contentpwd,'krbtgt',$contentpwd,1,
  662: 							     $upass) == 0);
  663: 			     } else { $pwdcorrect=0; }
  664:                           } elsif ($howpwd eq 'localauth') {
  665: 			    $pwdcorrect=&localauth::localauth($uname,$upass,
  666: 							      $contentpwd);
  667: 			  }
  668:                           if ($pwdcorrect) {
  669:                              print $client "authorized\n";
  670:                           } else {
  671:                              print $client "non_authorized\n";
  672:                           }  
  673: 		       } else {
  674:                           print $client "unknown_user\n";
  675:                        }
  676: 		     } else {
  677: 		       print $client "refused\n";
  678: 		     }
  679: # ---------------------------------------------------------------------- passwd
  680:                    } elsif ($userinput =~ /^passwd/) {
  681: 		     if ($wasenc==1) {
  682:                        my 
  683:                        ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
  684:                        chomp($npass);
  685:                        $upass=&unescape($upass);
  686:                        $npass=&unescape($npass);
  687: 		       &logthis("Trying to change password for $uname");
  688: 		       my $proname=propath($udom,$uname);
  689:                        my $passfilename="$proname/passwd";
  690:                        if (-e $passfilename) {
  691: 			   my $realpasswd;
  692:                           { my $pf = IO::File->new($passfilename);
  693: 			    $realpasswd=<$pf>; }
  694:                           chomp($realpasswd);
  695:                           my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  696:                           if ($howpwd eq 'internal') {
  697: 			   if (crypt($upass,$contentpwd) eq $contentpwd) {
  698: 			     my $salt=time;
  699:                              $salt=substr($salt,6,2);
  700: 			     my $ncpass=crypt($npass,$salt);
  701:                              { my $pf = IO::File->new(">$passfilename");
  702:  	  		       print $pf "internal:$ncpass\n"; }             
  703: 			     &logthis("Result of password change for $uname: pwchange_success");
  704:                              print $client "ok\n";
  705:                            } else {
  706:                              print $client "non_authorized\n";
  707:                            }
  708:                           } elsif ($howpwd eq 'unix') {
  709: 			      # Unix means we have to access /etc/password
  710: 			      # one way or another.
  711: 			      # First: Make sure the current password is
  712: 			      #        correct
  713: 			      $contentpwd=(getpwnam($uname))[1];
  714: 			      my $pwdcorrect = "0";
  715: 			      my $pwauth_path="/usr/local/sbin/pwauth";
  716: 			      unless ($contentpwd eq 'x') {
  717: 				  $pwdcorrect=
  718:                                     (crypt($upass,$contentpwd) eq $contentpwd);
  719: 			      } elsif (-e $pwauth_path) {
  720: 				  open PWAUTH, "|$pwauth_path" or
  721: 				      die "Cannot invoke authentication";
  722: 				  print PWAUTH "$uname\n$upass\n";
  723: 				  close PWAUTH;
  724: 				  $pwdcorrect=!$?;
  725: 			      }
  726: 			     if ($pwdcorrect) {
  727: 				 my $execdir=$perlvar{'lonDaemons'};
  728: 				 my $pf = IO::File->new("|$execdir/lcpasswd");
  729: 				 print $pf "$uname\n$npass\n$npass\n";
  730: 				 close $pf;
  731: 				 my $result = ($?>0 ? 'pwchange_failure' 
  732: 					       : 'ok');
  733: 				 &logthis("Result of password change for $uname: $result");
  734: 				 print $client "$result\n";
  735: 			     } else {
  736: 				 print $client "non_authorized\n";
  737: 			     }
  738: 			  } else {
  739:                             print $client "auth_mode_error\n";
  740:                           }  
  741: 		       } else {
  742:                           print $client "unknown_user\n";
  743:                        }
  744: 		     } else {
  745: 		       print $client "refused\n";
  746: 		     }
  747: # -------------------------------------------------------------------- makeuser
  748:                    } elsif ($userinput =~ /^makeuser/) {
  749: 		     Debug("Make user received");
  750:     	             my $oldumask=umask(0077);
  751: 		     if ($wasenc==1) {
  752:                        my 
  753:                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
  754: 		       &Debug("cmd =".$cmd." $udom =".$udom.
  755: 				    " uname=".$uname);
  756:                        chomp($npass);
  757:                        $npass=&unescape($npass);
  758:                        my $proname=propath($udom,$uname);
  759:                        my $passfilename="$proname/passwd";
  760: 		       &Debug("Password file created will be:".
  761: 				    $passfilename);
  762:                        if (-e $passfilename) {
  763: 			   print $client "already_exists\n";
  764:                        } elsif ($udom ne $perlvar{'lonDefDomain'}) {
  765:                            print $client "not_right_domain\n";
  766:                        } else {
  767:                            @fpparts=split(/\//,$proname);
  768:                            $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
  769:                            $fperror='';
  770:                            for ($i=3;$i<=$#fpparts;$i++) {
  771:                                $fpnow.='/'.$fpparts[$i]; 
  772:                                unless (-e $fpnow) {
  773: 				   unless (mkdir($fpnow,0777)) {
  774:                                       $fperror="error:$!";
  775:                                    }
  776:                                }
  777:                            }
  778:                            unless ($fperror) {
  779: 			     if ($umode eq 'krb4') {
  780:                                { 
  781:                                  my $pf = IO::File->new(">$passfilename");
  782:  	  		         print $pf "krb4:$npass\n"; 
  783:                                }             
  784:                                print $client "ok\n";
  785:                              } elsif ($umode eq 'internal') {
  786: 			       my $salt=time;
  787:                                $salt=substr($salt,6,2);
  788: 			       my $ncpass=crypt($npass,$salt);
  789:                                { 
  790: 				 &Debug("Creating internal auth");
  791: 				 my $pf = IO::File->new(">$passfilename");
  792:  	  		         print $pf "internal:$ncpass\n"; 
  793:                                }
  794:                                print $client "ok\n";
  795: 			     } elsif ($umode eq 'localauth') {
  796: 			       {
  797: 				 my $pf = IO::File->new(">$passfilename");
  798:   	  		         print $pf "localauth:$npass\n";
  799: 			       }
  800: 			       print $client "ok\n";
  801: 			     } elsif ($umode eq 'unix') {
  802: 			       {
  803: 				 my $execpath="$perlvar{'lonDaemons'}/".
  804: 				              "lcuseradd";
  805: 				 {
  806: 				     &Debug("Executing external: ".
  807: 						  $execpath);
  808: 				     my $se = IO::File->new("|$execpath");
  809: 				     print $se "$uname\n";
  810: 				     print $se "$npass\n";
  811: 				     print $se "$npass\n";
  812: 				 }
  813:                                  my $pf = IO::File->new(">$passfilename");
  814:  	  		         print $pf "unix:\n"; 
  815: 			       }
  816: 			       print $client "ok\n";
  817: 			     } elsif ($umode eq 'none') {
  818:                                { 
  819:                                  my $pf = IO::File->new(">$passfilename");
  820:  	  		         print $pf "none:\n"; 
  821:                                }             
  822:                                print $client "ok\n";
  823:                              } else {
  824:                                print $client "auth_mode_error\n";
  825:                              }  
  826:                            } else {
  827:                                print $client "$fperror\n";
  828:                            }
  829:                        }
  830: 		     } else {
  831: 		       print $client "refused\n";
  832: 		     }
  833: 		     umask($oldumask);
  834: # -------------------------------------------------------------- changeuserauth
  835:                    } elsif ($userinput =~ /^changeuserauth/) {
  836: 		       &Debug("Changing authorization");
  837: 		      if ($wasenc==1) {
  838:                        my 
  839:                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
  840:                        chomp($npass);
  841: 		       &Debug("cmd = ".$cmd." domain= ".$udom.
  842: 			      "uname =".$uname." umode= ".$umode);
  843:                        $npass=&unescape($npass);
  844:                        my $proname=propath($udom,$uname);
  845:                        my $passfilename="$proname/passwd";
  846: 		       if ($udom ne $perlvar{'lonDefDomain'}) {
  847:                            print $client "not_right_domain\n";
  848:                        } else {
  849: 			   if ($umode eq 'krb4') {
  850:                                { 
  851: 				   my $pf = IO::File->new(">$passfilename");
  852: 				   print $pf "krb4:$npass\n"; 
  853:                                }             
  854:                                print $client "ok\n";
  855: 			   } elsif ($umode eq 'internal') {
  856: 			       my $salt=time;
  857:                                $salt=substr($salt,6,2);
  858: 			       my $ncpass=crypt($npass,$salt);
  859:                                { 
  860: 				   my $pf = IO::File->new(">$passfilename");
  861: 				   print $pf "internal:$ncpass\n"; 
  862:                                }
  863:                                print $client "ok\n";
  864: 			   } elsif ($umode eq 'localauth') {
  865: 			       {
  866: 				   my $pf = IO::File->new(">$passfilename");
  867: 				   print $pf "localauth:$npass\n";
  868: 			       }
  869: 			       print $client "ok\n";
  870: 			   } elsif ($umode eq 'unix') {
  871: 			       {
  872: 				   my $execpath="$perlvar{'lonDaemons'}/".
  873: 				       "lcuseradd";
  874: 				   {
  875: 				       my $se = IO::File->new("|$execpath");
  876: 				       print $se "$uname\n";
  877: 				       print $se "$npass\n";
  878: 				       print $se "$npass\n";
  879: 				   }
  880: 				   my $pf = IO::File->new(">$passfilename");
  881: 				   print $pf "unix:\n"; 
  882: 			       }
  883: 			       print $client "ok\n";
  884: 			   } elsif ($umode eq 'none') {
  885:                                { 
  886: 				   my $pf = IO::File->new(">$passfilename");
  887: 				   print $pf "none:\n"; 
  888:                                }             
  889:                                print $client "ok\n";
  890: 			   } else {
  891:                                print $client "auth_mode_error\n";
  892: 			   }  
  893:                        }
  894: 		     } else {
  895: 		       print $client "refused\n";
  896: 		     }
  897: # ------------------------------------------------------------------------ home
  898:                    } elsif ($userinput =~ /^home/) {
  899:                        my ($cmd,$udom,$uname)=split(/:/,$userinput);
  900:                        chomp($uname);
  901:                        my $proname=propath($udom,$uname);
  902:                        if (-e $proname) {
  903:                           print $client "found\n";
  904:                        } else {
  905: 			  print $client "not_found\n";
  906:                        }
  907: # ---------------------------------------------------------------------- update
  908:                    } elsif ($userinput =~ /^update/) {
  909:                        my ($cmd,$fname)=split(/:/,$userinput);
  910:                        my $ownership=ishome($fname);
  911:                        if ($ownership eq 'not_owner') {
  912:                         if (-e $fname) {
  913:                           my ($dev,$ino,$mode,$nlink,
  914:                               $uid,$gid,$rdev,$size,
  915:                               $atime,$mtime,$ctime,
  916:                               $blksize,$blocks)=stat($fname);
  917:                           $now=time;
  918:                           $since=$now-$atime;
  919:                           if ($since>$perlvar{'lonExpire'}) {
  920:                               $reply=
  921:                                     reply("unsub:$fname","$hostid{$clientip}");
  922:                               unlink("$fname");
  923:                           } else {
  924: 			     my $transname="$fname.in.transfer";
  925:                              my $remoteurl=
  926:                                     reply("sub:$fname","$hostid{$clientip}");
  927:                              my $response;
  928:                               {
  929:                              my $ua=new LWP::UserAgent;
  930:                              my $request=new HTTP::Request('GET',"$remoteurl");
  931:                              $response=$ua->request($request,$transname);
  932: 			      }
  933:                              if ($response->is_error()) {
  934: 				 unlink($transname);
  935:                                  my $message=$response->status_line;
  936:                                  &logthis(
  937:                                   "LWP GET: $message for $fname ($remoteurl)");
  938:                              } else {
  939: 	                         if ($remoteurl!~/\.meta$/) {
  940:                                   my $ua=new LWP::UserAgent;
  941:                                   my $mrequest=
  942:                                    new HTTP::Request('GET',$remoteurl.'.meta');
  943:                                   my $mresponse=
  944:                                    $ua->request($mrequest,$fname.'.meta');
  945:                                   if ($mresponse->is_error()) {
  946: 		                    unlink($fname.'.meta');
  947:                                   }
  948: 	                         }
  949:                                  rename($transname,$fname);
  950: 			     }
  951:                           }
  952:                           print $client "ok\n";
  953:                         } else {
  954:                           print $client "not_found\n";
  955:                         }
  956: 		       } else {
  957: 			print $client "rejected\n";
  958:                        }
  959: # ----------------------------------------------------------------- unsubscribe
  960:                    } elsif ($userinput =~ /^unsub/) {
  961:                        my ($cmd,$fname)=split(/:/,$userinput);
  962:                        if (-e $fname) {
  963:                            if (unlink("$fname.$hostid{$clientip}")) {
  964:                               print $client "ok\n";
  965: 			   } else {
  966:                               print $client "not_subscribed\n";
  967: 			   }
  968:                        } else {
  969: 			   print $client "not_found\n";
  970:                        }
  971: # ------------------------------------------------------------------- subscribe
  972:                    } elsif ($userinput =~ /^sub/) {
  973:                        my ($cmd,$fname)=split(/:/,$userinput);
  974:                        my $ownership=ishome($fname);
  975:                        if ($ownership eq 'owner') {
  976:                         if (-e $fname) {
  977: 			 if (-d $fname) {
  978: 			   print $client "directory\n";
  979:                          } else {
  980:                            $now=time;
  981:                            { 
  982: 			    my $sh;
  983:                             if ($sh=
  984:                              IO::File->new(">$fname.$hostid{$clientip}")) {
  985:                                print $sh "$clientip:$now\n";
  986: 			    }
  987: 			   }
  988:                            unless ($fname=~/\.meta$/) {
  989: 			       unlink("$fname.meta.$hostid{$clientip}");
  990:                            }
  991:                            $fname=~s/\/home\/httpd\/html\/res/raw/;
  992:                            $fname="http://$thisserver/".$fname;
  993:                            print $client "$fname\n";
  994: 		         }
  995:                         } else {
  996: 		      	   print $client "not_found\n";
  997:                         }
  998: 		       } else {
  999:                         print $client "rejected\n";
 1000: 		       }
 1001: # ------------------------------------------------------------------------- log
 1002:                    } elsif ($userinput =~ /^log/) {
 1003:                        my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
 1004:                        chomp($what);
 1005:                        my $proname=propath($udom,$uname);
 1006:                        my $now=time;
 1007:                        {
 1008: 			 my $hfh;
 1009: 			 if ($hfh=IO::File->new(">>$proname/activity.log")) { 
 1010:                             print $hfh "$now:$hostid{$clientip}:$what\n";
 1011:                             print $client "ok\n"; 
 1012: 			} else {
 1013:                             print $client "error:$!\n";
 1014: 		        }
 1015: 		       }
 1016: # ------------------------------------------------------------------------- put
 1017:                    } elsif ($userinput =~ /^put/) {
 1018:                       my ($cmd,$udom,$uname,$namespace,$what)
 1019:                           =split(/:/,$userinput);
 1020:                       $namespace=~s/\//\_/g;
 1021:                       $namespace=~s/\W//g;
 1022:                       if ($namespace ne 'roles') {
 1023:                        chomp($what);
 1024:                        my $proname=propath($udom,$uname);
 1025:                        my $now=time;
 1026:                        unless ($namespace=~/^nohist\_/) {
 1027: 			   my $hfh;
 1028: 			   if (
 1029:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
 1030: 			       ) { print $hfh "P:$now:$what\n"; }
 1031: 		       }
 1032:                        my @pairs=split(/\&/,$what);
 1033:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
 1034:                            foreach $pair (@pairs) {
 1035: 			       ($key,$value)=split(/=/,$pair);
 1036:                                $hash{$key}=$value;
 1037:                            }
 1038: 			   if (untie(%hash)) {
 1039:                               print $client "ok\n";
 1040:                            } else {
 1041:                               print $client "error:$!\n";
 1042:                            }
 1043:                        } else {
 1044:                            print $client "error:$!\n";
 1045:                        }
 1046: 		      } else {
 1047:                           print $client "refused\n";
 1048:                       }
 1049: # -------------------------------------------------------------------- rolesput
 1050:                    } elsif ($userinput =~ /^rolesput/) {
 1051: 		       &Debug("rolesput");
 1052: 		    if ($wasenc==1) {
 1053:                        my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
 1054:                           =split(/:/,$userinput);
 1055: 		       &Debug("cmd = ".$cmd." exedom= ".$exedom.
 1056: 				    "user = ".$exeuser." udom=".$udom.
 1057: 				    "what = ".$what);
 1058:                        my $namespace='roles';
 1059:                        chomp($what);
 1060:                        my $proname=propath($udom,$uname);
 1061:                        my $now=time;
 1062:                        {
 1063: 			   my $hfh;
 1064: 			   if (
 1065:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
 1066: 			       ) { 
 1067:                                   print $hfh "P:$now:$exedom:$exeuser:$what\n";
 1068:                                  }
 1069: 		       }
 1070:                        my @pairs=split(/\&/,$what);
 1071:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
 1072:                            foreach $pair (@pairs) {
 1073: 			       ($key,$value)=split(/=/,$pair);
 1074:                                $hash{$key}=$value;
 1075:                            }
 1076: 			   if (untie(%hash)) {
 1077:                               print $client "ok\n";
 1078:                            } else {
 1079:                               print $client "error:$!\n";
 1080:                            }
 1081:                        } else {
 1082:                            print $client "error:$!\n";
 1083:                        }
 1084: 		      } else {
 1085:                           print $client "refused\n";
 1086:                       }
 1087: # ------------------------------------------------------------------------- get
 1088:                    } elsif ($userinput =~ /^get/) {
 1089:                        my ($cmd,$udom,$uname,$namespace,$what)
 1090:                           =split(/:/,$userinput);
 1091:                        $namespace=~s/\//\_/g;
 1092:                        $namespace=~s/\W//g;
 1093:                        chomp($what);
 1094:                        my @queries=split(/\&/,$what);
 1095:                        my $proname=propath($udom,$uname);
 1096:                        my $qresult='';
 1097:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
 1098:                            for ($i=0;$i<=$#queries;$i++) {
 1099:                                $qresult.="$hash{$queries[$i]}&";
 1100:                            }
 1101: 			   if (untie(%hash)) {
 1102: 		              $qresult=~s/\&$//;
 1103:                               print $client "$qresult\n";
 1104:                            } else {
 1105:                               print $client "error:$!\n";
 1106:                            }
 1107:                        } else {
 1108:                            print $client "error:$!\n";
 1109:                        }
 1110: # ------------------------------------------------------------------------ eget
 1111:                    } elsif ($userinput =~ /^eget/) {
 1112:                        my ($cmd,$udom,$uname,$namespace,$what)
 1113:                           =split(/:/,$userinput);
 1114:                        $namespace=~s/\//\_/g;
 1115:                        $namespace=~s/\W//g;
 1116:                        chomp($what);
 1117:                        my @queries=split(/\&/,$what);
 1118:                        my $proname=propath($udom,$uname);
 1119:                        my $qresult='';
 1120:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
 1121:                            for ($i=0;$i<=$#queries;$i++) {
 1122:                                $qresult.="$hash{$queries[$i]}&";
 1123:                            }
 1124: 			   if (untie(%hash)) {
 1125: 		              $qresult=~s/\&$//;
 1126:                               if ($cipher) {
 1127:                                 my $cmdlength=length($qresult);
 1128:                                 $qresult.="         ";
 1129:                                 my $encqresult='';
 1130:                                 for 
 1131: 				(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
 1132:                                  $encqresult.=
 1133:                                  unpack("H16",
 1134:                                  $cipher->encrypt(substr($qresult,$encidx,8)));
 1135:                                 }
 1136:                                 print $client "enc:$cmdlength:$encqresult\n";
 1137: 			      } else {
 1138: 			        print $client "error:no_key\n";
 1139:                               }
 1140:                            } else {
 1141:                               print $client "error:$!\n";
 1142:                            }
 1143:                        } else {
 1144:                            print $client "error:$!\n";
 1145:                        }
 1146: # ------------------------------------------------------------------------- del
 1147:                    } elsif ($userinput =~ /^del/) {
 1148:                        my ($cmd,$udom,$uname,$namespace,$what)
 1149:                           =split(/:/,$userinput);
 1150:                        $namespace=~s/\//\_/g;
 1151:                        $namespace=~s/\W//g;
 1152:                        chomp($what);
 1153:                        my $proname=propath($udom,$uname);
 1154:                        my $now=time;
 1155:                        unless ($namespace=~/^nohist\_/) {
 1156: 			   my $hfh;
 1157: 			   if (
 1158:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
 1159: 			       ) { print $hfh "D:$now:$what\n"; }
 1160: 		       }
 1161:                        my @keys=split(/\&/,$what);
 1162:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
 1163:                            foreach $key (@keys) {
 1164:                                delete($hash{$key});
 1165:                            }
 1166: 			   if (untie(%hash)) {
 1167:                               print $client "ok\n";
 1168:                            } else {
 1169:                               print $client "error:$!\n";
 1170:                            }
 1171:                        } else {
 1172:                            print $client "error:$!\n";
 1173:                        }
 1174: # ------------------------------------------------------------------------ keys
 1175:                    } elsif ($userinput =~ /^keys/) {
 1176:                        my ($cmd,$udom,$uname,$namespace)
 1177:                           =split(/:/,$userinput);
 1178:                        $namespace=~s/\//\_/g;
 1179:                        $namespace=~s/\W//g;
 1180:                        my $proname=propath($udom,$uname);
 1181:                        my $qresult='';
 1182:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
 1183:                            foreach $key (keys %hash) {
 1184:                                $qresult.="$key&";
 1185:                            }
 1186: 			   if (untie(%hash)) {
 1187: 		              $qresult=~s/\&$//;
 1188:                               print $client "$qresult\n";
 1189:                            } else {
 1190:                               print $client "error:$!\n";
 1191:                            }
 1192:                        } else {
 1193:                            print $client "error:$!\n";
 1194:                        }
 1195: # ------------------------------------------------------------------------ dump
 1196:                    } elsif ($userinput =~ /^dump/) {
 1197:                        my ($cmd,$udom,$uname,$namespace,$regexp)
 1198:                           =split(/:/,$userinput);
 1199:                        $namespace=~s/\//\_/g;
 1200:                        $namespace=~s/\W//g;
 1201:                        if (defined($regexp)) {
 1202:                           $regexp=&unescape($regexp);
 1203: 		       } else {
 1204:                           $regexp='.';
 1205: 		       }
 1206:                        my $proname=propath($udom,$uname);
 1207:                        my $qresult='';
 1208:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
 1209:                            foreach $key (keys %hash) {
 1210:                                if (eval('$key=~/$regexp/')) {
 1211:                                   $qresult.="$key=$hash{$key}&";
 1212: 			       }
 1213:                            }
 1214: 			   if (untie(%hash)) {
 1215: 		              $qresult=~s/\&$//;
 1216:                               print $client "$qresult\n";
 1217:                            } else {
 1218:                               print $client "error:$!\n";
 1219:                            }
 1220:                        } else {
 1221:                            print $client "error:$!\n";
 1222:                        }
 1223: # ----------------------------------------------------------------------- store
 1224:                    } elsif ($userinput =~ /^store/) {
 1225:                       my ($cmd,$udom,$uname,$namespace,$rid,$what)
 1226:                           =split(/:/,$userinput);
 1227:                       $namespace=~s/\//\_/g;
 1228:                       $namespace=~s/\W//g;
 1229:                       if ($namespace ne 'roles') {
 1230:                        chomp($what);
 1231:                        my $proname=propath($udom,$uname);
 1232:                        my $now=time;
 1233:                        unless ($namespace=~/^nohist\_/) {
 1234: 			   my $hfh;
 1235: 			   if (
 1236:                              $hfh=IO::File->new(">>$proname/$namespace.hist")
 1237: 			       ) { print $hfh "P:$now:$rid:$what\n"; }
 1238: 		       }
 1239:                        my @pairs=split(/\&/,$what);
 1240:                          
 1241:     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
 1242:                            my @previouskeys=split(/&/,$hash{"keys:$rid"});
 1243:                            my $key;
 1244:                            $hash{"version:$rid"}++;
 1245:                            my $version=$hash{"version:$rid"};
 1246:                            my $allkeys=''; 
 1247:                            foreach $pair (@pairs) {
 1248: 			       ($key,$value)=split(/=/,$pair);
 1249:                                $allkeys.=$key.':';
 1250:                                $hash{"$version:$rid:$key"}=$value;
 1251:                            }
 1252:                            $hash{"$version:$rid:timestamp"}=$now;
 1253:                            $allkeys.='timestamp';
 1254:                            $hash{"$version:keys:$rid"}=$allkeys;
 1255: 			   if (untie(%hash)) {
 1256:                               print $client "ok\n";
 1257:                            } else {
 1258:                               print $client "error:$!\n";
 1259:                            }
 1260:                        } else {
 1261:                            print $client "error:$!\n";
 1262:                        }
 1263: 		      } else {
 1264:                           print $client "refused\n";
 1265:                       }
 1266: # --------------------------------------------------------------------- restore
 1267:                    } elsif ($userinput =~ /^restore/) {
 1268:                        my ($cmd,$udom,$uname,$namespace,$rid)
 1269:                           =split(/:/,$userinput);
 1270:                        $namespace=~s/\//\_/g;
 1271:                        $namespace=~s/\W//g;
 1272:                        chomp($rid);
 1273:                        my $proname=propath($udom,$uname);
 1274:                        my $qresult='';
 1275:       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
 1276:                 	   my $version=$hash{"version:$rid"};
 1277:                            $qresult.="version=$version&";
 1278:                            my $scope;
 1279:                            for ($scope=1;$scope<=$version;$scope++) {
 1280: 			      my $vkeys=$hash{"$scope:keys:$rid"};
 1281:                               my @keys=split(/:/,$vkeys);
 1282:                               my $key;
 1283:                               $qresult.="$scope:keys=$vkeys&";
 1284:                               foreach $key (@keys) {
 1285: 	     $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
 1286:                               }                                  
 1287:                            }
 1288: 			   if (untie(%hash)) {
 1289: 		              $qresult=~s/\&$//;
 1290:                               print $client "$qresult\n";
 1291:                            } else {
 1292:                               print $client "error:$!\n";
 1293:                            }
 1294:                        } else {
 1295:                            print $client "error:$!\n";
 1296:                        }
 1297: # ------------------------------------------------------------------- querysend
 1298:                    } elsif ($userinput =~ /^querysend/) {
 1299:                        my ($cmd,$query,
 1300: 			   $custom,$customshow)=split(/:/,$userinput);
 1301: 		       $query=~s/\n*$//g;
 1302: 		       unless ($custom or $customshow) {
 1303: 			   print $client "".
 1304: 			       sqlreply("$hostid{$clientip}\&$query")."\n";
 1305: 		       }
 1306: 		       else {
 1307: 			   print $client "".
 1308: 			       sqlreply("$hostid{$clientip}\&$query".
 1309: 					"\&$custom"."\&$customshow")."\n";
 1310: 		       }
 1311: # ------------------------------------------------------------------ queryreply
 1312:                    } elsif ($userinput =~ /^queryreply/) {
 1313:                        my ($cmd,$id,$reply)=split(/:/,$userinput); 
 1314: 		       my $store;
 1315:                        my $execdir=$perlvar{'lonDaemons'};
 1316:                        if ($store=IO::File->new(">$execdir/tmp/$id")) {
 1317: 			   $reply=~s/\&/\n/g;
 1318: 			   print $store $reply;
 1319: 			   close $store;
 1320: 			   my $store2=IO::File->new(">$execdir/tmp/$id.end");
 1321: 			   print $store2 "done\n";
 1322: 			   close $store2;
 1323: 			   print $client "ok\n";
 1324: 		       }
 1325: 		       else {
 1326: 			   print $client "error:$!\n";
 1327: 		       }
 1328: # ----------------------------------------------------------------------- idput
 1329:                    } elsif ($userinput =~ /^idput/) {
 1330:                        my ($cmd,$udom,$what)=split(/:/,$userinput);
 1331:                        chomp($what);
 1332:                        $udom=~s/\W//g;
 1333:                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
 1334:                        my $now=time;
 1335:                        {
 1336: 			   my $hfh;
 1337: 			   if (
 1338:                              $hfh=IO::File->new(">>$proname.hist")
 1339: 			       ) { print $hfh "P:$now:$what\n"; }
 1340: 		       }
 1341:                        my @pairs=split(/\&/,$what);
 1342:                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
 1343:                            foreach $pair (@pairs) {
 1344: 			       ($key,$value)=split(/=/,$pair);
 1345:                                $hash{$key}=$value;
 1346:                            }
 1347: 			   if (untie(%hash)) {
 1348:                               print $client "ok\n";
 1349:                            } else {
 1350:                               print $client "error:$!\n";
 1351:                            }
 1352:                        } else {
 1353:                            print $client "error:$!\n";
 1354:                        }
 1355: # ----------------------------------------------------------------------- idget
 1356:                    } elsif ($userinput =~ /^idget/) {
 1357:                        my ($cmd,$udom,$what)=split(/:/,$userinput);
 1358:                        chomp($what);
 1359:                        $udom=~s/\W//g;
 1360:                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
 1361:                        my @queries=split(/\&/,$what);
 1362:                        my $qresult='';
 1363:                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) {
 1364:                            for ($i=0;$i<=$#queries;$i++) {
 1365:                                $qresult.="$hash{$queries[$i]}&";
 1366:                            }
 1367: 			   if (untie(%hash)) {
 1368: 		              $qresult=~s/\&$//;
 1369:                               print $client "$qresult\n";
 1370:                            } else {
 1371:                               print $client "error:$!\n";
 1372:                            }
 1373:                        } else {
 1374:                            print $client "error:$!\n";
 1375:                        }
 1376: # ---------------------------------------------------------------------- tmpput
 1377:                    } elsif ($userinput =~ /^tmpput/) {
 1378:                        my ($cmd,$what)=split(/:/,$userinput);
 1379: 		       my $store;
 1380:                        $tmpsnum++;
 1381:                        my $id=$$.'_'.$clientip.'_'.$tmpsnum;
 1382:                        $id=~s/\W/\_/g;
 1383:                        $what=~s/\n//g;
 1384:                        my $execdir=$perlvar{'lonDaemons'};
 1385:                        if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
 1386: 			   print $store $what;
 1387: 			   close $store;
 1388: 			   print $client "$id\n";
 1389: 		       }
 1390: 		       else {
 1391: 			   print $client "error:$!\n";
 1392: 		       }
 1393: 
 1394: # ---------------------------------------------------------------------- tmpget
 1395:                    } elsif ($userinput =~ /^tmpget/) {
 1396:                        my ($cmd,$id)=split(/:/,$userinput);
 1397:                        chomp($id);
 1398:                        $id=~s/\W/\_/g;
 1399:                        my $store;
 1400:                        my $execdir=$perlvar{'lonDaemons'};
 1401:                        if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
 1402:                            my $reply=<$store>;
 1403: 			   print $client "$reply\n";
 1404:                            close $store;
 1405: 		       }
 1406: 		       else {
 1407: 			   print $client "error:$!\n";
 1408: 		       }
 1409: 
 1410: # -------------------------------------------------------------------------- ls
 1411:                    } elsif ($userinput =~ /^ls/) {
 1412:                        my ($cmd,$ulsdir)=split(/:/,$userinput);
 1413:                        my $ulsout='';
 1414:                        my $ulsfn;
 1415:                        if (-e $ulsdir) {
 1416: 			if (opendir(LSDIR,$ulsdir)) {
 1417:                           while ($ulsfn=readdir(LSDIR)) {
 1418: 			     my @ulsstats=stat($ulsdir.'/'.$ulsfn);
 1419:                              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
 1420:                           }
 1421:                           closedir(LSDIR);
 1422: 		        }
 1423: 		       } else {
 1424:                           $ulsout='no_such_dir';
 1425:                        }
 1426:                        if ($ulsout eq '') { $ulsout='empty'; }
 1427:                        print $client "$ulsout\n";
 1428: # ------------------------------------------------------------------ Hanging up
 1429:                    } elsif (($userinput =~ /^exit/) ||
 1430:                             ($userinput =~ /^init/)) {
 1431:                        &logthis(
 1432:       "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
 1433:                        print $client "bye\n";
 1434:                        $client->close();
 1435: 		       last;
 1436: # ------------------------------------------------------------- unknown command
 1437:                    } else {
 1438:                        # unknown command
 1439:                        print $client "unknown_cmd\n";
 1440:                    }
 1441: # -------------------------------------------------------------------- complete
 1442: 		   alarm(0);
 1443:                    &status('Listening to '.$hostid{$clientip});
 1444: 	       }
 1445: # --------------------------------------------- client unknown or fishy, refuse
 1446:             } else {
 1447: 	        print $client "refused\n";
 1448:                 $client->close();
 1449:                 &logthis("<font color=blue>WARNING: "
 1450:                 ."Rejected client $clientip, closing connection</font>");
 1451:             }
 1452: 	}              
 1453: 
 1454: # =============================================================================
 1455:        
 1456: 	&logthis("<font color=red>CRITICAL: "
 1457: 		 ."Disconnect from $clientip ($hostid{$clientip})</font>");    
 1458:         # tidy up gracefully and finish
 1459:     
 1460:         $server->close();
 1461: 
 1462:         # this exit is VERY important, otherwise the child will become
 1463:         # a producer of more and more children, forking yourself into
 1464:         # process death.
 1465:         exit;
 1466:     }
 1467: }
 1468: 
 1469: # ----------------------------------- POD (plain old documentation, CPAN style)
 1470: 
 1471: =head1 NAME
 1472: 
 1473: lond - "LON Daemon" Server (port "LOND" 5663)
 1474: 
 1475: =head1 SYNOPSIS
 1476: 
 1477: Usage: B<lond>
 1478: 
 1479: Should only be run as user=www.  This is a command-line script which
 1480: is invoked by B<loncron>.  There is no expectation that a typical user
 1481: will manually start B<lond> from the command-line.  (In other words,
 1482: DO NOT START B<lond> YOURSELF.)
 1483: 
 1484: =head1 DESCRIPTION
 1485: 
 1486: There are two characteristics associated with the running of B<lond>,
 1487: PROCESS MANAGEMENT (starting, stopping, handling child processes)
 1488: and SERVER-SIDE ACTIVITIES (password authentication, user creation,
 1489: subscriptions, etc).  These are described in two large
 1490: sections below.
 1491: 
 1492: B<PROCESS MANAGEMENT>
 1493: 
 1494: Preforker - server who forks first. Runs as a daemon. HUPs.
 1495: Uses IDEA encryption
 1496: 
 1497: B<lond> forks off children processes that correspond to the other servers
 1498: in the network.  Management of these processes can be done at the
 1499: parent process level or the child process level.
 1500: 
 1501: B<logs/lond.log> is the location of log messages.
 1502: 
 1503: The process management is now explained in terms of linux shell commands,
 1504: subroutines internal to this code, and signal assignments:
 1505: 
 1506: =over 4
 1507: 
 1508: =item *
 1509: 
 1510: PID is stored in B<logs/lond.pid>
 1511: 
 1512: This is the process id number of the parent B<lond> process.
 1513: 
 1514: =item *
 1515: 
 1516: SIGTERM and SIGINT
 1517: 
 1518: Parent signal assignment:
 1519:  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 1520: 
 1521: Child signal assignment:
 1522:  $SIG{INT}  = 'DEFAULT'; (and SIGTERM is DEFAULT also)
 1523: (The child dies and a SIGALRM is sent to parent, awaking parent from slumber
 1524:  to restart a new child.)
 1525: 
 1526: Command-line invocations:
 1527:  B<kill> B<-s> SIGTERM I<PID>
 1528:  B<kill> B<-s> SIGINT I<PID>
 1529: 
 1530: Subroutine B<HUNTSMAN>:
 1531:  This is only invoked for the B<lond> parent I<PID>.
 1532: This kills all the children, and then the parent.
 1533: The B<lonc.pid> file is cleared.
 1534: 
 1535: =item *
 1536: 
 1537: SIGHUP
 1538: 
 1539: Current bug:
 1540:  This signal can only be processed the first time
 1541: on the parent process.  Subsequent SIGHUP signals
 1542: have no effect.
 1543: 
 1544: Parent signal assignment:
 1545:  $SIG{HUP}  = \&HUPSMAN;
 1546: 
 1547: Child signal assignment:
 1548:  none (nothing happens)
 1549: 
 1550: Command-line invocations:
 1551:  B<kill> B<-s> SIGHUP I<PID>
 1552: 
 1553: Subroutine B<HUPSMAN>:
 1554:  This is only invoked for the B<lond> parent I<PID>,
 1555: This kills all the children, and then the parent.
 1556: The B<lond.pid> file is cleared.
 1557: 
 1558: =item *
 1559: 
 1560: SIGUSR1
 1561: 
 1562: Parent signal assignment:
 1563:  $SIG{USR1} = \&USRMAN;
 1564: 
 1565: Child signal assignment:
 1566:  $SIG{USR1}= \&logstatus;
 1567: 
 1568: Command-line invocations:
 1569:  B<kill> B<-s> SIGUSR1 I<PID>
 1570: 
 1571: Subroutine B<USRMAN>:
 1572:  When invoked for the B<lond> parent I<PID>,
 1573: SIGUSR1 is sent to all the children, and the status of
 1574: each connection is logged.
 1575: 
 1576: =item *
 1577: 
 1578: SIGCHLD
 1579: 
 1580: Parent signal assignment:
 1581:  $SIG{CHLD} = \&REAPER;
 1582: 
 1583: Child signal assignment:
 1584:  none
 1585: 
 1586: Command-line invocations:
 1587:  B<kill> B<-s> SIGCHLD I<PID>
 1588: 
 1589: Subroutine B<REAPER>:
 1590:  This is only invoked for the B<lond> parent I<PID>.
 1591: Information pertaining to the child is removed.
 1592: The socket port is cleaned up.
 1593: 
 1594: =back
 1595: 
 1596: B<SERVER-SIDE ACTIVITIES>
 1597: 
 1598: Server-side information can be accepted in an encrypted or non-encrypted
 1599: method.
 1600: 
 1601: =over 4
 1602: 
 1603: =item ping
 1604: 
 1605: Query a client in the hosts.tab table; "Are you there?"
 1606: 
 1607: =item pong
 1608: 
 1609: Respond to a ping query.
 1610: 
 1611: =item ekey
 1612: 
 1613: Read in encrypted key, make cipher.  Respond with a buildkey.
 1614: 
 1615: =item load
 1616: 
 1617: Respond with CPU load based on a computation upon /proc/loadavg.
 1618: 
 1619: =item currentauth
 1620: 
 1621: Reply with current authentication information (only over an
 1622: encrypted channel).
 1623: 
 1624: =item auth
 1625: 
 1626: Only over an encrypted channel, reply as to whether a user's
 1627: authentication information can be validated.
 1628: 
 1629: =item passwd
 1630: 
 1631: Allow for a password to be set.
 1632: 
 1633: =item makeuser
 1634: 
 1635: Make a user.
 1636: 
 1637: =item passwd
 1638: 
 1639: Allow for authentication mechanism and password to be changed.
 1640: 
 1641: =item home
 1642: 
 1643: Respond to a question "are you the home for a given user?"
 1644: 
 1645: =item update
 1646: 
 1647: Update contents of a subscribed resource.
 1648: 
 1649: =item unsubscribe
 1650: 
 1651: The server is unsubscribing from a resource.
 1652: 
 1653: =item subscribe
 1654: 
 1655: The server is subscribing to a resource.
 1656: 
 1657: =item log
 1658: 
 1659: Place in B<logs/lond.log>
 1660: 
 1661: =item put
 1662: 
 1663: stores hash in namespace
 1664: 
 1665: =item rolesput
 1666: 
 1667: put a role into a user's environment
 1668: 
 1669: =item get
 1670: 
 1671: returns hash with keys from array
 1672: reference filled in from namespace
 1673: 
 1674: =item eget
 1675: 
 1676: returns hash with keys from array
 1677: reference filled in from namesp (encrypts the return communication)
 1678: 
 1679: =item rolesget
 1680: 
 1681: get a role from a user's environment
 1682: 
 1683: =item del
 1684: 
 1685: deletes keys out of array from namespace
 1686: 
 1687: =item keys
 1688: 
 1689: returns namespace keys
 1690: 
 1691: =item dump
 1692: 
 1693: dumps the complete (or key matching regexp) namespace into a hash
 1694: 
 1695: =item store
 1696: 
 1697: stores hash permanently
 1698: for this url; hashref needs to be given and should be a \%hashname; the
 1699: remaining args aren't required and if they aren't passed or are '' they will
 1700: be derived from the ENV
 1701: 
 1702: =item restore
 1703: 
 1704: returns a hash for a given url
 1705: 
 1706: =item querysend
 1707: 
 1708: Tells client about the lonsql process that has been launched in response
 1709: to a sent query.
 1710: 
 1711: =item queryreply
 1712: 
 1713: Accept information from lonsql and make appropriate storage in temporary
 1714: file space.
 1715: 
 1716: =item idput
 1717: 
 1718: Defines usernames as corresponding to IDs.  (These "IDs" are unique identifiers
 1719: for each student, defined perhaps by the institutional Registrar.)
 1720: 
 1721: =item idget
 1722: 
 1723: Returns usernames corresponding to IDs.  (These "IDs" are unique identifiers
 1724: for each student, defined perhaps by the institutional Registrar.)
 1725: 
 1726: =item tmpput
 1727: 
 1728: Accept and store information in temporary space.
 1729: 
 1730: =item tmpget
 1731: 
 1732: Send along temporarily stored information.
 1733: 
 1734: =item ls
 1735: 
 1736: List part of a user's directory.
 1737: 
 1738: =item Hanging up (exit or init)
 1739: 
 1740: What to do when a client tells the server that they (the client)
 1741: are leaving the network.
 1742: 
 1743: =item unknown command
 1744: 
 1745: If B<lond> is sent an unknown command (not in the list above),
 1746: it replys to the client "unknown_cmd".
 1747: 
 1748: =item UNKNOWN CLIENT
 1749: 
 1750: If the anti-spoofing algorithm cannot verify the client,
 1751: the client is rejected (with a "refused" message sent
 1752: to the client, and the connection is closed.
 1753: 
 1754: =back
 1755: 
 1756: =head1 PREREQUISITES
 1757: 
 1758: IO::Socket
 1759: IO::File
 1760: Apache::File
 1761: Symbol
 1762: POSIX
 1763: Crypt::IDEA
 1764: LWP::UserAgent()
 1765: GDBM_File
 1766: Authen::Krb4
 1767: 
 1768: =head1 COREQUISITES
 1769: 
 1770: =head1 OSNAMES
 1771: 
 1772: linux
 1773: 
 1774: =head1 SCRIPT CATEGORIES
 1775: 
 1776: Server/Process
 1777: 
 1778: =cut

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