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

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

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 {
Removed from v.1.22  
changed lines
  Added in v.1.25

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