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

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

version 1.10, 2017/05/18 22:13:52 version 1.22, 2023/05/22 21:10:56
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 MIME::Base64;
 use Crypt::OpenSSL::X509;  use Crypt::OpenSSL::X509;
   use Crypt::X509::CRL;
   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 240  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 315  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 783  sub dump_profile_database { Line 790  sub dump_profile_database {
     return $qresult;      return $qresult;
 }  }
   
   sub is_course {
       my ($cdom,$cnum) = @_;
   
       return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
                      ($cnum =~ /^$LONCAPA::match_courseid$/));
       my $hashid = $cdom.':'.$cnum;
       my ($iscourse,$cached) =
           &Apache::lonnet::is_cached_new('iscourse',$hashid);
       unless (defined($cached)) {
           my $hashref =
               &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
           if (ref($hashref) eq 'HASH') {
               my $esc_key = &escape($cdom.'_'.$cnum);
               if (exists($hashref->{$esc_key})) {
                   $iscourse = 1;
               } else {
                   $iscourse = 0;
               }
               &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
               unless (&untie_domain_hash($hashref)) {
                   &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
               }
           } else {
               &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom");
           }
       }
       return $iscourse;
   }
   
 sub server_certs {  sub server_certs {
     my ($perlvar) = @_;      my ($perlvar,$lonhost,$hostname) = @_;
     my %pemfiles = (      my %pemfiles = (
                      key      => 'lonnetPrivateKey',                       key      => 'lonnetPrivateKey',
                      host     => 'lonnetCertificate',                       host     => 'lonnetCertificate',
                      hostname => 'lonnetHostnameCertificate',                       hostname => 'lonnetHostnameCertificate',
                      ca       => 'lonnetCertificateAuthority',                       ca       => 'lonnetCertificateAuthority',
                        crl      => 'lonnetCertRevocationList',
                    );                     );
     my (%md5hash,%info);      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') {      if (ref($perlvar) eq 'HASH') {
           $expected_cn{'host'} = $Apache::lonnet::serverhomeIDs{$hostname};
           $expected_cn{'hostname'} = 'internal-'.$hostname;
         my $certsdir = $perlvar->{'lonCertificateDirectory'};          my $certsdir = $perlvar->{'lonCertificateDirectory'};
         if (-d $certsdir) {          if (-d $certsdir) {
             foreach my $key (keys(%pemfiles)) {              $crlfile = $certsdir.'/'.$perlvar->{$pemfiles{'crl'}};
               $cafile = $certsdir.'/'.$perlvar->{$pemfiles{'ca'}};
               foreach my $key (@ordered) {
                 if ($perlvar->{$pemfiles{$key}}) {                  if ($perlvar->{$pemfiles{$key}}) {
                     my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};                      my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}};
                     if (-e $file) {                      if (-e $file) {
                         if ($key eq 'key') {                          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 |")) {                              if (open(PIPE,"openssl rsa -noout -in $file -check |")) {
                                 my $check = <PIPE>;                                  my $check = <PIPE>;
                                 close(PIPE);                                  close(PIPE);
Line 809  sub server_certs { Line 906  sub server_certs {
                             if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {                              if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) {
                                 $md5hash{$key} = <PIPE>;                                  $md5hash{$key} = <PIPE>;
                                 close(PIPE);                                  close(PIPE);
                                   chomp($md5hash{$key});
                             }                              }
                         } else {                          } else {
                             if ($key eq 'ca') {                              if ($key eq 'ca') {
Line 827  sub server_certs { Line 925  sub server_certs {
                                 if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {                                  if (open(PIPE,"openssl x509 -noout -modulus -in $file | openssl md5 |")) {
                                     $md5hash{$key} = <PIPE>;                                      $md5hash{$key} = <PIPE>;
                                     close(PIPE);                                      close(PIPE);
                                       chomp($md5hash{$key});
                                 }                                  }
                             }                              }
                             my $x509 = Crypt::OpenSSL::X509->new_from_file($file);                              my $x509 = Crypt::OpenSSL::X509->new_from_file($file);
Line 842  sub server_certs { Line 941  sub server_certs {
                             $info{$key}{'alg'} = $x509->sig_alg_name();                              $info{$key}{'alg'} = $x509->sig_alg_name();
                             $info{$key}{'size'} = $x509->bit_length();                              $info{$key}{'size'} = $x509->bit_length();
                             $info{$key}{'email'} = $x509->email();                              $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;
                                           }
                                       }
                                   }
                               }
                         }                          }
                     }                      }
                 }                  }
Line 851  sub server_certs { Line 993  sub server_certs {
     foreach my $key ('host','hostname') {      foreach my $key ('host','hostname') {
         if ($md5hash{$key}) {          if ($md5hash{$key}) {
             if ($md5hash{$key} eq $md5hash{'key'}) {              if ($md5hash{$key} eq $md5hash{'key'}) {
                 $info{$key}{'status'} = 'ok';                  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/) {              } elsif ($info{'key'}{'status'} =~ /ok/) {
                 $info{$key}{'status'} = 'otherkey';                  $info{$key}{'status'} = 'otherkey';
             } else {              } else {
                 $info{$key}{'status'} = 'nokey';                  $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;      my $result;
     foreach my $key (keys(%info)) {      foreach my $key (keys(%info)) {
Line 867  sub server_certs { Line 1029  sub server_certs {
     return $result;      return $result;
 }  }
   
   sub get_dom {
       my ($userinput) = @_;
       my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4); 
       my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or
           return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
       my $qresult='';
       if (ref($hashref)) {
           chomp($what);
           my @queries=split(/\&/,$what);
           for (my $i=0;$i<=$#queries;$i++) {
               $qresult.="$hashref->{$queries[$i]}&";
           }
           $qresult=~s/\&$//;
       }
       &untie_user_hash($hashref) or
           return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
       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__
Line 989  courseID -- for the course for which the Line 1495  courseID -- for the course for which the
 The contents of the inner hash, for that single item in the outer hash  The contents of the inner hash, for that single item in the outer hash
 are returned (and cached in memcache for 10 minutes).  are returned (and cached in memcache for 10 minutes).
   
   =item get_dom ( $userinput )
   
   get_dom() will retrieve domain configuration information from a GDBM file
   in /home/httpd/lonUsers/$dom on the primary library server in a domain.
   The single argument passed is the string: $cmd:$udom:$namespace:$what
   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
   (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
   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)
   for each item, again separated from the next item with an ampersand.
   
 =back  =back
   
Removed from v.1.10  
changed lines
  Added in v.1.22

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