Return to LWPReq.pm CVS log

Up to [LON-CAPA] / loncom

- Unset debugging for IO::Socket::SSL (if set) on completion of request.

# 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;