|
version 1.1172.2.146.2.12, 2023/01/23 18:12:09
|
version 1.1172.2.146.2.13, 2023/07/09 00:49:22
|
|
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 2435 sub get_domain_defaults {
|
Line 2512 sub get_domain_defaults {
|
| 'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
| 'requestauthor','selfenrollment', |
'requestauthor','selfenrollment', |
| 'coursecategories','autoenroll', |
'coursecategories','autoenroll', |
| 'helpsettings','wafproxy','ltisec'],$domain); |
'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 2506 sub get_domain_defaults {
|
Line 2585 sub get_domain_defaults {
|
| $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 2601 sub get_domain_defaults {
|
Line 2690 sub get_domain_defaults {
|
| } |
} |
| if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') { |
if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') { |
| if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') { |
if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') { |
| $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'}; |
$domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'}; |
| |
} |
| |
} |
| |
} |
| |
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'}; |
| } |
} |
| } |
} |
| } |
} |
|
Line 3987 sub resizeImage {
|
Line 4087 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 3999 sub resizeImage {
|
Line 4099 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 4210 sub finishuserfileupload {
|
Line 4310 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 4446 sub embedded_dependency {
|
Line 4559 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 4809 sub flushcourselogs {
|
Line 4946 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 7758 sub is_portfolio_file {
|
Line 7895 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 7770 sub usertools_access {
|
Line 7918 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 = ( |
|
Line 7967 sub is_advanced_user {
|
Line 8116 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 8002 sub check_can_request {
|
Line 8155 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 8374 sub allowed {
|
Line 8527 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 10182 sub assignrole {
|
Line 10341 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 10475 sub modifyuser {
|
Line 10638 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 11825 sub get_domain_lti {
|
Line 11992 sub get_domain_lti {
|
| } else { |
} else { |
| return %lti; |
return %lti; |
| } |
} |
| |
|
| if ($context eq 'linkprot') { |
if ($context eq 'linkprot') { |
| $cachename = $context; |
$cachename = $context; |
| } else { |
} else { |
| $cachename = $name; |
$cachename = $name; |
| } |
} |
| |
|
| my ($result,$cached)=&is_cached_new($cachename,$cdom); |
my ($result,$cached)=&is_cached_new($cachename,$cdom); |
| if (defined($cached)) { |
if (defined($cached)) { |
| if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
|
Line 11847 sub get_domain_lti {
|
Line 12012 sub get_domain_lti {
|
| } else { |
} else { |
| %lti = %{$domconfig{$name}}; |
%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; |
my $cachetime = 24*60*60; |
| &do_cache_new($cachename,$cdom,\%lti,$cachetime); |
&do_cache_new($cachename,$cdom,\%lti,$cachetime); |
|
Line 11867 sub get_domain_lti {
|
Line 12020 sub get_domain_lti {
|
| } |
} |
| |
|
| sub get_course_lti { |
sub get_course_lti { |
| my ($cnum,$cdom) = @_; |
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 $hashid=$cdom.'_'.$cnum; |
| my %courselti; |
my ($result,$cached)=&is_cached_new($cachename,$hashid); |
| my ($result,$cached)=&is_cached_new('courselti',$hashid); |
|
| if (defined($cached)) { |
if (defined($cached)) { |
| if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
| %courselti = %{$result}; |
%lti = %{$result}; |
| } |
} |
| } else { |
} else { |
| %courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1); |
%lti = &dump($name,$cdom,$cnum,undef,undef,undef,1); |
| my $cachetime = 24*60*60; |
my $cachetime = 24*60*60; |
| &do_cache_new('courselti',$hashid,\%courselti,$cachetime); |
&do_cache_new($cachename,$hashid,\%lti,$cachetime); |
| } |
} |
| return %courselti; |
return %lti; |
| } |
} |
| |
|
| sub courselti_itemid { |
sub courselti_itemid { |
|
Line 12258 sub EXT {
|
Line 12420 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 12292 sub EXT {
|
Line 12459 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 12385 sub sort_course_groups { # Sort groups b
|
Line 12552 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 12458 my %metaentry;
|
Line 12625 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 '') || |
|
Line 12482 sub metadata {
|
Line 12649 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 12655 sub metadata {
|
Line 12881 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 12730 sub metadata {
|
Line 12956 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 15955 condval($condidx) : value of condition i
|
Line 16181 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