[BACK]Return to Lond.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Lond.pm between versions 1.8.2.3.2.3 and 1.8.2.3.2.4

version 1.8.2.3.2.3, 2022/02/20 21:06:30 version 1.8.2.3.2.4, 2023/07/05 21:47:51
Line 39  use Apache::lonnet; Line 39  use Apache::lonnet;
 use GDBM_File;  use GDBM_File;
 use Net::OAuth;  use Net::OAuth;
 use Crypt::CBC;  use Crypt::CBC;
   use Digest::SHA;
   use Digest::MD5 qw(md5_hex);
   
 sub dump_with_regexp {  sub dump_with_regexp {
     my ( $tail, $clientversion ) = @_;      my ( $tail, $clientversion ) = @_;
Line 980  sub domlti_itemid { Line 982  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 1040  sub domlti_itemid { Line 1045  sub domlti_itemid {
     return $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;
   }
   
 1;  1;
   
 __END__  __END__
Removed from v.1.8.2.3.2.3  
changed lines
  Added in v.1.8.2.3.2.4

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