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

Diff for /loncom/lond between versions 1.9 and 1.21

version 1.9, 2000/02/08 17:34:24 version 1.21, 2000/09/25 20:22:58
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,01/14,2/8 Gerd Kortemeyer  # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
   # 03/07,05/31 Gerd Kortemeyer
   # 06/26 Scott Harrison
   # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
   #
 # 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 34  while ($configline=<CONFIG>) { Line 38  while ($configline=<CONFIG>) {
 }  }
 close(CONFIG);  close(CONFIG);
   
   # --------------------------------------------- Check if other instance running
   
   my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
   
   if (-e $pidfile) {
      my $lfh=IO::File->new("$pidfile");
      my $pide=<$lfh>;
      chomp($pide);
      if (kill 0 => $pide) { die "already running"; }
   }
   
 $PREFORK=4; # number of children to maintain, at least four spare  $PREFORK=4; # number of children to maintain, at least four spare
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
Line 103  sub logthis { Line 118  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 133  sub reconlonc { Line 165  sub reconlonc {
 }  }
   
 # -------------------------------------------------- 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 165  sub reply { Line 198  sub reply {
   return $answer;    return $answer;
 }  }
   
   # -------------------------------------------------------------- Talk to lonsql
   
   sub sqlreply {
       my ($cmd)=@_;
       my $answer=subsqlreply($cmd);
       if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); }
       return $answer;
   }
   
   sub subsqlreply {
       my ($cmd)=@_;
       my $unixsock="mysqlsock";
       my $peerfile="$perlvar{'lonSockDir'}/$unixsock";
       my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                         Type    => SOCK_STREAM,
                                         Timeout => 10)
          or return "con_lost";
       print $sclient "$cmd\n";
       my $answer=<$sclient>;
       chomp($answer);
       if (!$answer) { $answer="con_lost"; }
       return $answer;
   }
   
 # -------------------------------------------- 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;
     $uname=~s/\W//g;      $uname=~s/\W//g;
     my $subdir=$uname;      my $subdir=$uname.'__';
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";      my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
     return $proname;      return $proname;
 }   } 
   
 # --------------------------------------- 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 253  sub make_new_child { Line 312  sub make_new_child {
         # unblock signals          # unblock signals
         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";
   
           $tmpsnum=0;
           
         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD          # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {          for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
Line 283  sub make_new_child { Line 344  sub make_new_child {
                   } else {                    } else {
       &logthis(        &logthis(
  "<font color=blue>WARNING: $clientip did not reply challenge</font>");   "<font color=blue>WARNING: $clientip did not reply challenge</font>");
                         print $client "bye\n";
                   }                    }
               } else {                } else {
   &logthis(    &logthis(
                     "<font color=blue>WARNING: "                      "<font color=blue>WARNING: "
                    ."$clientip failed to initialize: >$remotereq< </font>");                     ."$clientip failed to initialize: >$remotereq< </font>");
     print $client "bye\n";
               }                }
     } else {      } else {
               &logthis(                &logthis(
  "<font color=blue>WARNING: Unknown client $clientip</font>");   "<font color=blue>WARNING: Unknown client $clientip</font>");
                 print $client "bye\n";
             }              }
             if ($clientok) {              if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again  # ---------------- New known client connecting, could mean machine online again
Line 354  sub make_new_child { Line 418  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 462  sub make_new_child { Line 527  sub make_new_child {
                                  &logthis(                                   &logthis(
                                   "LWP GET: $message for $fname ($remoteurl)");                                    "LWP GET: $message for $fname ($remoteurl)");
                              } else {                               } else {
                            if ($remoteurl!~/\.meta$/) {
                                     my $mrequest=
                                      new HTTP::Request('GET',$remoteurl.'.meta');
                                     my $mresponse=
                                      $ua->request($mrequest,$fname.'.meta');
                                     if ($mresponse->is_error()) {
                       unlink($fname.'.meta');
                                     }
                            }
                                  rename($transname,$fname);                                   rename($transname,$fname);
      }       }
                           }                            }
Line 490  sub make_new_child { Line 564  sub make_new_child {
                        my $ownership=ishome($fname);                         my $ownership=ishome($fname);
                        if ($ownership eq 'owner') {                         if ($ownership eq 'owner') {
                         if (-e $fname) {                          if (-e $fname) {
    if (-d $fname) {
      print $client "directory\n";
                            } else {
                            $now=time;                             $now=time;
                            {                              { 
                             my $sh=IO::File->new(">$fname.$hostid{$clientip}");                              my $sh=IO::File->new(">$fname.$hostid{$clientip}");
Line 498  sub make_new_child { Line 575  sub make_new_child {
                            $fname=~s/\/home\/httpd\/html\/res/raw/;                             $fname=~s/\/home\/httpd\/html\/res/raw/;
                            $fname="http://$thisserver/".$fname;                             $fname="http://$thisserver/".$fname;
                            print $client "$fname\n";                             print $client "$fname\n";
            }
                         } else {                          } else {
          print $client "not_found\n";           print $client "not_found\n";
                         }                          }
        } else {         } else {
                         print $client "rejected\n";                          print $client "rejected\n";
        }         }
   # ------------------------------------------------------------------------- log
                      } elsif ($userinput =~ /^log/) {
                          my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
                          chomp($what);
                          my $proname=propath($udom,$uname);
                          my $now=time;
                          {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname/activity.log")) { 
                               print $hfh "$now:$hostid{$clientip}:$what\n";
                               print $client "ok\n"; 
    } else {
                               print $client "error:$!\n";
           }
          }
 # ------------------------------------------------------------------------- put  # ------------------------------------------------------------------------- put
                    } elsif ($userinput =~ /^put/) {                     } elsif ($userinput =~ /^put/) {
                       my ($cmd,$udom,$uname,$namespace,$what)                        my ($cmd,$udom,$uname,$namespace,$what)
Line 581  sub make_new_child { Line 674  sub make_new_child {
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        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_READER,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 604  sub make_new_child { Line 697  sub make_new_child {
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        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_READER,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 666  sub make_new_child { Line 759  sub make_new_child {
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        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_READER,0640)) {
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                $qresult.="$key&";                                 $qresult.="$key&";
                            }                             }
Line 687  sub make_new_child { Line 780  sub make_new_child {
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        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_READER,0640)) {
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                $qresult.="$key=$hash{$key}&";                                 $qresult.="$key=$hash{$key}&";
                            }                             }
Line 751  sub make_new_child { Line 844  sub make_new_child {
                        chomp($rid);                         chomp($rid);
                        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_READER,0640)) {
                   my $version=$hash{"version:$rid"};                    my $version=$hash{"version:$rid"};
                            $qresult.="version=$version&";                             $qresult.="version=$version&";
                            my $scope;                             my $scope;
Line 761  sub make_new_child { Line 854  sub make_new_child {
                               my $key;                                my $key;
                               $qresult.="$scope:keys=$vkeys&";                                $qresult.="$scope:keys=$vkeys&";
                               foreach $key (@keys) {                                foreach $key (@keys) {
      $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";       $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
                               }                                                                  }                                  
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
Line 773  sub make_new_child { Line 866  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
   # ------------------------------------------------------------------- querysend
                      } elsif ($userinput =~ /^querysend/) {
                          my ($cmd,$query)=split(/:/,$userinput);
          $query=~s/\n*$//g;
                        print $client sqlreply("$hostid{$clientip}\&$query")."\n";
   # ------------------------------------------------------------------ queryreply
                      } elsif ($userinput =~ /^queryreply/) {
                          my ($cmd,$id,$reply)=split(/:/,$userinput); 
          my $store;
                          my $execdir=$perlvar{'lonDaemons'};
                          if ($store=IO::File->new(">$execdir/tmp/$id")) {
      print $store $reply;
      close $store;
      print $client "ok\n";
          }
          else {
      print $client "error:$!\n";
          }
 # ----------------------------------------------------------------------- idput  # ----------------------------------------------------------------------- idput
                    } elsif ($userinput =~ /^idput/) {                     } elsif ($userinput =~ /^idput/) {
                        my ($cmd,$udom,$what)=split(/:/,$userinput);                         my ($cmd,$udom,$what)=split(/:/,$userinput);
Line 808  sub make_new_child { Line 919  sub make_new_child {
                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";                         my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        my $qresult='';                         my $qresult='';
                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 821  sub make_new_child { Line 932  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
   # ---------------------------------------------------------------------- tmpput
                      } elsif ($userinput =~ /^tmpput/) {
                          my ($cmd,$what)=split(/:/,$userinput);
          my $store;
                          $tmpsnum++;
                          my $id=$$.'_'.$clientip.'_'.$tmpsnum;
                          $id=~s/\W/\_/g;
                          $what=~s/\n//g;
                          my $execdir=$perlvar{'lonDaemons'};
                          if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
      print $store $what;
      close $store;
      print $client "$id\n";
          }
          else {
      print $client "error:$!\n";
          }
   
   # ---------------------------------------------------------------------- tmpget
                      } elsif ($userinput =~ /^tmpget/) {
                          my ($cmd,$id)=split(/:/,$userinput);
                          chomp($id);
                          $id=~s/\W/\_/g;
                          my $store;
                          my $execdir=$perlvar{'lonDaemons'};
                          if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
                              my $reply=<$store>;
      print $client "$reply\n";
                              close $store;
          }
          else {
      print $client "error:$!\n";
          }
   
 # -------------------------------------------------------------------------- ls  # -------------------------------------------------------------------------- ls
                    } elsif ($userinput =~ /^ls/) {                     } elsif ($userinput =~ /^ls/) {
                        my ($cmd,$ulsdir)=split(/:/,$userinput);                         my ($cmd,$ulsdir)=split(/:/,$userinput);
Line 834  sub make_new_child { Line 979  sub make_new_child {
        } else {         } else {
                           $ulsout='no_such_dir';                            $ulsout='no_such_dir';
                        }                         }
                          if ($ulsout eq '') { $ulsout='empty'; }
                        print $client "$ulsout\n";                         print $client "$ulsout\n";
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
                    } else {                     } else {
Line 848  sub make_new_child { Line 994  sub make_new_child {
                 ."Rejected client $clientip, closing connection</font>");                  ."Rejected client $clientip, closing connection</font>");
             }                            }              
             &logthis("<font color=red>CRITICAL: "              &logthis("<font color=red>CRITICAL: "
                     ."Disconnect from $clientip ($hostid{$clientip})");                      ."Disconnect from $clientip ($hostid{$clientip})</font>");
 # =============================================================================  # =============================================================================
         }          }
           
Removed from v.1.9  
changed lines
  Added in v.1.21

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.