File:
[LON-CAPA] /
loncom /
LWPReq.pm
Revision
1.2:
download - view:
text,
annotated -
select for diffs
Mon Jul 25 19:49:45 2016 UTC (7 years, 11 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
- Use Server Name Indication (SNI) and SSL when replicating content from
/raw/.
- Domain status screen has link to show status of LON-CAPA SSL certificates.
- "SSL" domain config for (a) "internal" LON-CAPA SSL connection to servers/VMs
in other domain, (b) Replication of domain's resources to other domains.
- Replication can use name-based virtual hosts with SSL, with verification of
client certificate (cert: /home/httpd/lonCerts/lonhostnamecert.pem, signed
by LON-CAPA CA, with Common Name of internal-<server hostname>, same IP address
as server hostname).
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.2 2016/07/25 19:49:45 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,$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 ($content ne '') {
119: $response = $ua->request($request,$content);
120: } else {
121: $response = $ua->request($request);
122: }
123: if (($response->code eq '302') && ($fn) && ($remotehostname) &&
124: ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
125: my $newurl = $response->header('Location');
126: unless ($dns_set) {
127: $dns_set = &setdns($remotehostid,$remotehostname);
128: }
129: if ($use_lc_ca && $certf && $keyf) {
130: $ssl_opts->{'SSL_hostname'} = 'internal-'.$stdhostname;
131: }
132: $request->uri($newurl);
133: if ($content ne '') {
134: $response = $ua->request($request,$content);
135: } else {
136: $response = $ua->request($request);
137: }
138: }
139: } else {
140: {
141: require Net::SSLGlue::LWP;
142: local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
143: if ($use_lc_ca && $certf && $keyf) {
144: $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;
145: $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;
146: $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;
147: if ($dns_set && $remotehostname) {
148: if ($remotehostname =~ /^internal\-/) {
149: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
150: }
151: }
152: } else {
153: $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;
154: }
155: if ($verifycert) {
156: $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
157: $Net::SSLGlue::LWP::SSLopts{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
158: if ($use_lc_ca) {
159: $Net::SSLGlue::LWP::SSLopts{'SSL_ca_file'} = $caf;
160: }
161: } else {
162: $Net::SSLGlue::LWP::SSLopts{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_NONE;
163: }
164: my $ua = LWP::UserAgent->new();
165: if ($timeout) {
166: $ua->timeout($timeout);
167: }
168: if ($use_lc_ca && $remotehostname && $fn) {
169: $ua->requests_redirectable(undef);
170: }
171: if ($content ne '') {
172: $response = $ua->request($request,$content);
173: } else {
174: $response = $ua->request($request);
175: }
176: if (($response->code eq '302') && ($fn) && ($remotehostname) &&
177: ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
178: my $newurl = $response->header('Location');
179: unless ($dns_set) {
180: $dns_set = &setdns($remotehostid,$remotehostname);
181: }
182: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = 'internal-'.$stdhostname;
183: $request->uri($newurl);
184: if ($content ne '') {
185: $response = $ua->request($request,$content);
186: } else {
187: $response = $ua->request($request);
188: }
189: }
190: }
191: }
192: if ($dns_set) {
193: $dns_set = &unsetdns();
194: }
195: return $response;
196: }
197:
198: sub setdns {
199: my ($remotehostid,$remotehostname) = @_;
200: my $ip = &Apache::lonnet::get_host_ip($remotehostid);
201: if ($remotehostname =~ /^internal\-/) {
202: LWP::UserAgent::DNS::Hosts->register_host(
203: $remotehostname => $ip,
204: );
205: } else {
206: LWP::UserAgent::DNS::Hosts->register_host(
207: 'internal-'.$remotehostname => $ip,
208: );
209: }
210: LWP::UserAgent::DNS::Hosts->enable_override;
211: return 1;
212: }
213:
214: sub unsetdns {
215: LWP::UserAgent::DNS::Hosts->clear_hosts();
216: return 0;
217: }
218:
219: sub raw_redirected {
220: my ($remotehostid,$lonhost) = @_;
221: my $remhostname = &Apache::lonnet::hostname($remotehostid);
222: my $redirect;
223: if ($remhostname) {
224: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$remotehostid);
225: my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/);
226: if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) {
227: my $internet_names = &Apache::lonnet::get_internet_names($remotehostid);
228: if (ref($internet_names) eq 'ARRAY') {
229: my $intdom = &Apache::lonnet::internet_dom($lonhost);
230: unless (grep(/^\Q$intdom\E$/,@{$internet_names})) {
231: my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname);
232: my $remhomedom = &Apache::lonnet::host_domain($remhomeID);
233: my %domdefaults = &Apache::lonnet::get_domain_defaults($remhomedom);
234: my $replication = $domdefaults{'replication'};
235: if (ref($replication) eq 'HASH') {
236: if (ref($replication->{'reqcerts'}) eq 'ARRAY') {
237: if (grep(/^\Q$intdom\E$/,@{$replication->{'reqcerts'}})) {
238: $redirect = 1;
239: } else {
240: $redirect = 0;
241: }
242: }
243: if (ref($replication->{'noreqcerts'}) eq 'ARRAY') {
244: if (grep(/^\Q$intdom\E$/,@{$replication->{'noreqcerts'}})) {
245: $redirect = 0;
246: } else {
247: $redirect = 1;
248: }
249: }
250: }
251: }
252: }
253: }
254: }
255: return $redirect;
256: }
257:
258: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>