Return to LWPReq.pm CVS log

Up to [LON-CAPA] / loncom

- Wrapper for LWP UserAgent to accommodate certificate
  verification for SSL.

    1: # The LearningOnline Network with CAPA
    2: # LON-CAPA wrapper for LWP UserAgent to accommodate certificate
    3: # verification for SSL.
    4: #
    5: # $Id: LWPReq.pm,v 1.1 2016/07/02 17:55:57 raeburn Exp $
    6: #
    7: # The LearningOnline Network with CAPA
    8: #
    9: # Copyright Michigan State University Board of Trustees
   10: #
   11: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   12: #
   13: # LON-CAPA is free software; you can redistribute it and/or modify
   14: # it under the terms of the GNU General Public License as published by
   15: # the Free Software Foundation; either version 2 of the License, or
   16: # (at your option) any later version.
   17: #
   18: # LON-CAPA is distributed in the hope that it will be useful,
   19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   21: # GNU General Public License for more details.
   22: #
   23: # You should have received a copy of the GNU General Public License
   24: # along with LON-CAPA; if not, write to the Free Software
   25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   26: #
   27: # /home/httpd/html/adm/gpl.txt
   28: #
   29: # http://www.lon-capa.org/
   30: #
   31: 
   32: package LONCAPA::LWPReq;
   33: 
   34: use strict;
   35: use lib '/home/httpd/perl/lib';
   36: use LONCAPA::Configuration;
   37: use IO::Socket::SSL();
   38: use LWP::UserAgent();
   39: 
   40: sub makerequest {
   41:     my ($request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_;
   42:     unless (ref($perlvar) eq' HASH') {
   43:         $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
   44:     }
   45:     my ($certf,$keyf,$caf,@opts);
   46:     if (ref($perlvar) eq 'HASH') {
   47:         $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};
   48:         $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};
   49:         $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};
   50:     }
   51:     if ($debug) {
   52:         $IO::Socket::SSL::DEBUG=$debug;
   53:     }
   54:     my $response;
   55:     if (LWP::UserAgent->VERSION >= 6.00) {
   56:         my $ssl_opts;
   57:         if ($use_lc_ca && $certf && $keyf) {
   58:             $ssl_opts->{'SSL_use_cert'} = 1;
   59:             $ssl_opts->{'SSL_cert_file'} = $certf;
   60:             $ssl_opts->{'SSL_key_file'} = $keyf;
   61:         } else {
   62:             $ssl_opts->{'SSL_use_cert'} = 0;
   63:         }
   64:         if ($verifycert) {
   65:             $ssl_opts->{'verify_hostname'} = 1;
   66:             $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
   67:             $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
   68:             if ($use_lc_ca) {   
   69:                 $ssl_opts->{'SSL_ca_file'} = $caf;
   70:             }
   71:         } else {
   72:             $ssl_opts->{'verify_hostname'} = 0;
   73:             $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE;
   74:         }
   75:         push(@opts,(ssl_opts => $ssl_opts));
   76:         my $ua = LWP::UserAgent->new(@opts);
   77:         if ($timeout) {
   78:             $ua->timeout($timeout);
   79:         }
   80:         if ($content ne '') {
   81:             $response = $ua->request($request,$content);
   82:         } else {
   83:             $response = $ua->request($request);
   84:         }
   85:     } else {
   86:         {
   87:             require Net::SSLGlue::LWP;
   88:             local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
   89:             if ($use_lc_ca && $certf && $keyf) {
   90:                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;
   91:                 $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;
   92:                 $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;
   93:             } else {
   94:                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;
   95:             }
   96:             if ($verifycert) {
   97:                 $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
   98:                 $Net::SSLGlue::LWP::SSLopts{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
   99:                 if ($use_lc_ca) {
  100:                     $Net::SSLGlue::LWP::SSLopts{'SSL_ca_file'} = $caf;
  101:                 }
  102:             } else {
  103:                 $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE;
  104:             }
  105:             my $ua = LWP::UserAgent->new();
  106:             if ($timeout) {
  107:                 $ua->timeout($timeout);
  108:             }
  109:             if ($content ne '') {
  110:                 $response = $ua->request($request,$content);
  111:             } else {
  112:                 $response = $ua->request($request);
  113:             }
  114:         }
  115:    }
  116:    return $response;
  117: }
  118: 
  119: 1;