version 1.22, 2023/05/22 21:10:56
|
version 1.25, 2023/12/28 18:14:08
|
Line 43 use Crypt::X509::CRL;
|
Line 43 use Crypt::X509::CRL;
|
use Crypt::PKCS10; |
use Crypt::PKCS10; |
use Net::OAuth; |
use Net::OAuth; |
use Crypt::CBC; |
use Crypt::CBC; |
use Net::OAuth; |
|
use Digest::SHA; |
use Digest::SHA; |
use Digest::MD5 qw(md5_hex); |
use Digest::MD5 qw(md5_hex); |
|
|
Line 66 sub dump_with_regexp {
|
Line 65 sub dump_with_regexp {
|
} |
} |
} |
} |
|
|
|
# |
|
# If dump is for file_permissions.db from a pre-2.12 server and |
|
# $uname:$udom is not a course, determine if value of portaccess |
|
# in effect for $uname:$udom allows portfolio files to be shared. |
|
# If sharing is not allowed, records returned for accesscontrol |
|
# are restricted to those based on ip (i.e., for externalresponse). |
|
# |
|
# Note: for 2.12 or later session-hosting server, determination |
|
# of portaccess value in effect occurs client-side. |
|
# |
|
my ($check_portaccess,$access,$now,$major,$minor,%by_ip); |
|
if ($namespace eq 'file_permissions') { |
|
if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) { |
|
$major = $1; |
|
$minor = $2; |
|
} |
|
unless ((($major > 2) || (($major == 2) && ($minor > 11))) || |
|
&is_course($udom,$uname)) { |
|
$check_portaccess = 1; |
|
$access = &portfolio_is_shareable($udom,$uname); |
|
} |
|
$now = time; |
|
} |
|
|
my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or |
my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or |
return "error: ".($!+0)." tie(GDBM) Failed while attempting dump"; |
return "error: ".($!+0)." tie(GDBM) Failed while attempting dump"; |
|
|
Line 79 sub dump_with_regexp {
|
Line 102 sub dump_with_regexp {
|
# |
# |
my $skipcheck; |
my $skipcheck; |
my @ids = &Apache::lonnet::current_machine_ids(); |
my @ids = &Apache::lonnet::current_machine_ids(); |
my (%homecourses, $major, $minor, $now); |
my %homecourses; |
# |
# |
# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA |
# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA |
# version on the server which requested the data. |
# version on the server which requested the data. |
Line 117 sub dump_with_regexp {
|
Line 140 sub dump_with_regexp {
|
} |
} |
} |
} |
} |
} |
|
if ($namespace eq 'file_permissions') { |
|
if ($check_portaccess) { |
|
unless ($access) { |
|
my $unesckey = &unescape($key); |
|
if ($unesckey =~ m{\0((\d+)_\d+_\d+:([a-z]+)_(\d+)_(\d+))$}) { |
|
my ($acl,$timestamp,$scope,$end,$start) = ($1,$2,$3,$4); |
|
if ($scope eq 'ip') { |
|
unless (($start > $now) && |
|
($end && $end<$now)) { |
|
my ($path) = split(/\0/,$unesckey); |
|
push(@{$by_ip{$path}},{$acl => $timestamp}); |
|
} |
|
} |
|
next; |
|
} elsif ($unesckey =~ m{\0accesscontrol$}) { |
|
next; |
|
} |
|
} |
|
} |
|
} |
if ($regexp eq '.') { |
if ($regexp eq '.') { |
$count++; |
$count++; |
if (defined($range) && $count >= $end) { last; } |
if (defined($range) && $count >= $end) { last; } |
Line 132 sub dump_with_regexp {
|
Line 175 sub dump_with_regexp {
|
} |
} |
} |
} |
} |
} |
|
if (($namespace eq 'file_permissions') && ($check_portaccess) && (!$access)) { |
|
if (keys(%by_ip)) { |
|
my %accesscontrol; |
|
foreach my $path (keys(%by_ip)) { |
|
if (ref($by_ip{$path}) eq 'ARRAY') { |
|
foreach my $item (@{$by_ip{$path}}) { |
|
if (ref($item) eq 'HASH') { |
|
my ($acl,$timestamp) = each(%$item); |
|
my $key = &escape("$path\0$acl"); |
|
my $value = $hashref->{$key}; |
|
$qresult.= "$key=$value&"; |
|
$accesscontrol{"$path\0accesscontrol"}{$acl} = $timestamp; |
|
} |
|
} |
|
} |
|
} |
|
if (keys(%accesscontrol)) { |
|
while (my ($key,$value) = each(%accesscontrol)) { |
|
$qresult.= &escape($key).'='.&Apache::lonnet::freeze_escape($value).'&'; |
|
} |
|
} |
|
} |
|
} |
&untie_user_hash($hashref) or |
&untie_user_hash($hashref) or |
return "error: ".($!+0)." untie(GDBM) Failed while attempting dump"; |
return "error: ".($!+0)." untie(GDBM) Failed while attempting dump"; |
# |
# |
Line 335 sub get_courseinfo_hash {
|
Line 400 sub get_courseinfo_hash {
|
return; |
return; |
} |
} |
|
|
|
sub portfolio_is_shareable { |
|
my ($udom,$uname) = @_; |
|
my $check_portaccess = 1; |
|
my ($userportaccess,$inststatus,$access); |
|
my $hashref = &tie_user_hash($udom, $uname, 'environment', &GDBM_READER()); |
|
if (ref($hashref) eq 'HASH') { |
|
my $accesskey = &escape('tools.portaccess'); |
|
$userportaccess = $hashref->{$accesskey}; |
|
$inststatus = $hashref->{'inststatus'}; |
|
&untie_user_hash($hashref); |
|
} |
|
if ($userportaccess ne '') { |
|
$access = $userportaccess; |
|
} else { |
|
my %domdefs = &Apache::lonnet::get_domain_defaults($udom); |
|
if (ref($domdefs{'portaccess'}) eq 'HASH') { |
|
if (($domdefs{'portaccess'}{'_LC_adv'} ne '') && |
|
(&Apache::lonnet::is_advanced_user($udom,$uname))) { |
|
if ($domdefs{'portaccess'}{'_LC_adv'}) { |
|
$access = 1; |
|
} else { |
|
$access = 0; |
|
} |
|
} elsif ($inststatus ne '') { |
|
my ($hasaccess,$hasnoaccess); |
|
foreach my $affiliation (split(/:/,$inststatus)) { |
|
if ($domdefs{'portaccess'}{$affiliation} ne '') { |
|
if ($domdefs{'portaccess'}{$affiliation}) { |
|
$hasaccess = 1; |
|
} else { |
|
$hasnoaccess = 1; |
|
} |
|
} |
|
} |
|
if ($hasaccess || $hasnoaccess) { |
|
if ($hasaccess) { |
|
$access = 1; |
|
} elsif ($hasnoaccess) { |
|
$access = 0; |
|
} |
|
} |
|
} else { |
|
if ($domdefs{'portaccess'}{'default'} ne '') { |
|
if ($domdefs{'portaccess'}{'default'}) { |
|
$access = 1; |
|
} elsif ($domdefs{'portaccess'}{'default'} == 0) { |
|
$access = 0; |
|
} |
|
} |
|
} |
|
} else { |
|
$access = 1; |
|
} |
|
} |
|
return $access; |
|
} |
|
|
sub dump_course_id_handler { |
sub dump_course_id_handler { |
my ($tail) = @_; |
my ($tail) = @_; |
|
|
Line 1197 sub domlti_itemid {
|
Line 1319 sub domlti_itemid {
|
$name = $context; |
$name = $context; |
} else { |
} else { |
$name = 'lti'; |
$name = 'lti'; |
|
if ($context eq '') { |
|
$context = 'provider'; |
|
} |
} |
} |
$cachename = $name.'enc'; |
$cachename = $name.'enc'; |
my %ltienc; |
my %ltienc; |
Line 1257 sub domlti_itemid {
|
Line 1382 sub domlti_itemid {
|
return $itemid; |
return $itemid; |
} |
} |
|
|
sub sign_params { |
sub sign_lti_payload { |
my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$post,$loncaparev,$paramsref,$inforef) = @_; |
my ($cdom,$cnum,$crsdef,$type,$context,$url,$idx,$keynum,$loncaparev,$paramsref,$inforef) = @_; |
return unless (ref($paramsref) eq 'HASH'); |
return unless (ref($paramsref) eq 'HASH'); |
my ($sigmethod,$type,$callback); |
my ($sigmethod,$callback,$reqtype,$reqmethod,$respfmt,$bodyhash); |
if (ref($inforef) eq 'HASH') { |
if (ref($inforef) eq 'HASH') { |
if (exists($inforef->{'method'})) { |
if (exists($inforef->{'method'})) { |
$sigmethod = $inforef->{'method'}; |
$sigmethod = $inforef->{'method'}; |
Line 1268 sub sign_params {
|
Line 1393 sub sign_params {
|
if (exists($inforef->{'cb'})) { |
if (exists($inforef->{'cb'})) { |
$callback = $inforef->{'cb'}; |
$callback = $inforef->{'cb'}; |
} |
} |
if (exists($inforef->{'type'})) { |
if (exists($inforef->{'reqtype'})) { |
$type = $inforef->{'type'}; |
$reqtype = $inforef->{'reqtype'}; |
|
} |
|
if (exists($inforef->{'reqmethod'})) { |
|
$reqmethod = $inforef->{'reqmethod'}; |
} |
} |
|
if (exists($inforef->{'body_hash'})) { |
|
$bodyhash = $inforef->{'body_hash'}; |
|
} |
|
if (exists($inforef->{'respfmt'})) { |
|
$respfmt = $inforef->{'respfmt'}; |
|
} |
|
} |
|
my ($key,$secret) = &get_lti_credentials($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev); |
|
return if (($key eq '') || ($secret eq '')); |
|
if ($sigmethod eq '') { |
|
$sigmethod = 'HMAC-SHA1'; |
|
} |
|
if ($callback eq '') { |
|
$callback = 'about:blank', |
|
} |
|
if ($reqtype eq '') { |
|
$reqtype = 'request token'; |
} |
} |
my ($cachename,$hashid,$key,$secret,%ltitoolsenc); |
if ($reqmethod eq '') { |
if ($crstool) { |
$reqmethod = 'POST'; |
$cachename = 'crsltitoolsenc'; |
} |
|
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
|
my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); |
|
my $request; |
|
if (($context eq 'grade') && ($reqtype eq 'consumer') && ($bodyhash ne '')) { |
|
$request = Net::OAuth->request($reqtype)->new( |
|
consumer_key => $key, |
|
consumer_secret => $secret, |
|
request_url => $url, |
|
request_method => $reqmethod, |
|
signature_method => $sigmethod, |
|
timestamp => time(), |
|
nonce => $nonce, |
|
body_hash => $bodyhash, |
|
); |
|
$request->add_required_message_params('body_hash'); |
|
} else { |
|
$request = Net::OAuth->request($reqtype)->new( |
|
consumer_key => $key, |
|
consumer_secret => $secret, |
|
request_url => $url, |
|
request_method => 'POST', |
|
signature_method => $sigmethod, |
|
timestamp => time, |
|
nonce => $nonce, |
|
callback => $callback, |
|
extra_params => $paramsref, |
|
version => '1.0', |
|
); |
|
} |
|
$request->sign(); |
|
if ($respfmt eq 'to_post_body') { |
|
return $request->to_post_body(); |
|
} elsif ($respfmt eq 'to_authorization_header') { |
|
return $request->to_authorization_header(); |
|
} else { |
|
return $request->to_hash(); |
|
} |
|
} |
|
|
|
sub get_lti_credentials { |
|
my ($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev) = @_; |
|
my ($dbname,$name,$cachename,$hashid,$key,$secret,%ltienc); |
|
if ($crsdef) { |
$hashid = $cdom.'_'.$cnum; |
$hashid = $cdom.'_'.$cnum; |
} else { |
} else { |
$cachename = 'ltitoolsenc'; |
|
$hashid = $cdom; |
$hashid = $cdom; |
} |
} |
|
if ($type eq 'tools') { |
|
if ($crsdef) { |
|
$dbname = 'nohist_toolsenc'; |
|
$cachename = 'crsltitoolsenc'; |
|
} else { |
|
$name = 'ltitools'; |
|
$dbname = 'encconfig'; |
|
$cachename = 'ltitoolsenc'; |
|
} |
|
} elsif ($type eq 'linkprot') { |
|
if ($crsdef) { |
|
$dbname = 'nohist_ltienc'; |
|
$cachename = 'courseltienc'; |
|
} else { |
|
$name = 'linkprot'; |
|
$dbname = 'encconfig'; |
|
$cachename = 'linkprotenc'; |
|
} |
|
} elsif ($type eq 'lti') { |
|
$name = 'lti'; |
|
$dbname = 'encconfig'; |
|
$cachename = 'ltienc'; |
|
} |
my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid); |
my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid); |
if (defined($enccached)) { |
if (defined($enccached)) { |
if (ref($encresult) eq 'HASH') { |
if (ref($encresult) eq 'HASH') { |
%ltitoolsenc = %{$encresult}; |
%ltienc = %{$encresult}; |
} |
} |
} else { |
} else { |
if ($crstool) { |
if ($crsdef) { |
my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_toolsenc','','')),$loncaparev); |
my $reply = &dump_with_regexp(join(":",($cdom,$cnum,$dbname,'','')),$loncaparev); |
%ltitoolsenc = %{&Apache::lonnet::unserialize($reply)}; |
%ltienc = %{&Apache::lonnet::unserialize($reply)}; |
} else { |
} else { |
my $reply = &get_dom("getdom:$cdom:encconfig:ltitools"); |
my $reply = &get_dom("getdom:$cdom:$dbname:$name"); |
my $ltitoolsencref = &Apache::lonnet::thaw_unescape($reply); |
my $encref = &Apache::lonnet::thaw_unescape($reply); |
if (ref($ltitoolsencref) eq 'HASH') { |
if (ref($encref) eq 'HASH') { |
%ltitoolsenc = %{$ltitoolsencref}; |
%ltienc = %{$encref}; |
} |
} |
} |
} |
my $cachetime = 24*60*60; |
my $cachetime = 24*60*60; |
&Apache::lonnet::do_cache_new($cachename,$hashid,\%ltitoolsenc,$cachetime); |
&Apache::lonnet::do_cache_new($cachename,$hashid,\%ltienc,$cachetime); |
} |
} |
if (!keys(%ltitoolsenc)) { |
if (!keys(%ltienc)) { |
return; |
return (); |
} elsif (exists($ltitoolsenc{$idx})) { |
} elsif (exists($ltienc{$idx})) { |
if (ref($ltitoolsenc{$idx}) eq 'HASH') { |
if (ref($ltienc{$idx}) eq 'HASH') { |
if (exists($ltitoolsenc{$idx}{'key'})) { |
if (exists($ltienc{$idx}{'key'})) { |
$key = $ltitoolsenc{$idx}{'key'}; |
$key = $ltienc{$idx}{'key'}; |
} |
} |
if (exists($ltitoolsenc{$idx}{'secret'})) { |
if (exists($ltienc{$idx}{'secret'})) { |
$secret = $ltitoolsenc{$idx}{'secret'}; |
$secret = $ltienc{$idx}{'secret'}; |
my $privhost; |
|
if ($keynum =~ /^\d+$/) { |
if ($keynum =~ /^\d+$/) { |
if ($crstool) { |
my $privhost; |
|
my $privname = 'ltitools'; |
|
if (($type eq 'lti') || ($type eq 'linkprot')) { |
|
$privname = 'lti'; |
|
} |
|
if ($crsdef) { |
my $primary = &Apache::lonnet::domain($cdom,'primary'); |
my $primary = &Apache::lonnet::domain($cdom,'primary'); |
my @ids = &Apache::lonnet::current_machine_ids(); |
my @ids = &Apache::lonnet::current_machine_ids(); |
unless (grep(/^\Q$primary\E$/,@ids)) { |
unless (grep(/^\Q$primary\E$/,@ids)) { |
$privhost = $primary; |
$privhost = $primary; |
my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,'ltitools'); |
my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,$privname); |
if ($result eq 'ok') { |
if ($result eq 'ok') { |
$secret = $plainsecret; |
$secret = $plainsecret; |
} else { |
} else { |
Line 1324 sub sign_params {
|
Line 1538 sub sign_params {
|
} |
} |
} |
} |
unless ($privhost) { |
unless ($privhost) { |
my $privkey = &get_dom("getdom:$cdom:private:$keynum:ltitools:key"); |
my $privkey = &get_dom("getdom:$cdom:private:$keynum:$privname:key"); |
if (($privkey ne '') && ($secret ne '')) { |
if (($privkey ne '') && ($secret ne '')) { |
my $cipher = new Crypt::CBC($privkey); |
my $cipher = new Crypt::CBC($privkey); |
$secret = $cipher->decrypt_hex($secret); |
$secret = $cipher->decrypt_hex($secret); |
Line 1336 sub sign_params {
|
Line 1550 sub sign_params {
|
} |
} |
} |
} |
} |
} |
return if (($key eq '') || ($secret eq '')); |
return ($key,$secret); |
if ($sigmethod eq '') { |
|
$sigmethod = 'HMAC-SHA1'; |
|
} |
|
if ($type eq '') { |
|
$type = 'request token'; |
|
} |
|
if ($callback eq '') { |
|
$callback = 'about:blank', |
|
} |
|
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
|
my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); |
|
my $request = Net::OAuth->request($type)->new( |
|
consumer_key => $key, |
|
consumer_secret => $secret, |
|
request_url => $url, |
|
request_method => 'POST', |
|
signature_method => $sigmethod, |
|
timestamp => time, |
|
nonce => $nonce, |
|
callback => $callback, |
|
extra_params => $paramsref, |
|
version => '1.0', |
|
); |
|
$request->sign(); |
|
if ($post) { |
|
return $request->to_post_body(); |
|
} else { |
|
return $request->to_hash(); |
|
} |
|
} |
} |
|
|
sub decrypt_secret { |
sub decrypt_secret { |