version 1.976.2.5, 2009/01/05 16:28:11
|
version 1.976.2.11, 2010/08/30 17:22:20
|
Line 177 sub create_connection {
|
Line 177 sub create_connection {
|
return 0; |
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 |
# -------------------------------------------------- Non-critical communication |
sub subreply { |
sub subreply { |
Line 508 sub appenv {
|
Line 522 sub appenv {
|
# ----------------------------------------------------- Delete from Environment |
# ----------------------------------------------------- Delete from Environment |
|
|
sub delenv { |
sub delenv { |
my $delthis=shift; |
my ($delthis,$regexp) = @_; |
if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { |
if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { |
&logthis("<font color=\"blue\">WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Attempt to delete from environment ".$delthis); |
"Attempt to delete from environment ".$delthis); |
Line 521 sub delenv {
|
Line 535 sub delenv {
|
tie(my %disk_env,'GDBM_File',$env{'user.environment'}, |
tie(my %disk_env,'GDBM_File',$env{'user.environment'}, |
(&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { |
(&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { |
foreach my $key (keys(%disk_env)) { |
foreach my $key (keys(%disk_env)) { |
if ($key=~/^\Q$delthis\E/) { |
if ($regexp) { |
delete($env{$key}); |
if ($key=~/^$delthis/) { |
delete($disk_env{$key}); |
delete($env{$key}); |
} |
delete($disk_env{$key}); |
|
} |
|
} else { |
|
if ($key=~/^\Q$delthis\E/) { |
|
delete($env{$key}); |
|
delete($disk_env{$key}); |
|
} |
|
} |
} |
} |
untie(%disk_env); |
untie(%disk_env); |
} |
} |
Line 727 sub changepass {
|
Line 748 sub changepass {
|
my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; |
my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; |
$currentpass = &escape($currentpass); |
$currentpass = &escape($currentpass); |
$newpass = &escape($newpass); |
$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); |
$server); |
if (! $answer) { |
if (! $answer) { |
&logthis("No reply on password change request to $server ". |
&logthis("No reply on password change request to $server ". |
Line 752 sub changepass {
|
Line 774 sub changepass {
|
} elsif ($answer =~ "^refused") { |
} elsif ($answer =~ "^refused") { |
&logthis("$server refused to change $uname in $udom password because ". |
&logthis("$server refused to change $uname in $udom password because ". |
"it was sent an unencrypted request to change the password."); |
"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; |
return $answer; |
} |
} |
Line 2603 sub courserolelog {
|
Line 2628 sub courserolelog {
|
$storehash{'section'} = $sec; |
$storehash{'section'} = $sec; |
} |
} |
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); |
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); |
|
if (($trole ne 'st') || ($sec ne '')) { |
|
&devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); |
|
} |
} |
} |
} |
} |
return; |
return; |
Line 2624 sub get_course_adv_roles {
|
Line 2652 sub get_course_adv_roles {
|
my %dumphash= |
my %dumphash= |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
my $now=time; |
my $now=time; |
|
my %privileged; |
foreach my $entry (keys %dumphash) { |
foreach my $entry (keys %dumphash) { |
my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
if (($tstart) && ($tstart<0)) { next; } |
if (($tstart) && ($tstart<0)) { next; } |
Line 2631 sub get_course_adv_roles {
|
Line 2660 sub get_course_adv_roles {
|
if (($tstart) && ($now<$tstart)) { next; } |
if (($tstart) && ($now<$tstart)) { next; } |
my ($role,$username,$domain,$section)=split(/\:/,$entry); |
my ($role,$username,$domain,$section)=split(/\:/,$entry); |
if ($username eq '' || $domain eq '') { next; } |
if ($username eq '' || $domain eq '') { next; } |
if ((&privileged($username,$domain)) && |
unless (ref($privileged{$domain}) eq 'HASH') { |
(!$nothide{$username.':'.$domain})) { next; } |
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 ($role eq 'cr') { next; } |
if ($codes) { |
if ($codes) { |
if ($section) { $role .= ':'.$section; } |
if ($section) { $role .= ':'.$section; } |
Line 2677 sub get_my_roles {
|
Line 2719 sub get_my_roles {
|
} |
} |
my %returnhash=(); |
my %returnhash=(); |
my $now=time; |
my $now=time; |
|
my %privileged; |
foreach my $entry (keys(%dumphash)) { |
foreach my $entry (keys(%dumphash)) { |
my ($role,$tend,$tstart); |
my ($role,$tend,$tstart); |
if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
Line 2725 sub get_my_roles {
|
Line 2768 sub get_my_roles {
|
} |
} |
} |
} |
if ($hidepriv) { |
if ($hidepriv) { |
if ((&privileged($username,$domain)) && |
if ($context eq 'userroles') { |
(!$nothide{$username.':'.$domain})) { |
if ((&privileged($username,$domain)) && |
next; |
(!$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) { |
if ($withsec) { |
Line 5086 sub update_allusers_table {
|
Line 5152 sub update_allusers_table {
|
'generation='.&escape($names->{'generation'}).'%%'. |
'generation='.&escape($names->{'generation'}).'%%'. |
'permanentemail='.&escape($names->{'permanentemail'}).'%%'. |
'permanentemail='.&escape($names->{'permanentemail'}).'%%'. |
'id='.&escape($names->{'id'}),$homeserver); |
'id='.&escape($names->{'id'}),$homeserver); |
my $reply = &get_query_reply($queryid); |
return; |
return $reply; |
|
} |
} |
|
|
# ------- Request retrieval of institutional classlists for course(s) |
# ------- Request retrieval of institutional classlists for course(s) |
Line 9214 in the user's environment.db and in %env
|
Line 9279 in the user's environment.db and in %env
|
|
|
=item * |
=item * |
X<delenv()> |
X<delenv()> |
B<delenv($regexp)>: removes all items from the session |
B<delenv($delthis,$regexp)>: removes all items from the session |
environment file that matches the regular expression in $regexp. The |
environment file that begin with $delthis. If the |
values are also delted from the current processes %env. |
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) |
=item * get_env_multiple($name) |
|
|