version 1.1172.2.144, 2021/12/24 21:13:15
|
version 1.1172.2.146.2.9, 2023/01/21 00:14:13
|
Line 127 our @EXPORT = qw(%env);
|
Line 127 our @EXPORT = qw(%env);
|
$logid ++; |
$logid ++; |
my $now = time(); |
my $now = time(); |
my $id=$now.'00000'.$$.'00000'.$logid; |
my $id=$now.'00000'.$$.'00000'.$logid; |
my $ip = &get_requestor_ip(); |
my $ip = &get_requestor_ip(); |
my $logentry = { |
my $logentry = { |
$id => { |
$id => { |
'exe_uname' => $env{'user.name'}, |
'exe_uname' => $env{'user.name'}, |
Line 1254 sub changepass {
|
Line 1254 sub changepass {
|
sub queryauthenticate { |
sub queryauthenticate { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
if (!$uhome) { |
if ((!$uhome) || ($uhome eq 'no_host')) { |
&logthis("User $uname at $udom is unknown when looking for authentication mechanism"); |
&logthis("User $uname at $udom is unknown when looking for authentication mechanism"); |
return 'no_host'; |
return 'no_host'; |
} |
} |
Line 1303 sub authenticate {
|
Line 1303 sub authenticate {
|
} |
} |
if ($answer eq 'non_authorized') { |
if ($answer eq 'non_authorized') { |
&logthis("User $uname at $udom rejected by $uhome"); |
&logthis("User $uname at $udom rejected by $uhome"); |
return 'no_host'; |
return 'no_host'; |
} |
} |
&logthis("User $uname at $udom threw error $answer when checking authentication mechanism"); |
&logthis("User $uname at $udom threw error $answer when checking authentication mechanism"); |
return 'no_host'; |
return 'no_host'; |
} |
} |
|
|
|
sub can_switchserver { |
|
my ($udom,$home) = @_; |
|
my ($canswitch,@intdoms); |
|
my $internet_names = &get_internet_names($home); |
|
if (ref($internet_names) eq 'ARRAY') { |
|
@intdoms = @{$internet_names}; |
|
} |
|
my $uint_dom = &internet_dom(&domain($udom,'primary')); |
|
if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) { |
|
$canswitch = 1; |
|
} else { |
|
my $serverhomeID = &get_server_homeID(&hostname($home)); |
|
my $serverhomedom = &host_domain($serverhomeID); |
|
my %defdomdefaults = &get_domain_defaults($serverhomedom); |
|
my %udomdefaults = &get_domain_defaults($udom); |
|
my $remoterev = &get_server_loncaparev('',$home); |
|
$canswitch = &can_host_session($udom,$home,$remoterev, |
|
$udomdefaults{'remotesessions'}, |
|
$defdomdefaults{'hostedsessions'}); |
|
} |
|
return $canswitch; |
|
} |
|
|
sub can_host_session { |
sub can_host_session { |
my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_; |
my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_; |
my $canhost = 1; |
my $canhost = 1; |
Line 1882 sub dump_dom {
|
Line 1905 sub dump_dom {
|
# ------------------------------------------ get items from domain db files |
# ------------------------------------------ get items from domain db files |
|
|
sub get_dom { |
sub get_dom { |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my ($namespace,$storearr,$udom,$uhome,$encrypt)=@_; |
return if ($udom eq 'public'); |
return if ($udom eq 'public'); |
my $items=''; |
my $items=''; |
foreach my $item (@$storearr) { |
foreach my $item (@$storearr) { |
Line 1909 sub get_dom {
|
Line 1932 sub get_dom {
|
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
# domain information is hosted on this machine |
# domain information is hosted on this machine |
$rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items"); |
$rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items"); |
} else { |
} else { |
$rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
if ($encrypt) { |
|
$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); |
|
} else { |
|
$rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
|
} |
} |
} |
my %returnhash; |
my %returnhash; |
if ($rep eq '' || $rep =~ /^error: 2 /) { |
if ($rep eq '' || $rep =~ /^error: 2 /) { |
Line 1934 sub get_dom {
|
Line 1961 sub get_dom {
|
# -------------------------------------------- put items in domain db files |
# -------------------------------------------- put items in domain db files |
|
|
sub put_dom { |
sub put_dom { |
my ($namespace,$storehash,$udom,$uhome)=@_; |
my ($namespace,$storehash,$udom,$uhome,$encrypt)=@_; |
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
Line 1955 sub put_dom {
|
Line 1982 sub put_dom {
|
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
if ($encrypt) { |
|
return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); |
|
} else { |
|
return &reply("putdom:$udom:$namespace:$items",$uhome); |
|
} |
} else { |
} else { |
&logthis("put_dom failed - no homeserver and/or domain"); |
&logthis("put_dom failed - no homeserver and/or domain"); |
} |
} |
Line 1989 sub del_dom {
|
Line 2020 sub del_dom {
|
} |
} |
} |
} |
|
|
|
sub store_dom { |
|
my ($storehash,$id,$namespace,$dom,$home,$encrypt) = @_; |
|
$$storehash{'ip'}=&get_requestor_ip(); |
|
$$storehash{'host'}=$perlvar{'lonHostID'}; |
|
my $namevalue=''; |
|
foreach my $key (keys(%{$storehash})) { |
|
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
|
} |
|
$namevalue=~s/\&$//; |
|
if (grep { $_ eq $home } current_machine_ids()) { |
|
return LONCAPA::Lond::store_dom("storedom:$dom:$namespace:$id:$namevalue"); |
|
} else { |
|
if ($namespace eq 'private') { |
|
return 'refused'; |
|
} elsif ($encrypt) { |
|
return reply("encrypt:storedom:$dom:$namespace:$id:$namevalue",$home); |
|
} else { |
|
return reply("storedom:$dom:$namespace:$id:$namevalue",$home); |
|
} |
|
} |
|
} |
|
|
|
sub restore_dom { |
|
my ($id,$namespace,$dom,$home,$encrypt) = @_; |
|
my $answer; |
|
if (grep { $_ eq $home } current_machine_ids()) { |
|
$answer = LONCAPA::Lond::restore_dom("restoredom:$dom:$namespace:$id"); |
|
} elsif ($namespace ne 'private') { |
|
if ($encrypt) { |
|
$answer=&reply("encrypt:restoredom:$dom:$namespace:$id",$home); |
|
} else { |
|
$answer=&reply("restoredom:$dom:$namespace:$id",$home); |
|
} |
|
} |
|
my %returnhash=(); |
|
unless (($answer eq '') || ($answer eq 'con_lost') || ($answer eq 'refused') || |
|
($answer eq 'unknown_cmd') || ($answer eq 'rejected')) { |
|
foreach my $line (split(/\&/,$answer)) { |
|
my ($name,$value)=split(/\=/,$line); |
|
$returnhash{&unescape($name)}=&thaw_unescape($value); |
|
} |
|
my $version; |
|
for ($version=1;$version<=$returnhash{'version'};$version++) { |
|
foreach my $item (split(/\:/,$returnhash{$version.':keys'})) { |
|
$returnhash{$item}=$returnhash{$version.':'.$item}; |
|
} |
|
} |
|
} |
|
return %returnhash; |
|
} |
|
|
# ----------------------------------construct domainconfig user for a domain |
# ----------------------------------construct domainconfig user for a domain |
sub get_domainconfiguser { |
sub get_domainconfiguser { |
my ($udom) = @_; |
my ($udom) = @_; |
Line 2267 sub inst_rulecheck {
|
Line 2349 sub inst_rulecheck {
|
$response=&unescape(&reply('instidrulecheck:'.&escape($udom). |
$response=&unescape(&reply('instidrulecheck:'.&escape($udom). |
':'.&escape($id).':'.$rulestr, |
':'.&escape($id).':'.$rulestr, |
$homeserver)); |
$homeserver)); |
|
} elsif ($item eq 'unamemap') { |
|
$response=&unescape(&reply('instunamemapcheck:'. |
|
&escape($udom).':'.&escape($uname). |
|
':'.$rulestr,$homeserver)); |
} elsif ($item eq 'selfcreate') { |
} elsif ($item eq 'selfcreate') { |
$response=&unescape(&reply('instselfcreatecheck:'. |
$response=&unescape(&reply('instselfcreatecheck:'. |
&escape($udom).':'.&escape($uname). |
&escape($udom).':'.&escape($uname). |
Line 2300 sub inst_userrules {
|
Line 2386 sub inst_userrules {
|
} elsif ($check eq 'email') { |
} elsif ($check eq 'email') { |
$response=&reply('instemailrules:'.&escape($udom), |
$response=&reply('instemailrules:'.&escape($udom), |
$homeserver); |
$homeserver); |
|
} elsif ($check eq 'unamemap') { |
|
$response=&reply('unamemaprules:'.&escape($udom), |
|
$homeserver); |
} else { |
} else { |
$response=&reply('instuserrules:'.&escape($udom), |
$response=&reply('instuserrules:'.&escape($udom), |
$homeserver); |
$homeserver); |
Line 2346 sub get_domain_defaults {
|
Line 2435 sub get_domain_defaults {
|
'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
'requestauthor','selfenrollment', |
'requestauthor','selfenrollment', |
'coursecategories','autoenroll', |
'coursecategories','autoenroll', |
'helpsettings'],$domain); |
'helpsettings','wafproxy','ltisec'],$domain); |
my @coursetypes = ('official','unofficial','community','textbook'); |
my @coursetypes = ('official','unofficial','community','textbook'); |
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'}; |
Line 2358 sub get_domain_defaults {
|
Line 2447 sub get_domain_defaults {
|
$domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'}; |
$domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'}; |
$domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'}; |
$domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'}; |
$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'}; |
$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'}; |
|
$domdefaults{'unamemap_rule'} = $domconfig{'defaults'}{'unamemap_rule'}; |
} else { |
} else { |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
Line 2428 sub get_domain_defaults {
|
Line 2518 sub get_domain_defaults {
|
if ($domconfig{'coursedefaults'}{'texengine'}) { |
if ($domconfig{'coursedefaults'}{'texengine'}) { |
$domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'}; |
$domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'}; |
} |
} |
|
if (exists($domconfig{'coursedefaults'}{'ltiauth'})) { |
|
$domdefaults{'crsltiauth'} = $domconfig{'coursedefaults'}{'ltiauth'}; |
|
} |
} |
} |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
Line 2483 sub get_domain_defaults {
|
Line 2576 sub get_domain_defaults {
|
} |
} |
if (ref($domconfig{'autoenroll'}) eq 'HASH') { |
if (ref($domconfig{'autoenroll'}) eq 'HASH') { |
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; |
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; |
|
$domdefaults{'failsafe'} = $domconfig{'autoenroll'}{'failsafe'}; |
} |
} |
if (ref($domconfig{'helpsettings'}) eq 'HASH') { |
if (ref($domconfig{'helpsettings'}) eq 'HASH') { |
$domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'}; |
$domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'}; |
Line 2497 sub get_domain_defaults {
|
Line 2591 sub get_domain_defaults {
|
} |
} |
} |
} |
} |
} |
|
if (ref($domconfig{'ltisec'}) eq 'HASH') { |
|
if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') { |
|
$domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'}; |
|
$domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'}; |
|
$domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'}; |
|
} |
|
if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') { |
|
if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') { |
|
$domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'}; |
|
} |
|
} |
|
} |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
return %domdefaults; |
return %domdefaults; |
} |
} |
Line 2583 sub get_passwdconf {
|
Line 2689 sub get_passwdconf {
|
return %passwdconf; |
return %passwdconf; |
} |
} |
|
|
|
sub course_portal_url { |
|
my ($cnum,$cdom,$r) = @_; |
|
my $chome = &homeserver($cnum,$cdom); |
|
my $hostname = &hostname($chome); |
|
my $protocol = $protocol{$chome}; |
|
$protocol = 'http' if ($protocol ne 'https'); |
|
my %domdefaults = &get_domain_defaults($cdom); |
|
my $firsturl; |
|
if ($domdefaults{'portal_def'}) { |
|
$firsturl = $domdefaults{'portal_def'}; |
|
} else { |
|
my $alias = &Apache::lonnet::use_proxy_alias($r,$chome); |
|
$hostname = $alias if ($alias ne ''); |
|
$firsturl = $protocol.'://'.$hostname; |
|
} |
|
return $firsturl; |
|
} |
|
|
# --------------------------------------------------- Assign a key to a student |
# --------------------------------------------------- Assign a key to a student |
|
|
sub assign_access_key { |
sub assign_access_key { |
Line 3167 sub ssi_body {
|
Line 3291 sub ssi_body {
|
# --------------------------------------------------------- Server Side Include |
# --------------------------------------------------------- Server Side Include |
|
|
sub absolute_url { |
sub absolute_url { |
my ($host_name) = @_; |
my ($host_name,$unalias,$keep_proto) = @_; |
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
if ($host_name eq '') { |
if ($host_name eq '') { |
$host_name = $ENV{'SERVER_NAME'}; |
$host_name = $ENV{'SERVER_NAME'}; |
} |
} |
|
if ($unalias) { |
|
my $alias = &get_proxy_alias(); |
|
if ($alias eq $host_name) { |
|
my $lonhost = $perlvar{'lonHostID'}; |
|
my $hostname = &hostname($lonhost); |
|
my $lcproto; |
|
if (($keep_proto) || ($hostname eq '')) { |
|
$lcproto = $protocol; |
|
} else { |
|
$lcproto = $protocol{$lonhost}; |
|
$lcproto = 'http' if ($lcproto ne 'https'); |
|
$lcproto .= '://'; |
|
} |
|
unless ($hostname eq '') { |
|
return $lcproto.$hostname; |
|
} |
|
} |
|
} |
return $protocol.$host_name; |
return $protocol.$host_name; |
} |
} |
|
|
Line 3188 sub absolute_url {
|
Line 3330 sub absolute_url {
|
sub ssi { |
sub ssi { |
|
|
my ($fn,%form)=@_; |
my ($fn,%form)=@_; |
my ($request,$response); |
my ($host,$request,$response); |
|
$host = &absolute_url('',1); |
|
|
$form{'no_update_last_known'}=1; |
$form{'no_update_last_known'}=1; |
&Apache::lonenc::check_encrypt(\$fn); |
&Apache::lonenc::check_encrypt(\$fn); |
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$request=new HTTP::Request('POST',$host.$fn); |
$request->content(join('&',map { |
$request->content(join('&',map { |
my $name = escape($_); |
my $name = escape($_); |
"$name=" . ( ref($form{$_}) eq 'ARRAY' |
"$name=" . ( ref($form{$_}) eq 'ARRAY' |
Line 3201 sub ssi {
|
Line 3344 sub ssi {
|
: &escape($form{$_}) ); |
: &escape($form{$_}) ); |
} keys(%form))); |
} keys(%form))); |
} else { |
} else { |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
$request=new HTTP::Request('GET',$host.$fn); |
} |
} |
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
Line 3470 sub can_edit_resource {
|
Line 3613 sub can_edit_resource {
|
$cfile = '/adm/wrapper'.$resurl; |
$cfile = '/adm/wrapper'.$resurl; |
} |
} |
} |
} |
|
} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
|
$incourse = 1; |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
} else { |
|
$forceedit = 1; |
|
} |
|
$cfile = $resurl; |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
$incourse = 1; |
$incourse = 1; |
if ($env{'form.forceedit'}) { |
if ($env{'form.forceedit'}) { |
Line 3494 sub can_edit_resource {
|
Line 3645 sub can_edit_resource {
|
$forceedit = 1; |
$forceedit = 1; |
} |
} |
$cfile = $resurl; |
$cfile = $resurl; |
|
} elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) { |
|
$incourse = 1; |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
} else { |
|
$forceedit = 1; |
|
} |
|
$cfile = $resurl; |
} elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { |
} elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { |
$incourse = 1; |
$incourse = 1; |
$forceview = 1; |
$forceview = 1; |
Line 3503 sub can_edit_resource {
|
Line 3662 sub can_edit_resource {
|
$cfile = &clutter($res); |
$cfile = &clutter($res); |
} else { |
} else { |
$cfile = $env{'form.suppurl'}; |
$cfile = $env{'form.suppurl'}; |
$cfile =~ s{^http://}{}; |
my $escfile = &unescape($cfile); |
$cfile = '/adm/wrapper/ext/'.$cfile; |
if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
|
$cfile = '/adm/wrapper'.$escfile; |
|
} else { |
|
$escfile =~ s{^http://}{}; |
|
$cfile = &escape("/adm/wrapper/ext/$escfile"); |
|
} |
} |
} |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
if ($env{'form.forceedit'}) { |
if ($env{'form.forceedit'}) { |
Line 4495 sub get_scantronformat_file {
|
Line 4659 sub get_scantronformat_file {
|
close($fh); |
close($fh); |
} |
} |
} |
} |
|
chomp(@lines); |
} |
} |
return @lines; |
return @lines; |
} |
} |
Line 5508 my %cachedtimes=();
|
Line 5673 my %cachedtimes=();
|
my $cachedtime=''; |
my $cachedtime=''; |
|
|
sub load_all_first_access { |
sub load_all_first_access { |
my ($uname,$udom)=@_; |
my ($uname,$udom,$ignorecache)=@_; |
if (($cachedkey eq $uname.':'.$udom) && |
if (($cachedkey eq $uname.':'.$udom) && |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) && |
|
(!$ignorecache)) { |
return; |
return; |
} |
} |
$cachedtime=time; |
$cachedtime=time; |
Line 5519 sub load_all_first_access {
|
Line 5685 sub load_all_first_access {
|
} |
} |
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb,$argmap)=@_; |
my ($type,$argsymb,$argmap,$ignorecache)=@_; |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
if ($argsymb) { $symb=$argsymb; } |
if ($argsymb) { $symb=$argsymb; } |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
Line 5531 sub get_first_access {
|
Line 5697 sub get_first_access {
|
} else { |
} else { |
$res=$symb; |
$res=$symb; |
} |
} |
&load_all_first_access($uname,$udom); |
&load_all_first_access($uname,$udom,$ignorecache); |
return $cachedtimes{"$courseid\0$res"}; |
return $cachedtimes{"$courseid\0$res"}; |
} |
} |
|
|
Line 6511 sub course_adhocrole_privs {
|
Line 6677 sub course_adhocrole_privs {
|
$full{$priv} = $restrict; |
$full{$priv} = $restrict; |
} |
} |
foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) { |
foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) { |
next if ($item eq ''); |
next if ($item eq ''); |
my ($rule,$rest) = split(/=/,$item); |
my ($rule,$rest) = split(/=/,$item); |
next unless (($rule eq 'off') || ($rule eq 'on')); |
next unless (($rule eq 'off') || ($rule eq 'on')); |
foreach my $priv (split(/:/,$rest)) { |
foreach my $priv (split(/:/,$rest)) { |
if ($priv ne '') { |
if ($priv ne '') { |
if ($rule eq 'off') { |
if ($rule eq 'off') { |
$possremove{$priv} = 1; |
$possremove{$priv} = 1; |
} else { |
} else { |
$possadd{$priv} = 1; |
$possadd{$priv} = 1; |
} |
} |
} |
} |
} |
} |
} |
} |
foreach my $priv (sort(keys(%full))) { |
foreach my $priv (sort(keys(%full))) { |
if (exists($currprivs{$priv})) { |
if (exists($currprivs{$priv})) { |
unless (exists($possremove{$priv})) { |
unless (exists($possremove{$priv})) { |
$storeprivs{$priv} = $currprivs{$priv}; |
$storeprivs{$priv} = $currprivs{$priv}; |
} |
} |
} elsif (exists($possadd{$priv})) { |
} elsif (exists($possadd{$priv})) { |
$storeprivs{$priv} = $full{$priv}; |
$storeprivs{$priv} = $full{$priv}; |
} |
} |
} |
} |
$coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); |
$coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); |
} |
} |
return $coursepriv; |
return $coursepriv; |
} |
} |
|
|
sub group_roleprivs { |
sub group_roleprivs { |
Line 6799 sub set_adhoc_privileges {
|
Line 6965 sub set_adhoc_privileges {
|
my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash); |
my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash); |
&appenv(\%userroles,[$role,'cm']); |
&appenv(\%userroles,[$role,'cm']); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec); |
unless ($caller eq 'constructaccess' && $env{'request.course.id'}) { |
unless (($caller eq 'constructaccess' && $env{'request.course.id'}) || |
|
($caller eq 'tiny')) { |
&appenv( {'request.role' => $spec, |
&appenv( {'request.role' => $spec, |
'request.role.domain' => $dcdom, |
'request.role.domain' => $dcdom, |
'request.course.sec' => $sec, |
'request.course.sec' => $sec, |
Line 6874 sub unserialize {
|
Line 7041 sub unserialize {
|
# see Lond::dump_with_regexp |
# see Lond::dump_with_regexp |
# if $escapedkeys hash keys won't get unescaped. |
# if $escapedkeys hash keys won't get unescaped. |
sub dump { |
sub dump { |
my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_; |
my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys,$encrypt)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
Line 6890 sub dump {
|
Line 7057 sub dump {
|
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
return %{&unserialize($reply, $escapedkeys)}; |
return %{&unserialize($reply, $escapedkeys)}; |
} |
} |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my $rep; |
|
if ($encrypt) { |
|
$rep=&reply("encrypt:edump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
|
} else { |
|
$rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
|
} |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
if (!($rep =~ /^error/ )) { |
if (!($rep =~ /^error/ )) { |
Line 7036 sub inc {
|
Line 7208 sub inc {
|
# --------------------------------------------------------------- put interface |
# --------------------------------------------------------------- put interface |
|
|
sub put { |
sub put { |
my ($namespace,$storehash,$udomain,$uname)=@_; |
my ($namespace,$storehash,$udomain,$uname,$encrypt)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
Line 7045 sub put {
|
Line 7217 sub put {
|
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
if ($encrypt) { |
|
return &reply("encrypt:put:$udomain:$uname:$namespace:$items",$uhome); |
|
} else { |
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
|
} |
} |
} |
|
|
# ------------------------------------------------------------ newput interface |
# ------------------------------------------------------------ newput interface |
Line 7582 sub usertools_access {
|
Line 7758 sub usertools_access {
|
blog => 1, |
blog => 1, |
webdav => 1, |
webdav => 1, |
portfolio => 1, |
portfolio => 1, |
|
timezone => 1, |
); |
); |
} |
} |
return if (!defined($tools{$tool})); |
return if (!defined($tools{$tool})); |
Line 7867 sub customaccess {
|
Line 8044 sub customaccess {
|
# ------------------------------------------------- Check for a user privilege |
# ------------------------------------------------- Check for a user privilege |
|
|
sub allowed { |
sub allowed { |
my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_; |
my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_; |
my $ver_orguri=$uri; |
my $ver_orguri=$uri; |
$uri=&deversion($uri); |
$uri=&deversion($uri); |
my $orguri=$uri; |
my $orguri=$uri; |
$uri=&declutter($uri); |
$uri=&declutter($uri); |
|
|
if ($priv eq 'evb') { |
if ($priv eq 'evb') { |
# Evade communication block restrictions for specified role in a course |
# Evade communication block restrictions for specified role in a course or domain |
if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) { |
if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) { |
return $1; |
return $1; |
} else { |
} else { |
Line 7884 sub allowed {
|
Line 8061 sub allowed {
|
|
|
if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } |
if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } |
# Free bre access to adm and meta resources |
# Free bre access to adm and meta resources |
if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$})) |
if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme|ext\.tool)$})) |
|| (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) |
|| (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) |
&& ($priv eq 'bre')) { |
&& ($priv eq 'bre')) { |
return 'F'; |
return 'F'; |
Line 7932 sub allowed {
|
Line 8109 sub allowed {
|
# Free bre to public access |
# Free bre to public access |
|
|
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
my $copyright=&metadata($uri,'copyright'); |
my $copyright; |
|
unless ($uri =~ /ext\.tool/) { |
|
$copyright=&metadata($uri,'copyright'); |
|
} |
if (($copyright eq 'public') && (!$env{'request.course.id'})) { |
if (($copyright eq 'public') && (!$env{'request.course.id'})) { |
return 'F'; |
return 'F'; |
} |
} |
Line 8089 sub allowed {
|
Line 8269 sub allowed {
|
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
if ($noblockcheck) { |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$uri); |
|
} |
|
if ($deeplinkblock) { |
|
$thisallowed='D'; |
|
} elsif ($noblockcheck) { |
$thisallowed.=$value; |
$thisallowed.=$value; |
} else { |
} else { |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
Line 8109 sub allowed {
|
Line 8295 sub allowed {
|
$refuri=&declutter($refuri); |
$refuri=&declutter($refuri); |
my ($match) = &is_on_map($refuri); |
my ($match) = &is_on_map($refuri); |
if ($match) { |
if ($match) { |
if ($noblockcheck) { |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
|
} |
|
if ($deeplinkblock) { |
|
$thisallowed='D'; |
|
} elsif ($noblockcheck) { |
$thisallowed='F'; |
$thisallowed='F'; |
} else { |
} else { |
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1); |
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1); |
Line 8182 sub allowed {
|
Line 8374 sub allowed {
|
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
if ($noblockcheck) { |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$uri); |
|
} |
|
if ($deeplinkblock) { |
|
$thisallowed = 'D'; |
|
} elsif ($noblockcheck) { |
$thisallowed.=$value; |
$thisallowed.=$value; |
} else { |
} else { |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
Line 8224 sub allowed {
|
Line 8422 sub allowed {
|
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
if ($noblockcheck) { |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
|
} |
|
if ($deeplinkblock) { |
|
$thisallowed = 'D'; |
|
} elsif ($noblockcheck) { |
$thisallowed.=$value; |
$thisallowed.=$value; |
} else { |
} else { |
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1); |
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1); |
Line 8404 sub allowed {
|
Line 8608 sub allowed {
|
} |
} |
} |
} |
|
|
|
# Restricted for deeplinked session? |
|
|
|
if ($env{'request.deeplink.login'}) { |
|
if ($env{'acc.deeplinkout'} && !$nodeeplinkout) { |
|
if (!$symb) { $symb=&symbread($uri,1); } |
|
if (($symb) && ($env{'acc.deeplinkout'}=~/\&\Q$symb\E\&/)) { |
|
return ''; |
|
} |
|
} |
|
} |
|
|
# Restricted by state or randomout? |
# Restricted by state or randomout? |
|
|
if ($thisallowed=~/X/) { |
if ($thisallowed=~/X/) { |
Line 8424 sub allowed {
|
Line 8639 sub allowed {
|
return 'A'; |
return 'A'; |
} elsif ($thisallowed eq 'B') { |
} elsif ($thisallowed eq 'B') { |
return 'B'; |
return 'B'; |
|
} elsif ($thisallowed eq 'D') { |
|
return 'D'; |
} |
} |
return 'F'; |
return 'F'; |
} |
} |
Line 8605 sub get_commblock_resources {
|
Line 8822 sub get_commblock_resources {
|
} |
} |
} |
} |
} |
} |
if ($interval[0] =~ /^\d+$/) { |
if ($interval[0] =~ /^(\d+)/) { |
|
my $timelimit = $1; |
my $first_access; |
my $first_access; |
if ($type eq 'resource') { |
if ($type eq 'resource') { |
$first_access=&get_first_access($interval[1],$item); |
$first_access=&get_first_access($interval[1],$item); |
Line 8615 sub get_commblock_resources {
|
Line 8833 sub get_commblock_resources {
|
$first_access=&get_first_access($interval[1]); |
$first_access=&get_first_access($interval[1]); |
} |
} |
if ($first_access) { |
if ($first_access) { |
my $timesup = $first_access+$interval[0]; |
my $timesup = $first_access+$timelimit; |
if ($timesup > $now) { |
if ($timesup > $now) { |
my $activeblock; |
my $activeblock; |
if ($type eq 'resource') { |
if ($type eq 'resource') { |
Line 8740 sub has_comm_blocking {
|
Line 8958 sub has_comm_blocking {
|
} |
} |
} |
} |
|
|
|
sub deeplink_check { |
|
my ($priv,$symb,$uri) = @_; |
|
return unless ($env{'request.course.id'}); |
|
return unless ($priv eq 'bre'); |
|
return if ($env{'request.state'} eq 'construct'); |
|
return if ($env{'request.role.adv'}); |
|
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
my (%possibles,@symbs); |
|
if (!$symb) { |
|
$symb = &symbread($uri,1,1,1,\%possibles); |
|
} |
|
if ($symb) { |
|
@symbs = ($symb); |
|
} elsif (keys(%possibles)) { |
|
@symbs = keys(%possibles); |
|
} |
|
|
|
my ($deeplink_symb,$allow); |
|
if ($env{'request.deeplink.login'}) { |
|
$deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom); |
|
} |
|
foreach my $symb (@symbs) { |
|
last if ($allow); |
|
my $deeplink = &EXT("resource.0.deeplink",$symb); |
|
if ($deeplink eq '') { |
|
$allow = 1; |
|
} else { |
|
my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink); |
|
if ($state ne 'only') { |
|
$allow = 1; |
|
} else { |
|
my $check_deeplink_entry; |
|
if ($protect ne 'none') { |
|
my ($acctype,$item) = split(/:/,$protect); |
|
if (($acctype eq 'ltic') && ($env{'user.linkprotector'})) { |
|
if (grep(/^\Q$item\Ec$/,split(/,/,$env{'user.linkprotector'}))) { |
|
$check_deeplink_entry = 1 |
|
} |
|
} elsif (($acctype eq 'ltid') && ($env{'user.linkprotector'})) { |
|
if (grep(/^\Q$item\Ed$/,split(/,/,$env{'user.linkprotector'}))) { |
|
$check_deeplink_entry = 1; |
|
} |
|
} elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) { |
|
if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) { |
|
$check_deeplink_entry = 1; |
|
} |
|
} |
|
} |
|
if (($protect eq 'none') || ($check_deeplink_entry)) { |
|
if ($scope eq 'res') { |
|
if ($symb eq $deeplink_symb) { |
|
$allow = 1; |
|
} |
|
} elsif (($scope eq 'map') || ($scope eq 'rec')) { |
|
my ($map_from_symb,$map_from_login); |
|
$map_from_symb = &deversion((&decode_symb($symb))[0]); |
|
if ($deeplink_symb =~ /\.(page|sequence)$/) { |
|
$map_from_login = &deversion((&decode_symb($deeplink_symb))[2]); |
|
} else { |
|
$map_from_login = &deversion((&decode_symb($deeplink_symb))[0]); |
|
} |
|
if (($map_from_symb) && ($map_from_login)) { |
|
if ($map_from_symb eq $map_from_login) { |
|
$allow = 1; |
|
} elsif ($scope eq 'rec') { |
|
my @recurseup = &get_map_hierarchy($map_from_symb,$env{'request.course.id'}); |
|
if (grep(/^\Q$map_from_login\E$/,@recurseup)) { |
|
$allow = 1; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return if ($allow); |
|
return 1; |
|
} |
|
|
# -------------------------------- Deversion and split uri into path an filename |
# -------------------------------- Deversion and split uri into path an filename |
|
|
# |
# |
Line 10444 sub writecoursepref {
|
Line 10743 sub writecoursepref {
|
|
|
sub createcourse { |
sub createcourse { |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code, |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code, |
$course_owner,$crstype,$cnum,$context,$category)=@_; |
$course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
if ($context eq 'requestcourses') { |
if ($context eq 'requestcourses') { |
my $can_create = 0; |
my $can_create = 0; |
my ($ownername,$ownerdom) = split(':',$course_owner); |
my ($ownername,$ownerdom) = split(':',$course_owner); |
if ($udom eq $ownerdom) { |
if ($udom eq $ownerdom) { |
if (&usertools_access($ownername,$ownerdom,$category,undef, |
my $reload; |
|
if (($callercontext eq 'auto') && |
|
($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) { |
|
$reload = 'reload'; |
|
} |
|
if (&usertools_access($ownername,$ownerdom,$category,$reload, |
$context)) { |
$context)) { |
$can_create = 1; |
$can_create = 1; |
} |
} |
Line 11486 sub resdata {
|
Line 11790 sub resdata {
|
return undef; |
return undef; |
} |
} |
|
|
sub get_numsuppfiles { |
sub get_domain_lti { |
my ($cnum,$cdom,$ignorecache)=@_; |
my ($cdom,$context) = @_; |
|
my ($name,$cachename,%lti); |
|
if ($context eq 'consumer') { |
|
$name = 'ltitools'; |
|
} elsif ($context eq 'provider') { |
|
$name = 'lti'; |
|
} elsif ($context eq 'linkprot') { |
|
$name = 'ltisec'; |
|
} else { |
|
return %lti; |
|
} |
|
|
|
if ($context eq 'linkprot') { |
|
$cachename = $context; |
|
} else { |
|
$cachename = $name; |
|
} |
|
|
|
my ($result,$cached)=&is_cached_new($cachename,$cdom); |
|
if (defined($cached)) { |
|
if (ref($result) eq 'HASH') { |
|
%lti = %{$result}; |
|
} |
|
} else { |
|
my %domconfig = &get_dom('configuration',[$name],$cdom); |
|
if (ref($domconfig{$name}) eq 'HASH') { |
|
if ($context eq 'linkprot') { |
|
if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') { |
|
%lti = %{$domconfig{$name}{'linkprot'}}; |
|
} |
|
} else { |
|
%lti = %{$domconfig{$name}}; |
|
} |
|
if (($context eq 'consumer') && (keys(%lti))) { |
|
my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1); |
|
if (ref($encdomconfig{$name}) eq 'HASH') { |
|
foreach my $id (keys(%lti)) { |
|
if (ref($encdomconfig{$name}{$id}) eq 'HASH') { |
|
foreach my $item ('key','secret') { |
|
$lti{$id}{$item} = $encdomconfig{$name}{$id}{$item}; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
my $cachetime = 24*60*60; |
|
&do_cache_new($cachename,$cdom,\%lti,$cachetime); |
|
} |
|
return %lti; |
|
} |
|
|
|
sub get_course_lti { |
|
my ($cnum,$cdom) = @_; |
|
my $hashid=$cdom.'_'.$cnum; |
|
my %courselti; |
|
my ($result,$cached)=&is_cached_new('courselti',$hashid); |
|
if (defined($cached)) { |
|
if (ref($result) eq 'HASH') { |
|
%courselti = %{$result}; |
|
} |
|
} else { |
|
%courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1); |
|
my $cachetime = 24*60*60; |
|
&do_cache_new('courselti',$hashid,\%courselti,$cachetime); |
|
} |
|
return %courselti; |
|
} |
|
|
|
sub courselti_itemid { |
|
my ($cnum,$cdom,$url,$method,$params,$context) = @_; |
|
my ($chome,$itemid); |
|
$chome = &homeserver($cnum,$cdom); |
|
return if ($chome eq 'no_host'); |
|
if (ref($params) eq 'HASH') { |
|
my $items = &freeze_escape($params); |
|
my $rep; |
|
if (grep { $_ eq $chome } current_machine_ids()) { |
|
$rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'}); |
|
} else { |
|
my $escurl = &escape($url); |
|
my $escmethod = &escape($method); |
|
my $items = &freeze_escape($params); |
|
$rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$chome); |
|
} |
|
unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') || |
|
($rep eq 'unknown_cmd')) { |
|
$itemid = $rep; |
|
} |
|
} |
|
return $itemid; |
|
} |
|
|
|
sub domainlti_itemid { |
|
my ($cdom,$url,$method,$params,$context) = @_; |
|
my ($primary_id,$itemid); |
|
$primary_id = &domain($cdom,'primary'); |
|
return if ($primary_id eq ''); |
|
if (ref($params) eq 'HASH') { |
|
my $items = &freeze_escape($params); |
|
my $rep; |
|
if (grep { $_ eq $primary_id } current_machine_ids()) { |
|
$rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'}); |
|
} else { |
|
my $cnum = ''; |
|
my $escurl = &escape($url); |
|
my $escmethod = &escape($method); |
|
my $items = &freeze_escape($params); |
|
$rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$primary_id); |
|
} |
|
unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') || |
|
($rep eq 'unknown_cmd')) { |
|
$itemid = $rep; |
|
} |
|
} |
|
return $itemid; |
|
} |
|
|
|
sub count_supptools { |
|
my ($cnum,$cdom,$ignorecache,$reload)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cnum.':'.$cdom; |
my ($suppcount,$cached); |
my ($numexttools,$cached); |
unless ($ignorecache) { |
unless ($ignorecache) { |
($suppcount,$cached) = &is_cached_new('suppcount',$hashid); |
($numexttools,$cached) = &is_cached_new('supptools',$hashid); |
} |
} |
unless (defined($cached)) { |
unless (defined($cached)) { |
my $chome=&homeserver($cnum,$cdom); |
my $chome=&homeserver($cnum,$cdom); |
|
$numexttools = 0; |
unless ($chome eq 'no_host') { |
unless ($chome eq 'no_host') { |
($suppcount,my $errors) = (0,0); |
my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$reload); |
my $suppmap = 'supplemental.sequence'; |
if (ref($supplemental) eq 'HASH') { |
($suppcount,$errors) = |
if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { |
&Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors); |
foreach my $key (keys(%{$supplemental->{'ids'}})) { |
|
if ($key =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
|
$numexttools ++; |
|
} |
|
} |
|
} |
|
} |
} |
} |
&do_cache_new('suppcount',$hashid,$suppcount,600); |
&do_cache_new('supptools',$hashid,$numexttools,600); |
} |
} |
return $suppcount; |
return $numexttools; |
|
} |
|
|
|
sub has_unhidden_suppfiles { |
|
my ($cnum,$cdom,$ignorecache,$possdel)=@_; |
|
my $hashid=$cnum.':'.$cdom; |
|
my ($showsupp,$cached); |
|
unless ($ignorecache) { |
|
($showsupp,$cached) = &is_cached_new('showsupp',$hashid); |
|
} |
|
unless (defined($cached)) { |
|
my $chome=&homeserver($cnum,$cdom); |
|
unless ($chome eq 'no_host') { |
|
my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel); |
|
if (ref($supplemental) eq 'HASH') { |
|
if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { |
|
foreach my $key (keys(%{$supplemental->{'ids'}})) { |
|
next if ($key =~ /\.sequence$/); |
|
if (ref($supplemental->{'ids'}->{$key}) eq 'ARRAY') { |
|
foreach my $id (@{$supplemental->{'ids'}->{$key}}) { |
|
unless ($supplemental->{'hidden'}->{$id}) { |
|
$showsupp = 1; |
|
last; |
|
} |
|
} |
|
} |
|
last if ($showsupp); |
|
} |
|
} |
|
} |
|
} |
|
&do_cache_new('showsupp',$hashid,$showsupp,600); |
|
} |
|
return $showsupp; |
} |
} |
|
|
# |
# |
# EXT resource caching routines |
# EXT resource caching routines |
# |
# |
|
|
|
{ |
|
# Cache (5 seconds) of map hierarchy for speedup of navmaps display |
|
# |
|
# The course for which we cache |
|
my $cachedmapkey=''; |
|
# The cached recursive maps for this course |
|
my %cachedmaps=(); |
|
# When this was last done |
|
my $cachedmaptime=''; |
|
|
sub clear_EXT_cache_status { |
sub clear_EXT_cache_status { |
&delenv('cache.EXT.'); |
&delenv('cache.EXT.'); |
} |
} |
Line 11823 sub EXT {
|
Line 12296 sub EXT {
|
if ($space eq 'name') { |
if ($space eq 'name') { |
return $ENV{'SERVER_NAME'}; |
return $ENV{'SERVER_NAME'}; |
} |
} |
|
} elsif ($realm eq 'client') { |
|
if ($space eq 'remote_addr') { |
|
return &get_requestor_ip(); |
|
} |
} |
} |
return ''; |
return ''; |
} |
} |
Line 11856 sub check_group_parms {
|
Line 12333 sub check_group_parms {
|
return $coursereply; |
return $coursereply; |
} |
} |
|
|
|
sub get_map_hierarchy { |
|
my ($mapname,$courseid) = @_; |
|
my @recurseup = (); |
|
if ($mapname) { |
|
if (($cachedmapkey eq $courseid) && |
|
(abs($cachedmaptime-time)<5)) { |
|
if (ref($cachedmaps{$mapname}) eq 'ARRAY') { |
|
return @{$cachedmaps{$mapname}}; |
|
} |
|
} |
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
if (ref($navmap)) { |
|
@recurseup = $navmap->recurseup_maps($mapname); |
|
undef($navmap); |
|
$cachedmaps{$mapname} = \@recurseup; |
|
$cachedmaptime=time; |
|
$cachedmapkey=$courseid; |
|
} |
|
} |
|
return @recurseup; |
|
} |
|
|
|
} |
|
|
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). |
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). |
my ($courseid,@groups) = @_; |
my ($courseid,@groups) = @_; |
@groups = sort(@groups); |
@groups = sort(@groups); |
Line 11941 sub metadata {
|
Line 12442 sub metadata {
|
# if it is a non metadata possible uri return quickly |
# if it is a non metadata possible uri return quickly |
if (($uri eq '') || |
if (($uri eq '') || |
(($uri =~ m|^/*adm/|) && |
(($uri =~ m|^/*adm/|) && |
($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) || |
($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
return undef; |
return undef; |
} |
} |
Line 12477 sub get_coursechange {
|
Line 12978 sub get_coursechange {
|
} |
} |
|
|
sub devalidate_coursechange_cache { |
sub devalidate_coursechange_cache { |
my ($cnum,$cdom)=@_; |
my ($cdom,$cnum)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cdom.'_'.$cnum; |
&devalidate_cache_new('crschange',$hashid); |
&devalidate_cache_new('crschange',$hashid); |
} |
} |
|
|
|
sub get_suppchange { |
|
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('suppchange',$hashid); |
|
if ((defined($cached)) && ($change ne '')) { |
|
return $change; |
|
} else { |
|
my %crshash = &get('environment',['internal.supplementalchange'],$cdom,$cnum); |
|
if ($crshash{'internal.supplementalchange'} 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.supplementalchange'}; |
|
} |
|
my $cachetime = 600; |
|
&do_cache_new('suppchange',$hashid,$change,$cachetime); |
|
} |
|
return $change; |
|
} |
|
|
|
sub devalidate_suppchange_cache { |
|
my ($cdom,$cnum)=@_; |
|
my $hashid=$cdom.'_'.$cnum; |
|
&devalidate_cache_new('suppchange',$hashid); |
|
} |
|
|
|
sub update_supp_caches { |
|
my ($cdom,$cnum) = @_; |
|
my %servers = &internet_dom_servers($cdom); |
|
my @ids=¤t_machine_ids(); |
|
foreach my $server (keys(%servers)) { |
|
next if (grep(/^\Q$server\E$/,@ids)); |
|
my $hashid=$cnum.':'.$cdom; |
|
my $cachekey = &escape('showsupp').':'.&escape($hashid); |
|
&remote_devalidate_cache($server,[$cachekey]); |
|
} |
|
&has_unhidden_suppfiles($cnum,$cdom,1,1); |
|
&count_supptools($cnum,$cdom,1); |
|
my $now = time; |
|
if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { |
|
&Apache::lonnet::appenv({'request.course.suppupdated' => $now}); |
|
} |
|
&put('environment',{'internal.supplementalchange' => $now}, |
|
$cdom,$cnum); |
|
&Apache::lonnet::appenv( |
|
{'course.'.$cdom.'_'.$cnum.'.internal.supplementalchange' => $now}); |
|
&do_cache_new('suppchange',$cdom.'_'.$cnum,$now,600); |
|
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 12668 sub symbread {
|
Line 13226 sub symbread {
|
my %bighash; |
my %bighash; |
my $syval=''; |
my $syval=''; |
if (($env{'request.course.fn'}) && ($thisfn)) { |
if (($env{'request.course.fn'}) && ($thisfn)) { |
my $targetfn = $thisfn; |
|
if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { |
|
$targetfn = 'adm/wrapper/'.$thisfn; |
|
} |
|
if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) { |
|
$targetfn=$1; |
|
} |
|
unless ($ignoresymbdb) { |
unless ($ignoresymbdb) { |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
$syval=$hash{$targetfn}; |
$syval=$hash{$thisfn}; |
untie(%hash); |
untie(%hash); |
} |
} |
if ($syval && $checkforblock) { |
if ($syval && $checkforblock) { |
Line 13850 sub clutter {
|
Line 14401 sub clutter {
|
# &logthis("Got a blank emb style"); |
# &logthis("Got a blank emb style"); |
} |
} |
} |
} |
|
} elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
} |
} |
return $thisfn; |
return $thisfn; |
} |
} |
Line 14921 prevents recursive calls to &allowed.
|
Line 15474 prevents recursive calls to &allowed.
|
2: browse allowed |
2: browse allowed |
A: passphrase authentication needed |
A: passphrase authentication needed |
B: access temporarily blocked because of a blocking event in a course. |
B: access temporarily blocked because of a blocking event in a course. |
|
D: access blocked because access is required via session initiated via deep-link |
|
|
=item * |
=item * |
|
|
Line 15213 data base, returning a hash that is keye
|
Line 15767 data base, returning a hash that is keye
|
values that are the resource value. I believe that the timestamps and |
values that are the resource value. I believe that the timestamps and |
versions are also returned. |
versions are also returned. |
|
|
get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's |
|
supplemental content area. This routine caches the number of files for |
|
10 minutes. |
|
|
|
=back |
=back |
|
|
=head2 Course Modification |
=head2 Course Modification |