version 1.948, 2008/03/10 23:26:28
|
version 1.949, 2008/03/12 02:46:27
|
Line 448 sub timed_flock {
|
Line 448 sub timed_flock {
|
# ---------------------------------------------------------- Append Environment |
# ---------------------------------------------------------- Append Environment |
|
|
sub appenv { |
sub appenv { |
my %newenv=@_; |
my ($newenv,$roles) = @_; |
foreach my $key (keys(%newenv)) { |
if (ref($newenv) eq 'HASH') { |
if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) { |
foreach my $key (keys(%{$newenv})) { |
&logthis("<font color=\"blue\">WARNING: ". |
my $refused = 0; |
"Attempt to modify environment ".$key." to ".$newenv{$key} |
if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) { |
.'</font>'); |
$refused = 1; |
delete($newenv{$key}); |
if (ref($roles) eq 'ARRAY') { |
} else { |
my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./); |
$env{$key}=$newenv{$key}; |
if (grep(/^\Q$role\E$/,@{$roles})) { |
|
$refused = 0; |
|
} |
|
} |
|
} |
|
if ($refused) { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Attempt to modify environment ".$key." to ".$newenv->{$key} |
|
.'</font>'); |
|
delete($newenv->{$key}); |
|
} else { |
|
$env{$key}=$newenv->{$key}; |
|
} |
|
} |
|
my $opened = open(my $env_file,'+<',$env{'user.environment'}); |
|
if ($opened |
|
&& &timed_flock($env_file,LOCK_EX) |
|
&& |
|
tie(my %disk_env,'GDBM_File',$env{'user.environment'}, |
|
(&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { |
|
while (my ($key,$value) = each(%{$newenv})) { |
|
$disk_env{$key} = $value; |
|
} |
|
untie(%disk_env); |
} |
} |
} |
|
my $opened = open(my $env_file,'+<',$env{'user.environment'}); |
|
if ($opened |
|
&& &timed_flock($env_file,LOCK_EX) |
|
&& |
|
tie(my %disk_env,'GDBM_File',$env{'user.environment'}, |
|
(&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { |
|
while (my ($key,$value) = each(%newenv)) { |
|
$disk_env{$key} = $value; |
|
} |
|
untie(%disk_env); |
|
} |
} |
return 'ok'; |
return 'ok'; |
} |
} |
Line 1183 sub assign_access_key {
|
Line 1195 sub assign_access_key {
|
# key now belongs to user |
# key now belongs to user |
my $envkey='key.'.$cdom.'_'.$cnum; |
my $envkey='key.'.$cdom.'_'.$cnum; |
if (&put('environment',{$envkey => $ckey}) eq 'ok') { |
if (&put('environment',{$envkey => $ckey}) eq 'ok') { |
&appenv('environment.'.$envkey => $ckey); |
&appenv({'environment.'.$envkey => $ckey}); |
return 'ok'; |
return 'ok'; |
} else { |
} else { |
return |
return |
Line 1746 sub allowuploaded {
|
Line 1758 sub allowuploaded {
|
my %httpref=(); |
my %httpref=(); |
my $httpurl=&hreflocation('',$url); |
my $httpurl=&hreflocation('',$url); |
$httpref{'httpref.'.$httpurl}=$srcurl; |
$httpref{'httpref.'.$httpurl}=$srcurl; |
&Apache::lonnet::appenv(%httpref); |
&Apache::lonnet::appenv(\%httpref); |
} |
} |
|
|
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
Line 3408 sub coursedescription {
|
Line 3420 sub coursedescription {
|
} |
} |
} |
} |
if (!$args->{'one_time'}) { |
if (!$args->{'one_time'}) { |
&appenv(%envhash); |
&appenv(\%envhash); |
} |
} |
return %returnhash; |
return %returnhash; |
} |
} |
Line 6351 sub directcondval {
|
Line 6363 sub directcondval {
|
untie(%bighash); |
untie(%bighash); |
} |
} |
my $value = &docondval($sub_condition); |
my $value = &docondval($sub_condition); |
&appenv('user.state.'.$env{'request.course.id'}.".$number" => $value); |
&appenv({'user.state.'.$env{'request.course.id'}.".$number" => $value}); |
return $value; |
return $value; |
} |
} |
if ($env{'user.state.'.$env{'request.course.id'}}) { |
if ($env{'user.state.'.$env{'request.course.id'}}) { |
Line 6537 sub EXT_cache_status {
|
Line 6549 sub EXT_cache_status {
|
sub EXT_cache_set { |
sub EXT_cache_set { |
my ($target_domain,$target_user) = @_; |
my ($target_domain,$target_user) = @_; |
my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; |
my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; |
#&appenv($cachename => time); |
#&appenv({$cachename => time}); |
} |
} |
|
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
Line 7439 sub symbread {
|
Line 7451 sub symbread {
|
if ($syval) { |
if ($syval) { |
#unless ($syval=~/\_\d+$/) { |
#unless ($syval=~/\_\d+$/) { |
#unless ($env{'form.request.prefix'}=~/\.(\d+)\_$/) { |
#unless ($env{'form.request.prefix'}=~/\.(\d+)\_$/) { |
#&appenv('request.ambiguous' => $thisfn); |
#&appenv({'request.ambiguous' => $thisfn}); |
#return $env{$cache_str}=''; |
#return $env{$cache_str}=''; |
#} |
#} |
#$syval.=$1; |
#$syval.=$1; |
Line 7491 sub symbread {
|
Line 7503 sub symbread {
|
return $env{$cache_str}=$syval; |
return $env{$cache_str}=$syval; |
} |
} |
} |
} |
&appenv('request.ambiguous' => $thisfn); |
&appenv({'request.ambiguous' => $thisfn}); |
return $env{$cache_str}=''; |
return $env{$cache_str}=''; |
} |
} |
|
|
Line 8005 sub tokenwrapper {
|
Line 8017 sub tokenwrapper {
|
my (undef,$udom,$uname,$file)=split('/',$uri,4); |
my (undef,$udom,$uname,$file)=split('/',$uri,4); |
if ($udom && $uname && $file) { |
if ($udom && $uname && $file) { |
$file=~s|(\?\.*)*$||; |
$file=~s|(\?\.*)*$||; |
&appenv("userfile.$udom/$uname/$file" => $env{'request.course.id'}); |
&appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}}); |
return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri. |
return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri. |
(($uri=~/\?/)?'&':'?').'token='.$token. |
(($uri=~/\?/)?'&':'?').'token='.$token. |
'&tokenissued='.$perlvar{'lonHostID'}; |
'&tokenissued='.$perlvar{'lonHostID'}; |
Line 8850 that was requested
|
Line 8862 that was requested
|
|
|
=item * |
=item * |
X<appenv()> |
X<appenv()> |
B<appenv(%hash)>: the value of %hash is written to |
B<appenv($hashref,$rolesarrayref)>: the value of %{$hashref} is written to |
the user envirnoment file, and will be restored for each access this |
the user envirnoment file, and will be restored for each access this |
user makes during this session, also modifies the %env for the current |
user makes during this session, also modifies the %env for the current |
process |
process. Optional rolesarrayref - if defined contains a reference to an array |
|
of roles which are exempt from the restriction on modifying user.role entries |
|
in the user's environment.db and in %env. |
|
|
=item * |
=item * |
X<delenv()> |
X<delenv()> |