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>