version 1.1, 2016/07/02 17:55:57
|
version 1.2, 2016/07/25 19:49:45
|
Line 1
|
Line 1
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# LON-CAPA wrapper for LWP UserAgent to accommodate certificate |
# LON-CAPA wrapper for LWP UserAgent to accommodate certification |
# verification for SSL. |
# verification for SSL. |
# |
# |
# $Id$ |
# $Id$ |
Line 36 use lib '/home/httpd/perl/lib';
|
Line 36 use lib '/home/httpd/perl/lib';
|
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use IO::Socket::SSL(); |
use IO::Socket::SSL(); |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
|
use LWP::UserAgent::DNS::Hosts(); |
|
use Apache::lonnet; |
|
|
sub makerequest { |
sub makerequest { |
my ($request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_; |
my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_; |
unless (ref($perlvar) eq' HASH') { |
unless (ref($perlvar) eq' HASH') { |
$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf'); |
$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf'); |
} |
} |
my ($certf,$keyf,$caf,@opts); |
my ($certf,$keyf,$caf,@opts,$dns_set,$lonhost); |
if (ref($perlvar) eq 'HASH') { |
if (ref($perlvar) eq 'HASH') { |
$certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'}; |
$lonhost = $perlvar->{'lonHostID'}; |
$keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'}; |
if ($perlvar->{'lonCertificateDirectory'}) { |
$caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'}; |
if ($perlvar->{'lonnetHostnameCertificate'}) { |
|
if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'}) { |
|
$certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'}; |
|
} |
|
} |
|
if ($perlvar->{'lonnetPrivateKey'}) { |
|
if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'}) { |
|
$keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'}; |
|
} |
|
} |
|
if ($perlvar->{'lonnetCertificateAuthority'}) { |
|
if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'}) { |
|
$caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'}; |
|
} |
|
} |
|
} |
} |
} |
if ($debug) { |
if ($debug) { |
$IO::Socket::SSL::DEBUG=$debug; |
$IO::Socket::SSL::DEBUG=$debug; |
} |
} |
my $response; |
my ($response,$stdhostname,$remotehostname,$fn); |
|
if ($request->uri =~ m{^https?://((?:internal\-|)([^/]+))(/raw/.+)$}) { |
|
$remotehostname = $1; |
|
$stdhostname = $2; |
|
$fn = $3; |
|
$dns_set = &setdns($remotehostid,$remotehostname); |
|
unless ($remotehostname =~ /^internal\-/) { |
|
if (($use_lc_ca && $certf && $keyf) && |
|
(&raw_redirected($remotehostid,$lonhost))) { |
|
$remotehostname = 'internal-'.$stdhostname; |
|
$request->uri('https://'.$remotehostname.$fn); |
|
} |
|
} |
|
} |
if (LWP::UserAgent->VERSION >= 6.00) { |
if (LWP::UserAgent->VERSION >= 6.00) { |
my $ssl_opts; |
my $ssl_opts; |
if ($use_lc_ca && $certf && $keyf) { |
if ($use_lc_ca && $certf && $keyf) { |
$ssl_opts->{'SSL_use_cert'} = 1; |
$ssl_opts->{'SSL_use_cert'} = 1; |
$ssl_opts->{'SSL_cert_file'} = $certf; |
$ssl_opts->{'SSL_cert_file'} = $certf; |
$ssl_opts->{'SSL_key_file'} = $keyf; |
$ssl_opts->{'SSL_key_file'} = $keyf; |
|
if ($dns_set && $remotehostname) { |
|
if ($remotehostname =~ /^internal\-/) { |
|
$ssl_opts->{'SSL_hostname'} = $remotehostname; |
|
} |
|
} |
} else { |
} else { |
$ssl_opts->{'SSL_use_cert'} = 0; |
$ssl_opts->{'SSL_use_cert'} = 0; |
} |
} |
Line 65 sub makerequest {
|
Line 100 sub makerequest {
|
$ssl_opts->{'verify_hostname'} = 1; |
$ssl_opts->{'verify_hostname'} = 1; |
$ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER; |
$ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER; |
$ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2'; |
$ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2'; |
if ($use_lc_ca) { |
if ($use_lc_ca) { |
$ssl_opts->{'SSL_ca_file'} = $caf; |
$ssl_opts->{'SSL_ca_file'} = $caf; |
} |
} |
} else { |
} else { |
Line 77 sub makerequest {
|
Line 112 sub makerequest {
|
if ($timeout) { |
if ($timeout) { |
$ua->timeout($timeout); |
$ua->timeout($timeout); |
} |
} |
|
if ($use_lc_ca && $remotehostname && $fn) { |
|
$ua->requests_redirectable(undef); |
|
} |
if ($content ne '') { |
if ($content ne '') { |
$response = $ua->request($request,$content); |
$response = $ua->request($request,$content); |
} else { |
} else { |
$response = $ua->request($request); |
$response = $ua->request($request); |
} |
} |
|
if (($response->code eq '302') && ($fn) && ($remotehostname) && |
|
($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) { |
|
my $newurl = $response->header('Location'); |
|
unless ($dns_set) { |
|
$dns_set = &setdns($remotehostid,$remotehostname); |
|
} |
|
if ($use_lc_ca && $certf && $keyf) { |
|
$ssl_opts->{'SSL_hostname'} = 'internal-'.$stdhostname; |
|
} |
|
$request->uri($newurl); |
|
if ($content ne '') { |
|
$response = $ua->request($request,$content); |
|
} else { |
|
$response = $ua->request($request); |
|
} |
|
} |
} else { |
} else { |
{ |
{ |
require Net::SSLGlue::LWP; |
require Net::SSLGlue::LWP; |
Line 90 sub makerequest {
|
Line 144 sub makerequest {
|
$Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1; |
$Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1; |
$Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf; |
$Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf; |
$Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf; |
$Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf; |
|
if ($dns_set && $remotehostname) { |
|
if ($remotehostname =~ /^internal\-/) { |
|
$Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname; |
|
} |
|
} |
} else { |
} else { |
$Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0; |
$Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0; |
} |
} |
Line 106 sub makerequest {
|
Line 165 sub makerequest {
|
if ($timeout) { |
if ($timeout) { |
$ua->timeout($timeout); |
$ua->timeout($timeout); |
} |
} |
|
if ($use_lc_ca && $remotehostname && $fn) { |
|
$ua->requests_redirectable(undef); |
|
} |
if ($content ne '') { |
if ($content ne '') { |
$response = $ua->request($request,$content); |
$response = $ua->request($request,$content); |
} else { |
} else { |
$response = $ua->request($request); |
$response = $ua->request($request); |
} |
} |
|
if (($response->code eq '302') && ($fn) && ($remotehostname) && |
|
($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) { |
|
my $newurl = $response->header('Location'); |
|
unless ($dns_set) { |
|
$dns_set = &setdns($remotehostid,$remotehostname); |
|
} |
|
$Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = 'internal-'.$stdhostname; |
|
$request->uri($newurl); |
|
if ($content ne '') { |
|
$response = $ua->request($request,$content); |
|
} else { |
|
$response = $ua->request($request); |
|
} |
|
} |
} |
} |
} |
} |
|
if ($dns_set) { |
|
$dns_set = &unsetdns(); |
|
} |
return $response; |
return $response; |
} |
} |
|
|
|
sub setdns { |
|
my ($remotehostid,$remotehostname) = @_; |
|
my $ip = &Apache::lonnet::get_host_ip($remotehostid); |
|
if ($remotehostname =~ /^internal\-/) { |
|
LWP::UserAgent::DNS::Hosts->register_host( |
|
$remotehostname => $ip, |
|
); |
|
} else { |
|
LWP::UserAgent::DNS::Hosts->register_host( |
|
'internal-'.$remotehostname => $ip, |
|
); |
|
} |
|
LWP::UserAgent::DNS::Hosts->enable_override; |
|
return 1; |
|
} |
|
|
|
sub unsetdns { |
|
LWP::UserAgent::DNS::Hosts->clear_hosts(); |
|
return 0; |
|
} |
|
|
|
sub raw_redirected { |
|
my ($remotehostid,$lonhost) = @_; |
|
my $remhostname = &Apache::lonnet::hostname($remotehostid); |
|
my $redirect; |
|
if ($remhostname) { |
|
my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$remotehostid); |
|
my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/); |
|
if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) { |
|
my $internet_names = &Apache::lonnet::get_internet_names($remotehostid); |
|
if (ref($internet_names) eq 'ARRAY') { |
|
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
|
unless (grep(/^\Q$intdom\E$/,@{$internet_names})) { |
|
my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname); |
|
my $remhomedom = &Apache::lonnet::host_domain($remhomeID); |
|
my %domdefaults = &Apache::lonnet::get_domain_defaults($remhomedom); |
|
my $replication = $domdefaults{'replication'}; |
|
if (ref($replication) eq 'HASH') { |
|
if (ref($replication->{'reqcerts'}) eq 'ARRAY') { |
|
if (grep(/^\Q$intdom\E$/,@{$replication->{'reqcerts'}})) { |
|
$redirect = 1; |
|
} else { |
|
$redirect = 0; |
|
} |
|
} |
|
if (ref($replication->{'noreqcerts'}) eq 'ARRAY') { |
|
if (grep(/^\Q$intdom\E$/,@{$replication->{'noreqcerts'}})) { |
|
$redirect = 0; |
|
} else { |
|
$redirect = 1; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return $redirect; |
|
} |
|
|
1; |
1; |