Return to Lond.pm CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/Lond.pm between versions 1.21 and 1.24

-version 1.21, 2022/02/17 22:35:50
+version 1.24, 2023/06/20 13:27:42
  Line 43  use Crypt::X509::CRL;
  use Crypt::PKCS10;
  use Net::OAuth;
  use Crypt::CBC;
+ use Digest::SHA;
+ use Digest::MD5 qw(md5_hex);
  sub dump_with_regexp {
      my ( $tail, $clientversion ) = @_;
- Line 1194  sub domlti_itemid {
+ Line 1196  sub domlti_itemid {
          $name = $context;
      } else {
          $name = 'lti';
+         if ($context eq '') {
+             $context = 'provider';
+         }
      }
      $cachename = $name.'enc';
      my %ltienc;
- Line 1254  sub domlti_itemid {
+ Line 1259  sub domlti_itemid {
      return $itemid;
  }
+ sub sign_lti_payload {
+     my ($cdom,$cnum,$crsdef,$type,$context,$url,$idx,$keynum,$loncaparev,$paramsref,$inforef) = @_;
+     return unless (ref($paramsref) eq 'HASH');
+     my ($sigmethod,$callback,$reqtype,$reqmethod,$respfmt,$bodyhash);
+     if (ref($inforef) eq 'HASH') {
+         if (exists($inforef->{'method'})) {
+             $sigmethod = $inforef->{'method'};
+         }
+         if (exists($inforef->{'cb'})) {
+             $callback = $inforef->{'cb'};
+         }
+         if (exists($inforef->{'reqtype'})) {
+             $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';
+     }
+     if ($reqmethod eq '') {
+         $reqmethod = 'POST';
+     }
+     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;
+     } else {
+         $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);
+     if (defined($enccached)) {
+         if (ref($encresult) eq 'HASH') {
+             %ltienc = %{$encresult};
+         }
+     } else {
+         if ($crsdef) {
+             my $reply = &dump_with_regexp(join(":",($cdom,$cnum,$dbname,'','')),$loncaparev);
+             %ltienc = %{&Apache::lonnet::unserialize($reply)};
+         } else {
+             my $reply = &get_dom("getdom:$cdom:$dbname:$name");
+             my $encref = &Apache::lonnet::thaw_unescape($reply);
+             if (ref($encref) eq 'HASH') {
+                 %ltienc = %{$encref};
+             }
+         }
+         my $cachetime = 24*60*60;
+         &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltienc,$cachetime);
+     }
+     if (!keys(%ltienc)) {
+          return ();
+     } elsif (exists($ltienc{$idx})) {
+         if (ref($ltienc{$idx}) eq 'HASH') {
+             if (exists($ltienc{$idx}{'key'})) {
+                 $key = $ltienc{$idx}{'key'};
+             }
+             if (exists($ltienc{$idx}{'secret'})) {
+                 $secret = $ltienc{$idx}{'secret'};
+                 if ($keynum =~ /^\d+$/) {
+                     my $privhost;
+                     my $privname = 'ltitools';
+                     if (($type eq 'lti') || ($type eq 'linkprot')) {
+                         $privname = 'lti';
+                     }
+                     if ($crsdef) {
+                         my $primary = &Apache::lonnet::domain($cdom,'primary');
+                         my @ids = &Apache::lonnet::current_machine_ids();
+                         unless (grep(/^\Q$primary\E$/,@ids)) {
+                             $privhost = $primary;
+                             my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,$privname);
+                             if ($result eq 'ok') {
+                                 $secret = $plainsecret;
+                             } else {
+                                 undef($secret);
+                             }
+                         }
+                     }
+                     unless ($privhost) {
+                         my $privkey = &get_dom("getdom:$cdom:private:$keynum:$privname:key");
+                         if (($privkey ne '') && ($secret ne '')) {
+                             my $cipher = new Crypt::CBC($privkey);
+                             $secret = $cipher->decrypt_hex($secret);
+                         } else {
+                             undef($secret);
+                         }
+                     }
+                 }
+             }
+         }
+     }
+     return ($key,$secret);
+ }
+ sub decrypt_secret {
+     my ($privhost,$secret,$keynum,$type) = @_;
+     return;
+ }
 ;
  __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.21
changed lines
	Added in v.1.24