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

Diff for /loncom/lond between versions 1.11 and 1.18

version 1.11, 2000/05/01 20:22:39 version 1.18, 2000/07/21 00:40:37
Line 5 Line 5
 # 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,  # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
 # 03/07 Gerd Kortemeyer  # 03/07,05/31 Gerd Kortemeyer
   # 06/26 Scott Harrison
   # 06/29,06/30,07/14,07/15,07/17,07/20 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 184  sub reply { Line 187  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;
Line 274  sub make_new_child { Line 301  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 304  sub make_new_child { Line 333  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 484  sub make_new_child { Line 516  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 512  sub make_new_child { Line 553  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 520  sub make_new_child { Line 564  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 795  sub make_new_child { Line 855  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 843  sub make_new_child { Line 921  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 856  sub make_new_child { Line 968  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 {
Removed from v.1.11  
changed lines
  Added in v.1.18

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