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

version 1.8.2.3.2.4, 2023/07/05 21:47:51 version 1.16, 2021/02/08 14:50:53
Line 37  use lib '/home/httpd/lib/perl/'; Line 37  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
 use GDBM_File;  use GDBM_File;
 use Net::OAuth;  use MIME::Base64;
 use Crypt::CBC;  use Crypt::OpenSSL::X509;
 use Digest::SHA;  use Crypt::X509::CRL;
 use Digest::MD5 qw(md5_hex);  use Crypt::PKCS10;
   
 sub dump_with_regexp {  sub dump_with_regexp {
     my ( $tail, $clientversion ) = @_;      my ( $tail, $clientversion ) = @_;
Line 242  sub check_homecourses { Line 242  sub check_homecourses {
                     }                      }
                 }                  }
                 unless (&untie_domain_hash($hashref)) {                  unless (&untie_domain_hash($hashref)) {
                     &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $domain");                      &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
                 }                  }
             } else {              } else {
                 &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $domain");                  &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 317  sub get_courseinfo_hash {
     };      };
     if ($@) {      if ($@) {
         if ($@ eq "timeout\n") {          if ($@ eq "timeout\n") {
             &Apache::lonnet::logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");              &logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
         } else {          } else {
             &Apache::lonnet::logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");              &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 805  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)) {
                 &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");                  &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
             }              }
         } else {          } else {
             &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom");              &logthis("Failed to tie hash for nohist_courseids.db for $cdom");
         }          }
     }      }
     return $iscourse;      return $iscourse;
 }  }
   
   sub server_certs {
       my ($perlvar,$lonhost,$hostname) = @_;
       my %pemfiles = (
                        key      => 'lonnetPrivateKey',
                        host     => 'lonnetCertificate',
                        hostname => 'lonnetHostnameCertificate',
                        ca       => 'lonnetCertificateAuthority',
                        crl      => 'lonnetCertRevocationList',
                      );
       my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile,$cafile,
           %rvkcerts,$numrvk);
       %info = (
                   key => {},
                   ca  => {},
                   host => {},
                   hostname => {},
                   crl => {},
               );
       my @ordered = ('crl','key','ca','host','hostname');
       if (ref($perlvar) eq 'HASH') {
           $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname};
           $expected_cn{'hostname'} = 'internal-'.$hostname;
           my $certsdir = $perlvar->{'lonCertificateDirectory'};
           if (-d $certsdir) {
               $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}};
               $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}};
               foreach my $key (@ordered) {
                   if ($perlvar->{$pemfiles{$key}}) {
                       my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};
                       if (-e $file) {
                           if ($key eq 'crl') {
                                if ((-e $crlfile) && (-e $cafile)) {
                                    if (open(PIPE,"openssl crl -in $crlfile -inform pem -CAfile $cafile -noout 2>&1 |")) {
                                        my $crlstatus = <PIPE>;
                                        close(PIPE);
                                        chomp($crlstatus);
                                        if ($crlstatus =~ /OK/) {
                                            $info{$key}{'status'} = 'ok';
                                            $info{$key}{'details'} = 'CRL valid for CA';
                                        }
                                    }
                                }
                                if (open(my $fh,'<',$crlfile)) {
                                    my $pem_crl = '';
                                    while (my $line=<$fh>) {
                                        chomp($line);
                                        next if ($line eq '-----BEGIN X509 CRL-----');
                                        next if ($line eq '-----END X509 CRL-----');
                                        $pem_crl .= $line;
                                    }
                                    close($fh);
                                    my $der_crl = MIME::Base64::decode_base64($pem_crl);
                                    if ($der_crl ne '') {
                                        my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
                                        if ($decoded->error) {
                                            $info{$key}{'status'} = 'error';
                                        } elsif (ref($decoded)) {
                                            $info{$key}{'start'} = $decoded->this_update;
                                            $info{$key}{'end'} = $decoded->next_update;
                                            $info{$key}{'alg'} = $decoded->SigEncAlg.' '.$decoded->SigHashAlg;
                                            $info{$key}{'cn'} = $decoded->issuer_cn;
                                            $info{$key}{'email'} = $decoded->issuer_email;
                                            $info{$key}{'size'} = $decoded->signature_length;
                                            my $rlref = $decoded->revocation_list;
                                            if (ref($rlref) eq 'HASH') {
                                                foreach my $key (keys(%{$rlref})) {
                                                    my $hkey = sprintf("%X",$key);
                                                    $rvkcerts{$hkey} = 1;
                                                }
                                                $numrvk = scalar(keys(%{$rlref}));
                                                if ($numrvk) {
                                                    $info{$key}{'details'} .= " ($numrvk revoked)"; 
                                                }
                                            }
                                        }
                                    }
                               }
                           } elsif ($key eq 'key') {
                               if (open(PIPE,"openssl rsa -noout -in $file -check |")) {
                                   my $check = <PIPE>;
                                   close(PIPE);
                                   chomp($check);
                                   $info{$key}{'status'} = $check;
                               }
                               if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {
                                   $md5hash{$key} = <PIPE>;
                                   close(PIPE);
                                   chomp($md5hash{$key});
                               }
                           } else {
                               if ($key eq 'ca') {
                                   if (open(PIPE,"openssl verify -CAfile $file $file |")) {
                                       my $check = <PIPE>;
                                       close(PIPE);
                                       chomp($check);
                                       if ($check eq "$file: OK") {
                                           $info{$key}{'status'} = 'ok';
                                       } else {
                                           $check =~ s/^\Q$file\E\:?\s*//;
                                           $info{$key}{'status'} = $check;
                                       }
                                   }
                               } else {
                                   if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {
                                       $md5hash{$key} = <PIPE>;
                                       close(PIPE);
                                       chomp($md5hash{$key});
                                   }
                               }
                               my $x509 = Crypt::OpenSSL::X509->new_from_file($file);
                               my @items = split(/,\s+/,$x509->subject());
                               foreach my $item (@items) {
                                   my ($name,$value) = split(/=/,$item);
                                   if ($name eq 'CN') {
                                       $info{$key}{'cn'} = $value;
                                   }
                               }
                               $info{$key}{'start'} = $x509->notBefore();
                               $info{$key}{'end'} = $x509->notAfter();
                               $info{$key}{'alg'} = $x509->sig_alg_name();
                               $info{$key}{'size'} = $x509->bit_length();
                               $info{$key}{'email'} = $x509->email();
                               $info{$key}{'serial'} = uc($x509->serial());
                               $info{$key}{'issuerhash'} = $x509->issuer_hash();
                               if ($x509->checkend(0)) {
                                   $expired{$key} = 1;
                               }
                               if (($key eq 'host') || ($key eq 'hostname')) {
                                   if ($info{$key}{'cn'} ne $expected_cn{$key}) {
                                       $wrongcn{$key} = 1;
                                   }
                                   if (($numrvk) && ($info{$key}{'serial'})) {
                                       if ($rvkcerts{$info{$key}{'serial'}}) {
                                           $revoked{$key} = 1;
                                       }
                                   }
                               }
                           }
                       }
                       if (($key eq 'host') || ($key eq 'hostname')) {
                           my $csrfile = $file;
                           $csrfile =~ s/\.pem$/.csr/;
                           if (-e $csrfile) {
                               if (open(PIPE,"openssl req -noout -modulus -in $csrfile |openssl md5 |")) {
                                   my $csrhash = <PIPE>;
                                   close(PIPE);
                                   chomp($csrhash);
                                   if ((!-e $file) || ($csrhash ne $md5hash{$key}) || ($expired{$key}) ||
                                       ($wrongcn{$key}) || ($revoked{$key})) {
                                       Crypt::PKCS10->setAPIversion(1);
                                       my $decoded = Crypt::PKCS10->new( $csrfile,(PEMonly => 1, readFile => 1));
                                       if (ref($decoded)) {
                                           if ($decoded->commonName() eq $expected_cn{$key}) {
                                               $info{$key.'-csr'}{'cn'} = $decoded->commonName();
                                               $info{$key.'-csr'}{'alg'} = $decoded->pkAlgorithm();
                                               $info{$key.'-csr'}{'email'} = $decoded->emailAddress();
                                               my $params = $decoded->subjectPublicKeyParams();
                                               if (ref($params) eq 'HASH') {
                                                   $info{$key.'-csr'}{'size'} = $params->{keylen};
                                               }
                                               $md5hash{$key.'-csr'} = $csrhash;
                                           }
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       foreach my $key ('host','hostname') {
           if ($md5hash{$key}) {
               if ($md5hash{$key} eq $md5hash{'key'}) {
                   if ($revoked{$key}) {
                       $info{$key}{'status'} = 'revoked';
                   } elsif ($expired{$key}) {
                       $info{$key}{'status'} = 'expired';
                   } elsif ($wrongcn{$key}) {
                       $info{$key}{'status'} = 'wrongcn';
                   } elsif ((exists($info{'ca'}{'issuerhash'})) &&
                            ($info{'ca'}{'issuerhash'} ne $info{$key}{'issuerhash'})) {
                       $info{$key}{'status'} = 'mismatch';
                   } else {
                       $info{$key}{'status'} = 'ok';
                   }
               } elsif ($info{'key'}{'status'} =~ /ok/) {
                   $info{$key}{'status'} = 'otherkey';
               } else {
                   $info{$key}{'status'} = 'nokey';
               }
           }
           if ($md5hash{$key.'-csr'}) {
               if ($md5hash{$key.'-csr'} eq $md5hash{'key'}) {
                   $info{$key.'-csr'}{'status'} = 'ok';
               } elsif ($info{'key'}{'status'} =~ /ok/) {
                   $info{$key.'-csr'}{'status'} = 'otherkey';
               } else {
                   $info{$key.'-csr'}{'status'} = 'nokey';
               }
           }
       }
       my $result;
       foreach my $key (keys(%info)) {
           $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($info{$key}).'&';
       }
       $result =~ s/\&$//;
       return $result;
   }
   
 sub get_dom {  sub get_dom {
     my ($userinput) = @_;      my ($userinput) = @_;
     my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4);      my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4); 
     my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or      my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or
         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";          return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
     my $qresult='';      my $qresult='';
Line 833  sub get_dom { Line 1043  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';  
         if ($context eq '') {  
             $context = 'provider';  
         }  
     }  
     $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_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__
Line 1350  in /home/httpd/lonUsers/$dom on the prim Line 1172  in /home/httpd/lonUsers/$dom on the prim
 The single argument passed is the string: $cmd:$udom:$namespace:$what  The single argument passed is the string: $cmd:$udom:$namespace:$what
 where $cmd is the command historically passed to lond - i.e., getdom  where $cmd is the command historically passed to lond - i.e., getdom
 or egetdom, $udom is the domain, $namespace is the name of the GDBM file  or egetdom, $udom is the domain, $namespace is the name of the GDBM file
 (encconfig or configuration), and $what is a string containing names of  (encconfig or configuration), and $what is a string containing names of 
 items to retrieve from the db file (each item name is escaped and separated  items to retrieve from the db file (each item name is escaped and separated
 from the next item name with an ampersand). The return value is either:  from the next item name with an ampersand). The return value is either:
 error: followed by an error message, or a string containing the value (escaped)  error: followed by an error message, or a string containing the value (escaped)

Removed from v.1.8.2.3.2.4  
changed lines
  Added in v.1.16


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