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

Diff for /loncom/lond between versions 1.7 and 1.11

version 1.7, 2000/01/12 19:30:43 version 1.11, 2000/05/01 20:22:39
Line 4 Line 4
 # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,  # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
 # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,  # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
 # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,  # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
 # 12/7,12/15,01/06,01/11,01/12 Gerd Kortemeyer  # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
   # 03/07 Gerd Kortemeyer
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
 # preforker - server who forks first  # preforker - server who forks first
 # runs as a daemon  # runs as a daemon
Line 79  sub HUNTSMAN {                      # si Line 80  sub HUNTSMAN {                      # si
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lond.pid");      unlink("$execdir/logs/lond.pid");
     &logthis("Shutting down");      &logthis("<font color=red>CRITICAL: Shutting down</font>");
     exit;                           # clean up with dignity      exit;                           # clean up with dignity
 }  }
   
Line 87  sub HUPSMAN {                      # sig Line 88  sub HUPSMAN {                      # sig
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     close($server);                # free up socket      close($server);                # free up socket
     &logthis("Restarting");      &logthis("<font color=red>CRITICAL: Restarting</font>");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lond");         # here we go again      exec("$execdir/lond");         # here we go again
 }  }
Line 103  sub logthis { Line 104  sub logthis {
     print $fh "$local ($$): $message\n";      print $fh "$local ($$): $message\n";
 }  }
   
   
   # -------------------------------------------------------- Escape Special Chars
   
   sub escape {
       my $str=shift;
       $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
       return $str;
   }
   
   # ----------------------------------------------------- Un-Escape Special Chars
   
   sub unescape {
       my $str=shift;
       $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       return $str;
   }
   
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
Line 120  sub reconlonc { Line 138  sub reconlonc {
             &logthis("$peerfile still not there, give it another try");              &logthis("$peerfile still not there, give it another try");
             sleep 5;              sleep 5;
             if (-e "$peerfile") { return; }              if (-e "$peerfile") { return; }
             &logthis("$peerfile still not there, giving up");              &logthis(
    "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
         } else {          } else {
     &logthis("lonc at pid $loncpid not responding, giving up");      &logthis(
                 "<font color=red>CRITICAL: "
                ."lonc at pid $loncpid not responding, giving up</font>");
         }          }
     } else {      } else {
         &logthis('lonc not running, giving up');        &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
     }      }
 }  }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
   
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
     my $peerfile="$perlvar{'lonSockDir'}/$server";      my $peerfile="$perlvar{'lonSockDir'}/$server";
Line 163  sub reply { Line 185  sub reply {
 }  }
   
 # -------------------------------------------- Return path to profile directory  # -------------------------------------------- Return path to profile directory
   
 sub propath {  sub propath {
     my ($udom,$uname)=@_;      my ($udom,$uname)=@_;
     $udom=~s/\W//g;      $udom=~s/\W//g;
Line 174  sub propath { Line 197  sub propath {
 }   } 
   
 # --------------------------------------- Is this the home server of an author?  # --------------------------------------- Is this the home server of an author?
   
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
Line 201  $execdir=$perlvar{'lonDaemons'}; Line 225  $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lond.pid");  open (PIDSAVE,">$execdir/logs/lond.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
 &logthis("Starting");  &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
   
 # ------------------------------------------------------- Now we are on our own  # ------------------------------------------------------- Now we are on our own
           
Line 263  sub make_new_child { Line 287  sub make_new_child {
             my ($port,$iaddr)=unpack_sockaddr_in($caller);              my ($port,$iaddr)=unpack_sockaddr_in($caller);
             my $clientip=inet_ntoa($iaddr);              my $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis("Connect from $clientip ($hostid{$clientip})");              &logthis(
   "<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");
             my $clientok;              my $clientok;
             if ($clientrec) {              if ($clientrec) {
       my $remotereq=<$client>;        my $remotereq=<$client>;
Line 277  sub make_new_child { Line 302  sub make_new_child {
       $clientok=1;        $clientok=1;
                       print $client "ok\n";                        print $client "ok\n";
                   } else {                    } else {
       &logthis("$clientip did not reply challenge");        &logthis(
    "<font color=blue>WARNING: $clientip did not reply challenge</font>");
                   }                    }
               } else {                } else {
   &logthis("$clientip failed to initialize: >$remotereq<");    &logthis(
                       "<font color=blue>WARNING: "
                      ."$clientip failed to initialize: >$remotereq< </font>");
               }                }
     } else {      } else {
               &logthis("Unknown client $clientip");                &logthis(
    "<font color=blue>WARNING: Unknown client $clientip</font>");
             }              }
             if ($clientok) {              if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again  # ---------------- New known client connecting, could mean machine online again
       &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");        &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
                 &logthis(
          "<font color=green>Established connection: $hostid{$clientip}</font>");
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
               while (my $userinput=<$client>) {                while (my $userinput=<$client>) {
                 chomp($userinput);                  chomp($userinput);
Line 344  sub make_new_child { Line 375  sub make_new_child {
      if ($wasenc==1) {       if ($wasenc==1) {
                        my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);                         my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
                        chomp($upass);                         chomp($upass);
                          $upass=unescape($upass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
                        if (-e $passfilename) {                         if (-e $passfilename) {
Line 498  sub make_new_child { Line 530  sub make_new_child {
                    } elsif ($userinput =~ /^put/) {                     } elsif ($userinput =~ /^put/) {
                       my ($cmd,$udom,$uname,$namespace,$what)                        my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                         $namespace=~s/\//\_/g;
                       $namespace=~s/\W//g;                        $namespace=~s/\W//g;
                       if ($namespace ne 'roles') {                        if ($namespace ne 'roles') {
                        chomp($what);                         chomp($what);
Line 564  sub make_new_child { Line 597  sub make_new_child {
                    } elsif ($userinput =~ /^get/) {                     } elsif ($userinput =~ /^get/) {
                        my ($cmd,$udom,$uname,$namespace,$what)                         my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($what);                         chomp($what);
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
Line 586  sub make_new_child { Line 620  sub make_new_child {
                    } elsif ($userinput =~ /^eget/) {                     } elsif ($userinput =~ /^eget/) {
                        my ($cmd,$udom,$uname,$namespace,$what)                         my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($what);                         chomp($what);
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
Line 621  sub make_new_child { Line 656  sub make_new_child {
                    } elsif ($userinput =~ /^del/) {                     } elsif ($userinput =~ /^del/) {
                        my ($cmd,$udom,$uname,$namespace,$what)                         my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
Line 648  sub make_new_child { Line 684  sub make_new_child {
                    } elsif ($userinput =~ /^keys/) {                     } elsif ($userinput =~ /^keys/) {
                        my ($cmd,$udom,$uname,$namespace)                         my ($cmd,$udom,$uname,$namespace)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($namespace);  
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
Line 669  sub make_new_child { Line 705  sub make_new_child {
                    } elsif ($userinput =~ /^dump/) {                     } elsif ($userinput =~ /^dump/) {
                        my ($cmd,$udom,$uname,$namespace)                         my ($cmd,$udom,$uname,$namespace)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($namespace);  
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
Line 690  sub make_new_child { Line 726  sub make_new_child {
                    } elsif ($userinput =~ /^store/) {                     } elsif ($userinput =~ /^store/) {
                       my ($cmd,$udom,$uname,$namespace,$rid,$what)                        my ($cmd,$udom,$uname,$namespace,$rid,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                         $namespace=~s/\//\_/g;
                       $namespace=~s/\W//g;                        $namespace=~s/\W//g;
                       if ($namespace ne 'roles') {                        if ($namespace ne 'roles') {
                        chomp($what);                         chomp($what);
Line 731  sub make_new_child { Line 768  sub make_new_child {
                    } elsif ($userinput =~ /^restore/) {                     } elsif ($userinput =~ /^restore/) {
                        my ($cmd,$udom,$uname,$namespace,$rid)                         my ($cmd,$udom,$uname,$namespace,$rid)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        chomp($rid);                         chomp($rid);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
Line 828  sub make_new_child { Line 866  sub make_new_child {
        }         }
             } else {              } else {
         print $client "refused\n";          print $client "refused\n";
                 &logthis("Rejected client $clientip, closing connection");                  &logthis("<font color=blue>WARNING: "
                   ."Rejected client $clientip, closing connection</font>");
             }                            }              
             &logthis("Disconnect from $clientip ($hostid{$clientip})");              &logthis("<font color=red>CRITICAL: "
                       ."Disconnect from $clientip ($hostid{$clientip})</font>");
 # =============================================================================  # =============================================================================
         }          }
           
Removed from v.1.7  
changed lines
  Added in v.1.11

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