Annotation of loncom/LWPReq.pm, revision 1.2
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.2 ! raeburn 5: # $Id: LWPReq.pm,v 1.1 2016/07/02 17:55:57 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.2 ! raeburn 43: my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$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.1 raeburn 118: if ($content ne '') {
119: $response = $ua->request($request,$content);
120: } else {
121: $response = $ua->request($request);
122: }
1.2 ! raeburn 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: }
1.1 raeburn 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;
1.2 ! raeburn 147: if ($dns_set && $remotehostname) {
! 148: if ($remotehostname =~ /^internal\-/) {
! 149: $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
! 150: }
! 151: }
1.1 raeburn 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: }
1.2 ! raeburn 168: if ($use_lc_ca && $remotehostname && $fn) {
! 169: $ua->requests_redirectable(undef);
! 170: }
1.1 raeburn 171: if ($content ne '') {
172: $response = $ua->request($request,$content);
173: } else {
174: $response = $ua->request($request);
175: }
1.2 ! raeburn 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: }
1.1 raeburn 190: }
191: }
1.2 ! raeburn 192: if ($dns_set) {
! 193: $dns_set = &unsetdns();
! 194: }
1.1 raeburn 195: return $response;
196: }
197:
1.2 ! raeburn 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:
1.1 raeburn 258: 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