--- loncom/lonnet/perl/lonnet.pm	2007/12/21 04:32:49	1.934
+++ loncom/lonnet/perl/lonnet.pm	2008/03/09 17:22:21	1.947
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.934 2007/12/21 04:32:49 raeburn Exp $
+# $Id: lonnet.pm,v 1.947 2008/03/09 17:22:21 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 'selfcreate') {
+                    $response=&unescape(&reply('instselfcreatecheck:'.
+                                               &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,23 @@ 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.
+# Returns:
+#   Scalar context: The content of the reply.
+#   Array context:  2 element list of the content and the full response variable.
+#     
+# Returns:
+#    The content of the response.
 sub ssi {
 
     my ($fn,%form)=@_;
+    my $count = scalar(@_);
+    
 
     my $ua=new LWP::UserAgent;
     
@@ -1669,8 +1719,13 @@ sub ssi {
 
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response=$ua->request($request);
+    my $status = $response->code;
 
-    return $response->content;
+    if (wantarray) {
+	return ($response->content, $response);
+    } else {
+	return $response->content;
+    }
 }
 
 sub externalssi {
@@ -2200,10 +2255,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 +2454,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 +2486,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 +2517,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 +2555,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 +2630,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/\:$/&/;
         }
@@ -2568,7 +2643,8 @@ sub courseidput {
 
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
-        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
+        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
+        $selfenrollonly)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -2585,7 +2661,8 @@ sub courseiddump {
                          $sincefilter.':'.&escape($descfilter).':'.
                          &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).
-                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+                         ':'.&escape($regexp_ok).':'.$as_hash.':'.
+                         &escape($selfenrollonly),$tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -3507,7 +3584,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);
@@ -5237,7 +5314,7 @@ sub plaintext {
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
-    my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
+    my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll)=@_;
     my $mrole;
     if ($role =~ /^cr\//) {
         my $cwosec=$url;
@@ -5271,11 +5348,15 @@ sub assignrole {
             } else {
                 $refused = 1;
             }
-            if ($refused) { 
-                &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
-                         ' '.$role.' '.$end.' '.$start.' by '.
-	  	         $env{'user.name'}.' at '.$env{'user.domain'});
-                return 'refused';
+            if ($refused) {
+                if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                    $refused = '';
+                } else {
+                    &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
+                             ' '.$role.' '.$end.' '.$start.' by '.
+	  	             $env{'user.name'}.' at '.$env{'user.domain'});
+                    return 'refused';
+                }
             }
         }
         $mrole=$role;
@@ -5469,7 +5550,7 @@ sub modifystudent {
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid) = @_;
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll) = @_;
     my ($cdom,$cnum,$chome);
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
@@ -5527,7 +5608,7 @@ sub modify_student_enrollment {
     if ($usec) {
 	$uurl.='/'.$usec;
     }
-    return &assignrole($udom,$uname,$uurl,'st',$end,$start);
+    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll);
 }
 
 sub format_name {
@@ -5646,7 +5727,7 @@ ENDINITMAP
 sub is_course {
     my ($cdom,$cnum) = @_;
     my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.',undef,1);
+				undef,'.');
     if (exists($courses{$cdom.'_'.$cnum})) {
         return 1;
     }
@@ -6697,7 +6778,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 +6812,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 {
@@ -8867,7 +8952,7 @@ explanation of a user role term
 
 =item *
 
-get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
 All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space
 (default), or if $context is 'userroles', roles for the user himself,
@@ -9322,6 +9407,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