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>