# The LearningOnline Network with CAPA # LON-CAPA wrapper for LWP UserAgent to accommodate certification # verification for SSL. # # $Id: LWPReq.pm,v 1.5 2018/12/22 17:52:39 raeburn Exp $ # # The LearningOnline Network with CAPA # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # package LONCAPA::LWPReq; use strict; use lib '/home/httpd/perl/lib'; use LONCAPA::Configuration; use IO::Socket::SSL(); use LWP::UserAgent(); use LWP::UserAgent::DNS::Hosts(); use Apache::lonnet; sub makerequest { my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$islocal,$debug) = @_; unless (ref($perlvar) eq' HASH') { $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf'); } my ($certf,$keyf,$caf,@opts,$dns_set,$lonhost); if (ref($perlvar) eq 'HASH') { $lonhost = $perlvar->{'lonHostID'}; if ($perlvar->{'lonCertificateDirectory'}) { 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) { $IO::Socket::SSL::DEBUG=$debug; } 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) { my $ssl_opts; if ($use_lc_ca && $certf && $keyf) { $ssl_opts->{'SSL_use_cert'} = 1; $ssl_opts->{'SSL_cert_file'} = $certf; $ssl_opts->{'SSL_key_file'} = $keyf; if ($dns_set && $remotehostname) { if ($remotehostname =~ /^internal\-/) { $ssl_opts->{'SSL_hostname'} = $remotehostname; } } } else { $ssl_opts->{'SSL_use_cert'} = 0; } if ($verifycert) { $ssl_opts->{'verify_hostname'} = 1; $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER; $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2'; if ($use_lc_ca) { $ssl_opts->{'SSL_ca_file'} = $caf; } } else { $ssl_opts->{'verify_hostname'} = 0; $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE; } push(@opts,(ssl_opts => $ssl_opts)); my $ua = LWP::UserAgent->new(@opts); if ($timeout) { $ua->timeout($timeout); } if ($use_lc_ca && $remotehostname && $fn) { $ua->requests_redirectable(undef); } if ($islocal) { $ua->local_address('127.0.0.1'); } if ($content ne '') { $response = $ua->request($request,$content); } else { $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 { { require Net::SSLGlue::LWP; local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts; if ($use_lc_ca && $certf && $keyf) { $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1; $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf; $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf; if ($dns_set && $remotehostname) { if ($remotehostname =~ /^internal\-/) { $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname; } } } else { $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0; } if ($verifycert) { $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER; $Net::SSLGlue::LWP::SSLopts{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2'; if ($use_lc_ca) { $Net::SSLGlue::LWP::SSLopts{'SSL_ca_file'} = $caf; } } else { $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE; } my $ua = LWP::UserAgent->new(); if ($timeout) { $ua->timeout($timeout); } if ($use_lc_ca && $remotehostname && $fn) { $ua->requests_redirectable(undef); } if ($islocal) { if (LWP::UserAgent->VERSION >= 5.834) { $ua->local_address('127.0.0.1'); } else { require LWP::Protocol::http; local @LWP::Protocol::http::EXTRA_SOCK_OPTS = (LocalAddr => '127.0.0.1'); } } if ($content ne '') { $response = $ua->request($request,$content); } else { $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 (($islocal) && (LWP::UserAgent->VERSION < 5.834)) { local @LWP::Protocol::http::EXTRA_SOCK_OPTS = (); } } } if ($debug) { $IO::Socket::SSL::DEBUG=0; } if ($dns_set) { $dns_set = &unsetdns(); } 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;