[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.135 and 1.151

version 1.135, 2003/08/12 09:39:23 version 1.151, 2003/10/03 15:11:03
Line 57 Line 57
 #      Management functions supported include:  #      Management functions supported include:
 #       - pushing /home/httpd/lonTabs/hosts.tab  #       - pushing /home/httpd/lonTabs/hosts.tab
 #       - pushing /home/httpd/lonTabs/domain.tab  #       - pushing /home/httpd/lonTabs/domain.tab
 ###  # 09/08/2003 Ron Fox:  Told lond to take care of change logging so we
   #      don't have to remember it:
   # $Log$
   # Revision 1.151  2003/10/03 15:11:03  albertel
   # - if we fail to fetch an update to the file, don't blow away the old one
   #   (this was the BUG that blew away that one default.sequence that Matthew
   #    ended up restoring from data.)
   #
   # Revision 1.150  2003/09/30 10:16:06  foxr
   # Added invocation of apachereload in ReloadApache sub.
   # This completes the addtion of the reinit functionality.
   #
   # Revision 1.149  2003/09/30 09:44:13  foxr
   # Tested UpdateHosts ability to
   # - Remove live children for hosts that are no longer in the hosts.tab
   # - Remove live children for hosts whose IPs have changed in the hosts.tab
   #
   # Revision 1.148  2003/09/29 10:09:18  foxr
   # Put in logic to reinit lond itself (except for apache reload).  I don't believe
   # this logic works correctly yet, however lond still does everything it used to doso I'll do the commit anyway.
   #
   # Revision 1.147  2003/09/23 11:23:31  foxr
   # Comlplete implementation of reinit functionality.  Must still implement
   # the actual initialization functionality, but the process can now
   # receive the request and either invoke the appropriate internal function or
   # signal the correct lonc.
   #
   # Revision 1.146  2003/09/16 10:28:14  foxr
   # ReinitProcess - decode the process selector and produce the associated pid
   # filename.  Note: While it is possible to test that valid process selectors are
   # handled properly I am not able to test that invalid process selectors produce
   # the appropriate error as lonManage also blocks the use of invalid process selectors.
   #
   # Revision 1.145  2003/09/16 10:13:20  foxr
   # Added ReinitProcess function to oversee the parsing and processing of the
   # reinit:<process> client request.
   #
   # Revision 1.144  2003/09/16 09:47:01  foxr
   # Added skeletal support for SIGUSR2 (update hosts.tab)
   #
   # Revision 1.143  2003/09/15 10:03:52  foxr
   # Completed and tested code for pushfile.
   #
   # Revision 1.142  2003/09/09 20:47:46  www
   # Permanently store chatroom entries in chatroom.log
   #
   # Revision 1.141  2003/09/08 10:32:07  foxr
   # Added PushFile sub This sub oversees the push of a new configuration table file
   # Currently supported files are:
   # - hosts.tab   (transaction pushfile:hosts:contents)
   # - domain.tab  (transaction pushfile:domain:contents)
   #
   
   
 use strict;  use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
Line 75  use Authen::Krb4; Line 127  use Authen::Krb4;
 use Authen::Krb5;  use Authen::Krb5;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use localauth;  use localauth;
   use File::Copy;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 87  my $currenthostid; Line 140  my $currenthostid;
 my $currentdomainid;  my $currentdomainid;
   
 my $client;  my $client;
   my $clientip;
   
 my $server;  my $server;
 my $thisserver;  my $thisserver;
   
 my %hostid;  my %hostid;
 my %hostdom;  my %hostdom;
 my %hostip;  my %hostip;
   my %perlvar; # Will have the apache conf defined perl vars.
   
 #  #
 #  The array below are password error strings."  #  The array below are password error strings."
Line 133  my @adderrors    = ("ok", Line 189  my @adderrors    = ("ok",
   
   
 #  #
   #   GetCertificate: Given a transaction that requires a certificate,
   #   this function will extract the certificate from the transaction
   #   request.  Note that at this point, the only concept of a certificate
   #   is the hostname to which we are connected.
   #
   #   Parameter:
   #      request   - The request sent by our client (this parameterization may
   #                  need to change when we really use a certificate granting
   #                  authority.
   #
   sub GetCertificate {
       my $request = shift;
   
       return $clientip;
   }
   
   
   #
   #  ValidManager: Determines if a given certificate represents a valid manager.
   #                in this primitive implementation, the 'certificate' is
   #                just the connecting loncapa client name.  This is checked
   #                against a valid client list in the configuration.
   #
   #                  
   sub ValidManager {
       my $certificate = shift; 
   
       my $hostentry   = $hostid{$certificate};
       if ($hostentry ne undef) {
    &logthis('<font color="yellow">Authenticating manager'.
    " $hostentry</font>");
    return 1;
       } else {
    &logthis('<font color="red"> Failed manager authentication '.
    "$certificate </font>");
       }
   }
   #
   #  CopyFile:  Called as part of the process of installing a 
   #             new configuration file.  This function copies an existing
   #             file to a backup file.
   # Parameters:
   #     oldfile  - Name of the file to backup.
   #     newfile  - Name of the backup file.
   # Return:
   #     0   - Failure (errno has failure reason).
   #     1   - Success.
   #
   sub CopyFile {
       my $oldfile = shift;
       my $newfile = shift;
   
       #  The file must exist:
   
       if(-e $oldfile) {
   
    # Read the old file.
   
    my $oldfh = IO::File->new("< $oldfile");
    if(!$oldfh) {
       return 0;
    }
    my @contents = <$oldfh>;  # Suck in the entire file.
   
    # write the backup file:
   
    my $newfh = IO::File->new("> $newfile");
    if(!(defined $newfh)){
       return 0;
    }
    my $lines = scalar @contents;
    for (my $i =0; $i < $lines; $i++) {
       print $newfh ($contents[$i]);
    }
   
    $oldfh->close;
    $newfh->close;
   
    chmod(0660, $newfile);
   
    return 1;
       
       } else {
    return 0;
       }
   }
   
   #
   #   InstallFile: Called to install an administrative file:
   #       - The file is created with <name>.tmp
   #       - The <name>.tmp file is then mv'd to <name>
   #   This lugubrious procedure is done to ensure that we are never without
   #   a valid, even if dated, version of the file regardless of who crashes
   #   and when the crash occurs.
   #
   #  Parameters:
   #       Name of the file
   #       File Contents.
   #  Return:
   #      nonzero - success.
   #      0       - failure and $! has an errno.
   #
   sub InstallFile {
       my $Filename = shift;
       my $Contents = shift;
       my $TempFile = $Filename.".tmp";
   
       #  Open the file for write:
   
       my $fh = IO::File->new("> $TempFile"); # Write to temp.
       if(!(defined $fh)) {
    &logthis('<font color="red"> Unable to create '.$TempFile."</font>");
    return 0;
       }
       #  write the contents of the file:
   
       print $fh ($Contents); 
       $fh->close; # In case we ever have a filesystem w. locking
   
       chmod(0660, $TempFile);
   
       # Now we can move install the file in position.
       
       move($TempFile, $Filename);
   
       return 1;
   }
   
   #
   #   PushFile:  Called to do an administrative push of a file.
   #              - Ensure the file being pushed is one we support.
   #              - Backup the old file to <filename.saved>
   #              - Separate the contents of the new file out from the
   #                rest of the request.
   #              - Write the new file.
   #  Parameter:
   #     Request - The entire user request.  This consists of a : separated
   #               string pushfile:tablename:contents.
   #     NOTE:  The contents may have :'s in it as well making things a bit
   #            more interesting... but not much.
   #  Returns:
   #     String to send to client ("ok" or "refused" if bad file).
   #
   sub PushFile {
       my $request = shift;    
       my ($command, $filename, $contents) = split(":", $request, 3);
       
       #  At this point in time, pushes for only the following tables are
       #  supported:
       #   hosts.tab  ($filename eq host).
       #   domain.tab ($filename eq domain).
       # Construct the destination filename or reject the request.
       #
       # lonManage is supposed to ensure this, however this session could be
       # part of some elaborate spoof that managed somehow to authenticate.
       #
   
       my $tablefile = $perlvar{'lonTabDir'}.'/'; # need to precede with dir.
       if ($filename eq "host") {
    $tablefile .= "hosts.tab";
       } elsif ($filename eq "domain") {
    $tablefile .= "domain.tab";
       } else {
    return "refused";
       }
       #
       # >copy< the old table to the backup table
       #        don't rename in case system crashes/reboots etc. in the time
       #        window between a rename and write.
       #
       my $backupfile = $tablefile;
       $backupfile    =~ s/\.tab$/.old/;
       if(!CopyFile($tablefile, $backupfile)) {
    &logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>");
    return "error:$!";
       }
       &logthis('<font color="green"> Pushfile: backed up '
       .$tablefile." to $backupfile</font>");
       
       #  Install the new file:
   
       if(!InstallFile($tablefile, $contents)) {
    &logthis('<font color="red"> Pushfile: unable to install '
    .$tablefile." $! </font>");
    return "error:$!";
       }
       else {
    &logthis('<font color="green"> Installed new '.$tablefile
    ."</font>");
   
       }
   
   
       #  Indicate success:
    
       return "ok";
   
   }
   
   #
   #  Called to re-init either lonc or lond.
   #
   #  Parameters:
   #    request   - The full request by the client.  This is of the form
   #                reinit:<process>  
   #                where <process> is allowed to be either of 
   #                lonc or lond
   #
   #  Returns:
   #     The string to be sent back to the client either:
   #   ok         - Everything worked just fine.
   #   error:why  - There was a failure and why describes the reason.
   #
   #
   sub ReinitProcess {
       my $request = shift;
   
   
       # separate the request (reinit) from the process identifier and
       # validate it producing the name of the .pid file for the process.
       #
       #
       my ($junk, $process) = split(":", $request);
       my $processpidfile = $perlvar{'lonDaemons'}.'/logs/';
       if($process eq 'lonc') {
    $processpidfile = $processpidfile."lonc.pid";
    if (!open(PIDFILE, "< $processpidfile")) {
       return "error:Open failed for $processpidfile";
    }
    my $loncpid = <PIDFILE>;
    close(PIDFILE);
    logthis('<font color="red"> Reinitializing lonc pid='.$loncpid
    ."</font>");
    kill("USR2", $loncpid);
       } elsif ($process eq 'lond') {
    logthis('<font color="red"> Reinitializing self (lond) </font>');
    &UpdateHosts; # Lond is us!!
       } else {
    &logthis('<font color="yellow" Invalid reinit request for '.$process
    ."</font>");
    return "error:Invalid process identifier $process";
       }
       return 'ok';
   }
   
   #
 #  Convert an error return code from lcpasswd to a string value.  #  Convert an error return code from lcpasswd to a string value.
 #  #
 sub lcpasswdstrerror {  sub lcpasswdstrerror {
Line 182  $SIG{__DIE__}=\&catchexception; Line 484  $SIG{__DIE__}=\&catchexception;
 # ---------------------------------- Read loncapa_apache.conf and loncapa.conf  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
 &status("Read loncapa.conf and loncapa_apache.conf");  &status("Read loncapa.conf and loncapa_apache.conf");
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
 my %perlvar=%{$perlvarref};  %perlvar=%{$perlvarref};
 undef $perlvarref;  undef $perlvarref;
   
 # ----------------------------- Make sure this process is running from user=www  # ----------------------------- Make sure this process is running from user=www
Line 208  if (-e $pidfile) { Line 510  if (-e $pidfile) {
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
   
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";  
   
 while (my $configline=<CONFIG>) {  
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);  
     chomp($ip); $ip=~s/\D+$//;  
     $hostid{$ip}=$id;  
     $hostdom{$id}=$domain;  
     $hostip{$id}=$ip;  
     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }  
 }  
 close(CONFIG);  
   
 # establish SERVER socket, bind and listen.  # establish SERVER socket, bind and listen.
 $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},  $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
Line 267  sub HUPSMAN {                      # sig Line 559  sub HUPSMAN {                      # sig
     exec("$execdir/lond");         # here we go again      exec("$execdir/lond");         # here we go again
 }  }
   
   #
   #    Kill off hashes that describe the host table prior to re-reading it.
   #    Hashes affected are:
   #       %hostid, %hostdom %hostip
   #
   sub KillHostHashes {
       foreach my $key (keys %hostid) {
    delete $hostid{$key};
       }
       foreach my $key (keys %hostdom) {
    delete $hostdom{$key};
       }
       foreach my $key (keys %hostip) {
    delete $hostip{$key};
       }
   }
   #
   #   Read in the host table from file and distribute it into the various hashes:
   #
   #    - %hostid  -  Indexed by IP, the loncapa hostname.
   #    - %hostdom -  Indexed by  loncapa hostname, the domain.
   #    - %hostip  -  Indexed by hostid, the Ip address of the host.
   sub ReadHostTable {
   
       open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
       
       while (my $configline=<CONFIG>) {
    my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
    chomp($ip); $ip=~s/\D+$//;
    $hostid{$ip}=$id;
    $hostdom{$id}=$domain;
    $hostip{$id}=$ip;
    if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
       }
       close(CONFIG);
   }
   #
   #  Reload the Apache daemon's state.
   #  This is done by invoking /home/httpd/perl/apachereload
   #  a setuid perl script that can be root for us to do this job.
   #
   sub ReloadApache {
       my $execdir = $perlvar{'lonDaemons'};
       my $script  = $execdir."/apachereload";
       system($script);
   }
   
   #
   #   Called in response to a USR2 signal.
   #   - Reread hosts.tab
   #   - All children connected to hosts that were removed from hosts.tab
   #     are killed via SIGINT
   #   - All children connected to previously existing hosts are sent SIGUSR1
   #   - Our internal hosts hash is updated to reflect the new contents of
   #     hosts.tab causing connections from hosts added to hosts.tab to
   #     now be honored.
   #
   sub UpdateHosts {
       logthis('<font color="blue"> Updating connections </font>');
       #
       #  The %children hash has the set of IP's we currently have children
       #  on.  These need to be matched against records in the hosts.tab
       #  Any ip's no longer in the table get killed off they correspond to
       #  either dropped or changed hosts.  Note that the re-read of the table
       #  will take care of new and changed hosts as connections come into being.
   
   
       KillHostHashes;
       ReadHostTable;
   
       foreach my $child (keys %children) {
    my $childip = $children{$child};
    if(!$hostid{$childip}) {
       logthis('<font color="blue"> UpdateHosts killing child '
       ." $child for ip $childip </font>");
       kill('INT', $child);
    } else {
       logthis('<font color="green"> keeping child for ip '
       ." $childip (pid=$child) </font>");
    }
       }
       ReloadApache;
   }
   
   
 sub checkchildren {  sub checkchildren {
     &initnewstatus();      &initnewstatus();
     &logstatus();      &logstatus();
Line 509  $SIG{CHLD} = \&REAPER; Line 886  $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;  $SIG{HUP}  = \&HUPSMAN;
 $SIG{USR1} = \&checkchildren;  $SIG{USR1} = \&checkchildren;
   $SIG{USR2} = \&UpdateHosts;
   
   #  Read the host hashes:
   
   ReadHostTable;
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
 #   Accept connections.  When a connection comes in, it is validated  #   Accept connections.  When a connection comes in, it is validated
Line 534  sub make_new_child { Line 914  sub make_new_child {
     sigprocmask(SIG_BLOCK, $sigset)      sigprocmask(SIG_BLOCK, $sigset)
         or die "Can't block SIGINT for fork: $!\n";          or die "Can't block SIGINT for fork: $!\n";
   
     my $clientip;  
     die "fork: $!" unless defined ($pid = fork);      die "fork: $!" unless defined ($pid = fork);
   
       $client->sockopt(SO_KEEPALIVE, 1); # Enable monitoring of
                                  # connection liveness.
   
       #
       #  Figure out who we're talking to so we can record the peer in 
       #  the pid hash.
       #
       my $caller = getpeername($client);
       my ($port,$iaddr)=unpack_sockaddr_in($caller);
       $clientip=inet_ntoa($iaddr);
           
     if ($pid) {      if ($pid) {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;          $children{$pid} = $clientip;
         $children++;          $children++;
         &status('Started child '.$pid);          &status('Started child '.$pid);
         return;          return;
Line 568  sub make_new_child { Line 958  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
     $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of   # see if we know client and check for spoof IP by challenge
                                       # connection liveness.  
             # see if we know client and check for spoof IP by challenge  
  my $caller = getpeername($client);  
             my ($port,$iaddr)=unpack_sockaddr_in($caller);  
             $clientip=inet_ntoa($iaddr);  
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis(              &logthis(
 "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"  "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
Line 652  sub make_new_child { Line 1038  sub make_new_child {
    if ($userinput =~ /^ping/) {     if ($userinput =~ /^ping/) {
                        print $client "$currenthostid\n";                         print $client "$currenthostid\n";
 # ------------------------------------------------------------------------ pong  # ------------------------------------------------------------------------ pong
    } elsif ($userinput =~ /^pong/) {     }elsif ($userinput =~ /^pong/) {
                        my $reply=&reply("ping",$hostid{$clientip});                         my $reply=&reply("ping",$hostid{$clientip});
                        print $client "$currenthostid:$reply\n";                          print $client "$currenthostid:$reply\n"; 
 # ------------------------------------------------------------------------ ekey  # ------------------------------------------------------------------------ ekey
Line 683  sub make_new_child { Line 1069  sub make_new_child {
    } elsif ($userinput =~ /^userload/) {     } elsif ($userinput =~ /^userload/) {
        my $userloadpercent=&userload();         my $userloadpercent=&userload();
        print $client "$userloadpercent\n";         print $client "$userloadpercent\n";
   
   #
   #        Transactions requiring encryption:
   #
 # ----------------------------------------------------------------- currentauth  # ----------------------------------------------------------------- currentauth
    } elsif ($userinput =~ /^currentauth/) {     } elsif ($userinput =~ /^currentauth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 697  sub make_new_child { Line 1087  sub make_new_child {
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
      }       }
   #--------------------------------------------------------------------- pushfile
      } elsif($userinput =~ /^pushfile/) { 
          if($wasenc == 1) {
      my $cert = GetCertificate($userinput);
      if(ValidManager($cert)) {
          my $reply = PushFile($userinput);
          print $client "$reply\n";
      } else {
          print $client "refused\n";
      } 
          } else {
      print $client "refused\n";
          }
   #--------------------------------------------------------------------- reinit
      } elsif($userinput =~ /^reinit/) {
          if ($wasenc == 1) {
      my $cert = GetCertificate($userinput);
      if(ValidManager($cert)) {
          chomp($userinput);
          my $reply = ReinitProcess($userinput);
          print $client  "$reply\n";
      } else {
          print $client "refused\n";
      }
          } else {
      print $client "refused\n";
          }
 # ------------------------------------------------------------------------ auth  # ------------------------------------------------------------------------ auth
                    } elsif ($userinput =~ /^auth/) {                     } elsif ($userinput =~ /^auth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 808  sub make_new_child { Line 1225  sub make_new_child {
      my $salt=time;       my $salt=time;
                              $salt=substr($salt,6,2);                               $salt=substr($salt,6,2);
      my $ncpass=crypt($npass,$salt);       my $ncpass=crypt($npass,$salt);
                              { my $pf = IO::File->new(">$passfilename");                               {
           print $pf "internal:$ncpass\n"; }                my $pf;
      &logthis("Result of password change for $uname: pwchange_success");   if ($pf = IO::File->new(">$passfilename")) {
                              print $client "ok\n";       print $pf "internal:$ncpass\n";
        &logthis("Result of password change for $uname: pwchange_success");
        print $client "ok\n";
    } else {
        &logthis("Unable to open $uname passwd to change password");
        print $client "non_authorized\n";
    }
        }             
        
                            } else {                             } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
                            }                             }
Line 990  sub make_new_child { Line 1415  sub make_new_child {
                        }                         }
 # -------------------------------------- fetch a user file from a remote server  # -------------------------------------- fetch a user file from a remote server
                    } elsif ($userinput =~ /^fetchuserfile/) {                     } elsif ($userinput =~ /^fetchuserfile/) {
                       my ($cmd,$fname)=split(/:/,$userinput);         my ($cmd,$fname)=split(/:/,$userinput);
       my ($udom,$uname,$ufile)=split(/\//,$fname);         my ($udom,$uname,$ufile)=split(/\//,$fname);
                       my $udir=propath($udom,$uname).'/userfiles';         my $udir=propath($udom,$uname).'/userfiles';
                       unless (-e $udir) { mkdir($udir,0770); }         unless (-e $udir) { mkdir($udir,0770); }
                        if (-e $udir) {                         if (-e $udir) {
                        $ufile=~s/^[\.\~]+//;     $ufile=~s/^[\.\~]+//;
                        $ufile=~s/\///g;     $ufile=~s/\///g;
                        my $transname=$udir.'/'.$ufile;     my $destname=$udir.'/'.$ufile;
                        my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;     my $transname=$udir.'/'.$ufile.'.in.transit';
                              my $response;     my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
                               {     my $response;
                              my $ua=new LWP::UserAgent;     {
                              my $request=new HTTP::Request('GET',"$remoteurl");         my $ua=new LWP::UserAgent;
                              $response=$ua->request($request,$transname);         my $request=new HTTP::Request('GET',"$remoteurl");
       }         $response=$ua->request($request,$transname);
                              if ($response->is_error()) {     }
  unlink($transname);     if ($response->is_error()) {
                                  my $message=$response->status_line;         unlink($transname);
                                  &logthis(         my $message=$response->status_line;
                                   "LWP GET: $message for $fname ($remoteurl)");         &logthis("LWP GET: $message for $fname ($remoteurl)");
  print $client "failed\n";         print $client "failed\n";
                              } else {     } else {
                                  print $client "ok\n";         if (!rename($transname,$destname)) {
                              }     &logthis("Unable to move $transname to $destname");
                      } else {     unlink($transname);
                        print $client "not_home\n";     print $client "failed\n";
                      }          } else {
      print $client "ok\n";
          }
      }
          } else {
      print $client "not_home\n";
          }
 # ------------------------------------------ authenticate access to a user file  # ------------------------------------------ authenticate access to a user file
                    } elsif ($userinput =~ /^tokenauthuserfile/) {                     } elsif ($userinput =~ /^tokenauthuserfile/) {
                        my ($cmd,$fname,$session)=split(/:/,$userinput);                         my ($cmd,$fname,$session)=split(/:/,$userinput);
Line 1733  sub make_new_child { Line 2164  sub make_new_child {
                        }                         }
                        if ($ulsout eq '') { $ulsout='empty'; }                         if ($ulsout eq '') { $ulsout='empty'; }
                        print $client "$ulsout\n";                         print $client "$ulsout\n";
   # ----------------------------------------------------------------- setannounce
                      } elsif ($userinput =~ /^setannounce/) {
          my ($cmd,$announcement)=split(/:/,$userinput);
          chomp($announcement);
          $announcement=&unescape($announcement);
                          if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
    '/announcement.txt')) {
      print $store $announcement;
                              close $store;
      print $client "ok\n";
          } else {
      print $client "error: ".($!+0)."\n";
          }
 # ------------------------------------------------------------------ Hanging up  # ------------------------------------------------------------------ Hanging up
                    } elsif (($userinput =~ /^exit/) ||                     } elsif (($userinput =~ /^exit/) ||
                             ($userinput =~ /^init/)) {                              ($userinput =~ /^init/)) {
Line 1887  sub chatadd { Line 2331  sub chatadd {
     my %hash;      my %hash;
     my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
     my @entries=();      my @entries=();
       my $time=time;
     if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",      if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
     &GDBM_WRCREAT(),0640)) {      &GDBM_WRCREAT(),0640)) {
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  my $time=time;  
  my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);   my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
  my ($thentime,$idnum)=split(/\_/,$lastid);   my ($thentime,$idnum)=split(/\_/,$lastid);
  my $newid=$time.'_000000';   my $newid=$time.'_000000';
Line 1910  sub chatadd { Line 2354  sub chatadd {
  }   }
  untie %hash;   untie %hash;
     }      }
       {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname/chatroom.log")) { 
       print $hfh "$time:".&unescape($newchat)."\n";
    }
       }
 }  }
   
 sub unsub {  sub unsub {
Line 2105  sub userload { Line 2555  sub userload {
  my $curtime=time;   my $curtime=time;
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      if ($filename eq '.' || $filename eq '..') {next;}
     my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];      my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
     if ($curtime-$atime < 3600) { $numusers++; }      if ($curtime-$mtime < 3600) { $numusers++; }
  }   }
  closedir(LONIDS);   closedir(LONIDS);
     }      }
Line 2228  each connection is logged. Line 2678  each connection is logged.
   
 =item *  =item *
   
   SIGUSR2
   
   Parent Signal assignment:
       $SIG{USR2} = \&UpdateHosts
   
   Child signal assignment:
       NONE
   
   
   =item *
   
 SIGCHLD  SIGCHLD
   
 Parent signal assignment:  Parent signal assignment:
Removed from v.1.135  
changed lines
  Added in v.1.151

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