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

Diff for /loncom/lond between versions 1.426 and 1.444

version 1.426, 2009/09/13 03:13:21 version 1.444, 2010/06/18 19:19:33
Line 42  use Crypt::IDEA; Line 42  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
 use Digest::MD5 qw(md5_hex);  use Digest::MD5 qw(md5_hex);
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  
 use Authen::Krb5;  use Authen::Krb5;
 use localauth;  use localauth;
 use localenroll;  use localenroll;
Line 67  my $currentdomainid; Line 66  my $currentdomainid;
 my $client;  my $client;
 my $clientip; # IP address of client.  my $clientip; # IP address of client.
 my $clientname; # LonCAPA name of client.  my $clientname; # LonCAPA name of client.
   my $clientversion;              # LonCAPA version running on client
   
 my $server;  my $server;
   
Line 975  sub read_profile { Line 975  sub read_profile {
  &GDBM_READER());   &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my @queries=split(/\&/,$what);          my @queries=split(/\&/,$what);
           if ($namespace eq 'roles') {
               @queries = map { &unescape($_); } @queries; 
           }
         my $qresult='';          my $qresult='';
   
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
Line 1815  sub change_password_handler { Line 1818  sub change_password_handler {
     #  npass - New password.      #  npass - New password.
     #  context - Context in which this was called       #  context - Context in which this was called 
     #            (preferences or reset_by_email).      #            (preferences or reset_by_email).
       #  lonhost - HostID of server where request originated 
         
     my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail);      my ($udom,$uname,$upass,$npass,$context,$lonhost)=split(/:/,$tail);
   
     $upass=&unescape($upass);      $upass=&unescape($upass);
     $npass=&unescape($npass);      $npass=&unescape($npass);
Line 1825  sub change_password_handler { Line 1829  sub change_password_handler {
     # First require that the user can be authenticated with their      # First require that the user can be authenticated with their
     # old password unless context was 'reset_by_email':      # old password unless context was 'reset_by_email':
           
     my $validated;      my ($validated,$failure);
     if ($context eq 'reset_by_email') {      if ($context eq 'reset_by_email') {
         $validated = 1;          if ($lonhost eq '') {
               $failure = 'invalid_client';
           } else {
               $validated = 1;
           }
     } else {      } else {
         $validated = &validate_user($udom, $uname, $upass);          $validated = &validate_user($udom, $uname, $upass);
     }      }
Line 1841  sub change_password_handler { Line 1849  sub change_password_handler {
     $salt=substr($salt,6,2);      $salt=substr($salt,6,2);
     my $ncpass=crypt($npass,$salt);      my $ncpass=crypt($npass,$salt);
     if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {      if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
  &logthis("Result of password change for "   my $msg="Result of password change for $uname: pwchange_success";
  ."$uname: pwchange_success");                  if ($lonhost) {
                       $msg .= " - request originated from: $lonhost";
                   }
                   &logthis($msg);
  &Reply($client, "ok\n", $userinput);   &Reply($client, "ok\n", $userinput);
     } else {      } else {
  &logthis("Unable to open $uname passwd "                  &logthis("Unable to open $uname passwd "               
Line 1863  sub change_password_handler { Line 1874  sub change_password_handler {
  }     }  
   
     } else {      } else {
  &Failure( $client, "non_authorized\n", $userinput);   if ($failure eq '') {
       $failure = 'non_authorized';
    }
    &Failure( $client, "$failure\n", $userinput);
     }      }
   
     return 1;      return 1;
Line 2050  sub is_home_handler { Line 2064  sub is_home_handler {
 &register_handler("home", \&is_home_handler, 0,1,0);  &register_handler("home", \&is_home_handler, 0,1,0);
   
 #  #
 #   Process an update request for a resource?? I think what's going on here is  #   Process an update request for a resource.
 #   that a resource has been modified that we hold a subscription to.  #   A resource has been modified that we hold a subscription to.
 #   If the resource is not local, then we must update, or at least invalidate our  #   If the resource is not local, then we must update, or at least invalidate our
 #   cached copy of the resource.   #   cached copy of the resource. 
 #   FUTURE WORK:  
 #      I need to look at this logic carefully.  My druthers would be to follow  
 #      typical caching logic, and simple invalidate the cache, drop any subscription  
 #      an let the next fetch start the ball rolling again... however that may  
 #      actually be more difficult than it looks given the complex web of  
 #      proxy servers.  
 # Parameters:  # Parameters:
 #    $cmd      - The command that got us here.  #    $cmd      - The command that got us here.
 #    $tail     - Tail of the command (remaining parameters).  #    $tail     - Tail of the command (remaining parameters).
Line 2083  sub update_resource_handler { Line 2091  sub update_resource_handler {
     my $ownership=ishome($fname);      my $ownership=ishome($fname);
     if ($ownership eq 'not_owner') {      if ($ownership eq 'not_owner') {
  if (-e $fname) {   if (-e $fname) {
               # Delete preview file, if exists
               unlink("$fname.tmp");
               # Get usage stats
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,      my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname);   $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname);
     my $now=time;      my $now=time;
     my $since=$now-$atime;      my $since=$now-$atime;
               # If the file has not been used within lonExpire seconds,
               # unsubscribe from it and delete local copy
     if ($since>$perlvar{'lonExpire'}) {      if ($since>$perlvar{'lonExpire'}) {
  my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");   my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
  &devalidate_meta_cache($fname);   &devalidate_meta_cache($fname);
  unlink("$fname");   unlink("$fname");
  unlink("$fname.meta");   unlink("$fname.meta");
     } else {      } else {
               # Yes, this is in active use. Get a fresh copy. Since it might be in
               # very active use and huge (like a movie), copy it to "in.transfer" filename first.
  my $transname="$fname.in.transfer";   my $transname="$fname.in.transfer";
  my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");   my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
  my $response;   my $response;
Line 2120  sub update_resource_handler { Line 2135  sub update_resource_handler {
  }   }
  alarm(0);   alarm(0);
     }      }
                       # we successfully transfered, copy file over to real name
     rename($transname,$fname);      rename($transname,$fname);
     &devalidate_meta_cache($fname);      &devalidate_meta_cache($fname);
  }   }
Line 3110  sub dump_with_regexp { Line 3126  sub dump_with_regexp {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
               if ($namespace eq 'roles') {
                   if ($key =~ /^($LONCAPA::match_domain)_($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)/) {
                       if ($clientversion =~ /^(\d+)\.(\d+)$/) {
                           my $major = $1;
                           my $minor = $2;
                           next if (($major < 2) || (($major == 2) && ($minor < 9)));
                       }
                   }
               }
     if ($regexp eq '.') {      if ($regexp eq '.') {
  $count++;   $count++;
  if (defined($range) && $count >= $end)   { last; }   if (defined($range) && $count >= $end)   { last; }
Line 3693  sub put_course_id_hash_handler { Line 3718  sub put_course_id_hash_handler {
 #                 caller -  if set to 'coursecatalog', courses set to be hidden  #                 caller -  if set to 'coursecatalog', courses set to be hidden
 #                           from course catalog will be excluded from results (unless  #                           from course catalog will be excluded from results (unless
 #                           overridden by "showhidden".  #                           overridden by "showhidden".
 #                 cloner - escaped username:domain of course cloner (if picking course to#   #                 cloner - escaped username:domain of course cloner (if picking course to
 #                          clone).  #                          clone).
 #                 cc_clone_list - escaped comma separated list of courses for which   #                 cc_clone_list - escaped comma separated list of courses for which 
 #                                 course cloner has active CC role (and so can clone  #                                 course cloner has active CC role (and so can clone
 #                                 automatically).  #                                 automatically).
 #                 cloneonly - filter by courses for which cloner has rights to clone.   #                 cloneonly - filter by courses for which cloner has rights to clone.
   #                 createdbefore - include courses for which creation date preceeded this date.
   #                 createdafter - include courses for which creation date followed this date.
   #                 creationcontext - include courses created in specified context 
 #  #
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
Line 3711  sub dump_course_id_handler { Line 3739  sub dump_course_id_handler {
   
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,          $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail);          $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
           $creationcontext) =split(/:/,$tail);
     my $now = time;      my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);      my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {      if (defined($description)) {
Line 3769  sub dump_course_id_handler { Line 3798  sub dump_course_id_handler {
             $cc_clone{$clonedom.'_'.$clonenum} = 1;              $cc_clone{$clonedom.'_'.$clonenum} = 1;
         }           } 
     }      }
       if ($createdbefore ne '') {
           $createdbefore = &unescape($createdbefore);
       } else {
          $createdbefore = 0;
       }
       if ($createdafter ne '') {
           $createdafter = &unescape($createdafter);
       } else {
           $createdafter = 0;
       }
       if ($creationcontext ne '') {
           $creationcontext = &unescape($creationcontext);
       } else {
           $creationcontext = '.';
       }
           
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
Line 3781  sub dump_course_id_handler { Line 3825  sub dump_course_id_handler {
     if ($hashref) {      if ($hashref) {
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,              my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
                 %unesc_val,$selfenroll_end,$selfenroll_types);                  %unesc_val,$selfenroll_end,$selfenroll_types,$created,
                   $context);
             $unesc_key = &unescape($key);              $unesc_key = &unescape($key);
             if ($unesc_key =~ /^lasttime:/) {              if ($unesc_key =~ /^lasttime:/) {
                 next;                  next;
Line 3795  sub dump_course_id_handler { Line 3840  sub dump_course_id_handler {
             my ($canclone,$valchange);              my ($canclone,$valchange);
             my $items = &Apache::lonnet::thaw_unescape($value);              my $items = &Apache::lonnet::thaw_unescape($value);
             if (ref($items) eq 'HASH') {              if (ref($items) eq 'HASH') {
                   if ($hashref->{$lasttime_key} eq '') {
                       next if ($since > 1);
                   }
                 $is_hash =  1;                  $is_hash =  1;
                 if (defined($clonerudom)) {                  if (defined($clonerudom)) {
                     if ($items->{'cloners'}) {                      if ($items->{'cloners'}) {
Line 3824  sub dump_course_id_handler { Line 3872  sub dump_course_id_handler {
                             $items->{'cloners'} = $cloneruname.':'.$clonerudom;                              $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                             $valchange = 1;                              $valchange = 1;
                         }                          }
                           unless ($canclone) {
                               if ($items->{'owner'} =~ /:/) {
                                   if ($items->{'owner'} eq $cloner) {
                                       $canclone = 1;
                                   }
                               } elsif ($cloner eq $items->{'owner'}.':'.$udom) {
                                   $canclone = 1;
                               }
                               if ($canclone) {
                                   $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                                   $valchange = 1;
                               }
                           }
                     }                      }
                 }                  }
                 if ($unpack || !$rtn_as_hash) {                  if ($unpack || !$rtn_as_hash) {
Line 3832  sub dump_course_id_handler { Line 3893  sub dump_course_id_handler {
                     $unesc_val{'owner'} = $items->{'owner'};                      $unesc_val{'owner'} = $items->{'owner'};
                     $unesc_val{'type'} = $items->{'type'};                      $unesc_val{'type'} = $items->{'type'};
                     $unesc_val{'cloners'} = $items->{'cloners'};                      $unesc_val{'cloners'} = $items->{'cloners'};
                       $unesc_val{'created'} = $items->{'created'};
                       $unesc_val{'context'} = $items->{'context'};
                 }                  }
                 $selfenroll_types = $items->{'selfenroll_types'};                  $selfenroll_types = $items->{'selfenroll_types'};
                 $selfenroll_end = $items->{'selfenroll_end_date'};                  $selfenroll_end = $items->{'selfenroll_end_date'};
                   $created = $items->{'created'};
                   $context = $items->{'context'};
                 if ($selfenrollonly) {                  if ($selfenrollonly) {
                     next if (!$selfenroll_types);                      next if (!$selfenroll_types);
                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {                      if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
                         next;                          next;
                     }                      }
                 }                  }
                   if ($creationcontext ne '.') {
                       next if (($context ne '') && ($context ne $creationcontext));  
                   }
                   if ($createdbefore > 0) {
                       next if (($created eq '') || ($created > $createdbefore));   
                   }
                   if ($createdafter > 0) {
                       next if (($created eq '') || ($created <= $createdafter)); 
                   }
                 if ($catfilter ne '') {                  if ($catfilter ne '') {
                     next if ($items->{'categories'} eq '');                      next if ($items->{'categories'} eq '');
                     my @categories = split('&',$items->{'categories'});                       my @categories = split('&',$items->{'categories'}); 
Line 3863  sub dump_course_id_handler { Line 3937  sub dump_course_id_handler {
             } else {              } else {
                 next if ($catfilter ne '');                  next if ($catfilter ne '');
                 next if ($selfenrollonly);                  next if ($selfenrollonly);
                   next if ($createdbefore || $createdafter);
                   next if ($creationcontext ne '.');
                 if ((defined($clonerudom)) && (defined($cloneruname)))  {                  if ((defined($clonerudom)) && (defined($cloneruname)))  {
                     if ($cc_clone{$unesc_key}) {                      if ($cc_clone{$unesc_key}) {
                         $canclone = 1;                          $canclone = 1;
Line 4009  sub dump_course_id_handler { Line 4085  sub dump_course_id_handler {
 }  }
 &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);  &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
   
   sub course_lastaccess_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$cnum) = split(':',$tail); 
       my (%lastaccess,$qresult);
       my $hashref = &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
       if ($hashref) {
           while (my ($key,$value) = each(%$hashref)) {
               my ($unesc_key,$lasttime);
               $unesc_key = &unescape($key);
               if ($cnum) {
                   next unless ($unesc_key =~ /\Q$cdom\E_\Q$cnum\E$/);
               }
               if ($unesc_key =~ /^lasttime:($LONCAPA::match_domain\_$LONCAPA::match_courseid)/) {
                   $lastaccess{$1} = $value;
               } else {
                   my $items = &Apache::lonnet::thaw_unescape($value);
                   if (ref($items) eq 'HASH') {
                       unless ($lastaccess{$unesc_key}) {
                           $lastaccess{$unesc_key} = '';
                       }
                   } else {
                       my @courseitems = split(':',$value);
                       $lastaccess{$unesc_key} = pop(@courseitems);
                   }
               }
           }
           foreach my $cid (sort(keys(%lastaccess))) {
               $qresult.=&escape($cid).'='.$lastaccess{$cid}.'&'; 
           }
           if (&untie_domain_hash($hashref)) {
               if ($qresult) {
                   chop($qresult);
               }
               &Reply($client, \$qresult, $userinput);
           } else {
               &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                       "while attempting lastacourseaccess\n", $userinput);
           }
       } else {
           &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
                   "while attempting lastcourseaccess\n", $userinput);
       }
       return 1;
   }
   &register_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);
   
 #  #
 # Puts an unencrypted entry in a namespace db file at the domain level   # Puts an unencrypted entry in a namespace db file at the domain level 
 #  #
Line 6214  sub make_new_child { Line 6337  sub make_new_child {
  &ReadManagerTable();   &ReadManagerTable();
  my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));   my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
  my $ismanager=($managers{$outsideip}    ne undef);   my $ismanager=($managers{$outsideip}    ne undef);
  $clientname  = "[unknonwn]";   $clientname  = "[unknown]";
  if($clientrec) { # Establish client type.   if($clientrec) { # Establish client type.
     $ConnectionType = "client";      $ConnectionType = "client";
     $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1];      $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1];
Line 6242  sub make_new_child { Line 6365  sub make_new_child {
  #   #
  #  If the remote is attempting a local init... give that a try:   #  If the remote is attempting a local init... give that a try:
  #   #
  my ($i, $inittype) = split(/:/, $remotereq);   (my $i, my $inittype, $clientversion) = split(/:/, $remotereq);
   
  # If the connection type is ssl, but I didn't get my   # If the connection type is ssl, but I didn't get my
  # certificate files yet, then I'll drop  back to    # certificate files yet, then I'll drop  back to 
Line 6262  sub make_new_child { Line 6385  sub make_new_child {
  }   }
   
  if($inittype eq "local") {   if($inittype eq "local") {
                       $clientversion = $perlvar{'lonVersion'};
     my $key = LocalConnection($client, $remotereq);      my $key = LocalConnection($client, $remotereq);
     if($key) {      if($key) {
  Debug("Got local key $key");   Debug("Got local key $key");
Line 6269  sub make_new_child { Line 6393  sub make_new_child {
  my $cipherkey = pack("H32", $key);   my $cipherkey = pack("H32", $key);
  $cipher       = new IDEA($cipherkey);   $cipher       = new IDEA($cipherkey);
  print $client "ok:local\n";   print $client "ok:local\n";
  &logthis('<font color="green"'   &logthis('<font color="green">'
  . "Successful local authentication </font>");   . "Successful local authentication </font>");
  $keymode = "local"   $keymode = "local"
     } else {      } else {
Line 6491  sub rewrite_password_file { Line 6615  sub rewrite_password_file {
   
 #     Returns the authorization type or nouser if there is no such user.  #     Returns the authorization type or nouser if there is no such user.
 #  #
 sub get_auth_type   sub get_auth_type {
 {  
   
     my ($domain, $user)  = @_;      my ($domain, $user)  = @_;
   
     Debug("get_auth_type( $domain, $user ) \n");      Debug("get_auth_type( $domain, $user ) \n");
Line 6588  sub validate_user { Line 6710  sub validate_user {
     } else {      } else {
  $validated = 0;   $validated = 0;
     }      }
  }   } elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain.
  elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain.              my $checkwithkrb5 = 0;
     if(! ($password =~ /$null/) ) {              if ($dist =~/^fedora(\d+)$/) {
  my $k4error = &Authen::Krb4::get_pw_in_tkt($user,                  if ($1 > 11) {
    "",                      $checkwithkrb5 = 1;
    $contentpwd,,                  }
    'krbtgt',              } elsif ($dist =~ /^suse([\d.]+)$/) {
    $contentpwd,                  if ($1 > 11.1) {
    1,                      $checkwithkrb5 = 1; 
    $password);                  }
  if(!$k4error) {              }
     $validated = 1;              if ($checkwithkrb5) {
  } else {                  $validated = &krb5_authen($password,$null,$user,$contentpwd);
     $validated = 0;              } else {
     &logthis('krb4: '.$user.', '.$contentpwd.', '.                  $validated = &krb4_authen($password,$null,$user,$contentpwd);
      &Authen::Krb4::get_err_txt($Authen::Krb4::error));              }
  }  
     } else {  
  $validated = 0; # Password has a match with null.  
     }  
  } elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.   } elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.
     if(!($password =~ /$null/)) { # Null password not allowed.              $validated = &krb5_authen($password,$null,$user,$contentpwd);
  my $krbclient = &Authen::Krb5::parse_name($user.'@'  
   .$contentpwd);  
  my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;  
  my $krbserver  = &Authen::Krb5::parse_name($krbservice);  
  my $credentials= &Authen::Krb5::cc_default();  
  $credentials->initialize(&Authen::Krb5::parse_name($user.'@'  
                                                                  .$contentpwd));  
                 my $krbreturn;  
                 if (exists(&Authen::Krb5::get_init_creds_password)) {  
                     $krbreturn =   
                         &Authen::Krb5::get_init_creds_password($krbclient,$password,  
                                                                $krbservice);  
                     $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds');  
                 } else {  
     $krbreturn  =   
                         &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,  
  $password,$credentials);  
     $validated = ($krbreturn == 1);  
                 }  
  if (!$validated) {  
     &logthis('krb5: '.$user.', '.$contentpwd.', '.  
      &Authen::Krb5::error());  
  }  
     } else {  
  $validated = 0;  
     }  
  } elsif ($howpwd eq "localauth") {    } elsif ($howpwd eq "localauth") { 
     #  Authenticate via installation specific authentcation method:      #  Authenticate via installation specific authentcation method:
     $validated = &localauth::localauth($user,       $validated = &localauth::localauth($user, 
Line 6666  sub validate_user { Line 6758  sub validate_user {
     return $validated;      return $validated;
 }  }
   
   sub krb4_authen {
       my ($password,$null,$user,$contentpwd) = @_;
       my $validated = 0;
       if (!($password =~ /$null/) ) {  # Null password not allowed.
           eval {
               require Authen::Krb4;
           };
           if (!$@) {
               my $k4error = &Authen::Krb4::get_pw_in_tkt($user,
                                                          "",
                                                          $contentpwd,,
                                                          'krbtgt',
                                                          $contentpwd,
                                                          1,
                                                          $password);
               if(!$k4error) {
                   $validated = 1;
               } else {
                   $validated = 0;
                   &logthis('krb4: '.$user.', '.$contentpwd.', '.
                             &Authen::Krb4::get_err_txt($Authen::Krb4::error));
               }
           } else {
               $validated = krb5_authen($password,$null,$user,$contentpwd);
           }
       }
       return $validated;
   }
   
   sub krb5_authen {
       my ($password,$null,$user,$contentpwd) = @_;
       my $validated = 0;
       if(!($password =~ /$null/)) { # Null password not allowed.
           my $krbclient = &Authen::Krb5::parse_name($user.'@'
                                                     .$contentpwd);
           my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
           my $krbserver  = &Authen::Krb5::parse_name($krbservice);
           my $credentials= &Authen::Krb5::cc_default();
           $credentials->initialize(&Authen::Krb5::parse_name($user.'@'
                                                               .$contentpwd));
           my $krbreturn;
           if (exists(&Authen::Krb5::get_init_creds_password)) {
               $krbreturn =
                   &Authen::Krb5::get_init_creds_password($krbclient,$password,
                                                             $krbservice);
               $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds');
           } else {
               $krbreturn  =
                   &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
                                                            $password,$credentials);
               $validated = ($krbreturn == 1);
           }
           if (!$validated) {
               &logthis('krb5: '.$user.', '.$contentpwd.', '.
                        &Authen::Krb5::error());
           }
       }
       return $validated;
   }
   
 sub addline {  sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;      my ($fname,$hostid,$ip,$newline)=@_;
Line 7036  sub sethost { Line 7187  sub sethost {
  eq &Apache::lonnet::get_host_ip($hostid)) {   eq &Apache::lonnet::get_host_ip($hostid)) {
  $currenthostid  =$hostid;   $currenthostid  =$hostid;
  $currentdomainid=&Apache::lonnet::host_domain($hostid);   $currentdomainid=&Apache::lonnet::host_domain($hostid);
  &logthis("Setting hostid to $hostid, and domain to $currentdomainid");  # &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {      } else {
  &logthis("Requested host id $hostid not an alias of ".   &logthis("Requested host id $hostid not an alias of ".
  $perlvar{'lonHostID'}." refusing connection");   $perlvar{'lonHostID'}." refusing connection");
Line 7786  string. Line 7937  string.
   
 =back  =back
   
   =back
   
   
 =cut  =cut
Removed from v.1.426  
changed lines
  Added in v.1.444

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