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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>