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

Diff for /loncom/Lond.pm between versions 1.16 and 1.22

version 1.16, 2021/02/08 14:50:53 version 1.22, 2023/05/22 21:10:56
Line 41  use MIME::Base64; Line 41  use MIME::Base64;
 use Crypt::OpenSSL::X509;  use Crypt::OpenSSL::X509;
 use Crypt::X509::CRL;  use Crypt::X509::CRL;
 use Crypt::PKCS10;  use Crypt::PKCS10;
   use Net::OAuth;
   use Crypt::CBC;
   use Net::OAuth;
   use Digest::SHA;
   use Digest::MD5 qw(md5_hex);
   
 sub dump_with_regexp {  sub dump_with_regexp {
     my ( $tail, $clientversion ) = @_;      my ( $tail, $clientversion ) = @_;
Line 242  sub check_homecourses { Line 247  sub check_homecourses {
                     }                      }
                 }                  }
                 unless (&untie_domain_hash($hashref)) {                  unless (&untie_domain_hash($hashref)) {
                     &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");                      &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
                 }                  }
             } else {              } else {
                 &logthis("Failed to tie hash for nohist_courseids.db for $domain");                  &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $domain");
             }              }
         }          }
         foreach my $hashid (keys(%recent)) {          foreach my $hashid (keys(%recent)) {
Line 317  sub get_courseinfo_hash { Line 322  sub get_courseinfo_hash {
     };      };
     if ($@) {      if ($@) {
         if ($@ eq "timeout\n") {          if ($@ eq "timeout\n") {
             &logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");              &Apache::lonnet::logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
         } else {          } else {
             &logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");              &Apache::lonnet::logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
         }          }
     } else {      } else {
         if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {          if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
Line 805  sub is_course { Line 810  sub is_course {
             }              }
             &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);              &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
             unless (&untie_domain_hash($hashref)) {              unless (&untie_domain_hash($hashref)) {
                 &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");                  &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
             }              }
         } else {          } else {
             &logthis("Failed to tie hash for nohist_courseids.db for $cdom");              &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom");
         }          }
     }      }
     return $iscourse;      return $iscourse;
Line 1043  sub get_dom { Line 1048  sub get_dom {
     return $qresult;      return $qresult;
 }  }
   
   sub store_dom {
       my ($userinput) = @_;
       my ($cmd,$dom,$namespace,$rid,$what) =split(/:/,$userinput);
       my $hashref  = &tie_domain_hash($dom,$namespace,&GDBM_WRCREAT(),"S","$rid:$what") or
           return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
       $hashref->{"version:$rid"}++;
       my $version=$hashref->{"version:$rid"};
       my $allkeys='';
       my @pairs=split(/\&/,$what);
       foreach my $pair (@pairs) {
           my ($key,$value)=split(/=/,$pair);
           $allkeys.=$key.':';
           $hashref->{"$version:$rid:$key"}=$value;
       }
       my $now = time;
       $hashref->{"$version:$rid:timestamp"}=$now;
       $allkeys.='timestamp';
       $hashref->{"$version:keys:$rid"}=$allkeys;
       &untie_user_hash($hashref) or
           return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
       return 'ok';
   }
   
   sub restore_dom {
       my ($userinput) = @_;
       my ($cmd,$dom,$namespace,$rid) = split(/:/,$userinput);
       my $hashref = &tie_domain_hash($dom,$namespace,&GDBM_READER()) or
           return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
       my $qresult='';
       if (ref($hashref)) {
           chomp($rid);
           my $version=$hashref->{"version:$rid"};
           $qresult.="version=$version&";
           my $scope;
           for ($scope=1;$scope<=$version;$scope++) {
               my $vkeys=$hashref->{"$scope:keys:$rid"};
               my @keys=split(/:/,$vkeys);
               my $key;
               $qresult.="$scope:keys=$vkeys&";
               foreach $key (@keys) {
                   $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
               }
           }
           $qresult=~s/\&$//;
       }
       &untie_user_hash($hashref) or
           return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
       return $qresult;
   }
   
   sub crslti_itemid {
       my ($cdom,$cnum,$url,$method,$params,$loncaparev) = @_;
       unless (ref($params) eq 'HASH') {
           return;
       }
       if (($cdom eq '') || ($cnum eq '')) {
           return;
       }
       my ($itemid,$consumer_key,$secret);
   
       if (exists($params->{'oauth_callback'})) {
           $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
       } else {
           $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
       }
   
       my $consumer_key = $params->{'oauth_consumer_key'};
       return if ($consumer_key eq '');
   
       my (%crslti,%crslti_by_key);
       my $hashid=$cdom.'_'.$cnum;
       my ($result,$cached)=&Apache::lonnet::is_cached_new('courseltienc',$hashid);
       if (defined($cached)) {
           if (ref($result) eq 'HASH') {
               %crslti = %{$result};
           }
       } else {
           my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_ltienc','','')),$loncaparev);
           %crslti = %{&Apache::lonnet::unserialize($reply)};
           my $cachetime = 24*60*60;
           &Apache::lonnet::do_cache_new('courseltienc',$hashid,\%crslti,$cachetime);
       }
   
       return if (!keys(%crslti));
   
       foreach my $id (keys(%crslti)) {
           if (ref($crslti{$id}) eq 'HASH') {
               my $key = $crslti{$id}{'key'};
               if (($key ne '') && ($crslti{$id}{'secret'} ne '')) {
                   push(@{$crslti_by_key{$key}},$id);
               }
           }
       }
   
       return if (!keys(%crslti_by_key));
   
       my %courselti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
   
       if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') {
           foreach my $id (@{$crslti_by_key{$consumer_key}}) {
               my $secret = $crslti{$id}{'secret'};
               if (ref($courselti{$id}) eq 'HASH') {
                   if ((exists($courselti{$id}{'cipher'})) &&
                       ($courselti{$id}{'cipher'} =~ /^\d+$/)) {
                       my $keynum = $courselti{$id}{'cipher'};
                       my $privkey = &get_dom("getdom:$cdom:private:$keynum:lti:key");
                       if ($privkey ne '') {
                           my $cipher = new Crypt::CBC($privkey);
                           $secret = $cipher->decrypt_hex($secret);
                       }
                   }
               }
               my $request = Net::OAuth->request('request token')->from_hash($params,
                                                 request_url => $url,
                                                 request_method => $method,
                                                 consumer_secret => $secret,);
               if ($request->verify()) {
                   $itemid = $id;
                   last;
               }
           }
       }
       return $itemid;
   }
   
   sub domlti_itemid {
       my ($dom,$context,$url,$method,$params,$loncaparev) = @_;
       unless (ref($params) eq 'HASH') {
           return;
       }
       if ($dom eq '') {
           return;
       }
       my ($itemid,$consumer_key,$secret);
   
       if (exists($params->{'oauth_callback'})) {
           $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
       } else {
           $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
       }
   
       my $consumer_key = $params->{'oauth_consumer_key'};
       return if ($consumer_key eq '');
   
       my ($name,$cachename);
       if ($context eq 'linkprot') {
           $name = $context;
       } else {
           $name = 'lti';
       }
       $cachename = $name.'enc';
       my %ltienc;
       my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$dom);
       if (defined($enccached)) {
           if (ref($encresult) eq 'HASH') {
               %ltienc = %{$encresult};
           }
       } else {
           my $reply = &get_dom("getdom:$dom:encconfig:$name");
           my $ltiencref = &Apache::lonnet::thaw_unescape($reply);
           if (ref($ltiencref) eq 'HASH') {
               %ltienc = %{$ltiencref};
           }
           my $cachetime = 24*60*60;
           &Apache::lonnet::do_cache_new($cachename,$dom,\%ltienc,$cachetime);
       }
   
       return if (!keys(%ltienc));
   
       my %lti_by_key;
       foreach my $id (keys(%ltienc)) {
           if (ref($ltienc{$id}) eq 'HASH') {
               my $key = $ltienc{$id}{'key'};
               if (($key ne '') && ($ltienc{$id}{'secret'} ne '')) {
                   push(@{$lti_by_key{$key}},$id);
               }
           }
       }
       return if (!keys(%lti_by_key));
   
       my %lti = &Apache::lonnet::get_domain_lti($dom,$context);
   
       if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') {
           foreach my $id (@{$lti_by_key{$consumer_key}}) {
               my $secret = $ltienc{$id}{'secret'};
               if (ref($lti{$id}) eq 'HASH') {
                   if ((exists($lti{$id}{'cipher'})) &&
                       ($lti{$id}{'cipher'} =~ /^\d+$/)) {
                       my $keynum = $lti{$id}{'cipher'};
                       my $privkey = &get_dom("getdom:$dom:private:$keynum:lti:key");
                       if ($privkey ne '') {
                           my $cipher = new Crypt::CBC($privkey);
                           $secret = $cipher->decrypt_hex($secret);
                       }
                   }
               }
               my $request = Net::OAuth->request('request token')->from_hash($params,
                                                 request_url => $url,
                                                 request_method => $method,
                                                 consumer_secret => $secret,);
               if ($request->verify()) {
                   $itemid = $id;
                   last;
               }
           }
       }
       return $itemid;
   }
   
   sub sign_params {
       my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$post,$loncaparev,$paramsref,$inforef) = @_;
       return unless (ref($paramsref) eq 'HASH');
       my ($sigmethod,$type,$callback);
       if (ref($inforef) eq 'HASH') {
           if (exists($inforef->{'method'})) {
               $sigmethod = $inforef->{'method'};
           }
           if (exists($inforef->{'cb'})) {
               $callback = $inforef->{'cb'};
           }
           if (exists($inforef->{'type'})) {
               $type = $inforef->{'type'};
           }
       }
       my ($cachename,$hashid,$key,$secret,%ltitoolsenc);
       if ($crstool) {
           $cachename = 'crsltitoolsenc';
           $hashid = $cdom.'_'.$cnum;
       } else {
           $cachename = 'ltitoolsenc';
           $hashid = $cdom;
       }
       my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid);
       if (defined($enccached)) {
           if (ref($encresult) eq 'HASH') {
               %ltitoolsenc = %{$encresult};
           }
       } else {
           if ($crstool) {
               my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_toolsenc','','')),$loncaparev);
               %ltitoolsenc = %{&Apache::lonnet::unserialize($reply)};
           } else {
               my $reply = &get_dom("getdom:$cdom:encconfig:ltitools");
               my $ltitoolsencref = &Apache::lonnet::thaw_unescape($reply);
               if (ref($ltitoolsencref) eq 'HASH') {
                   %ltitoolsenc = %{$ltitoolsencref};
               }
           }
           my $cachetime = 24*60*60;
           &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltitoolsenc,$cachetime);
       }
       if (!keys(%ltitoolsenc)) {
            return;
       } elsif (exists($ltitoolsenc{$idx})) {
           if (ref($ltitoolsenc{$idx}) eq 'HASH') {
               if (exists($ltitoolsenc{$idx}{'key'})) {
                   $key = $ltitoolsenc{$idx}{'key'};
               }
               if (exists($ltitoolsenc{$idx}{'secret'})) {
                   $secret = $ltitoolsenc{$idx}{'secret'};
                   my $privhost;
                   if ($keynum =~ /^\d+$/) {
                       if ($crstool) {
                           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,'ltitools');
                               if ($result eq 'ok') {
                                   $secret = $plainsecret;
                               } else {
                                   undef($secret);
                               }
                           }
                       }
                       unless ($privhost) {
                           my $privkey = &get_dom("getdom:$cdom:private:$keynum:ltitools:key");
                           if (($privkey ne '') && ($secret ne '')) {
                               my $cipher = new Crypt::CBC($privkey);
                               $secret = $cipher->decrypt_hex($secret);
                           } else {
                               undef($secret);
                           }
                       }
                   }
               }
           }
       }
       return if (($key eq '') || ($secret eq ''));
       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 {
       my ($privhost,$secret,$keynum,$type) = @_;
       return;
   }
   
 1;  1;
   
 __END__  __END__
Removed from v.1.16  
changed lines
  Added in v.1.22

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.