[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.4

version 1.1.1.1, 1999/10/13 17:48:51 version 1.4, 1999/11/04 20:53:04
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 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 17  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 253  sub make_new_child { Line 256  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 348  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 387  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 460  sub make_new_child { Line 507  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) {                             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 482  sub make_new_child { Line 529  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 (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 504  sub make_new_child { Line 551  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 (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 545  sub make_new_child { Line 592  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 565  sub make_new_child { Line 612  sub make_new_child {
                        chomp($namespace);                         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 586  sub make_new_child { Line 633  sub make_new_child {
                        chomp($namespace);                         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/\&$//;                $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
Line 613  sub make_new_child { Line 660  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 681  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 656  sub make_new_child { Line 703  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.4

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