1: # The LearningOnline Network with CAPA
2: # LON-CAPA wrapper for LWP UserAgent to accommodate certification
3: # verification for SSL.
4: #
5: # $Id: LWPReq.pm,v 1.4 2018/09/20 18:43:24 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: use LWP::UserAgent::DNS::Hosts();
40: use Apache::lonnet;
41:
42: sub makerequest {
43: my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$islocal,$debug) = @_;
44: unless (ref($perlvar) eq' HASH') {
45: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
46: }
47: my ($certf,$keyf,$caf,@opts,$dns_set,$lonhost);
48: if (ref($perlvar) eq 'HASH') {
49: $lonhost = $perlvar->{'lonHostID'};
50: if ($perlvar->{'lonCertificateDirectory'}) {
51: if ($perlvar->{'lonnetHostnameCertificate'}) {
52: if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'}) {
53: $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};
54: }
55: }
56: if ($perlvar->{'lonnetPrivateKey'}) {
57: if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'}) {
58: $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};
59: }
60: }
61: if ($perlvar->{'lonnetCertificateAuthority'}) {
62: if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'}) {
63: $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};
64: }
65: }
66: }
67: }
68: if ($debug) {
69: $IO::Socket::SSL::DEBUG=$debug;
70: }
71: my ($response,$stdhostname,$remotehostname,$fn);
72: if ($request->uri =~ m{^https?://((?:internal\-|)([^/]+))(/raw/.+)$}) {
73: $remotehostname = $1;
74: $stdhostname = $2;
75: $fn = $3;
76: $dns_set = &setdns($remotehostid,$remotehostname);
77: unless ($remotehostname =~ /^internal\-/) {
78: if (($use_lc_ca && $certf && $keyf) &&
79: (&raw_redirected($remotehostid,$lonhost))) {
80: $remotehostname = 'internal-'.$stdhostname;
81: $request->uri('https://'.$remotehostname.$fn);
82: }
83: }
84: }
85: if (LWP::UserAgent->VERSION >= 6.00) {
86: my $ssl_opts;
87: if ($use_lc_ca && $certf && $keyf) {
88: $ssl_opts->{'SSL_use_cert'} = 1;
89: $ssl_opts->{'SSL_cert_file'} = $certf;
90: $ssl_opts->{'SSL_key_file'} = $keyf;
91: if ($dns_set && $remotehostname) {
92: if ($remotehostname =~ /^internal\-/) {
93: $ssl_opts->{'SSL_hostname'} = $remotehostname;
94: }
95: }
96: } else {
97: $ssl_opts->{'SSL_use_cert'} = 0;
98: }
99: if ($verifycert) {
100: $ssl_opts->{'verify_hostname'} = 1;
101: $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
102: $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
103: if ($use_lc_ca) {
104: $ssl_opts->{'SSL_ca_file'} = $caf;
105: }
106: } else {
107: $ssl_opts->{'verify_hostname'} = 0;
108: $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE;
109: }
110: push(@opts,(ssl_opts => $ssl_opts));
111: my $ua = LWP::UserAgent->new(@opts);
112: if ($timeout) {
113: $ua->timeout($timeout);
114: }
115: if ($use_lc_ca && $remotehostname && $fn) {
116: $ua->requests_redirectable(undef);
117: }
118: if ($islocal) {
119: $ua->local_address('127.0.0.1');
120: }
121: if ($content ne '') {
122: $response = $ua->request($request,$content);
123: } else {
124: $response = $ua->request($request);
125: }
126: if (($response->code eq '302') && ($fn) && ($remotehostname) &&
127: ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
128: my $newurl = $response->header('Location');
129: unless ($dns_set) {
130: $dns_set = &setdns($remotehostid,$remotehostname);
131: }
132: if ($use_lc_ca && $certf && $keyf) {
133: $ssl_opts->{'SSL_hostname'} = 'internal-'.$stdhostname;
134: }
135: $request->uri($newurl);
136: if ($content ne '') {
137: $response = $ua->request($request,$content);
138: } else {
139: $response = $ua->request($request);
140: }
141: }
142: } else {
143: {
144: require Net::SSLGlue::LWP;
145: local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
146: if ($use_lc_ca && $certf && $keyf) {
147: $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;
148: $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;
149: $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;
150: if ($dns_set && $remotehostname) {
151: if ($remotehostname =~ /^internal\-/) {
152: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
153: }
154: }
155: } else {
156: $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;
157: }
158: if ($verifycert) {
159: $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
160: $Net::SSLGlue::LWP::SSLopts{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
161: if ($use_lc_ca) {
162: $Net::SSLGlue::LWP::SSLopts{'SSL_ca_file'} = $caf;
163: }
164: } else {
165: $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE;
166: }
167: my $ua = LWP::UserAgent->new();
168: if ($timeout) {
169: $ua->timeout($timeout);
170: }
171: if ($use_lc_ca && $remotehostname && $fn) {
172: $ua->requests_redirectable(undef);
173: }
174: if ($islocal) {
175: if (LWP::UserAgent->VERSION >= 5.834) {
176: $ua->local_address('127.0.0.1');
177: } else {
178: require LWP::Protocol::http;
179: local @LWP::Protocol::http::EXTRA_SOCK_OPTS =
180: (LocalAddr => '127.0.0.1');
181: }
182: }
183: if ($content ne '') {
184: $response = $ua->request($request,$content);
185: } else {
186: $response = $ua->request($request);
187: }
188: if (($response->code eq '302') && ($fn) && ($remotehostname) &&
189: ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
190: my $newurl = $response->header('Location');
191: unless ($dns_set) {
192: $dns_set = &setdns($remotehostid,$remotehostname);
193: }
194: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = 'internal-'.$stdhostname;
195: $request->uri($newurl);
196: if ($content ne '') {
197: $response = $ua->request($request,$content);
198: } else {
199: $response = $ua->request($request);
200: }
201: }
202: if (($islocal) && (LWP::UserAgent->VERSION < 5.834)) {
203: local @LWP::Protocol::http::EXTRA_SOCK_OPTS = ();
204: }
205: }
206: }
207: if ($dns_set) {
208: $dns_set = &unsetdns();
209: }
210: return $response;
211: }
212:
213: sub setdns {
214: my ($remotehostid,$remotehostname) = @_;
215: my $ip = &Apache::lonnet::get_host_ip($remotehostid);
216: if ($remotehostname =~ /^internal\-/) {
217: LWP::UserAgent::DNS::Hosts->register_host(
218: $remotehostname => $ip,
219: );
220: } else {
221: LWP::UserAgent::DNS::Hosts->register_host(
222: 'internal-'.$remotehostname => $ip,
223: );
224: }
225: LWP::UserAgent::DNS::Hosts->enable_override;
226: return 1;
227: }
228:
229: sub unsetdns {
230: LWP::UserAgent::DNS::Hosts->clear_hosts();
231: return 0;
232: }
233:
234: sub raw_redirected {
235: my ($remotehostid,$lonhost) = @_;
236: my $remhostname = &Apache::lonnet::hostname($remotehostid);
237: my $redirect;
238: if ($remhostname) {
239: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$remotehostid);
240: my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/);
241: if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) {
242: my $internet_names = &Apache::lonnet::get_internet_names($remotehostid);
243: if (ref($internet_names) eq 'ARRAY') {
244: my $intdom = &Apache::lonnet::internet_dom($lonhost);
245: unless (grep(/^\Q$intdom\E$/,@{$internet_names})) {
246: my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname);
247: my $remhomedom = &Apache::lonnet::host_domain($remhomeID);
248: my %domdefaults = &Apache::lonnet::get_domain_defaults($remhomedom);
249: my $replication = $domdefaults{'replication'};
250: if (ref($replication) eq 'HASH') {
251: if (ref($replication->{'reqcerts'}) eq 'ARRAY') {
252: if (grep(/^\Q$intdom\E$/,@{$replication->{'reqcerts'}})) {
253: $redirect = 1;
254: } else {
255: $redirect = 0;
256: }
257: }
258: if (ref($replication->{'noreqcerts'}) eq 'ARRAY') {
259: if (grep(/^\Q$intdom\E$/,@{$replication->{'noreqcerts'}})) {
260: $redirect = 0;
261: } else {
262: $redirect = 1;
263: }
264: }
265: }
266: }
267: }
268: }
269: }
270: return $redirect;
271: }
272:
273: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to LWPReq.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom