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

Diff for /loncom/lond between versions 1.1.1.1 and 1.8

version 1.1.1.1, 1999/10/13 17:48:51 version 1.8, 2000/01/14 14:46:57
Line 2 Line 2
 # The LearningOnline Network  # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)  # lond "LON Daemon" Server (port "LOND" 5663)
 # 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,10/7,10/8,10/9,10/11 Gerd Kortemeyer  # 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,
   # 12/7,12/15,01/06,01/11,01/12,01/14 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 16  use Symbol; Line 18  use Symbol;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
   use GDBM_File;
   use Authen::Krb4;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ------------------------------------ Read httpd access.conf and get variables
   
Line 24  open (CONFIG,"/etc/httpd/conf/access.con Line 28  open (CONFIG,"/etc/httpd/conf/access.con
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {      if ($configline =~ /PerlSetVar/) {
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
           chomp($varvalue);
         $perlvar{$varname}=$varvalue;          $perlvar{$varname}=$varvalue;
     }      }
 }  }
Line 253  sub make_new_child { Line 258  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
             # see if we know client              # see if we know client and check for spoof IP by challenge
             my $caller=getpeername($client);              my $caller=getpeername($client);
             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("Connect from $clientip ($hostid{$clientip})");
               my $clientok;
             if ($clientrec) {              if ($clientrec) {
         my $remotereq=<$client>;
                 $remotereq=~s/\W//g;
                 if ($remotereq eq 'init') {
     my $challenge="$$".time;
                     print $client "$challenge\n";
                     $remotereq=<$client>;
                     $remotereq=~s/\W//g;
                     if ($challenge eq $remotereq) {
         $clientok=1;
                         print $client "ok\n";
                     } else {
         &logthis("$clientip did not reply challenge");
                     }
                 } else {
     &logthis("$clientip failed to initialize: >$remotereq<");
                 }
       } else {
                 &logthis("Unknown client $clientip");
               }
               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}");
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
Line 324  sub make_new_child { Line 350  sub make_new_child {
                           my $pf = IO::File->new($passfilename);                            my $pf = IO::File->new($passfilename);
                           my $realpasswd=<$pf>;                            my $realpasswd=<$pf>;
                           chomp($realpasswd);                            chomp($realpasswd);
                           if ($realpasswd eq $upass ) {                            my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
                             my $pwdcorrect=0;
                             if ($howpwd eq 'internal') {
         $pwdcorrect=
     (crypt($upass,$contentpwd) eq $contentpwd);
                             } elsif ($howpwd eq 'unix') {
                                 $contentpwd=(getpwnam($uname))[1];
                                 $pwdcorrect=
                                     (crypt($upass,$contentpwd) eq $contentpwd);
                             } elsif ($howpwd eq 'krb4') {
                                 $pwdcorrect=(
                                    Authen::Krb4::get_pw_in_tkt($uname,"",
                                           $contentpwd,'krbtgt',$contentpwd,1,
        $upass) == 0);
                             }
                             if ($pwdcorrect) {
                              print $client "authorized\n";                               print $client "authorized\n";
                           } else {                            } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
Line 348  sub make_new_child { Line 389  sub make_new_child {
                           { my $pf = IO::File->new($passfilename);                            { my $pf = IO::File->new($passfilename);
     $realpasswd=<$pf>; }      $realpasswd=<$pf>; }
                           chomp($realpasswd);                            chomp($realpasswd);
                           if ($realpasswd eq $upass ) {                            my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
                             if ($howpwd eq 'internal') {
      if (crypt($upass,$contentpwd) eq $contentpwd) {
        my $salt=time;
                                $salt=substr($salt,6,2);
        my $ncpass=crypt($npass,$salt);
                              { my $pf = IO::File->new(">$passfilename");                               { my $pf = IO::File->new(">$passfilename");
           print $pf "$npass\n";; }                              print $pf "internal:$ncpass\n";; }             
                              print $client "ok\n";                               print $client "ok\n";
                           } else {                             } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
                              }
                             } else {
                               print $client "auth_mode_error\n";
                           }                              }  
        } else {         } else {
                           print $client "unknown_user\n";                            print $client "unknown_user\n";
Line 447  sub make_new_child { Line 496  sub make_new_child {
        }         }
 # ------------------------------------------------------------------------- put  # ------------------------------------------------------------------------- put
                    } elsif ($userinput =~ /^put/) {                     } elsif ($userinput =~ /^put/) {
                        my ($cmd,$udom,$uname,$namespace,$what)                        my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                        $namespace=~s/\W//g;                        $namespace=~s/\//\_/g;
                         $namespace=~s/\W//g;
                         if ($namespace ne 'roles') {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
Line 460  sub make_new_child { Line 511  sub make_new_child {
        ) { print $hfh "P:$now:$what\n"; }         ) { print $hfh "P:$now:$what\n"; }
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
                        if (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                              foreach $pair (@pairs) {
          ($key,$value)=split(/=/,$pair);
                                  $hash{$key}=$value;
                              }
      if (untie(%hash)) {
                                 print $client "ok\n";
                              } else {
                                 print $client "error:$!\n";
                              }
                          } else {
                              print $client "error:$!\n";
                          }
         } else {
                             print $client "refused\n";
                         }
   # -------------------------------------------------------------------- rolesput
                      } elsif ($userinput =~ /^rolesput/) {
       if ($wasenc==1) {
                          my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
                             =split(/:/,$userinput);
                          my $namespace='roles';
                          chomp($what);
                          my $proname=propath($udom,$uname);
                          my $now=time;
                          {
      my $hfh;
      if (
                                $hfh=IO::File->new(">>$proname/$namespace.hist")
          ) { 
                                     print $hfh "P:$now:$exedom:$exeuser:$what\n";
                                    }
          }
                          my @pairs=split(/\&/,$what);
         if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;                                 $hash{$key}=$value;
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error:$!\n";                                print $client "error:$!\n";
Line 473  sub make_new_child { Line 558  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
         } else {
                             print $client "refused\n";
                         }
 # ------------------------------------------------------------------------- get  # ------------------------------------------------------------------------- get
                    } 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);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
                        if (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
Line 499  sub make_new_child { Line 588  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);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
                        if (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                               if ($cipher) {                                if ($cipher) {
                                 my $cmdlength=length($qresult);                                  my $cmdlength=length($qresult);
Line 534  sub make_new_child { Line 624  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 545  sub make_new_child { Line 636  sub make_new_child {
        ) { print $hfh "D:$now:$what\n"; }         ) { print $hfh "D:$now:$what\n"; }
        }         }
                        my @keys=split(/\&/,$what);                         my @keys=split(/\&/,$what);
                        if (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            foreach $key (@keys) {                             foreach $key (@keys) {
                                delete($hash{$key});                                 delete($hash{$key});
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error:$!\n";                                print $client "error:$!\n";
Line 561  sub make_new_child { Line 652  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 (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                $qresult.="$key&";                                 $qresult.="$key&";
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
Line 582  sub make_new_child { Line 673  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 (dbmopen(%hash,"$proname/$namespace.db",0644)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                $qresult.="$key=$hash{$key}&";                                 $qresult.="$key=$hash{$key}&";
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
                 $qresult=~s/\&$//;
                                 print $client "$qresult\n";
                              } else {
                                 print $client "error:$!\n";
                              }
                          } else {
                              print $client "error:$!\n";
                          }
   # ----------------------------------------------------------------------- store
                      } elsif ($userinput =~ /^store/) {
                         my ($cmd,$udom,$uname,$namespace,$rid,$what)
                             =split(/:/,$userinput);
                         $namespace=~s/\//\_/g;
                         $namespace=~s/\W//g;
                         if ($namespace ne 'roles') {
                          chomp($what);
                          my $proname=propath($udom,$uname);
                          my $now=time;
                          {
      my $hfh;
      if (
                                $hfh=IO::File->new(">>$proname/$namespace.hist")
          ) { print $hfh "P:$now:$rid:$what\n"; }
          }
                          my @pairs=split(/\&/,$what);
                            
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                              my @previouskeys=split(/&/,$hash{"keys:$rid"});
                              my $key;
                              $hash{"version:$rid"}++;
                              my $version=$hash{"version:$rid"};
                              my $allkeys=''; 
                              foreach $pair (@pairs) {
          ($key,$value)=split(/=/,$pair);
                                  $allkeys.=$key.':';
                                  $hash{"$version:$rid:$key"}=$value;
                              }
                              $allkeys=~s/:$//;
                              $hash{"$version:keys:$rid"}=$allkeys;
      if (untie(%hash)) {
                                 print $client "ok\n";
                              } else {
                                 print $client "error:$!\n";
                              }
                          } else {
                              print $client "error:$!\n";
                          }
         } else {
                             print $client "refused\n";
                         }
   # --------------------------------------------------------------------- restore
                      } elsif ($userinput =~ /^restore/) {
                          my ($cmd,$udom,$uname,$namespace,$rid)
                             =split(/:/,$userinput);
                          $namespace=~s/\//\_/g;
                          $namespace=~s/\W//g;
                          chomp($rid);
                          my $proname=propath($udom,$uname);
                          my $qresult='';
         if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                     my $version=$hash{"version:$rid"};
                              $qresult.="version=$version&";
                              my $scope;
                              for ($scope=1;$scope<=$version;$scope++) {
         my $vkeys=$hash{"$scope:keys:$rid"};
                                 my @keys=split(/:/,$vkeys);
                                 my $key;
                                 $qresult.="$scope:keys=$vkeys&";
                                 foreach $key (@keys) {
        $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";
                                 }                                  
                              }
      if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
Line 613  sub make_new_child { Line 777  sub make_new_child {
        ) { print $hfh "P:$now:$what\n"; }         ) { print $hfh "P:$now:$what\n"; }
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
                        if (dbmopen(%hash,"$proname.db",0644)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;                                 $hash{$key}=$value;
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error:$!\n";                                print $client "error:$!\n";
Line 634  sub make_new_child { Line 798  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 (dbmopen(%hash,"$proname.db",0644)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
    if (dbmclose(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
Line 647  sub make_new_child { Line 811  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
   # -------------------------------------------------------------------------- ls
                      } elsif ($userinput =~ /^ls/) {
                          my ($cmd,$ulsdir)=split(/:/,$userinput);
                          my $ulsout='';
                          my $ulsfn;
                          if (-e $ulsdir) {
                             while ($ulsfn=<$ulsdir/*>) {
        my @ulsstats=stat($ulsfn);
                                $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
                             }
          } else {
                             $ulsout='no_such_dir';
                          }
                          print $client "$ulsout\n";
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
                    } else {                     } else {
                        # unknown command                         # unknown command
Line 656  sub make_new_child { Line 834  sub make_new_child {
        }         }
             } else {              } else {
         print $client "refused\n";          print $client "refused\n";
                 &logthis("Unknown client $clientip, closing connection");                  &logthis("Rejected client $clientip, closing connection");
             }                            }              
             &logthis("Disconnect from $clientip ($hostid{$clientip})");              &logthis("Disconnect from $clientip ($hostid{$clientip})");
 # =============================================================================  # =============================================================================
Removed from v.1.1.1.1  
changed lines
  Added in v.1.8

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