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

Diff for /loncom/lond between versions 1.87 and 1.94

version 1.87, 2002/08/09 10:05:00 version 1.94, 2002/09/03 02:01:14
Line 74  use Crypt::IDEA; Line 74  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  use Authen::Krb4;
   use Authen::Krb5;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use localauth;  use localauth;
   
Line 488  sub make_new_child { Line 489  sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
   
         $tmpsnum=0;          $tmpsnum=0;
       #---------------------------------------------------- kerberos 5 initialization
           &Authen::Krb5::init_context();
           &Authen::Krb5::init_ets();
   
         # 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++) {
             &status('Idle, waiting for connection');              &status('Idle, waiting for connection');
Line 497  sub make_new_child { Line 501  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
       $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
                                         # connection liveness.
             # see if we know client and check for spoof IP by challenge              # 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);
Line 652  sub make_new_child { Line 658  sub make_new_child {
                                         $contentpwd,'krbtgt',$contentpwd,1,                                          $contentpwd,'krbtgt',$contentpwd,1,
      $upass) == 0);       $upass) == 0);
      } else { $pwdcorrect=0; }       } else { $pwdcorrect=0; }
                             } elsif ($howpwd eq 'krb5') {
         $null=pack("C",0);
         unless ($upass=~/$null/) {
     my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd);
     my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd;
     my $krbserver=&Authen::Krb5::parse_name($krbservice);
     my $credentials=&Authen::Krb5::cc_default();
     $credentials->initialize($krbclient);
     my $krbreturn = 
       &Authen::Krb5::get_in_tkt_with_password(
        $krbclient,$krbserver,$upass,$credentials);
   #  unless ($krbreturn) {
   #      &logthis("Krb5 Error: ".
   #       &Authen::Krb5::error());
   #  }
     $pwdcorrect = ($krbreturn == 1);
      } else { $pwdcorrect=0; }
                           } elsif ($howpwd eq 'localauth') {                            } elsif ($howpwd eq 'localauth') {
     $pwdcorrect=&localauth::localauth($uname,$upass,      $pwdcorrect=&localauth::localauth($uname,$upass,
       $contentpwd);        $contentpwd);
Line 737  sub make_new_child { Line 760  sub make_new_child {
      }       }
 # -------------------------------------------------------------------- makeuser  # -------------------------------------------------------------------- makeuser
                    } elsif ($userinput =~ /^makeuser/) {                     } elsif ($userinput =~ /^makeuser/) {
      Debug("Make user received");       &Debug("Make user received");
                 my $oldumask=umask(0077);                  my $oldumask=umask(0077);
      if ($wasenc==1) {       if ($wasenc==1) {
                        my                          my 
Line 767  sub make_new_child { Line 790  sub make_new_child {
                                }                                 }
                            }                             }
                            unless ($fperror) {                             unless ($fperror) {
      if ($umode eq 'krb4') {         my $result=&make_passwd_file($umode,$npass,
                                {       $passfilename);
                                  my $pf = IO::File->new(">$passfilename");         print $client $result;
             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);  
                                {   
  &Debug("Creating internal auth");  
  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";  
  {  
      &Debug("Executing external: ".  
   $execpath);  
      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 {                             } else {
                                print $client "$fperror\n";                                 print $client "$fperror\n";
                            }                             }
Line 827  sub make_new_child { Line 806  sub make_new_child {
        &Debug("Changing authorization");         &Debug("Changing authorization");
       if ($wasenc==1) {        if ($wasenc==1) {
                        my                          my 
                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);         ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                        chomp($npass);                         chomp($npass);
        &Debug("cmd = ".$cmd." domain= ".$udom.         &Debug("cmd = ".$cmd." domain= ".$udom.
       "uname =".$uname." umode= ".$umode);        "uname =".$uname." umode= ".$umode);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=&propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
        if ($udom ne $perlvar{'lonDefDomain'}) {         if ($udom ne $perlvar{'lonDefDomain'}) {
                            print $client "not_right_domain\n";                             print $client "not_right_domain\n";
                        } else {                         } else {
    if ($umode eq 'krb4') {     my $result=&make_passwd_file($umode,$npass,
                                {    $passfilename);
    my $pf = IO::File->new(">$passfilename");     print $client $result;
    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 {       } else {
        print $client "refused\n";         print $client "refused\n";
Line 952  sub make_new_child { Line 890  sub make_new_child {
                       my ($cmd,$fname)=split(/:/,$userinput);                        my ($cmd,$fname)=split(/:/,$userinput);
       my ($udom,$uname,$ufile)=split(/\//,$fname);        my ($udom,$uname,$ufile)=split(/\//,$fname);
                       my $udir=propath($udom,$uname).'/userfiles';                        my $udir=propath($udom,$uname).'/userfiles';
                       unless (-e $udir) { mkdir($udir); }                        unless (-e $udir) { mkdir($udir,0770); }
                        if (-e $udir) {                         if (-e $udir) {
                        $ufile=~s/^[\.\~]+//;                         $ufile=~s/^[\.\~]+//;
                        $ufile=~s/\///g;                         $ufile=~s/\///g;
Line 1214  sub make_new_child { Line 1152  sub make_new_child {
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
                              study($regexp);
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                if (eval('$key=~/$regexp/')) {                                 my $unescapeKey = &unescape($key);
                                  if (eval('$unescapeKey=~/$regexp/')) {
                                   $qresult.="$key=$hash{$key}&";                                    $qresult.="$key=$hash{$key}&";
        }                                }
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
Line 1537  sub GetAuthType Line 1477  sub GetAuthType
  my ($authtype, $contentpwd) = split(/:/, $realpassword);   my ($authtype, $contentpwd) = split(/:/, $realpassword);
  Debug("Authtype = $authtype, content = $contentpwd\n");   Debug("Authtype = $authtype, content = $contentpwd\n");
  my $availinfo = '';   my $availinfo = '';
  if($authtype eq 'krb4') {   if($authtype eq 'krb4' or $authtype eq 'krb5') {
     $availinfo = $contentpwd;      $availinfo = $contentpwd;
  }   }
   
Line 1573  sub getchat { Line 1513  sub getchat {
     my %hash;      my %hash;
     my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
     my @entries=();      my @entries=();
     if       if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
      (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_READER(),0640))      &GDBM_READER(),0640)) {
     {   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;   untie %hash;
          untie %hash;  
     }      }
     return @entries;      return @entries;
 }  }
   
 sub chatadd {  sub chatadd {
   my ($cdom,$cname,$newchat)=@_;      my ($cdom,$cname,$newchat)=@_;
   my %hash;      my %hash;
   my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
   my @entries=();      my @entries=();
   if       if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
   (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_WRCREAT(),0640))      &GDBM_WRCREAT(),0640)) {
    {   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
     @entries=map { $_.':'.$hash{$_} } sort keys %hash;   my $time=time;
     my $time=time;   my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
     my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);   my ($thentime,$idnum)=split(/\_/,$lastid);
     my ($thentime,$idnum)=split(/\_/,$lastid);   my $newid=$time.'_000000';
     my $newid=$time.'_000000';   if ($thentime==$time) {
     if ($thentime==$time) {      $idnum=~s/^0+//;
  $idnum=~s/^0+//;      $idnum++;
         $idnum++;      $idnum=substr('000000'.$idnum,-6,6);
         $idnum=substr('000000'.$idnum,-6,6);      $newid=$time.'_'.$idnum;
         $newid=$time.'_'.$idnum;   }
     }   $hash{$newid}=$newchat;
     $hash{$newid}=$newchat;   my $expired=$time-3600;
     my $expired=$time-3600;   foreach (keys %hash) {
     foreach (keys %hash) {      my ($thistime)=($_=~/(\d+)\_/);
         my ($thistime)=($_=~/(\d+)\_/);      if ($thistime<$expired) {
         if ($thistime<$expired) {   delete $hash{$_};
    undef $hash{$_};      }
         }   }
    untie %hash;
     }      }
     untie %hash;  
    }  
 }  }
   
 sub unsub {  sub unsub {
Line 1661  sub subscribe { Line 1599  sub subscribe {
     }      }
     return $result;      return $result;
 }  }
   
   sub make_passwd_file {
       my ($umode,$npass,$passfilename)=@_;
       my $result="ok\n";
       if ($umode eq 'krb4' or $umode eq 'krb5') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "$umode:$npass\n";
    }
       } elsif ($umode eq 'internal') {
    my $salt=time;
    $salt=substr($salt,6,2);
    my $ncpass=crypt($npass,$salt);
    {
       &Debug("Creating internal auth");
       my $pf = IO::File->new(">$passfilename");
       print $pf "internal:$ncpass\n"; 
    }
       } elsif ($umode eq 'localauth') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "localauth:$npass\n";
    }
       } elsif ($umode eq 'unix') {
    {
       my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
       {
    &Debug("Executing external: ".$execpath);
    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";
    }
       } elsif ($umode eq 'none') {
    {
       my $pf = IO::File->new(">$passfilename");
       print $pf "none:\n";
    }
       } else {
    $result="auth_mode_error\n";
       }
       return $result;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Line 1959  Crypt::IDEA Line 1944  Crypt::IDEA
 LWP::UserAgent()  LWP::UserAgent()
 GDBM_File  GDBM_File
 Authen::Krb4  Authen::Krb4
   Authen::Krb5
   
 =head1 COREQUISITES  =head1 COREQUISITES
   
Removed from v.1.87  
changed lines
  Added in v.1.94

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