|
version 1.1172.2.144, 2021/12/24 21:13:15
|
version 1.1172.2.146.2.18, 2024/02/28 05:34:14
|
|
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 365 sub remote_devalidate_cache {
|
Line 365 sub remote_devalidate_cache {
|
| return &reply('devalidatecache:'.&escape($cachestr),$lonhost); |
return &reply('devalidatecache:'.&escape($cachestr),$lonhost); |
| } |
} |
| |
|
| |
sub sign_lti { |
| |
my ($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,$keynum,$paramsref,$inforef) = @_; |
| |
my $chome; |
| |
if (&domain($cdom) ne '') { |
| |
if ($crsdef) { |
| |
$chome = &homeserver($cnum,$cdom); |
| |
} else { |
| |
$chome = &domain($cdom,'primary'); |
| |
} |
| |
} |
| |
if ($cdom && $chome && ($chome ne 'no_host')) { |
| |
if ((ref($paramsref) eq 'HASH') && |
| |
(ref($inforef) eq 'HASH')) { |
| |
my $rep; |
| |
if (grep { $_ eq $chome } ¤t_machine_ids()) { |
| |
# domain information is hosted on this machine |
| |
$rep = |
| |
&LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type, |
| |
$context,$url,$ltinum,$keynum, |
| |
$perlvar{'lonVersion'}, |
| |
$paramsref,$inforef); |
| |
if (ref($rep) eq 'HASH') { |
| |
return ('ok',$rep); |
| |
} |
| |
} else { |
| |
my ($escurl,$params,$info); |
| |
$escurl = &escape($url); |
| |
if (ref($paramsref) eq 'HASH') { |
| |
$params = &freeze_escape($paramsref); |
| |
} |
| |
if (ref($inforef) eq 'HASH') { |
| |
$info = &freeze_escape($inforef); |
| |
} |
| |
$rep=&reply("encrypt:signlti:$cdom:$cnum:$crsdef:$type:$context:$escurl:$ltinum:$keynum:$params:$info",$chome); |
| |
} |
| |
if (($rep eq '') || ($rep =~ /^con_lost|error|no_such_host|unknown_cmd/i)) { |
| |
return (); |
| |
} elsif (($inforef->{'respfmt'} eq 'to_post_body') || |
| |
($inforef->{'respfmt'} eq 'to_authorization_header')) { |
| |
return ('ok',$rep); |
| |
} else { |
| |
my %returnhash; |
| |
foreach my $item (split(/\&/,$rep)) { |
| |
my ($name,$value)=split(/\=/,$item); |
| |
$returnhash{&unescape($name)}=&thaw_unescape($value); |
| |
} |
| |
return('ok',\%returnhash); |
| |
} |
| |
} else { |
| |
return (); |
| |
} |
| |
} else { |
| |
return (); |
| |
&logthis("sign_lti failed - no homeserver and/or domain ($cdom) ($chome)"); |
| |
} |
| |
} |
| |
|
| # -------------------------------------------------- Non-critical communication |
# -------------------------------------------------- Non-critical communication |
| sub subreply { |
sub subreply { |
| my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
|
Line 418 sub reply {
|
Line 475 sub reply {
|
| my $subcmd = $1; |
my $subcmd = $1; |
| if (($subcmd eq 'auth') || ($subcmd eq 'passwd') || |
if (($subcmd eq 'auth') || ($subcmd eq 'passwd') || |
| ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
| ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) { |
($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades') || |
| |
($subcmd eq 'put')) { |
| (undef,undef,my @rest) = split(/:/,$cmd); |
(undef,undef,my @rest) = split(/:/,$cmd); |
| if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) { |
if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) { |
| splice(@rest,2,1,'Hidden'); |
splice(@rest,2,1,'Hidden'); |
| } elsif ($subcmd eq 'passwd') { |
} elsif ($subcmd eq 'passwd') { |
| splice(@rest,2,2,('Hidden','Hidden')); |
splice(@rest,2,2,('Hidden','Hidden')); |
| } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
} elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
| ($subcmd eq 'autoexportgrades')) { |
($subcmd eq 'autoexportgrades') || ($subcmd eq 'put')) { |
| splice(@rest,3,1,'Hidden'); |
splice(@rest,3,1,'Hidden'); |
| } |
} |
| $logged = join(':',('encrypt:'.$subcmd,@rest)); |
$logged = join(':',('encrypt:'.$subcmd,@rest)); |
|
Line 694 sub check_for_valid_session {
|
Line 752 sub check_for_valid_session {
|
| if ($disk_env{'request.role'}) { |
if ($disk_env{'request.role'}) { |
| $userhashref->{'role'} = $disk_env{'request.role'}; |
$userhashref->{'role'} = $disk_env{'request.role'}; |
| } |
} |
| |
$userhashref->{'lti'} = $disk_env{'request.lti.login'}; |
| |
if ($userhashref->{'lti'}) { |
| |
$userhashref->{'ltitarget'} = $disk_env{'request.lti.target'}; |
| |
$userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'}; |
| |
} |
| } |
} |
| untie(%disk_env); |
untie(%disk_env); |
| |
|
|
Line 1035 sub find_existing_session {
|
Line 1098 sub find_existing_session {
|
| return; |
return; |
| } |
} |
| |
|
| |
sub delusersession { |
| |
my ($lonid,$udom,$uname) = @_; |
| |
my $uprimary_id = &domain($udom,'primary'); |
| |
my $uintdom = &internet_dom($uprimary_id); |
| |
my $intdom = &internet_dom($lonid); |
| |
my $serverhomedom = &host_domain($lonid); |
| |
if (($uintdom ne '') && ($uintdom eq $intdom)) { |
| |
return &reply(join(':','delusersession', |
| |
map {&escape($_)} ($udom,$uname)),$lonid); |
| |
} |
| |
return; |
| |
} |
| |
|
| |
|
| # check if user's browser sent load balancer cookie and server still has session |
# check if user's browser sent load balancer cookie and server still has session |
| # and is not overloaded. |
# and is not overloaded. |
| sub check_for_balancer_cookie { |
sub check_for_balancer_cookie { |
|
Line 1254 sub changepass {
|
Line 1331 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 1380 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 1982 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 2009 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 2038 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 2059 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 2097 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 2426 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 2463 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 2344 sub get_domain_defaults {
|
Line 2510 sub get_domain_defaults {
|
| &Apache::lonnet::get_dom('configuration',['defaults','quotas', |
&Apache::lonnet::get_dom('configuration',['defaults','quotas', |
| 'requestcourses','inststatus', |
'requestcourses','inststatus', |
| 'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
| 'requestauthor','selfenrollment', |
'requestauthor','authordefaults', |
| 'coursecategories','autoenroll', |
'selfenrollment','coursecategories', |
| 'helpsettings'],$domain); |
'autoenroll','helpsettings', |
| |
'wafproxy','ltisec','toolsec', |
| |
'domexttool','exttool'],$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 2355 sub get_domain_defaults {
|
Line 2523 sub get_domain_defaults {
|
| $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
| $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
| $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; |
$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; |
| |
$domdefaults{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'}; |
| |
$domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'}; |
| $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 2384 sub get_domain_defaults {
|
Line 2555 sub get_domain_defaults {
|
| $domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
$domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
| } |
} |
| } |
} |
| |
if (ref($domconfig{'authordefaults'}) eq 'HASH') { |
| |
foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') { |
| |
if ($item eq 'editors') { |
| |
if (ref($domconfig{'authordefaults'}{'editors'}) eq 'ARRAY') { |
| |
$domdefaults{$item} = join(',',@{$domconfig{'authordefaults'}{'editors'}}); |
| |
} |
| |
} else { |
| |
$domdefaults{$item} = $domconfig{'authordefaults'}{$item}; |
| |
} |
| |
} |
| |
} |
| if (ref($domconfig{'requestauthor'}) eq 'HASH') { |
if (ref($domconfig{'requestauthor'}) eq 'HASH') { |
| $domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; |
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; |
| } |
} |
|
Line 2408 sub get_domain_defaults {
|
Line 2590 sub get_domain_defaults {
|
| if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
| $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; |
$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; |
| } |
} |
| |
if (ref($domconfig{'coursedefaults'}{'coursequota'}) eq 'HASH') { |
| |
$domdefaults{$type.'coursequota'} = $domconfig{'coursedefaults'}{'coursequota'}{$type}; |
| |
} |
| if ($domdefaults{'postsubmit'} eq 'on') { |
if ($domdefaults{'postsubmit'} eq 'on') { |
| if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { |
| $domdefaults{$type.'postsubtimeout'} = |
$domdefaults{$type.'postsubtimeout'} = |
| $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; |
$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; |
| } |
} |
| } |
} |
| |
if (ref($domconfig{'coursedefaults'}{'domexttool'}) eq 'HASH') { |
| |
$domdefaults{$type.'domexttool'} = $domconfig{'coursedefaults'}{'domexttool'}{$type}; |
| |
} else { |
| |
$domdefaults{$type.'domexttool'} = 1; |
| |
} |
| |
if (ref($domconfig{'coursedefaults'}{'exttool'}) eq 'HASH') { |
| |
$domdefaults{$type.'exttool'} = $domconfig{'coursedefaults'}{'exttool'}{$type}; |
| |
} else { |
| |
$domdefaults{$type.'exttool'} = 0; |
| |
} |
| } |
} |
| if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') { |
| if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') { |
if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') { |
|
Line 2428 sub get_domain_defaults {
|
Line 2623 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 2681 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 2696 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{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'}; |
| |
} |
| |
} |
| |
if (ref($domconfig{'ltisec'}{'suggested'}) eq 'HASH') { |
| |
my %suggestions = %{$domconfig{'ltisec'}{'suggested'}}; |
| |
foreach my $item (keys(%{$domconfig{'ltisec'}{'suggested'}})) { |
| |
unless (ref($domconfig{'ltisec'}{'suggested'}{$item}) eq 'HASH') { |
| |
delete($suggestions{$item}); |
| |
} |
| |
} |
| |
if (keys(%suggestions)) { |
| |
$domdefaults{'linkprotsuggested'} = \%suggestions; |
| |
} |
| |
} |
| |
} |
| |
if (ref($domconfig{'toolsec'}) eq 'HASH') { |
| |
if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') { |
| |
$domdefaults{'toolenc_crs'} = $domconfig{'toolsec'}{'encrypt'}{'crs'}; |
| |
$domdefaults{'toolenc_dom'} = $domconfig{'toolsec'}{'encrypt'}{'dom'}; |
| |
} |
| |
if (ref($domconfig{'toolsec'}{'private'}) eq 'HASH') { |
| |
if (ref($domconfig{'toolsec'}{'private'}{'keys'}) eq 'ARRAY') { |
| |
$domdefaults{'toolprivhosts'} = $domconfig{'toolsec'}{'private'}{'keys'}; |
| |
} |
| |
} |
| |
} |
| &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
| return %domdefaults; |
return %domdefaults; |
| } |
} |
|
Line 2533 sub get_dom_instcats {
|
Line 2766 sub get_dom_instcats {
|
| if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes, |
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes, |
| \@codetitles,\%cat_titles,\%cat_order) eq 'ok') { |
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') { |
| $instcats = { |
$instcats = { |
| |
totcodes => $totcodes, |
| codes => \%codes, |
codes => \%codes, |
| codetitles => \@codetitles, |
codetitles => \@codetitles, |
| cat_titles => \%cat_titles, |
cat_titles => \%cat_titles, |
|
Line 2583 sub get_passwdconf {
|
Line 2817 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; |
| |
} |
| |
|
| |
sub url_prefix { |
| |
my ($r,$dom,$home,$context) = @_; |
| |
my $prefix; |
| |
my %domdefs = &get_domain_defaults($dom); |
| |
if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) { |
| |
if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) { |
| |
$prefix = $1; |
| |
} |
| |
} |
| |
if ($prefix eq '') { |
| |
my $hostname = &hostname($home); |
| |
my $protocol = $protocol{$home}; |
| |
$protocol = 'http' if ($protocol{$home} ne 'https'); |
| |
my $alias = &use_proxy_alias($r,$home); |
| |
$hostname = $alias if ($alias ne ''); |
| |
$prefix = $protocol.'://'.$hostname; |
| |
} |
| |
return $prefix; |
| |
} |
| |
|
| # --------------------------------------------------- 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 3439 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 3478 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 3492 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 3761 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 3793 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 3810 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 3800 sub resizeImage {
|
Line 4112 sub resizeImage {
|
| # input: $formname - the contents of the file are in $env{"form.$formname"} |
# input: $formname - the contents of the file are in $env{"form.$formname"} |
| # the desired filename is in $env{"form.$formname.filename"} |
# the desired filename is in $env{"form.$formname.filename"} |
| # $context - possible values: coursedoc, existingfile, overwrite, |
# $context - possible values: coursedoc, existingfile, overwrite, |
| # canceloverwrite, scantron or ''. |
# canceloverwrite, scantron, toollogo or ''. |
| # if 'coursedoc': upload to the current course |
# if 'coursedoc': upload to the current course |
| # if 'existingfile': write file to tmp/overwrites directory |
# if 'existingfile': write file to tmp/overwrites directory |
| # if 'canceloverwrite': delete file written to tmp/overwrites directory |
# if 'canceloverwrite': delete file written to tmp/overwrites directory |
|
Line 3812 sub resizeImage {
|
Line 4124 sub resizeImage {
|
| # Section => 4, CODE => 5, FirstQuestion => 9 }). |
# Section => 4, CODE => 5, FirstQuestion => 9 }). |
| # $allfiles - reference to hash for embedded objects |
# $allfiles - reference to hash for embedded objects |
| # $codebase - reference to hash for codebase of java objects |
# $codebase - reference to hash for codebase of java objects |
| # $desuname - username for permanent storage of uploaded file |
# $destuname - username for permanent storage of uploaded file |
| # $dsetudom - domain for permanaent storage of uploaded file |
# $destudom - domain for permanaent storage of uploaded file |
| # $thumbwidth - width (pixels) of thumbnail to make for uploaded image |
# $thumbwidth - width (pixels) of thumbnail to make for uploaded image |
| # $thumbheight - height (pixels) of thumbnail to make for uploaded image |
# $thumbheight - height (pixels) of thumbnail to make for uploaded image |
| # $resizewidth - width (pixels) to which to resize uploaded image |
# $resizewidth - width (pixels) to which to resize uploaded image |
|
Line 4023 sub finishuserfileupload {
|
Line 4335 sub finishuserfileupload {
|
| if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
| my $input = $filepath.'/'.$file; |
my $input = $filepath.'/'.$file; |
| my $output = $filepath.'/'.'tn-'.$file; |
my $output = $filepath.'/'.'tn-'.$file; |
| |
my $makethumb; |
| my $thumbsize = $thumbwidth.'x'.$thumbheight; |
my $thumbsize = $thumbwidth.'x'.$thumbheight; |
| my @args = ('convert','-sample',$thumbsize,$input,$output); |
if ($context eq 'toollogo') { |
| system({$args[0]} @args); |
my ($fullwidth,$fullheight) = &check_dimensions($input); |
| if (-e $filepath.'/'.'tn-'.$file) { |
if ($fullwidth ne '' && $fullheight ne '') { |
| $fetchthumb = 1; |
if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) { |
| |
$makethumb = 1; |
| |
} |
| |
} |
| |
} else { |
| |
$makethumb = 1; |
| |
} |
| |
if ($makethumb) { |
| |
my @args = ('convert','-sample',$thumbsize,$input,$output); |
| |
system({$args[0]} @args); |
| |
if (-e $filepath.'/'.'tn-'.$file) { |
| |
$fetchthumb = 1; |
| |
} |
| } |
} |
| } |
} |
| |
|
|
Line 4259 sub embedded_dependency {
|
Line 4584 sub embedded_dependency {
|
| return; |
return; |
| } |
} |
| |
|
| |
sub check_dimensions { |
| |
my ($inputfile) = @_; |
| |
my ($fullwidth,$fullheight); |
| |
if (($inputfile =~ m|^[/\w.\-]+$|) && (-e $inputfile)) { |
| |
my $mm = new File::MMagic; |
| |
my $mime_type = $mm->checktype_filename($inputfile); |
| |
if ($mime_type =~ m{^image/}) { |
| |
if (open(PIPE,"identify $inputfile 2>&1 |")) { |
| |
my $imageinfo = <PIPE>; |
| |
if (!close(PIPE)) { |
| |
&Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile"); |
| |
} |
| |
chomp($imageinfo); |
| |
my ($fullsize) = |
| |
($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/); |
| |
if ($fullsize) { |
| |
($fullwidth,$fullheight) = split(/x/,$fullsize); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return ($fullwidth,$fullheight); |
| |
} |
| |
|
| sub bubblesheet_converter { |
sub bubblesheet_converter { |
| my ($cdom,$fullpath,$config,$format) = @_; |
my ($cdom,$fullpath,$config,$format) = @_; |
| if ((&domain($cdom) ne '') && |
if ((&domain($cdom) ne '') && |
|
Line 4495 sub get_scantronformat_file {
|
Line 4844 sub get_scantronformat_file {
|
| close($fh); |
close($fh); |
| } |
} |
| } |
} |
| |
chomp(@lines); |
| } |
} |
| return @lines; |
return @lines; |
| } |
} |
|
Line 4621 sub flushcourselogs {
|
Line 4971 sub flushcourselogs {
|
| # Typo in rev. 1.458 (2003/12/09)?? |
# Typo in rev. 1.458 (2003/12/09)?? |
| # These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'} |
# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'} |
| # |
# |
| # While these ramain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'} |
# While these remain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'} |
| # $dom and $name will always be null, so the &inc() call will default to storing this data |
# $dom and $name will always be null, so the &inc() call will default to storing this data |
| # in a nohist_accesscount.db file for the user rather than the course. |
# in a nohist_accesscount.db file for the user rather than the course. |
| # |
# |
|
Line 4850 sub courserolelog {
|
Line 5200 sub courserolelog {
|
| $storehash{'group'} = $sec; |
$storehash{'group'} = $sec; |
| } else { |
} else { |
| $storehash{'section'} = $sec; |
$storehash{'section'} = $sec; |
| |
my ($curruserdomstr,$newuserdomstr); |
| |
if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) { |
| |
$curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'}; |
| |
} else { |
| |
my %courseinfo = &coursedescription($cdom.'/'.$cnum); |
| |
$curruserdomstr = $courseinfo{'internal.userdomains'}; |
| |
} |
| |
if ($curruserdomstr ne '') { |
| |
my @udoms = split(/,/,$curruserdomstr); |
| |
unless (grep(/^\Q$domain\E/,@udoms)) { |
| |
push(@udoms,$domain); |
| |
$newuserdomstr = join(',',sort(@udoms)); |
| |
} |
| |
} else { |
| |
$newuserdomstr = $domain; |
| |
} |
| |
if ($newuserdomstr ne '') { |
| |
my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr }, |
| |
$cdom,$cnum); |
| |
if ($putresult eq 'ok') { |
| |
unless (($selfenroll) || ($context eq 'selfenroll')) { |
| |
if (($context eq 'createcourse') || ($context eq 'requestcourses') || |
| |
($context eq 'automated') || ($context eq 'domain')) { |
| |
$env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr; |
| |
} elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) { |
| |
&appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr}); |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| &write_log('course',$namespace,\%storehash,$delflag,$username, |
&write_log('course',$namespace,\%storehash,$delflag,$username, |
| $domain,$cnum,$cdom); |
$domain,$cnum,$cdom); |
|
Line 5508 my %cachedtimes=();
|
Line 5888 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 5900 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 5912 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 6357 sub rolesinit {
|
Line 6738 sub rolesinit {
|
| my %firstaccess = &dump('firstaccesstimes', $domain, $username); |
my %firstaccess = &dump('firstaccesstimes', $domain, $username); |
| my %timerinterval = &dump('timerinterval', $domain, $username); |
my %timerinterval = &dump('timerinterval', $domain, $username); |
| my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, |
my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, |
| %timerintchk, %timerintenv); |
%timerintchk, %timerintenv,%coauthorenv); |
| |
|
| foreach my $key (keys(%firstaccess)) { |
foreach my $key (keys(%firstaccess)) { |
| my ($cid, $rest) = split(/\0/, $key); |
my ($cid, $rest) = split(/\0/, $key); |
|
Line 6371 sub rolesinit {
|
Line 6752 sub rolesinit {
|
| |
|
| my %allroles=(); |
my %allroles=(); |
| my %allgroups=(); |
my %allgroups=(); |
| |
my %gotcoauconfig=(); |
| |
|
| for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { |
for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { |
| my $role = $rolesdump{$area}; |
my $role = $rolesdump{$area}; |
|
Line 6422 sub rolesinit {
|
Line 6804 sub rolesinit {
|
| } else { |
} else { |
| # Normal role, defined in roles.tab |
# Normal role, defined in roles.tab |
| &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
| |
if (($trole eq 'ca') || ($trole eq 'aa')) { |
| |
(undef,my ($audom,$auname)) = split(/\//,$area); |
| |
unless ($gotcoauconfig{$area}) { |
| |
my @ca_settings = ('authoreditors'); |
| |
my %info = &userenvironment($audom,$auname,@ca_settings); |
| |
$gotcoauconfig{$area} = 1; |
| |
foreach my $item (@ca_settings) { |
| |
if (exists($info{$item})) { |
| |
my $name = $item; |
| |
if ($item eq 'authoreditors') { |
| |
$name = 'editors'; |
| |
} |
| |
$coauthorenv{"environment.internal.$name.$area"} = $info{$item}; |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| |
|
| my $cid = $tdomain.'_'.$trest; |
my $cid = $tdomain.'_'.$trest; |
|
Line 6450 sub rolesinit {
|
Line 6849 sub rolesinit {
|
| $env{'user.adv'} = $userroles{'user.adv'}; |
$env{'user.adv'} = $userroles{'user.adv'}; |
| $env{'user.rar'} = $userroles{'user.rar'}; |
$env{'user.rar'} = $userroles{'user.rar'}; |
| |
|
| return (\%userroles,\%firstaccenv,\%timerintenv); |
return (\%userroles,\%firstaccenv,\%timerintenv,\%coauthorenv); |
| } |
} |
| |
|
| sub set_arearole { |
sub set_arearole { |
|
Line 6511 sub course_adhocrole_privs {
|
Line 6910 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 7198 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 7274 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 7290 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 7441 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 7450 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 7559 sub is_portfolio_file {
|
Line 7968 sub is_portfolio_file {
|
| return; |
return; |
| } |
} |
| |
|
| |
sub is_coursetool_logo { |
| |
my ($uri) = @_; |
| |
if ($env{'request.course.id'}) { |
| |
my $courseurl = &courseid_to_courseurl($env{'request.course.id'}); |
| |
if ($uri =~ m{^/*uploaded\Q$courseurl\E/toollogo/\d+/[^/]+$}) { |
| |
return 1; |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| sub usertools_access { |
sub usertools_access { |
| my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_; |
my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_; |
| my ($access,%tools); |
my ($access,%tools); |
|
Line 7571 sub usertools_access {
|
Line 7991 sub usertools_access {
|
| unofficial => 1, |
unofficial => 1, |
| community => 1, |
community => 1, |
| textbook => 1, |
textbook => 1, |
| |
lti => 1, |
| ); |
); |
| } elsif ($context eq 'requestauthor') { |
} elsif ($context eq 'requestauthor') { |
| %tools = ( |
%tools = ( |
| requestauthor => 1, |
requestauthor => 1, |
| ); |
); |
| |
} elsif ($context eq 'authordefaults') { |
| |
%tools = ( |
| |
webdav => 1, |
| |
); |
| } else { |
} else { |
| %tools = ( |
%tools = ( |
| aboutme => 1, |
aboutme => 1, |
| blog => 1, |
blog => 1, |
| webdav => 1, |
|
| portfolio => 1, |
portfolio => 1, |
| |
timezone => 1, |
| ); |
); |
| } |
} |
| return if (!defined($tools{$tool})); |
return if (!defined($tools{$tool})); |
|
Line 7597 sub usertools_access {
|
Line 8022 sub usertools_access {
|
| return $env{'environment.canrequest.'.$tool}; |
return $env{'environment.canrequest.'.$tool}; |
| } elsif ($context eq 'requestauthor') { |
} elsif ($context eq 'requestauthor') { |
| return $env{'environment.canrequest.author'}; |
return $env{'environment.canrequest.author'}; |
| |
} elsif ($context eq 'authordefaults') { |
| |
if ($tool eq 'webdav') { |
| |
return $env{'environment.availabletools.'.$tool}; |
| |
} |
| } else { |
} else { |
| return $env{'environment.availabletools.'.$tool}; |
return $env{'environment.availabletools.'.$tool}; |
| } |
} |
|
Line 7606 sub usertools_access {
|
Line 8035 sub usertools_access {
|
| my ($toolstatus,$inststatus,$envkey); |
my ($toolstatus,$inststatus,$envkey); |
| if ($context eq 'requestauthor') { |
if ($context eq 'requestauthor') { |
| $envkey = $context; |
$envkey = $context; |
| |
} elsif ($context eq 'authordefaults') { |
| |
if ($tool eq 'webdav') { |
| |
$envkey = 'tools.'.$tool; |
| |
} |
| } else { |
} else { |
| $envkey = $context.'.'.$tool; |
$envkey = $context.'.'.$tool; |
| } |
} |
|
Line 7767 sub is_advanced_user {
|
Line 8200 sub is_advanced_user {
|
| } |
} |
| |
|
| sub check_can_request { |
sub check_can_request { |
| my ($dom,$can_request,$request_domains) = @_; |
my ($dom,$can_request,$request_domains,$uname,$udom) = @_; |
| my $canreq = 0; |
my $canreq = 0; |
| |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) { |
| |
$uname = $env{'user.name'}; |
| |
$udom = $env{'user.domain'}; |
| |
} |
| my ($types,$typename) = &Apache::loncommon::course_types(); |
my ($types,$typename) = &Apache::loncommon::course_types(); |
| my @options = ('approval','validate','autolimit'); |
my @options = ('approval','validate','autolimit'); |
| my $optregex = join('|',@options); |
my $optregex = join('|',@options); |
| if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) { |
if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) { |
| foreach my $type (@{$types}) { |
foreach my $type (@{$types}) { |
| if (&usertools_access($env{'user.name'}, |
if (&usertools_access($uname,$udom,$type,undef, |
| $env{'user.domain'}, |
'requestcourses')) { |
| $type,undef,'requestcourses')) { |
|
| $canreq ++; |
$canreq ++; |
| if (ref($request_domains) eq 'HASH') { |
if (ref($request_domains) eq 'HASH') { |
| push(@{$request_domains->{$type}},$env{'user.domain'}); |
push(@{$request_domains->{$type}},$udom); |
| } |
} |
| if ($dom eq $env{'user.domain'}) { |
if ($dom eq $udom) { |
| $can_request->{$type} = 1; |
$can_request->{$type} = 1; |
| } |
} |
| } |
} |
| if ($env{'environment.reqcrsotherdom.'.$type} ne '') { |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && |
| |
($env{'environment.reqcrsotherdom.'.$type} ne '')) { |
| my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type}); |
my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type}); |
| if (@curr > 0) { |
if (@curr > 0) { |
| foreach my $item (@curr) { |
foreach my $item (@curr) { |
|
Line 7802 sub check_can_request {
|
Line 8239 sub check_can_request {
|
| } |
} |
| } |
} |
| } |
} |
| unless($dom eq $env{'user.domain'}) { |
unless ($dom eq $env{'user.domain'}) { |
| $canreq ++; |
$canreq ++; |
| if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) { |
if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) { |
| $can_request->{$type} = 1; |
$can_request->{$type} = 1; |
|
Line 7867 sub customaccess {
|
Line 8304 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 8321 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 8369 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 8529 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 8555 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 8159 sub allowed {
|
Line 8611 sub allowed {
|
| |
|
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| |
|
| |
if ($priv eq 'bre') { |
| |
if (&is_coursetool_logo($uri)) { |
| |
return 'F'; |
| |
} |
| |
} |
| |
|
| # If this is modifying password (internal auth) domains must match for user and user's role. |
# If this is modifying password (internal auth) domains must match for user and user's role. |
| |
|
| if ($priv eq 'mip') { |
if ($priv eq 'mip') { |
|
Line 8182 sub allowed {
|
Line 8640 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 8688 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 8874 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 8905 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 9088 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 9099 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 9224 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 9860 sub assignrole {
|
Line 10425 sub assignrole {
|
| } |
} |
| } |
} |
| } |
} |
| } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
} elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
| $refused = ''; |
if ($role eq 'st') { |
| |
$refused = ''; |
| |
} elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) { |
| |
$refused = ''; |
| |
} |
| } elsif ($context eq 'requestcourses') { |
} elsif ($context eq 'requestcourses') { |
| my @possroles = ('st','ta','ep','in','cc','co'); |
my @possroles = ('st','ta','ep','in','cc','co'); |
| if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) { |
if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) { |
|
Line 10153 sub modifyuser {
|
Line 10722 sub modifyuser {
|
| my $newuser; |
my $newuser; |
| if ($uhome eq 'no_host') { |
if ($uhome eq 'no_host') { |
| $newuser = 1; |
$newuser = 1; |
| |
unless (($umode && ($upass ne '')) || ($umode eq 'localauth') || |
| |
($umode eq 'lti')) { |
| |
return 'error: more information needed to create new user'; |
| |
} |
| } |
} |
| # ----------------------------------------------------------------- Create User |
# ----------------------------------------------------------------- Create User |
| if (($uhome eq 'no_host') && |
if (($uhome eq 'no_host') && |
| (($umode && $upass) || ($umode eq 'localauth'))) { |
(($umode && $upass) || ($umode eq 'localauth') || ($umode eq 'lti'))) { |
| my $unhome=''; |
my $unhome=''; |
| if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { |
if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { |
| $unhome = $desiredhome; |
$unhome = $desiredhome; |
|
Line 10444 sub writecoursepref {
|
Line 11017 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 12064 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}}; |
| |
} |
| |
} |
| |
my $cachetime = 24*60*60; |
| |
&do_cache_new($cachename,$cdom,\%lti,$cachetime); |
| |
} |
| |
return %lti; |
| |
} |
| |
|
| |
sub get_course_lti { |
| |
my ($cnum,$cdom,$context) = @_; |
| |
my ($name,$cachename,%lti); |
| |
if ($context eq 'consumer') { |
| |
$name = 'ltitools'; |
| |
$cachename = 'courseltitools'; |
| |
} elsif ($context eq 'provider') { |
| |
$name = 'lti'; |
| |
$cachename = 'courselti'; |
| |
} else { |
| |
return %lti; |
| |
} |
| |
my $hashid=$cdom.'_'.$cnum; |
| |
my ($result,$cached)=&is_cached_new($cachename,$hashid); |
| |
if (defined($cached)) { |
| |
if (ref($result) eq 'HASH') { |
| |
%lti = %{$result}; |
| |
} |
| |
} else { |
| |
%lti = &dump($name,$cdom,$cnum,undef,undef,undef,1); |
| |
my $cachetime = 24*60*60; |
| |
&do_cache_new($cachename,$hashid,\%lti,$cachetime); |
| |
} |
| |
return %lti; |
| |
} |
| |
|
| |
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 $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 $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 get_ltitools_id { |
| |
my ($context,$cdom,$cnum,$title) = @_; |
| |
my ($lockhash,$tries,$gotlock,$id,$error); |
| |
|
| |
# get lock on ltitools db |
| |
$lockhash = { |
| |
lock => $env{'user.name'}. |
| |
':'.$env{'user.domain'}, |
| |
}; |
| |
$tries = 0; |
| |
if ($context eq 'domain') { |
| |
$gotlock = &newput_dom('ltitools',$lockhash,$cdom); |
| |
} else { |
| |
$gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); |
| |
} |
| |
while (($gotlock ne 'ok') && ($tries<10)) { |
| |
$tries ++; |
| |
sleep (0.1); |
| |
if ($context eq 'domain') { |
| |
$gotlock = &newput_dom('ltitools',$lockhash,$cdom); |
| |
} else { |
| |
$gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); |
| |
} |
| |
} |
| |
if ($gotlock eq 'ok') { |
| |
my %currids; |
| |
if ($context eq 'domain') { |
| |
%currids = &dump_dom('ltitools',$cdom); |
| |
} else { |
| |
%currids = &dump('ltitools',$cdom,$cnum); |
| |
} |
| |
if ($currids{'lock'}) { |
| |
delete($currids{'lock'}); |
| |
if (keys(%currids)) { |
| |
my @curr = sort { $a <=> $b } keys(%currids); |
| |
if ($curr[-1] =~ /^\d+$/) { |
| |
$id = 1 + $curr[-1]; |
| |
} |
| |
} else { |
| |
$id = 1; |
| |
} |
| |
if ($id) { |
| |
if ($context eq 'domain') { |
| |
unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') { |
| |
$error = 'nostore'; |
| |
} |
| |
} else { |
| |
unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') { |
| |
$error = 'nostore'; |
| |
} |
| |
} |
| |
} else { |
| |
$error = 'nonumber'; |
| |
} |
| |
} |
| |
my $dellockoutcome; |
| |
if ($context eq 'domain') { |
| |
$dellockoutcome = &del_dom('ltitools',['lock'],$cdom); |
| |
} else { |
| |
$dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum); |
| |
} |
| |
} else { |
| |
$error = 'nolock'; |
| |
} |
| |
return ($id,$error); |
| |
} |
| |
|
| |
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('supptools',$hashid,$numexttools,600); |
| |
} |
| |
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('suppcount',$hashid,$suppcount,600); |
&do_cache_new('showsupp',$hashid,$showsupp,600); |
| } |
} |
| return $suppcount; |
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 11764 sub EXT {
|
Line 12571 sub EXT {
|
| } |
} |
| # ------------------------------------------ fourth, look in resource metadata |
# ------------------------------------------ fourth, look in resource metadata |
| |
|
| $spacequalifierrest=~s/\./\_/; |
my $what = $spacequalifierrest; |
| my $filename; |
$what=~s/\./\_/; |
| |
my $filename; |
| if (!$symbparm) { $symbparm=&symbread(); } |
if (!$symbparm) { $symbparm=&symbread(); } |
| if ($symbparm) { |
if ($symbparm) { |
| $filename=(&decode_symb($symbparm))[2]; |
$filename=(&decode_symb($symbparm))[2]; |
| } else { |
} else { |
| $filename=$env{'request.filename'}; |
$filename=$env{'request.filename'}; |
| } |
} |
| my $metadata=&metadata($filename,$spacequalifierrest); |
my $toolsymb; |
| |
if (($filename =~ /ext\.tool$/) && ($what ne '0_gradable')) { |
| |
$toolsymb = $symbparm; |
| |
} |
| |
my $metadata=&metadata($filename,$what,$toolsymb); |
| if (defined($metadata)) { return &get_reply([$metadata,'resource']); } |
if (defined($metadata)) { return &get_reply([$metadata,'resource']); } |
| $metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
$metadata=&metadata($filename,'parameter_'.$what,$toolsymb); |
| if (defined($metadata)) { return &get_reply([$metadata,'resource']); } |
if (defined($metadata)) { return &get_reply([$metadata,'resource']); } |
| |
|
| # ---------------------------------------------- fourth, look in rest of course |
# ----------------------------------------------- fifth, look in rest of course |
| if ($symbparm && defined($courseid) && |
if ($symbparm && defined($courseid) && |
| $courseid eq $env{'request.course.id'}) { |
$courseid eq $env{'request.course.id'}) { |
| my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, |
my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, |
|
Line 11798 sub EXT {
|
Line 12610 sub EXT {
|
| if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); } |
if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); } |
| } |
} |
| if ($recurse) { return undef; } |
if ($recurse) { return undef; } |
| my $pack_def=&packages_tab_default($filename,$varname); |
my $pack_def=&packages_tab_default($filename,$varname,$toolsymb); |
| if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); } |
if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); } |
| # ---------------------------------------------------- Any other user namespace |
# ---------------------------------------------------- Any other user namespace |
| } elsif ($realm eq 'environment') { |
} elsif ($realm eq 'environment') { |
|
Line 11823 sub EXT {
|
Line 12635 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 12672 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 11863 sub sort_course_groups { # Sort groups b
|
Line 12703 sub sort_course_groups { # Sort groups b
|
| } |
} |
| |
|
| sub packages_tab_default { |
sub packages_tab_default { |
| my ($uri,$varname)=@_; |
my ($uri,$varname,$toolsymb)=@_; |
| my (undef,$part,$name)=split(/\./,$varname); |
my (undef,$part,$name)=split(/\./,$varname); |
| |
|
| my (@extension,@specifics,$do_default); |
my (@extension,@specifics,$do_default); |
| foreach my $package (split(/,/,&metadata($uri,'packages'))) { |
foreach my $package (split(/,/,&metadata($uri,'packages',$toolsymb))) { |
| my ($pack_type,$pack_part)=split(/_/,$package,2); |
my ($pack_type,$pack_part)=split(/_/,$package,2); |
| if ($pack_type eq 'default') { |
if ($pack_type eq 'default') { |
| $do_default=1; |
$do_default=1; |
|
Line 11936 my %metaentry;
|
Line 12776 my %metaentry;
|
| my %importedpartids; |
my %importedpartids; |
| my %importedrespids; |
my %importedrespids; |
| sub metadata { |
sub metadata { |
| my ($uri,$what,$liburi,$prefix,$depthcount)=@_; |
my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_; |
| $uri=&declutter($uri); |
$uri=&declutter($uri); |
| # 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 11960 sub metadata {
|
Line 12800 sub metadata {
|
| my ($result,$cached)=&is_cached_new('meta',$uri); |
my ($result,$cached)=&is_cached_new('meta',$uri); |
| if (defined($cached)) { return $result->{':'.$what}; } |
if (defined($cached)) { return $result->{':'.$what}; } |
| } |
} |
| |
|
| |
# |
| |
# If the uri is for an external tool the file from |
| |
# which metadata should be retrieved depends on whether |
| |
# the tool had been configured to be gradable (set in the Course |
| |
# Editor or Resource Editor). |
| |
# |
| |
# If a valid symb has been included as the third arg in the call |
| |
# to &metadata() that can be used to retrieve the value of |
| |
# parameter_0_gradable set for the resource, and included in the |
| |
# uploaded map containing the tool. The value is retrieved via |
| |
# &EXT(), if a valid symb is available. Otherwise the value of |
| |
# gradable in the exttool_$marker.db file for the tool instance |
| |
# is retrieved via &get(). |
| |
# |
| |
# When lonuserstate::traceroute() calls lonnet::EXT() for |
| |
# hiddenresource and encrypturl (during course initialization) |
| |
# the map-level parameter for resource.0.gradable included in the |
| |
# uploaded map containing the tool will not yet have been stored |
| |
# in the user_course_parms.db file for the user's session, so in |
| |
# this case fall back to retrieving gradable status from the |
| |
# exttool_$marker.db file. |
| |
# |
| |
# In order to avoid an infinite loop, &metadata() will return |
| |
# before a call to &EXT(), if the uri is for an external tool |
| |
# and the $what for which metadata is being requested is |
| |
# parameter_0_gradable or 0_gradable. |
| |
# |
| |
|
| |
if ($uri =~ /ext\.tool$/) { |
| |
if (($what eq 'parameter_0_gradable') || ($what eq '0_gradable')) { |
| |
return; |
| |
} else { |
| |
my ($checked,$use_passback); |
| |
if ($toolsymb ne '') { |
| |
(undef,undef,my $tooluri) = &decode_symb($toolsymb); |
| |
if (($tooluri eq $uri) && (&EXT('resource.0.gradable',$toolsymb))) { |
| |
$checked = 1; |
| |
if (&EXT('resource.0.gradable',$toolsymb) =~ /^yes$/i) { |
| |
$use_passback = 1; |
| |
} |
| |
} |
| |
} |
| |
unless ($checked) { |
| |
my ($ignore,$cdom,$cnum,$marker) = split(m{/},$uri); |
| |
$marker=~s/\D//g; |
| |
if ($marker) { |
| |
my %toolsettings=&get('exttool_'.$marker,['gradable'],$cdom,$cnum); |
| |
$use_passback = $toolsettings{'gradable'}; |
| |
} |
| |
} |
| |
if ($use_passback) { |
| |
$filename = '/home/httpd/html/res/lib/templates/LTIpassback.tool'; |
| |
} else { |
| |
$filename = '/home/httpd/html/res/lib/templates/LTIstandard.tool'; |
| |
} |
| |
} |
| |
} |
| |
|
| { |
{ |
| # Imported parts would go here |
# Imported parts would go here |
| my @origfiletagids=(); |
my @origfiletagids=(); |
|
Line 12133 sub metadata {
|
Line 13032 sub metadata {
|
| |
|
| if ($depthcount<20) { |
if ($depthcount<20) { |
| my $metadata = |
my $metadata = |
| &metadata($uri,'keys', $location,$unikey, |
&metadata($uri,'keys',$toolsymb,$location,$unikey, |
| $depthcount+1); |
$depthcount+1); |
| foreach my $meta (split(',',$metadata)) { |
foreach my $meta (split(',',$metadata)) { |
| $metaentry{':'.$meta}=$metaentry{':'.$meta}; |
$metaentry{':'.$meta}=$metaentry{':'.$meta}; |
|
Line 12208 sub metadata {
|
Line 13107 sub metadata {
|
| $dir=~s|[^/]*$||; |
$dir=~s|[^/]*$||; |
| $location=&filelocation($dir,$location); |
$location=&filelocation($dir,$location); |
| my $rights_metadata = |
my $rights_metadata = |
| &metadata($uri,'keys',$location,'_rights', |
&metadata($uri,'keys',$toolsymb,$location,'_rights', |
| $depthcount+1); |
$depthcount+1); |
| foreach my $rights (split(',',$rights_metadata)) { |
foreach my $rights (split(',',$rights_metadata)) { |
| #$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights}; |
#$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights}; |
|
Line 12477 sub get_coursechange {
|
Line 13376 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 13624 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 14799 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 15872 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 16165 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 |
|
Line 15384 condval($condidx) : value of condition i
|
Line 16332 condval($condidx) : value of condition i
|
| |
|
| =item * |
=item * |
| |
|
| metadata($uri,$what,$liburi,$prefix,$depthcount) : request a |
metadata($uri,$what,$toolsymb,$liburi,$prefix,$depthcount) : request a |
| resource's metadata, $what should be either a specific key, or either |
resource's metadata, $what should be either a specific key, or either |
| 'keys' (to get a list of possible keys) or 'packages' to get a list of |
'keys' (to get a list of possible keys) or 'packages' to get a list of |
| packages that this resource currently uses, the last 3 arguments are only used internally for recursive metadata. |
packages that this resource currently uses, the last 3 arguments are |
| |
only used internally for recursive metadata. |
| |
|
| |
the toolsymb is only used where the uri is for an external tool (for which |
| |
the uri as well as the symb are guaranteed to be unique). |
| |
|
| this function automatically caches all requests |
this function automatically caches all requests |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lonnet / perl