--- loncom/Lond.pm 2012/07/17 14:49:39 1.4 +++ loncom/Lond.pm 2018/12/10 18:56:18 1.13 @@ -1,6 +1,6 @@ # The LearningOnline Network # -# $Id: Lond.pm,v 1.4 2012/07/17 14:49:39 droeschl Exp $ +# $Id: Lond.pm,v 1.13 2018/12/10 18:56:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,8 @@ use lib '/home/httpd/lib/perl/'; use LONCAPA; use Apache::lonnet; use GDBM_File; - +use Crypt::OpenSSL::X509; +use Crypt::PKCS10; sub dump_with_regexp { my ( $tail, $clientversion ) = @_; @@ -333,7 +334,7 @@ sub dump_course_id_handler { my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter, - $creationcontext,$domcloner) = split(/:/,$tail); + $creationcontext,$domcloner,$hasuniquecode,$reqcrsdom,$reqinstcode) = split(/:/,$tail); my $now = time; my ($cloneruname,$clonerudom,%cc_clone); if (defined($description)) { @@ -406,12 +407,19 @@ sub dump_course_id_handler { } else { $creationcontext = '.'; } + unless ($hasuniquecode) { + $hasuniquecode = '.'; + } + if ($reqinstcode ne '') { + $reqinstcode = &unescape($reqinstcode); + } my $unpack = 1; if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && $typefilter eq '.') { $unpack = 0; } if (!defined($since)) { $since=0; } + my (%gotcodedefaults,%otcodedefaults); my $qresult=''; my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()) @@ -431,12 +439,15 @@ sub dump_course_id_handler { $lasttime = $hashref->{$lasttime_key}; next if ($lasttime<$since); } - my ($canclone,$valchange); + my ($canclone,$valchange,$clonefromcode); my $items = &Apache::lonnet::thaw_unescape($value); if (ref($items) eq 'HASH') { if ($hashref->{$lasttime_key} eq '') { next if ($since > 1); } + if ($items->{'inst_code'}) { + $clonefromcode = $items->{'inst_code'}; + } $is_hash = 1; if ($domcloner) { $canclone = 1; @@ -462,6 +473,41 @@ sub dump_course_id_handler { } } } + unless ($canclone) { + if (($reqcrsdom eq $udom) && ($reqinstcode) && ($clonefromcode)) { + if (grep(/\=/,@cloneable)) { + foreach my $cloner (@cloneable) { + if (($cloner ne '*') && ($cloner !~ /^\*\:$LONCAPA::match_domain$/) && + ($cloner !~ /^$LONCAPA::match_username\:$LONCAPA::match_domain$/) && ($cloner ne '')) { + if ($cloner =~ /=/) { + my (%codedefaults,@code_order); + if (ref($gotcodedefaults{$udom}) eq 'HASH') { + if (ref($gotcodedefaults{$udom}{'defaults'}) eq 'HASH') { + %codedefaults = %{$gotcodedefaults{$udom}{'defaults'}}; + } + if (ref($gotcodedefaults{$udom}{'order'}) eq 'ARRAY') { + @code_order = @{$gotcodedefaults{$udom}{'order'}}; + } + } else { + &Apache::lonnet::auto_instcode_defaults($udom, + \%codedefaults, + \@code_order); + $gotcodedefaults{$udom}{'defaults'} = \%codedefaults; + $gotcodedefaults{$udom}{'order'} = \@code_order; + } + if (@code_order > 0) { + if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order, + $cloner,$clonefromcode,$reqinstcode)) { + $canclone = 1; + last; + } + } + } + } + } + } + } + } } elsif (defined($cloneruname)) { if ($cc_clone{$unesc_key}) { $canclone = 1; @@ -482,6 +528,24 @@ sub dump_course_id_handler { } } } + unless (($canclone) || ($items->{'cloners'})) { + my %domdefs = &Apache::lonnet::get_domain_defaults($udom); + if ($domdefs{'canclone'}) { + unless ($domdefs{'canclone'} eq 'none') { + if ($domdefs{'canclone'} eq 'domain') { + if ($clonerudom eq $udom) { + $canclone = 1; + } + } elsif (($clonefromcode) && ($reqinstcode) && + ($udom eq $reqcrsdom)) { + if (&Apache::lonnet::default_instcode_cloning($udom,$domdefs{'canclone'}, + $clonefromcode,$reqinstcode)) { + $canclone = 1; + } + } + } + } + } } if ($unpack || !$rtn_as_hash) { $unesc_val{'descr'} = $items->{'description'}; @@ -530,6 +594,9 @@ sub dump_course_id_handler { next if !$showhidden; } } + if ($hasuniquecode ne '.') { + next unless ($items->{'uniquecode'}); + } } else { next if ($catfilter ne ''); next if ($selfenrollonly); @@ -716,6 +783,188 @@ sub dump_profile_database { 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)) { + &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom"); + } + } else { + &logthis("Failed to tie hash for nohist_courseids.db for $cdom"); + } + } + return $iscourse; +} + +sub server_certs { + my ($perlvar,$lonhost,$hostname) = @_; + my %pemfiles = ( + key => 'lonnetPrivateKey', + host => 'lonnetCertificate', + hostname => 'lonnetHostnameCertificate', + ca => 'lonnetCertificateAuthority', + ); + my (%md5hash,%expected_cn,%expired,%revoked,%wrongcn,%info,$crlfile); + 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->{'lonnetCertRevocationList'}; + foreach my $key (keys(%pemfiles)) { + if ($perlvar->{$pemfiles{$key}}) { + my $file = $certsdir.'/'.$perlvar->{$pemfiles{$key}}; + if (-e $file) { + if ($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'} = $x509->serial(); + 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 ((-e $crlfile) && ($info{$key}{'serial'} =~ /^\w+$/)) { + my $serial = $info{$key}{'serial'}; + if (open(PIPE,"openssl crl -inform PEM -text -in $crlfile | grep $serial |")) { + my $result = ; + close(PIPE); + chomp($result); + if ($result ne '') { + $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'; + } 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; +} 1; @@ -776,7 +1025,7 @@ Returns: 1 (Continue processing). Side effects: response is written to $client. -=item dump_couse_id_handler +=item dump_course_id_handler #TODO copy from lond 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.