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, 9 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>