--- loncom/Lond.pm 2024/08/18 01:37:26 1.8.2.3.2.5 +++ loncom/Lond.pm 2022/02/16 00:06:08 1.20 @@ -1,6 +1,6 @@ # The LearningOnline Network # -# $Id: Lond.pm,v 1.8.2.3.2.5 2024/08/18 01:37:26 raeburn Exp $ +# $Id: Lond.pm,v 1.20 2022/02/16 00:06:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,10 +37,12 @@ use lib '/home/httpd/lib/perl/'; use LONCAPA; use Apache::lonnet; use GDBM_File; +use MIME::Base64; +use Crypt::OpenSSL::X509; +use Crypt::X509::CRL; +use Crypt::PKCS10; use Net::OAuth; use Crypt::CBC; -use Digest::SHA; -use Digest::MD5 qw(md5_hex); sub dump_with_regexp { my ( $tail, $clientversion ) = @_; @@ -61,30 +63,6 @@ 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 return "error: ".($!+0)." tie(GDBM) Failed while attempting dump"; @@ -98,7 +76,7 @@ sub dump_with_regexp { # my $skipcheck; my @ids = &Apache::lonnet::current_machine_ids(); - my %homecourses; + my (%homecourses, $major, $minor, $now); # # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA # version on the server which requested the data. @@ -136,26 +114,6 @@ 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 '.') { $count++; if (defined($range) && $count >= $end) { last; } @@ -171,29 +129,7 @@ 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 return "error: ".($!+0)." untie(GDBM) Failed while attempting dump"; # @@ -396,63 +332,6 @@ sub get_courseinfo_hash { 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 { my ($tail) = @_; @@ -937,9 +816,219 @@ sub is_course { 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 = ; + 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 = ; + close(PIPE); + chomp($check); + $info{$key}{'status'} = $check; + } + if (open(PIPE,"openssl rsa -noout -modulus -in $file | openssl md5 |")) { + $md5hash{$key} = ; + close(PIPE); + chomp($md5hash{$key}); + } + } else { + if ($key eq 'ca') { + if (open(PIPE,"openssl verify -CAfile $file $file |")) { + my $check = ; + 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} = ; + 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 = ; + 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 { 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 return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd"; my $qresult=''; @@ -1100,61 +1189,65 @@ sub domlti_itemid { 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); + my ($encresult,$enccached)=&Apache::lonnet::is_cached_new('ltienc',$dom); if (defined($enccached)) { if (ref($encresult) eq 'HASH') { %ltienc = %{$encresult}; } } else { - my $reply = &get_dom("getdom:$dom:encconfig:$name"); + my $reply = &get_dom("getdom:$dom:encconfig:lti"); 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); + &Apache::lonnet::do_cache_new('ltienc',$dom,\%ltienc,$cachetime); } return if (!keys(%ltienc)); + my %lti; + if ($context eq 'deeplink') { + my ($result,$cached)=&Apache::lonnet::is_cached_new('lti',$dom); + if (defined($cached)) { + if (ref($result) eq 'HASH') { + %lti = %{$result}; + } + } else { + my $reply = &get_dom("getdom:$dom:configuration:lti"); + my $ltiref = &Apache::lonnet::thaw_unescape($reply); + if (ref($ltiref) eq 'HASH') { + %lti = %{$ltiref}; + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('lti',$dom,\%lti,$cachetime); + } + } + return if (!keys(%lti)); + 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); + if ($context eq 'deeplink') { + if (ref($lti{$id}) eq 'HASH') { + if (!$lti{$id}{'requser'}) { + push(@{$lti_by_key{$key}},$id); + } + } + } else { + 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, @@ -1168,182 +1261,6 @@ sub domlti_itemid { 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__ @@ -1473,7 +1390,7 @@ in /home/httpd/lonUsers/$dom on the prim 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 +(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)