Annotation of loncom/LWPReq.pm, revision 1.3
1.1 raeburn 1: # The LearningOnline Network with CAPA
1.2 raeburn 2: # LON-CAPA wrapper for LWP UserAgent to accommodate certification
1.1 raeburn 3: # verification for SSL.
4: #
1.3 ! raeburn 5: # $Id: LWPReq.pm,v 1.2 2016/07/25 19:49:45 raeburn Exp $
1.1 raeburn 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();
1.2 raeburn 39: use LWP::UserAgent::DNS::Hosts();
40: use Apache::lonnet;
1.1 raeburn 41:
42: sub makerequest {
1.3 ! raeburn 43: my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$islocal,$debug) = @_;
1.1 raeburn 44: unless (ref($perlvar) eq' HASH') {
45: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
46: }
1.2 raeburn 47: my ($certf,$keyf,$caf,@opts,$dns_set,$lonhost);
1.1 raeburn 48: if (ref($perlvar) eq 'HASH') {
1.2 raeburn 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: }
1.1 raeburn 67: }
68: if ($debug) {
69: $IO::Socket::SSL::DEBUG=$debug;
70: }
1.2 raeburn 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: }
1.1 raeburn 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;
1.2 raeburn 91: if ($dns_set && $remotehostname) {
92: if ($remotehostname =~ /^internal\-/) {
93: $ssl_opts->{'SSL_hostname'} = $remotehostname;
94: }
95: }
1.1 raeburn 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';
1.2 raeburn 103: if ($use_lc_ca) {
1.1 raeburn 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: }
1.2 raeburn 115: if ($use_lc_ca && $remotehostname && $fn) {
116: $ua->requests_redirectable(undef);
117: }
1.3 ! raeburn 118: if ($islocal) {
! 119: $ua->local_address('127.0.0.1');
! 120: }
1.1 raeburn 121: if ($content ne '') {
122: $response = $ua->request($request,$content);
123: } else {
124: $response = $ua->request($request);
125: }
1.2 raeburn 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: }
1.1 raeburn 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;
1.2 raeburn 150: if ($dns_set && $remotehostname) {
151: if ($remotehostname =~ /^internal\-/) {
152: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
153: }
154: }
1.1 raeburn 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: }
1.2 raeburn 171: if ($use_lc_ca && $remotehostname && $fn) {
172: $ua->requests_redirectable(undef);
173: }
1.3 ! raeburn 174: if ($islocal) {
! 175: if (LWP::UserAgent->VERSION >= 5.834) {
! 176: $ua->local_address('127.0.0.1');
! 177: } else {
! 178: local @LWP::Protocol::http::EXTRA_SOCK_OPTS =
! 179: (LocalAddr => '127.0.0.1');
! 180: }
! 181: }
1.1 raeburn 182: if ($content ne '') {
183: $response = $ua->request($request,$content);
184: } else {
185: $response = $ua->request($request);
186: }
1.2 raeburn 187: if (($response->code eq '302') && ($fn) && ($remotehostname) &&
188: ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
189: my $newurl = $response->header('Location');
190: unless ($dns_set) {
191: $dns_set = &setdns($remotehostid,$remotehostname);
192: }
193: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = 'internal-'.$stdhostname;
194: $request->uri($newurl);
195: if ($content ne '') {
196: $response = $ua->request($request,$content);
197: } else {
198: $response = $ua->request($request);
199: }
200: }
1.3 ! raeburn 201: if (($islocal) && (LWP::UserAgent->VERSION < 5.834)) {
! 202: local @LWP::Protocol::http::EXTRA_SOCK_OPTS = ();
! 203: }
1.1 raeburn 204: }
205: }
1.2 raeburn 206: if ($dns_set) {
207: $dns_set = &unsetdns();
208: }
1.1 raeburn 209: return $response;
210: }
211:
1.2 raeburn 212: sub setdns {
213: my ($remotehostid,$remotehostname) = @_;
214: my $ip = &Apache::lonnet::get_host_ip($remotehostid);
215: if ($remotehostname =~ /^internal\-/) {
216: LWP::UserAgent::DNS::Hosts->register_host(
217: $remotehostname => $ip,
218: );
219: } else {
220: LWP::UserAgent::DNS::Hosts->register_host(
221: 'internal-'.$remotehostname => $ip,
222: );
223: }
224: LWP::UserAgent::DNS::Hosts->enable_override;
225: return 1;
226: }
227:
228: sub unsetdns {
229: LWP::UserAgent::DNS::Hosts->clear_hosts();
230: return 0;
231: }
232:
233: sub raw_redirected {
234: my ($remotehostid,$lonhost) = @_;
235: my $remhostname = &Apache::lonnet::hostname($remotehostid);
236: my $redirect;
237: if ($remhostname) {
238: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$remotehostid);
239: my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/);
240: if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) {
241: my $internet_names = &Apache::lonnet::get_internet_names($remotehostid);
242: if (ref($internet_names) eq 'ARRAY') {
243: my $intdom = &Apache::lonnet::internet_dom($lonhost);
244: unless (grep(/^\Q$intdom\E$/,@{$internet_names})) {
245: my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname);
246: my $remhomedom = &Apache::lonnet::host_domain($remhomeID);
247: my %domdefaults = &Apache::lonnet::get_domain_defaults($remhomedom);
248: my $replication = $domdefaults{'replication'};
249: if (ref($replication) eq 'HASH') {
250: if (ref($replication->{'reqcerts'}) eq 'ARRAY') {
251: if (grep(/^\Q$intdom\E$/,@{$replication->{'reqcerts'}})) {
252: $redirect = 1;
253: } else {
254: $redirect = 0;
255: }
256: }
257: if (ref($replication->{'noreqcerts'}) eq 'ARRAY') {
258: if (grep(/^\Q$intdom\E$/,@{$replication->{'noreqcerts'}})) {
259: $redirect = 0;
260: } else {
261: $redirect = 1;
262: }
263: }
264: }
265: }
266: }
267: }
268: }
269: return $redirect;
270: }
271:
1.1 raeburn 272: 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