[LON-CAPA-cvs] cvs: loncom / LWPReq.pm

[raeburn]

raeburn		Sat Jul  2 17:55:57 2016 EDT

  Added files:                 
    /loncom	LWPReq.pm 
  Log:
  - Wrapper for LWP UserAgent to accommodate certificate
    verification for SSL.
  
  

Index: loncom/LWPReq.pm
+++ loncom/LWPReq.pm
# The LearningOnline Network with CAPA
# LON-CAPA wrapper for LWP UserAgent to accommodate certificate
# verification for SSL.
#
# $Id: LWPReq.pm,v 1.1 2016/07/02 17:55:57 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();

sub makerequest {
    my ($request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_;
    unless (ref($perlvar) eq' HASH') {
        $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
    }
    my ($certf,$keyf,$caf, at opts);
    if (ref($perlvar) eq 'HASH') {
        $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};
        $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};
        $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};
    }
    if ($debug) {
        $IO::Socket::SSL::DEBUG=$debug;
    }
    my $response;
    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;
        } 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 ($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;
            } 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 ($content ne '') {
                $response = $ua->request($request,$content);
            } else {
                $response = $ua->request($request);
            }
        }
   }
   return $response;
}

1;