version 1.1172.2.2, 2012/05/28 15:02:06
|
version 1.1172.2.11, 2012/09/25 23:06:07
|
Line 75 use LWP::UserAgent();
|
Line 75 use LWP::UserAgent();
|
use HTTP::Date; |
use HTTP::Date; |
use Image::Magick; |
use Image::Magick; |
|
|
use Encode; |
|
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
%managerstab); |
%managerstab); |
Line 110 require Exporter;
|
Line 108 require Exporter;
|
our @ISA = qw (Exporter); |
our @ISA = qw (Exporter); |
our @EXPORT = qw(%env); |
our @EXPORT = qw(%env); |
|
|
|
# ------------------------------------ Logging (parameters, docs, slots, roles) |
# --------------------------------------------------------------------- Logging |
|
{ |
{ |
my $logid; |
my $logid; |
sub instructor_log { |
sub write_log { |
my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; |
my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; |
if (($cnum eq '') || ($cdom eq '')) { |
if ($context eq 'course') { |
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
if (($cnum eq '') || ($cdom eq '')) { |
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
} |
} |
} |
$logid++; |
$logid++; |
my $now = time(); |
my $now = time(); |
my $id=$now.'00000'.$$.'00000'.$logid; |
my $id=$now.'00000'.$$.'00000'.$logid; |
return &Apache::lonnet::put('nohist_'.$hash_name, |
my $logentry = { |
{ $id => { |
$id => { |
'exe_uname' => $env{'user.name'}, |
'exe_uname' => $env{'user.name'}, |
'exe_udom' => $env{'user.domain'}, |
'exe_udom' => $env{'user.domain'}, |
'exe_time' => $now, |
'exe_time' => $now, |
'exe_ip' => $ENV{'REMOTE_ADDR'}, |
'exe_ip' => $ENV{'REMOTE_ADDR'}, |
'delflag' => $delflag, |
'delflag' => $delflag, |
'logentry' => $storehash, |
'logentry' => $storehash, |
'uname' => $uname, |
'uname' => $uname, |
'udom' => $udom, |
'udom' => $udom, |
} |
} |
},$cdom,$cnum); |
}; |
|
return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum); |
} |
} |
} |
} |
|
|
Line 1238 sub check_loadbalancing {
|
Line 1238 sub check_loadbalancing {
|
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
$offloadto,$otherserver); |
$offloadto,$otherserver); |
my $lonhost = $perlvar{'lonHostID'}; |
my $lonhost = $perlvar{'lonHostID'}; |
|
my @hosts = ¤t_machine_ids(); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); |
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); |
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
Line 1264 sub check_loadbalancing {
|
Line 1265 sub check_loadbalancing {
|
my $currtargets = $result->{'targets'}; |
my $currtargets = $result->{'targets'}; |
my $currrules = $result->{'rules'}; |
my $currrules = $result->{'rules'}; |
if ($currbalancer ne '') { |
if ($currbalancer ne '') { |
my @hosts = ¤t_machine_ids(); |
|
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
$is_balancer = 1; |
$is_balancer = 1; |
} |
} |
Line 1352 sub check_loadbalancing {
|
Line 1352 sub check_loadbalancing {
|
$offloadto = &this_host_spares($dom_in_use); |
$offloadto = &this_host_spares($dom_in_use); |
} |
} |
} |
} |
my $lowest_load = 30000; |
if ($is_balancer) { |
if (ref($offloadto) eq 'HASH') { |
my $lowest_load = 30000; |
if (ref($offloadto->{'primary'}) eq 'ARRAY') { |
if (ref($offloadto) eq 'HASH') { |
foreach my $try_server (@{$offloadto->{'primary'}}) { |
if (ref($offloadto->{'primary'}) eq 'ARRAY') { |
($otherserver,$lowest_load) = |
foreach my $try_server (@{$offloadto->{'primary'}}) { |
&compare_server_load($try_server,$otherserver,$lowest_load); |
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
|
} |
} |
} |
} |
my $found_server = ($otherserver ne '' && $lowest_load < 100); |
my $found_server = ($otherserver ne '' && $lowest_load < 100); |
|
|
|
if (!$found_server) { |
if (!$found_server) { |
if (ref($offloadto->{'default'}) eq 'ARRAY') { |
if (ref($offloadto->{'default'}) eq 'ARRAY') { |
foreach my $try_server (@{$offloadto->{'default'}}) { |
foreach my $try_server (@{$offloadto->{'default'}}) { |
|
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
|
} |
|
} |
|
} |
|
} elsif (ref($offloadto) eq 'ARRAY') { |
|
if (@{$offloadto} == 1) { |
|
$otherserver = $offloadto->[0]; |
|
} elsif (@{$offloadto} > 1) { |
|
foreach my $try_server (@{$offloadto}) { |
($otherserver,$lowest_load) = |
($otherserver,$lowest_load) = |
&compare_server_load($try_server,$otherserver,$lowest_load); |
&compare_server_load($try_server,$otherserver,$lowest_load); |
} |
} |
} |
} |
} |
} |
} elsif (ref($offloadto) eq 'ARRAY') { |
if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) { |
if (@{$offloadto} == 1) { |
$is_balancer = 0; |
$otherserver = $offloadto->[0]; |
if ($uname ne '' && $udom ne '') { |
} elsif (@{$offloadto} > 1) { |
if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { |
foreach my $try_server (@{$offloadto}) { |
|
($otherserver,$lowest_load) = |
&appenv({'user.loadbalexempt' => $lonhost, |
&compare_server_load($try_server,$otherserver,$lowest_load); |
'user.loadbalcheck.time' => time}); |
|
} |
} |
} |
} |
} |
} |
} |
Line 1386 sub check_loadbalancing {
|
Line 1398 sub check_loadbalancing {
|
sub get_loadbalancer_targets { |
sub get_loadbalancer_targets { |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my $offloadto; |
my $offloadto; |
if ($rule_in_effect eq '') { |
if ($rule_in_effect eq 'none') { |
|
return [$perlvar{'lonHostID'}]; |
|
} elsif ($rule_in_effect eq '') { |
$offloadto = $currtargets; |
$offloadto = $currtargets; |
} else { |
} else { |
if ($rule_in_effect eq 'homeserver') { |
if ($rule_in_effect eq 'homeserver') { |
Line 1404 sub get_loadbalancer_targets {
|
Line 1418 sub get_loadbalancer_targets {
|
} |
} |
} |
} |
} else { |
} else { |
my %servers = &dom_servers($udom); |
my %servers = &internet_dom_servers($udom); |
my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); |
my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); |
if (&hostname($remotebalancer) ne '') { |
if (&hostname($remotebalancer) ne '') { |
$offloadto = [$remotebalancer]; |
$offloadto = [$remotebalancer]; |
Line 1923 sub get_domain_defaults {
|
Line 1937 sub get_domain_defaults {
|
my %domconfig = |
my %domconfig = |
&Apache::lonnet::get_dom('configuration',['defaults','quotas', |
&Apache::lonnet::get_dom('configuration',['defaults','quotas', |
'requestcourses','inststatus', |
'requestcourses','inststatus', |
'coursedefaults','usersessions'],$domain); |
'coursedefaults','usersessions', |
|
'requestauthor'],$domain); |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; |
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; |
Line 1942 sub get_domain_defaults {
|
Line 1957 sub get_domain_defaults {
|
} else { |
} else { |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
} |
} |
my @usertools = ('aboutme','blog','portfolio'); |
my @usertools = ('aboutme','blog','webdav','portfolio'); |
foreach my $item (@usertools) { |
foreach my $item (@usertools) { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
Line 1954 sub get_domain_defaults {
|
Line 1969 sub get_domain_defaults {
|
$domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
$domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
} |
} |
} |
} |
|
if (ref($domconfig{'requestauthor'}) eq 'HASH') { |
|
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; |
|
} |
if (ref($domconfig{'inststatus'}) eq 'HASH') { |
if (ref($domconfig{'inststatus'}) eq 'HASH') { |
foreach my $item ('inststatustypes','inststatusorder') { |
foreach my $item ('inststatustypes','inststatusorder') { |
$domdefaults{$item} = $domconfig{'inststatus'}{$item}; |
$domdefaults{$item} = $domconfig{'inststatus'}{$item}; |
Line 2383 sub chatsend {
|
Line 2401 sub chatsend {
|
|
|
sub getversion { |
sub getversion { |
my $fname=&clutter(shift); |
my $fname=&clutter(shift); |
unless ($fname=~/^\/res\//) { return -1; } |
unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; } |
return ¤tversion(&filelocation('',$fname)); |
return ¤tversion(&filelocation('',$fname)); |
} |
} |
|
|
Line 2570 sub ssi {
|
Line 2588 sub ssi {
|
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
my $response= $ua->request($request); |
my $response= $ua->request($request); |
my $content = Encode::decode_utf8($response->content); |
|
if (wantarray) { |
if (wantarray) { |
return ($content, $response); |
return ($response->content, $response); |
} else { |
} else { |
return $content; |
return $response->content; |
} |
} |
} |
} |
|
|
Line 3512 sub userrolelog {
|
Line 3529 sub userrolelog {
|
|
|
sub courserolelog { |
sub courserolelog { |
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_; |
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_; |
if (($trole eq 'cc') || ($trole eq 'in') || |
if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { |
($trole eq 'ep') || ($trole eq 'ad') || |
my $cdom = $1; |
($trole eq 'ta') || ($trole eq 'st') || |
my $cnum = $2; |
($trole=~/^cr/) || ($trole eq 'gr') || |
my $sec = $3; |
($trole eq 'co')) { |
my $namespace = 'rolelog'; |
if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { |
my %storehash = ( |
my $cdom = $1; |
role => $trole, |
my $cnum = $2; |
start => $tstart, |
my $sec = $3; |
end => $tend, |
my $namespace = 'rolelog'; |
selfenroll => $selfenroll, |
my %storehash = ( |
context => $context, |
role => $trole, |
); |
start => $tstart, |
if ($trole eq 'gr') { |
end => $tend, |
$namespace = 'groupslog'; |
selfenroll => $selfenroll, |
$storehash{'group'} = $sec; |
context => $context, |
} else { |
); |
$storehash{'section'} = $sec; |
if ($trole eq 'gr') { |
} |
$namespace = 'groupslog'; |
&write_log('course',$namespace,\%storehash,$delflag,$username, |
$storehash{'group'} = $sec; |
$domain,$cnum,$cdom); |
} else { |
if (($trole ne 'st') || ($sec ne '')) { |
$storehash{'section'} = $sec; |
&devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); |
} |
|
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); |
|
if (($trole ne 'st') || ($sec ne '')) { |
|
&devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); |
|
} |
|
} |
} |
} |
} |
return; |
return; |
} |
} |
|
|
|
sub domainrolelog { |
|
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; |
|
if ($area =~ m{^/($match_domain)/$}) { |
|
my $cdom = $1; |
|
my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom); |
|
my $namespace = 'rolelog'; |
|
my %storehash = ( |
|
role => $trole, |
|
start => $tstart, |
|
end => $tend, |
|
context => $context, |
|
); |
|
&write_log('domain',$namespace,\%storehash,$delflag,$username, |
|
$domain,$domconfiguser,$cdom); |
|
} |
|
return; |
|
|
|
} |
|
|
|
sub coauthorrolelog { |
|
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; |
|
if ($area =~ m{^/($match_domain)/($match_username)$}) { |
|
my $audom = $1; |
|
my $auname = $2; |
|
my $namespace = 'rolelog'; |
|
my %storehash = ( |
|
role => $trole, |
|
start => $tstart, |
|
end => $tend, |
|
context => $context, |
|
); |
|
&write_log('author',$namespace,\%storehash,$delflag,$username, |
|
$domain,$auname,$audom); |
|
} |
|
return; |
|
} |
|
|
sub get_course_adv_roles { |
sub get_course_adv_roles { |
my ($cid,$codes) = @_; |
my ($cid,$codes) = @_; |
$cid=$env{'request.course.id'} unless (defined($cid)); |
$cid=$env{'request.course.id'} unless (defined($cid)); |
Line 3656 sub get_my_roles {
|
Line 3705 sub get_my_roles {
|
} |
} |
my ($rolecode,$username,$domain,$section,$area); |
my ($rolecode,$username,$domain,$section,$area); |
if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
($area,$rolecode) = split(/_/,$entry); |
($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/); |
(undef,$domain,$username,$section) = split(/\//,$area); |
(undef,$domain,$username,$section) = split(/\//,$area); |
} else { |
} else { |
($role,$username,$domain,$section) = split(/\:/,$entry); |
($role,$username,$domain,$section) = split(/\:/,$entry); |
Line 4978 sub delete_env_groupprivs {
|
Line 5027 sub delete_env_groupprivs {
|
sub check_adhoc_privs { |
sub check_adhoc_privs { |
my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; |
my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
|
my $setprivs; |
if ($env{$cckey}) { |
if ($env{$cckey}) { |
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); |
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); |
&role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); |
&role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); |
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { |
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
|
$setprivs = 1; |
} |
} |
} else { |
} else { |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
|
$setprivs = 1; |
} |
} |
|
return $setprivs; |
} |
} |
|
|
sub set_adhoc_privileges { |
sub set_adhoc_privileges { |
Line 5628 sub usertools_access {
|
Line 5681 sub usertools_access {
|
unofficial => 1, |
unofficial => 1, |
community => 1, |
community => 1, |
); |
); |
|
} elsif ($context eq 'requestauthor') { |
|
%tools = ( |
|
requestauthor => 1, |
|
); |
} else { |
} else { |
%tools = ( |
%tools = ( |
aboutme => 1, |
aboutme => 1, |
blog => 1, |
blog => 1, |
|
webdav => 1, |
portfolio => 1, |
portfolio => 1, |
); |
); |
} |
} |
Line 5646 sub usertools_access {
|
Line 5704 sub usertools_access {
|
if ($action ne 'reload') { |
if ($action ne 'reload') { |
if ($context eq 'requestcourses') { |
if ($context eq 'requestcourses') { |
return $env{'environment.canrequest.'.$tool}; |
return $env{'environment.canrequest.'.$tool}; |
|
} elsif ($context eq 'requestauthor') { |
|
return $env{'environment.canrequest.author'}; |
} else { |
} else { |
return $env{'environment.availabletools.'.$tool}; |
return $env{'environment.availabletools.'.$tool}; |
} |
} |
} |
} |
} |
} |
|
|
my ($toolstatus,$inststatus); |
my ($toolstatus,$inststatus,$envkey); |
|
if ($context eq 'requestauthor') { |
|
$envkey = $context; |
|
} else { |
|
$envkey = $context.'.'.$tool; |
|
} |
|
|
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && |
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && |
($action ne 'reload')) { |
($action ne 'reload')) { |
$toolstatus = $env{'environment.'.$context.'.'.$tool}; |
$toolstatus = $env{'environment.'.$envkey}; |
$inststatus = $env{'environment.inststatus'}; |
$inststatus = $env{'environment.inststatus'}; |
} else { |
} else { |
if (ref($userenvref) eq 'HASH') { |
if (ref($userenvref) eq 'HASH') { |
$toolstatus = $userenvref->{$context.'.'.$tool}; |
$toolstatus = $userenvref->{$envkey}; |
$inststatus = $userenvref->{'inststatus'}; |
$inststatus = $userenvref->{'inststatus'}; |
} else { |
} else { |
my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus'); |
my %userenv = &userenvironment($udom,$uname,$envkey,'inststatus'); |
$toolstatus = $userenv{$context.'.'.$tool}; |
$toolstatus = $userenv{$envkey}; |
$inststatus = $userenv{'inststatus'}; |
$inststatus = $userenv{'inststatus'}; |
} |
} |
} |
} |
Line 5730 sub usertools_access {
|
Line 5795 sub usertools_access {
|
} |
} |
} |
} |
} else { |
} else { |
if ($context eq 'tools') { |
if (($context eq 'tools') && ($tool ne 'webdav')) { |
$access = 1; |
$access = 1; |
} else { |
} else { |
$access = 0; |
$access = 0; |
Line 7451 sub assignrole {
|
Line 7516 sub assignrole {
|
} |
} |
} |
} |
} |
} |
|
} elsif ($context eq 'requestauthor') { |
|
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && |
|
($url eq '/'.$udom.'/') && ($role eq 'au')) { |
|
if ($env{'environment.requestauthor'} eq 'automatic') { |
|
$refused = ''; |
|
} else { |
|
my %domdefaults = &get_domain_defaults($udom); |
|
if (ref($domdefaults{'requestauthor'}) eq 'HASH') { |
|
my $checkbystatus; |
|
if ($env{'user.adv'}) { |
|
my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'}; |
|
if ($disposition eq 'automatic') { |
|
$refused = ''; |
|
} elsif ($disposition eq '') { |
|
$checkbystatus = 1; |
|
} |
|
} else { |
|
$checkbystatus = 1; |
|
} |
|
if ($checkbystatus) { |
|
if ($env{'environment.inststatus'}) { |
|
my @inststatuses = split(/,/,$env{'environment.inststatus'}); |
|
foreach my $type (@inststatuses) { |
|
if (($type ne '') && |
|
($domdefaults{'requestauthor'}{$type} eq 'automatic')) { |
|
$refused = ''; |
|
} |
|
} |
|
} elsif ($domdefaults{'requestauthor'}{'default'} eq 'automatic') { |
|
$refused = ''; |
|
} |
|
} |
|
} |
|
} |
|
} |
} |
} |
if ($refused) { |
if ($refused) { |
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. |
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. |
Line 7501 sub assignrole {
|
Line 7601 sub assignrole {
|
if ($answer eq 'ok') { |
if ($answer eq 'ok') { |
&userrolelog($role,$uname,$udom,$url,$start,$end); |
&userrolelog($role,$uname,$udom,$url,$start,$end); |
# for course roles, perform group memberships changes triggered by role change. |
# for course roles, perform group memberships changes triggered by role change. |
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context); |
|
unless ($role =~ /^gr/) { |
unless ($role =~ /^gr/) { |
&Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, |
&Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, |
$origstart,$selfenroll,$context); |
$origstart,$selfenroll,$context); |
} |
} |
|
if (($role eq 'cc') || ($role eq 'in') || |
|
($role eq 'ep') || ($role eq 'ad') || |
|
($role eq 'ta') || ($role eq 'st') || |
|
($role=~/^cr/) || ($role eq 'gr') || |
|
($role eq 'co')) { |
|
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
|
$selfenroll,$context); |
|
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || |
|
($role eq 'au') || ($role eq 'dc')) { |
|
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
|
$context); |
|
} elsif (($role eq 'ca') || ($role eq 'aa')) { |
|
&coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
|
$context); |
|
} |
if ($role eq 'cc') { |
if ($role eq 'cc') { |
&autoupdate_coowners($url,$end,$start,$uname,$udom); |
&autoupdate_coowners($url,$end,$start,$uname,$udom); |
} |
} |
Line 9800 sub devalidate_slots_cache {
|
Line 9914 sub devalidate_slots_cache {
|
&devalidate_cache_new('allslots',$hashid); |
&devalidate_cache_new('allslots',$hashid); |
} |
} |
|
|
|
sub get_coursechange { |
|
my ($cdom,$cnum) = @_; |
|
if ($cdom eq '' || $cnum eq '') { |
|
return unless ($env{'request.course.id'}); |
|
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
} |
|
my $hashid=$cdom.'_'.$cnum; |
|
my ($change,$cached)=&is_cached_new('crschange',$hashid); |
|
if ((defined($cached)) && ($change ne '')) { |
|
return $change; |
|
} else { |
|
my %crshash; |
|
%crshash = &get('environment',['internal.contentchange'],$cdom,$cnum); |
|
if ($crshash{'internal.contentchange'} eq '') { |
|
$change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'}; |
|
if ($change eq '') { |
|
%crshash = &get('environment',['internal.created'],$cdom,$cnum); |
|
$change = $crshash{'internal.created'}; |
|
} |
|
} else { |
|
$change = $crshash{'internal.contentchange'}; |
|
} |
|
my $cachetime = 600; |
|
&do_cache_new('crschange',$hashid,$change,$cachetime); |
|
} |
|
return $change; |
|
} |
|
|
|
sub devalidate_coursechange_cache { |
|
my ($cnum,$cdom)=@_; |
|
my $hashid=$cnum.':'.$cdom; |
|
&devalidate_cache_new('crschange',$hashid); |
|
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 9827 sub symblist {
|
Line 9976 sub symblist {
|
# --------------------------------------------------------------- Verify a symb |
# --------------------------------------------------------------- Verify a symb |
|
|
sub symbverify { |
sub symbverify { |
my ($symb,$thisurl)=@_; |
my ($symb,$thisurl,$encstate)=@_; |
my $thisfn=$thisurl; |
my $thisfn=$thisurl; |
$thisfn=&declutter($thisfn); |
$thisfn=&declutter($thisfn); |
# direct jump to resource in page or to a sequence - will construct own symbs |
# direct jump to resource in page or to a sequence - will construct own symbs |
Line 9864 sub symbverify {
|
Line 10013 sub symbverify {
|
if ( |
if ( |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
eq $symb) { |
eq $symb) { |
|
if (ref($encstate)) { |
|
$$encstate = $bighash{'encrypted_'.$id}; |
|
} |
if (($env{'request.role.adv'}) || |
if (($env{'request.role.adv'}) || |
($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || |
($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || |
($thisurl eq '/adm/navmaps')) { |
($thisurl eq '/adm/navmaps')) { |
Line 9944 sub deversion {
|
Line 10096 sub deversion {
|
sub symbread { |
sub symbread { |
my ($thisfn,$donotrecurse)=@_; |
my ($thisfn,$donotrecurse)=@_; |
my $cache_str='request.symbread.cached.'.$thisfn; |
my $cache_str='request.symbread.cached.'.$thisfn; |
if (defined($env{$cache_str})) { return $env{$cache_str}; } |
if (defined($env{$cache_str})) { |
|
if (($thisfn) || ($env{$cache_str} ne '')) { |
|
return $env{$cache_str}; |
|
} |
|
} |
# no filename provided? try from environment |
# no filename provided? try from environment |
unless ($thisfn) { |
unless ($thisfn) { |
if ($env{'request.symb'}) { |
if ($env{'request.symb'}) { |
Line 12060 returns the data handle
|
Line 12216 returns the data handle
|
|
|
=item * |
=item * |
|
|
symbverify($symb,$thisfn) : verifies that $symb actually exists and is |
symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists |
a possible symb for the URL in $thisfn, and if is an encryypted |
and is a possible symb for the URL in $thisfn, and if is an encrypted |
resource that the user accessed using /enc/ returns a 1 on success, 0 |
resource that the user accessed using /enc/ returns a 1 on success, 0 |
on failure, user must be in a course, as it assumes the existance of |
on failure, user must be in a course, as it assumes the existence of |
the course initial hash, and uses $env('request.course.id'} |
the course initial hash, and uses $env('request.course.id'}. The third |
|
arg is an optional reference to a scalar. If this arg is passed in the |
|
call to symbverify, it will be set to 1 if the symb has been set to be |
|
encrypted; otherwise it will be null. |
|
|
|
|
=item * |
=item * |