--- loncom/lonnet/perl/lonnet.pm	2001/11/05 22:48:19	1.168
+++ loncom/lonnet/perl/lonnet.pm	2001/11/16 06:21:39	1.169
@@ -1,6 +1,44 @@
 # The LearningOnline Network
 # 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: lonnet.pm,v 1.169 2001/11/16 06:21:39 harris41 Exp $
+###
+
 # Functions for use by content handlers:
 #
 # metadata_query(sql-query-string,custom-metadata-regex) : 
@@ -97,40 +135,6 @@
 # metadata(file,entry): returns the metadata entry for a file. entry='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;
 
@@ -406,6 +410,44 @@ sub 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)
 
 sub authenticate {
@@ -1693,6 +1735,19 @@ sub assignrole {
     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