--- loncom/lonnet/perl/lonnet.pm	2008/12/21 15:26:50	1.976.2.3
+++ loncom/lonnet/perl/lonnet.pm	2010/08/30 17:22:20	1.976.2.11
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.976.2.3 2008/12/21 15:26:50 raeburn Exp $
+# $Id: lonnet.pm,v 1.976.2.11 2010/08/30 17:22:20 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -177,6 +177,20 @@ sub create_connection {
     return 0;
 }
 
+sub get_server_timezone {
+    my ($cnum,$cdom) = @_;
+    my $home=&homeserver($cnum,$cdom);
+    if ($home ne 'no_host') {
+        my $cachetime = 24*3600;
+        my ($timezone,$cached)=&is_cached_new('servertimezone',$home);
+        if (defined($cached)) {
+            return $timezone;
+        } else {
+            my $timezone = &reply('servertimezone',$home);
+            return &do_cache_new('servertimezone',$home,$timezone,$cachetime);
+        }
+    }
+}
 
 # -------------------------------------------------- Non-critical communication
 sub subreply {
@@ -508,7 +522,7 @@ sub appenv {
 # ----------------------------------------------------- Delete from Environment
 
 sub delenv {
-    my $delthis=shift;
+    my ($delthis,$regexp) = @_;
     if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
         &logthis("<font color=\"blue\">WARNING: ".
                 "Attempt to delete from environment ".$delthis);
@@ -521,10 +535,17 @@ sub delenv {
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
-	    if ($key=~/^$delthis/) { 
-		delete($env{$key});
-		delete($disk_env{$key});
-	    }
+            if ($regexp) {
+                if ($key=~/^$delthis/) {
+                    delete($env{$key});
+                    delete($disk_env{$key});
+                }
+            } else {
+                if ($key=~/^\Q$delthis\E/) {
+                    delete($env{$key});
+                    delete($disk_env{$key});
+                }
+            }
 	}
 	untie(%disk_env);
     }
@@ -727,7 +748,8 @@ sub changepass {
     my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);
-    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
+    my $lonhost = $perlvar{'lonHostID'};
+    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context:$lonhost",
 		       $server);
     if (! $answer) {
 	&logthis("No reply on password change request to $server ".
@@ -752,6 +774,9 @@ sub changepass {
     } elsif ($answer =~ "^refused") {
 	&logthis("$server refused to change $uname in $udom password because ".
 		 "it was sent an unencrypted request to change the password.");
+    } elsif ($answer =~ "invalid_client") {
+        &logthis("$server refused to change $uname in $udom password because ".
+                 "it was a reset by e-mail originating from an invalid server.");
     }
     return $answer;
 }
@@ -1227,7 +1252,6 @@ sub inst_userrules {
 sub get_domain_defaults {
     my ($domain) = @_;
     my $cachetime = 60*60*24;
-    my ($defauthtype,$defautharg,$deflang,%deftools);
     my ($result,$cached)=&is_cached_new('domdefaults',$domain);
     if (defined($cached)) {
         if (ref($result) eq 'HASH') {
@@ -1241,6 +1265,8 @@ sub get_domain_defaults {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
         $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
+        $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
+        $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
     } else {
         $domdefaults{'lang_def'} = &domain($domain,'lang_def');
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -2602,6 +2628,9 @@ sub courserolelog {
                 $storehash{'section'} = $sec;
             }
             &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+            if (($trole ne 'st') || ($sec ne '')) {
+                &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+            }
         }
     }
     return;
@@ -2623,6 +2652,7 @@ sub get_course_adv_roles {
     my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
     my $now=time;
+    my %privileged;
     foreach my $entry (keys %dumphash) {
 	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
@@ -2630,8 +2660,21 @@ sub get_course_adv_roles {
         if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$entry);
 	if ($username eq '' || $domain eq '') { next; }
-	if ((&privileged($username,$domain)) && 
-	    (!$nothide{$username.':'.$domain})) { next; }
+        unless (ref($privileged{$domain}) eq 'HASH') {
+            my %dompersonnel =
+                &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+            $privileged{$domain} = {};
+            foreach my $server (keys(%dompersonnel)) {
+                if (ref($dompersonnel{$server}) eq 'HASH') {
+                    foreach my $user (keys(%{$dompersonnel{$server}})) {
+                        my ($trole,$uname,$udom) = split(/:/,$user);
+                        $privileged{$udom}{$uname} = 1;
+                    }
+                }
+            }
+        }
+        if ((exists($privileged{$domain}{$username})) &&
+            (!$nothide{$username.':'.$domain})) { next; }
 	if ($role eq 'cr') { next; }
         if ($codes) {
             if ($section) { $role .= ':'.$section; }
@@ -2676,6 +2719,7 @@ sub get_my_roles {
     }
     my %returnhash=();
     my $now=time;
+    my %privileged;
     foreach my $entry (keys(%dumphash)) {
         my ($role,$tend,$tstart);
         if ($context eq 'userroles') {
@@ -2724,9 +2768,32 @@ sub get_my_roles {
             }
         }
         if ($hidepriv) {
-            if ((&privileged($username,$domain)) &&
-                (!$nothide{$username.':'.$domain})) { 
-                next;
+            if ($context eq 'userroles') {
+                if ((&privileged($username,$domain)) &&
+                    (!$nothide{$username.':'.$domain})) {
+                    next;
+                }
+            } else {
+                unless (ref($privileged{$domain}) eq 'HASH') {
+                    my %dompersonnel =
+                        &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+                    $privileged{$domain} = {};
+                    if (keys(%dompersonnel)) {
+                        foreach my $server (keys(%dompersonnel)) {
+                            if (ref($dompersonnel{$server}) eq 'HASH') {
+                                foreach my $user (keys(%{$dompersonnel{$server}})) {
+                                    my ($trole,$uname,$udom) = split(/:/,$user);
+                                    $privileged{$udom}{$uname} = $trole;
+                                }
+                            }
+                        }
+                    }
+                }
+                if (exists($privileged{$domain}{$username})) {
+                    if (!$nothide{$username.':'.$domain}) {
+                        next;
+                    }
+                }
             }
         }
         if ($withsec) {
@@ -5085,8 +5152,7 @@ sub update_allusers_table {
                'generation='.&escape($names->{'generation'}).'%%'.
                'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
                'id='.&escape($names->{'id'}),$homeserver);
-    my $reply = &get_query_reply($queryid);
-    return $reply;
+    return;
 }
 
 # ------- Request retrieval of institutional classlists for course(s)
@@ -9213,9 +9279,11 @@ in the user's environment.db and in %env
 
 =item *
 X<delenv()>
-B<delenv($regexp)>: removes all items from the session
-environment file that matches the regular expression in $regexp. The
-values are also delted from the current processes %env.
+B<delenv($delthis,$regexp)>: removes all items from the session
+environment file that begin with $delthis. If the
+optional second arg - $regexp - is true, $delthis is treated as a
+regular expression, otherwise \Q$delthis\E is used.
+The values are also deleted from the current processes %env.
 
 =item * get_env_multiple($name)