Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.168 and 1.169

version 1.168, 2001/11/05 22:48:19 version 1.169, 2001/11/16 06:21:39
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # TCP networking package  # TCP networking package
 #  #
   # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
   # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
   # 11/8,11/16,11/18,11/22,11/23,12/22,
   # 01/06,01/13,02/24,02/28,02/29,
   # 03/01,03/02,03/06,03/07,03/13,
   # 04/05,05/29,05/31,06/01,
   # 06/05,06/26 Gerd Kortemeyer
   # 06/26 Ben Tyszka
   # 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer
   # 08/14 Ben Tyszka
   # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
   # 10/04 Gerd Kortemeyer
   # 10/04 Guy Albertelli
   # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
   # 10/30,10/31,
   # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
   # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
   # 05/01/01 Guy Albertelli
   # 05/01,06/01,09/01 Gerd Kortemeyer
   # 09/01 Guy Albertelli
   # 09/01,10/01,11/01 Gerd Kortemeyer
   # YEAR=2001
   # 02/27/01 Scott Harrison
   # 3/2 Gerd Kortemeyer
   # 3/15,3/19 Scott Harrison
   # 3/19,3/20 Gerd Kortemeyer
   # 3/22,3/27,4/2,4/16,4/17 Scott Harrison
   # 5/26,5/28 Gerd Kortemeyer
   # 5/30 H. K. Ng
   # 6/1 Gerd Kortemeyer
   # July Guy Albertelli
   # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
   # 10/2 Gerd Kortemeyer
   # 10/5,10/10,11/13,11/15 Scott Harrison
   #
   # $Id$
   ###
   
 # Functions for use by content handlers:  # Functions for use by content handlers:
 #  #
 # metadata_query(sql-query-string,custom-metadata-regex) :   # metadata_query(sql-query-string,custom-metadata-regex) : 
Line 97 Line 135
 # metadata(file,entry): returns the metadata entry for a file. entry='keys'  # metadata(file,entry): returns the metadata entry for a file. entry='keys'
 #                       returns a comma separated list of keys  #                       returns a comma separated list of keys
 #  #
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,  
 # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,  
 # 11/8,11/16,11/18,11/22,11/23,12/22,  
 # 01/06,01/13,02/24,02/28,02/29,  
 # 03/01,03/02,03/06,03/07,03/13,  
 # 04/05,05/29,05/31,06/01,  
 # 06/05,06/26 Gerd Kortemeyer  
 # 06/26 Ben Tyszka  
 # 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer  
 # 08/14 Ben Tyszka  
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer  
 # 10/04 Gerd Kortemeyer  
 # 10/04 Guy Albertelli  
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,   
 # 10/30,10/31,  
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,  
 # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer  
 # 05/01/01 Guy Albertelli  
 # 05/01,06/01,09/01 Gerd Kortemeyer  
 # 09/01 Guy Albertelli  
 # 09/01,10/01,11/01 Gerd Kortemeyer  
 # YEAR=2001  
 # 02/27/01 Scott Harrison  
 # 3/2 Gerd Kortemeyer  
 # 3/15,3/19 Scott Harrison  
 # 3/19,3/20 Gerd Kortemeyer  
 # 3/22,3/27,4/2,4/16,4/17 Scott Harrison  
 # 5/26,5/28 Gerd Kortemeyer  
 # 5/30 H. K. Ng  
 # 6/1 Gerd Kortemeyer  
 # July Guy Albertelli  
 # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,  
 # 10/2 Gerd Kortemeyer  
 # 10/5,10/10 Scott Harrison  
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 406  sub spareserver { Line 410  sub spareserver {
     return $spareserver;      return $spareserver;
 }  }
   
   # ----------------------- Try to determine user's current authentication scheme
   
   sub queryauthenticate {
       my ($uname,$udom)=@_;
       if (($perlvar{'lonRole'} eq 'library') && 
           ($udom eq $perlvar{'lonDefDomain'})) {
    my $answer=reply("encrypt:currentauth:$udom:$uname",
    $perlvar{'lonHostID'});
    unless ($answer eq 'unknown_user' or $answer eq 'refused') {
       if (length($answer)) {
    return $answer;
       }
       else {
    &logthis("User $uname at $udom lacks an authentication mechanism");
    return 'no_host';
       }
    }
       }
   
       my $tryserver;
       foreach $tryserver (keys %libserv) {
    if ($hostdom{$tryserver} eq $udom) {
              my $answer=reply("encrypt:currentauth:$udom:$uname",$tryserver);
      unless ($answer eq 'unknown_user' or $answer eq 'refused') {
          if (length($answer)) {
      return $answer;
          }
          else {
      &logthis("User $uname at $udom lacks an authentication mechanism");
      return 'no_host';
          }
      }
          }
       }
       &logthis("User $uname at $udom lacks an authentication mechanism");    
       return 'no_host';
   }
   
 # --------- Try to authenticate user from domain's lib servers (first this one)  # --------- Try to authenticate user from domain's lib servers (first this one)
   
 sub authenticate {  sub authenticate {
Line 1693  sub assignrole { Line 1735  sub assignrole {
     return &reply($command,&homeserver($uname,$udom));      return &reply($command,&homeserver($uname,$udom));
 }  }
   
   # -------------------------------------------------- Modify user authentication
   sub modifyuserauth {
       my ($udom,$uname,$umode,$upass)=@_;
       my $uhome=&homeserver($uname,$udom);
       &logthis('Call to modify user authentication'.$udom.', '.$uname.', '.
                $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});  
       my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
        &escape($upass),$uhome);
       unless ($reply eq 'ok') {
    return 'error: '.$reply;
       }   
   }
   
 # --------------------------------------------------------------- Modify a user  # --------------------------------------------------------------- Modify a user
   
   

Removed from v.1.168  
changed lines
  Added in v.1.169


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