version 1.540, 2017/06/06 20:03:24
|
version 1.549, 2018/08/20 22:42:05
|
Line 108 my %perlvar; # Will have the apache co
|
Line 108 my %perlvar; # Will have the apache co
|
my %secureconf; # Will have requirements for security |
my %secureconf; # Will have requirements for security |
# of lond connections |
# of lond connections |
|
|
|
my %crlchecked; # Will contain clients for which the client's SSL |
|
# has been checked against the cluster's Certificate |
|
# Revocation List. |
|
|
my $dist; |
my $dist; |
|
|
# |
# |
Line 420 sub SSLConnection {
|
Line 424 sub SSLConnection {
|
Debug("Approving promotion -> ssl"); |
Debug("Approving promotion -> ssl"); |
# And do so: |
# And do so: |
|
|
|
my $CRLFile; |
|
unless ($crlchecked{$clientname}) { |
|
$CRLFile = lonssl::CRLFile(); |
|
$crlchecked{$clientname} = 1; |
|
} |
|
|
my $SSLSocket = lonssl::PromoteServerSocket($Socket, |
my $SSLSocket = lonssl::PromoteServerSocket($Socket, |
$CACertificate, |
$CACertificate, |
$Certificate, |
$Certificate, |
$KeyFile); |
$KeyFile, |
|
$clientname, |
|
$CRLFile, |
|
$clientversion); |
if(! ($SSLSocket) ) { # SSL socket promotion failed. |
if(! ($SSLSocket) ) { # SSL socket promotion failed. |
my $err = lonssl::LastError(); |
my $err = lonssl::LastError(); |
&logthis("<font color=\"red\"> CRITICAL " |
&logthis("<font color=\"red\"> CRITICAL " |
Line 779 sub ConfigFileFromSelector {
|
Line 792 sub ConfigFileFromSelector {
|
my $selector = shift; |
my $selector = shift; |
my $tablefile; |
my $tablefile; |
|
|
my $tabledir = $perlvar{'lonTabDir'}.'/'; |
if ($selector eq 'loncapaCAcrl') { |
if (($selector eq "hosts") || ($selector eq "domain") || |
my $tabledir = $perlvar{'lonCertificateDirectory'}; |
($selector eq "dns_hosts") || ($selector eq "dns_domain")) { |
if (-d $tabledir) { |
$tablefile = $tabledir.$selector.'.tab'; |
$tablefile = $tabledir.'/'.$selector.'.pem'; |
|
} |
|
} else { |
|
my $tabledir = $perlvar{'lonTabDir'}.'/'; |
|
if (($selector eq "hosts") || ($selector eq "domain") || |
|
($selector eq "dns_hosts") || ($selector eq "dns_domain")) { |
|
$tablefile = $tabledir.$selector.'.tab'; |
|
} |
} |
} |
return $tablefile; |
return $tablefile; |
} |
} |
Line 806 sub PushFile {
|
Line 826 sub PushFile {
|
my ($command, $filename, $contents) = split(":", $request, 3); |
my ($command, $filename, $contents) = split(":", $request, 3); |
&Debug("PushFile"); |
&Debug("PushFile"); |
|
|
# At this point in time, pushes for only the following tables are |
# At this point in time, pushes for only the following tables and |
# supported: |
# CRL file are supported: |
# hosts.tab ($filename eq host). |
# hosts.tab ($filename eq host). |
# domain.tab ($filename eq domain). |
# domain.tab ($filename eq domain). |
# dns_hosts.tab ($filename eq dns_host). |
# dns_hosts.tab ($filename eq dns_host). |
# dns_domain.tab ($filename eq dns_domain). |
# dns_domain.tab ($filename eq dns_domain). |
|
# loncapaCAcrl.pem ($filename eq loncapaCAcrl); |
# Construct the destination filename or reject the request. |
# Construct the destination filename or reject the request. |
# |
# |
# lonManage is supposed to ensure this, however this session could be |
# lonManage is supposed to ensure this, however this session could be |
Line 832 sub PushFile {
|
Line 853 sub PushFile {
|
|
|
if($filename eq "host") { |
if($filename eq "host") { |
$contents = AdjustHostContents($contents); |
$contents = AdjustHostContents($contents); |
} elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { |
} elsif (($filename eq 'dns_host') || ($filename eq 'dns_domain') || |
|
($filename eq 'loncapaCAcrl')) { |
if ($contents eq '') { |
if ($contents eq '') { |
&logthis('<font color="red"> Pushfile: unable to install ' |
&logthis('<font color="red"> Pushfile: unable to install ' |
.$tablefile." - no data received from push. </font>"); |
.$tablefile." - no data received from push. </font>"); |
Line 843 sub PushFile {
|
Line 865 sub PushFile {
|
if ($managers{$clientip} eq $clientname) { |
if ($managers{$clientip} eq $clientname) { |
my $clientprotocol = $Apache::lonnet::protocol{$clientname}; |
my $clientprotocol = $Apache::lonnet::protocol{$clientname}; |
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
my $url = '/adm/'.$filename; |
my $url; |
$url =~ s{_}{/}; |
if ($filename eq 'loncapaCAcrl') { |
|
$url = '/adm/dns/loncapaCRL'; |
|
} else { |
|
$url = '/adm/'.$filename; |
|
$url =~ s{_}{/}; |
|
} |
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); |
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); |
my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0); |
my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0); |
if ($response->is_error()) { |
if ($response->is_error()) { |
Line 1882 sub ls3_handler {
|
Line 1909 sub ls3_handler {
|
my $rights; |
my $rights; |
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
|
|
|
my ($crscheck,$toplevel,$currdom,$currnum,$skip); |
|
unless ($islocal) { |
|
my ($major,$minor) = split(/\./,$clientversion); |
|
if (($major < 2) || ($major == 2 && $minor < 12)) { |
|
$crscheck = 1; |
|
} |
|
} |
if (-e $ulsdir) { |
if (-e $ulsdir) { |
if(-d $ulsdir) { |
if(-d $ulsdir) { |
unless (($getpropath) || ($getuserdir) || |
unless (($getpropath) || ($getuserdir) || |
Line 1891 sub ls3_handler {
|
Line 1926 sub ls3_handler {
|
&Failure($client,"refused\n",$userinput); |
&Failure($client,"refused\n",$userinput); |
return 1; |
return 1; |
} |
} |
if (opendir(LSDIR,$ulsdir)) { |
if (($crscheck) && |
|
($ulsdir =~ m{^/home/httpd/html/res/($LONCAPA::match_domain)(/?$|/$LONCAPA::match_courseid)})) { |
|
($currdom,my $posscnum) = ($1,$2); |
|
if (($posscnum eq '') || ($posscnum eq '/')) { |
|
$toplevel = 1; |
|
} else { |
|
$posscnum =~ s{^/+}{}; |
|
if (&LONCAPA::Lond::is_course($currdom,$posscnum)) { |
|
$skip = 1; |
|
} |
|
} |
|
} |
|
if ((!$skip) && (opendir(LSDIR,$ulsdir))) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
|
if (($crscheck) && ($toplevel) && ($currdom ne '') && |
|
($ulsfn =~ /^$LONCAPA::match_courseid$/) && (-d "$ulsdir/$ulsfn")) { |
|
if (&LONCAPA::Lond::is_course($currdom,$ulsfn)) { |
|
next; |
|
} |
|
} |
undef($obs); |
undef($obs); |
undef($rights); |
undef($rights); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
Line 2070 sub server_distarch_handler {
|
Line 2123 sub server_distarch_handler {
|
sub server_certs_handler { |
sub server_certs_handler { |
my ($cmd,$tail,$client) = @_; |
my ($cmd,$tail,$client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $result; |
my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'}); |
my $result = &LONCAPA::Lond::server_certs(\%perlvar); |
my $result = &LONCAPA::Lond::server_certs(\%perlvar,$perlvar{'lonHostID'},$hostname); |
&Reply($client,\$result,$userinput); |
&Reply($client,\$result,$userinput); |
return; |
return; |
} |
} |
Line 2607 sub update_resource_handler {
|
Line 2660 sub update_resource_handler {
|
my $request=new HTTP::Request('GET',"$remoteurl"); |
my $request=new HTTP::Request('GET',"$remoteurl"); |
$response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1); |
$response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1); |
if ($response->is_error()) { |
if ($response->is_error()) { |
# FIXME: we should probably clean up here instead of just whine |
my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname"); |
unlink($transname); |
&devalidate_meta_cache($fname); |
|
if (-e $transname) { |
|
unlink($transname); |
|
} |
|
unlink($fname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
} else { |
} else { |
Line 5742 sub validate_course_section_handler {
|
Line 5799 sub validate_course_section_handler {
|
# Formal Parameters: |
# Formal Parameters: |
# $cmd - The command request that got us dispatched. |
# $cmd - The command request that got us dispatched. |
# $tail - The tail of the command. In this case this is a colon separated |
# $tail - The tail of the command. In this case this is a colon separated |
# set of words that will be split into: |
# set of values that will be split into: |
# $inst_class - Institutional code for the specific class section |
# $inst_class - Institutional code for the specific class section |
# $courseowner - The escaped username:domain of the course owner |
# $ownerlist - An escaped comma-separated list of username:domain |
|
# of the course owner, and co-owner(s). |
# $cdom - The domain of the course from the institution's |
# $cdom - The domain of the course from the institution's |
# point of view. |
# point of view. |
# $client - The socket open on the client. |
# $client - The socket open on the client. |
Line 5769 sub validate_class_access_handler {
|
Line 5827 sub validate_class_access_handler {
|
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); |
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); |
|
|
# |
# |
|
# Validate course owner or co-owners(s) access to enrollment data for all sections |
|
# and crosslistings for a particular course. |
|
# |
|
# |
|
# Formal Parameters: |
|
# $cmd - The command request that got us dispatched. |
|
# $tail - The tail of the command. In this case this is a colon separated |
|
# set of values that will be split into: |
|
# $ownerlist - An escaped comma-separated list of username:domain |
|
# of the course owner, and co-owner(s). |
|
# $cdom - The domain of the course from the institution's |
|
# point of view. |
|
# $classes - Frozen hash of institutional course sections and |
|
# crosslistings. |
|
# $client - The socket open on the client. |
|
# Returns: |
|
# 1 - continue processing. |
|
# |
|
|
|
sub validate_classes_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($ownerlist,$cdom,$classes) = split(/:/, $tail); |
|
my $classesref = &Apache::lonnet::thaw_unescape($classes); |
|
my $owners = &unescape($ownerlist); |
|
my $result; |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
my %validations; |
|
my $response = &localenroll::check_instclasses($owners,$cdom,$classesref, |
|
\%validations); |
|
if ($response eq 'ok') { |
|
foreach my $key (keys(%validations)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
} else { |
|
$result = 'error'; |
|
} |
|
}; |
|
if (!$@) { |
|
&Reply($client, \$result, $userinput); |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("autovalidateinstclasses", \&validate_classes_handler, 0, 1, 0); |
|
|
|
# |
# Create a password for a new LON-CAPA user added by auto-enrollment. |
# Create a password for a new LON-CAPA user added by auto-enrollment. |
# Only used for case where authentication method for new user is localauth |
# Only used for case where authentication method for new user is localauth |
# |
# |
Line 6937 sub UpdateHosts {
|
Line 7045 sub UpdateHosts {
|
|
|
my %oldconf = %secureconf; |
my %oldconf = %secureconf; |
my %connchange; |
my %connchange; |
if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { |
if (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') { |
logthis('<font color="blue"> Reloaded SSL connection rules </font>'); |
logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>'); |
} else { |
} else { |
logthis('<font color="yellow"> Failed to reload SSL connection rules </font>'); |
logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>'); |
} |
} |
if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) { |
if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) { |
foreach my $type ('dom','intdom','other') { |
foreach my $type ('dom','intdom','other') { |
Line 7219 if ($arch eq 'unknown') {
|
Line 7327 if ($arch eq 'unknown') {
|
chomp($arch); |
chomp($arch); |
} |
} |
|
|
unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { |
unless (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') { |
&logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>'); |
&logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>'); |
} |
} |
|
|
Line 8314 sub make_passwd_file {
|
Line 8422 sub make_passwd_file {
|
$result = "pass_file_failed_error"; |
$result = "pass_file_failed_error"; |
} |
} |
} |
} |
|
} elsif ($umode eq 'lti') { |
|
my $pf = IO::File->new(">$passfilename"); |
|
if($pf) { |
|
print $pf "lti:\n"; |
|
&update_passwd_history($uname,$udom,$umode,$action); |
|
} else { |
|
$result = "pass_file_failed_error"; |
|
} |
} else { |
} else { |
$result="auth_mode_error"; |
$result="auth_mode_error"; |
} |
} |
Line 8820 is closed and the child exits.
|
Line 8936 is closed and the child exits.
|
=item Red CRITICAL Can't get key file <error> |
=item Red CRITICAL Can't get key file <error> |
|
|
SSL key negotiation is being attempted but the call to |
SSL key negotiation is being attempted but the call to |
lonssl::KeyFile failed. This usually means that the |
lonssl::KeyFile failed. This usually means that the |
configuration file is not correctly defining or protecting |
configuration file is not correctly defining or protecting |
the directories/files lonCertificateDirectory or |
the directories/files lonCertificateDirectory or |
lonnetPrivateKey |
lonnetPrivateKey |