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

Diff for /loncom/lond between versions 1.41 and 1.55

version 1.41, 2001/03/24 16:07:36 version 1.55, 2001/11/16 06:19:33
Line 14 Line 14
 # 02/12 Gerd Kortemeyer  # 02/12 Gerd Kortemeyer
 # 03/15 Scott Harrison  # 03/15 Scott Harrison
 # 03/24 Gerd Kortemeyer  # 03/24 Gerd Kortemeyer
   # 04/02 Scott Harrison
   # 05/11,05/28,08/30 Gerd Kortemeyer
   # 9/30,10/22,11/13,11/15 Scott Harrison
 #  #
   # $Id$
   ###
   
 # 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 30  use Crypt::IDEA; Line 36  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  use Authen::Krb4;
   use lib '/home/httpd/lib/perl/';
   use localauth;
   
 # grabs exception and records it to log before exiting  # grabs exception and records it to log before exiting
 sub catchexception {  sub catchexception {
Line 362  sub make_new_child { Line 370  sub make_new_child {
             my $clientip=inet_ntoa($iaddr);              my $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis(              &logthis(
 "<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");  "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
               );
             my $clientok;              my $clientok;
             if ($clientrec) {              if ($clientrec) {
       my $remotereq=<$client>;        my $remotereq=<$client>;
Line 447  sub make_new_child { Line 456  sub make_new_child {
                        $loadavg =~ s/\s.*//g;                         $loadavg =~ s/\s.*//g;
                        my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};                         my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
        print $client "$loadpercent\n";         print $client "$loadpercent\n";
   # ----------------------------------------------------------------- currentauth
      } elsif ($userinput =~ /^currentauth/) {
        if ($wasenc==1) {
                          my ($cmd,$udom,$uname)=split(/:/,$userinput);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
                          if (-e $passfilename) {
      my $pf = IO::File->new($passfilename);
      my $realpasswd=<$pf>;
      chomp($realpasswd);
      my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
      my $availablecontent='';
      if ($howpwd eq 'krb4') {
          $availablecontent=$contentpwd;
      }
      print $client "$howpwd:$availablecontent\n";
          } else {
                             print $client "unknown_user\n";
                          }
        } else {
          print $client "refused\n";
        }
 # ------------------------------------------------------------------------ auth  # ------------------------------------------------------------------------ auth
                    } elsif ($userinput =~ /^auth/) {                     } elsif ($userinput =~ /^auth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 466  sub make_new_child { Line 497  sub make_new_child {
   (crypt($upass,$contentpwd) eq $contentpwd);    (crypt($upass,$contentpwd) eq $contentpwd);
                           } elsif ($howpwd eq 'unix') {                            } elsif ($howpwd eq 'unix') {
                               $contentpwd=(getpwnam($uname))[1];                                $contentpwd=(getpwnam($uname))[1];
                               $pwdcorrect=        my $pwauth_path="/usr/local/sbin/pwauth";
                                   (crypt($upass,$contentpwd) eq $contentpwd);        unless ($contentpwd eq 'x') {
     $pwdcorrect=
                                       (crypt($upass,$contentpwd) eq $contentpwd);
         }
         elsif (-e $pwauth_path) {
     open PWAUTH, "|$pwauth_path" or
         die "Cannot invoke authentication";
     print PWAUTH "$uname\n$upass\n";
     close PWAUTH;
     $pwdcorrect=!$?;
         }
                           } elsif ($howpwd eq 'krb4') {                            } elsif ($howpwd eq 'krb4') {
                               $pwdcorrect=(                                $pwdcorrect=(
                                  Authen::Krb4::get_pw_in_tkt($uname,"",                                   Authen::Krb4::get_pw_in_tkt($uname,"",
                                         $contentpwd,'krbtgt',$contentpwd,1,                                          $contentpwd,'krbtgt',$contentpwd,1,
      $upass) == 0);       $upass) == 0);
                           }                            } elsif ($howpwd eq 'localauth') {
       $pwdcorrect=&localauth::localauth($uname,$upass,
         $contentpwd);
     }
                           if ($pwdcorrect) {                            if ($pwdcorrect) {
                              print $client "authorized\n";                               print $client "authorized\n";
                           } else {                            } else {
Line 560  sub make_new_child { Line 604  sub make_new_child {
                                {                                  { 
                                  my $pf = IO::File->new(">$passfilename");                                   my $pf = IO::File->new(">$passfilename");
             print $pf "internal:$ncpass\n";               print $pf "internal:$ncpass\n"; 
                                }                                              }
                                print $client "ok\n";                                 print $client "ok\n";
                              } elsif ($umode eq 'none') {       } elsif ($umode eq 'localauth') {
          {
    my $pf = IO::File->new(">$passfilename");
               print $pf "localauth:$npass\n";
          }
          print $client "ok\n";
        } elsif ($umode eq 'unix') {
          {
    my $execpath="$perlvar{'lonDaemons'}/".
                 "lcuseradd";
    {
        my $se = IO::File->new("|$execpath");
        print $se "$uname\n";
        print $se "$npass\n";
        print $se "$npass\n";
    }
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "unix:\n"; 
          }
          print $client "ok\n";
        } elsif ($umode eq 'none') {
                                {                                  { 
                                  my $pf = IO::File->new(">$passfilename");                                   my $pf = IO::File->new(">$passfilename");
             print $pf "none:\n";               print $pf "none:\n"; 
Line 578  sub make_new_child { Line 642  sub make_new_child {
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
      }       }
   # -------------------------------------------------------------- changeuserauth
                      } elsif ($userinput =~ /^changeuserauth/) {
        if ($wasenc==1) {
                          my 
                          ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                          chomp($npass);
                          $npass=&unescape($npass);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
          if ($udom ne $perlvar{'lonDefDomain'}) {
                              print $client "not_right_domain\n";
                          } else {
      if ($umode eq 'krb4') {
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "krb4:$npass\n"; 
                                  }             
                                  print $client "ok\n";
      } elsif ($umode eq 'internal') {
          my $salt=time;
                                  $salt=substr($salt,6,2);
          my $ncpass=crypt($npass,$salt);
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "internal:$ncpass\n"; 
                                  }
                                  print $client "ok\n";
      } elsif ($umode eq 'localauth') {
          {
      my $pf = IO::File->new(">$passfilename");
      print $pf "localauth:$npass\n";
          }
          print $client "ok\n";
      } elsif ($umode eq 'unix') {
          {
      my $execpath="$perlvar{'lonDaemons'}/".
          "lcuseradd";
      {
          my $se = IO::File->new("|$execpath");
          print $se "$uname\n";
          print $se "$npass\n";
          print $se "$npass\n";
      }
      my $pf = IO::File->new(">$passfilename");
      print $pf "unix:\n"; 
          }
          print $client "ok\n";
      } elsif ($umode eq 'none') {
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "none:\n"; 
                                  }             
                                  print $client "ok\n";
      } else {
                                  print $client "auth_mode_error\n";
      }  
                          }
        } else {
          print $client "refused\n";
        }
 # ------------------------------------------------------------------------ home  # ------------------------------------------------------------------------ home
                    } elsif ($userinput =~ /^home/) {                     } elsif ($userinput =~ /^home/) {
                        my ($cmd,$udom,$uname)=split(/:/,$userinput);                         my ($cmd,$udom,$uname)=split(/:/,$userinput);
Line 669  sub make_new_child { Line 793  sub make_new_child {
                                print $sh "$clientip:$now\n";                                 print $sh "$clientip:$now\n";
     }      }
    }     }
                              unless ($fname=~/\.meta$/) {
          unlink("$fname.meta.$hostid{$clientip}");
                              }
                            $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";
Line 704  sub make_new_child { Line 831  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 829  sub make_new_child { Line 956  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 900  sub make_new_child { Line 1027  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 966  sub make_new_child { Line 1093  sub make_new_child {
                        }                         }
 # ------------------------------------------------------------------- querysend  # ------------------------------------------------------------------- querysend
                    } elsif ($userinput =~ /^querysend/) {                     } elsif ($userinput =~ /^querysend/) {
                        my ($cmd,$query,$custom)=split(/:/,$userinput);                         my ($cmd,$query,
      $custom,$customshow)=split(/:/,$userinput);
        $query=~s/\n*$//g;         $query=~s/\n*$//g;
        unless ($custom) {         unless ($custom or $customshow) {
    print $client "".     print $client "".
        sqlreply("$hostid{$clientip}\&$query")."\n";         sqlreply("$hostid{$clientip}\&$query")."\n";
        }         }
        else {         else {
    print $client "".     print $client "".
        sqlreply("$hostid{$clientip}\&$query".         sqlreply("$hostid{$clientip}\&$query".
  "\&$custom")."\n";   "\&$custom"."\&$customshow")."\n";
        }         }
 # ------------------------------------------------------------------ queryreply  # ------------------------------------------------------------------ queryreply
                    } elsif ($userinput =~ /^queryreply/) {                     } elsif ($userinput =~ /^queryreply/) {
Line 983  sub make_new_child { Line 1111  sub make_new_child {
        my $store;         my $store;
                        my $execdir=$perlvar{'lonDaemons'};                         my $execdir=$perlvar{'lonDaemons'};
                        if ($store=IO::File->new(">$execdir/tmp/$id")) {                         if ($store=IO::File->new(">$execdir/tmp/$id")) {
      $reply=~s/\&/\n/g;
    print $store $reply;     print $store $reply;
    close $store;     close $store;
      my $store2=IO::File->new(">$execdir/tmp/$id.end");
      print $store2 "done\n";
      close $store2;
    print $client "ok\n";     print $client "ok\n";
        }         }
        else {         else {
Line 1080  sub make_new_child { Line 1212  sub make_new_child {
                        if (-e $ulsdir) {                         if (-e $ulsdir) {
  if (opendir(LSDIR,$ulsdir)) {   if (opendir(LSDIR,$ulsdir)) {
                           while ($ulsfn=readdir(LSDIR)) {                            while ($ulsfn=readdir(LSDIR)) {
      my @ulsstats=stat($ulsfn);       my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';                               $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
                           }                            }
                           closedir(LSDIR);                            closedir(LSDIR);
Line 1090  sub make_new_child { Line 1222  sub make_new_child {
                        }                         }
                        if ($ulsout eq '') { $ulsout='empty'; }                         if ($ulsout eq '') { $ulsout='empty'; }
                        print $client "$ulsout\n";                         print $client "$ulsout\n";
   # ------------------------------------------------------------------ Hanging up
                      } elsif (($userinput =~ /^exit/) ||
                               ($userinput =~ /^init/)) {
                          &logthis(
         "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
                          print $client "bye\n";
          last;
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
                    } else {                     } else {
                        # unknown command                         # unknown command
Removed from v.1.41  
changed lines
  Added in v.1.55

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.