;
+ 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;
+ }
+ }
+ }
+ }
}
}
}
@@ -851,13 +1115,33 @@ sub server_certs {
foreach my $key ('host','hostname') {
if ($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/) {
$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)) {
@@ -867,6 +1151,413 @@ sub server_certs {
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';
+ 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;
__END__
@@ -989,7 +1680,18 @@ courseID -- for the course for which the
The contents of the inner hash, for that single item in the outer hash
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
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.