--- loncom/lonnet/perl/lonnet.pm	2007/12/21 04:34:50	1.935
+++ loncom/lonnet/perl/lonnet.pm	2008/02/24 22:59:17	1.943
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.935 2007/12/21 04:34:50 raeburn Exp $
+# $Id: lonnet.pm,v 1.943 2008/02/24 22:59:17 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1064,6 +1064,10 @@ sub inst_rulecheck {
                     $response=&unescape(&reply('instidrulecheck:'.&escape($udom).
                                               ':'.&escape($id).':'.$rulestr,
                                               $homeserver));
+                } elsif ($item eq 'selfenroll') {
+                    $response=&unescape(&reply('instselfenrollcheck:'.
+                                               &escape($udom).':'.&escape($uname).
+                                              ':'.$rulestr,$homeserver));
                 }
                 if ($response ne 'refused') {
                     my @pairs=split(/\&/,$response);
@@ -1090,6 +1094,9 @@ sub inst_userrules {
             if ($check eq 'id') {
                 $response=&reply('instidrules:'.&escape($udom),
                                  $homeserver);
+            } elsif ($check eq 'email') {
+                $response=&reply('instemailrules:'.&escape($udom),
+                                 $homeserver);
             } else {
                 $response=&reply('instuserrules:'.&escape($udom),
                                  $homeserver);
@@ -1115,6 +1122,35 @@ sub inst_userrules {
     return (\%ruleshash,\@ruleorder);
 }
 
+# ------------------------- Get Authentication and Language Defaults for Domain
+
+sub get_domain_defaults {
+    my ($domain) = @_;
+    my $cachetime = 60*60*24;
+    my ($defauthtype,$defautharg,$deflang);
+    my ($result,$cached)=&is_cached_new('domdefaults',$domain);
+    if (defined($cached)) {
+        if (ref($result) eq 'HASH') {
+            return %{$result};
+        }
+    }
+    my %domdefaults;
+    my %domconfig =
+         &Apache::lonnet::get_dom('configuration',['defaults'],$domain);
+    if (ref($domconfig{'defaults'}) eq 'HASH') {
+        $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
+        $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
+        $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
+    } else {
+        $domdefaults{'lang_def'} = &domain($domain,'lang_def');
+        $domdefaults{'auth_def'} = &domain($domain,'auth_def');
+        $domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def');
+    }
+    &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
+                                  $cachetime);
+    return %domdefaults;
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -1650,9 +1686,21 @@ sub absolute_url {
     return $protocol.$host_name;
 }
 
+#
+#   Server side include.
+# Parameters:
+#  fn     Possibly encrypted resource name/id.
+#  form   Hash that describes how the rendering should be done
+#         and other things.
+#  r      Optional reference that will be given the response.
+#         This is mostly provided so that the caller can implement
+#         error detection, recovery and retry policies.
+#     
+# Returns:
+#    The content of the response.
 sub ssi {
 
-    my ($fn,%form)=@_;
+    my ($fn,%form, $r)=@_;
 
     my $ua=new LWP::UserAgent;
     
@@ -1670,6 +1718,10 @@ sub ssi {
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response=$ua->request($request);
 
+    if ($r) {
+	$$r = $response;
+    }
+
     return $response->content;
 }
 
@@ -2200,10 +2252,10 @@ sub flushcourselogs {
             }
         }
         $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
-            'description' => &escape($coursedescrbuf{$crsid}),
-            'inst_code'    => &escape($courseinstcodebuf{$crsid}),
-            'type'        => &escape($coursetypebuf{$crsid}),
-            'owner'       => &escape($courseownerbuf{$crsid}),
+            'description' => $coursedescrbuf{$crsid},
+            'inst_code'    => $courseinstcodebuf{$crsid},
+            'type'        => $coursetypebuf{$crsid},
+            'owner'       => $courseownerbuf{$crsid},
         };
     }
 #
@@ -2399,7 +2451,11 @@ sub get_course_adv_roles {
     my %coursehash=&coursedescription($cid);
     my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
-	$nothide{join(':',split(/[\@\:]/,$user))}=1;
+        if ($user !~ /:/) {
+	    $nothide{join(':',split(/[\@]/,$user))}=1;
+        } else {
+            $nothide{$user}=1;
+        }
     }
     my %returnhash=();
     my %dumphash=
@@ -2427,15 +2483,25 @@ sub get_course_adv_roles {
 }
 
 sub get_my_roles {
-    my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec)=@_;
+    my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
-    my %dumphash;
+    my (%dumphash,%nothide);
     if ($context eq 'userroles') { 
         %dumphash = &dump('roles',$udom,$uname);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
+        if ($hidepriv) {
+            my %coursehash=&coursedescription($udom.'_'.$uname);
+            foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
+                if ($user !~ /:/) {
+                    $nothide{join(':',split(/[\@]/,$user))} = 1;
+                } else {
+                    $nothide{$user} = 1;
+                }
+            }
+        }
     }
     my %returnhash=();
     my $now=time;
@@ -2448,7 +2514,7 @@ sub get_my_roles {
         }
         if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';
-        if (($tend) && ($tend<$now)) {
+        if (($tend) && ($tend<=$now)) {
             $status = 'previous';
         } 
         if (($tstart) && ($now<$tstart)) {
@@ -2486,6 +2552,12 @@ sub get_my_roles {
                 }
             }
         }
+        if ($hidepriv) {
+            if ((&privileged($username,$domain)) &&
+                (!$nothide{$username.':'.$domain})) { 
+                next;
+            }
+        }
         if ($withsec) {
             $returnhash{$username.':'.$domain.':'.$role.':'.$section} =
                 $tstart.':'.$tend;
@@ -2555,7 +2627,7 @@ sub courseidput {
         foreach my $cid (keys(%$storehash)) {
             $what .= &escape($cid).'=';
             foreach my $item ('description','inst_code','owner','type') {
-                $what .= &escape($storehash->{$item}).':';
+                $what .= &escape($storehash->{$cid}{$item}).':';
             }
             $what =~ s/\:$/&/;
         }
@@ -3507,7 +3579,7 @@ sub set_userprivs {
     }
     foreach my $role (keys(%{$allroles})) {
         my %thesepriv;
-        if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; }
+        if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; }
         foreach my $item (split(/:/,$$allroles{$role})) {
             if ($item ne '') {
                 my ($privilege,$restrictions)=split(/&/,$item);
@@ -6697,7 +6769,7 @@ sub EXT {
 	    if ($part eq '') { $part='0'; }
 	    my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
 				 $symbparm,$udom,$uname,$section,1);
-	    if (@partgeneral) { return &get_reply(\@partgeneral); }
+	    if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
 	}
 	if ($recurse) { return undef; }
 	my $pack_def=&packages_tab_default($filename,$varname);
@@ -6731,10 +6803,14 @@ sub EXT {
 
 sub get_reply {
     my ($reply_value) = @_;
-    if (wantarray) {
-	return @$reply_value;
+    if (ref($reply_value) eq 'ARRAY') {
+        if (wantarray) {
+	    return @$reply_value;
+        }
+        return $reply_value->[0];
+    } else {
+        return $reply_value;
     }
-    return $reply_value->[0];
 }
 
 sub check_group_parms {
@@ -9322,6 +9398,18 @@ put_dom($namespace,$storehash,$udom,$uho
 domain level either on specified domain server ($uhome) or primary domain 
 server ($udom and $uhome are optional)
 
+=item * 
+
+get_domain_defaults($target_domain) : returns hash with defaults for
+authentication and language in the domain. Keys are: auth_def, auth_arg_def,
+lang_def; corresponsing values are authentication type (internal, krb4, krb5,
+or localauth), initial password or a kerberos realm, language (e.g., en-us).
+Values are retrieved from cache (if current), or from domain's configuration.db
+(if available), or lastly from values in lonTabs/dns_domain,tab, 
+or lonTabs/domain.tab. 
+
+%domdefaults = &get_auth_defaults($target_domain);
+
 =back
 
 =head2 Network Status Functions