Diff for /loncom/LWPReq.pm between versions 1.1 and 1.2

version 1.1, 2016/07/02 17:55:57 version 1.2, 2016/07/25 19:49:45
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # LON-CAPA wrapper for LWP UserAgent to accommodate certificate  # LON-CAPA wrapper for LWP UserAgent to accommodate certification
 # verification for SSL.  # verification for SSL.
 #  #
 # $Id$  # $Id$
Line 36  use lib '/home/httpd/perl/lib'; Line 36  use lib '/home/httpd/perl/lib';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use IO::Socket::SSL();  use IO::Socket::SSL();
 use LWP::UserAgent();  use LWP::UserAgent();
   use LWP::UserAgent::DNS::Hosts();
   use Apache::lonnet;
   
 sub makerequest {  sub makerequest {
     my ($request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_;      my ($remotehostid,$request,$content,$perlvar,$timeout,$verifycert,$use_lc_ca,$debug) = @_;
     unless (ref($perlvar) eq' HASH') {      unless (ref($perlvar) eq' HASH') {
         $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');          $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
     }      }
     my ($certf,$keyf,$caf,@opts);      my ($certf,$keyf,$caf,@opts,$dns_set,$lonhost);
     if (ref($perlvar) eq 'HASH') {      if (ref($perlvar) eq 'HASH') {
         $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};          $lonhost = $perlvar->{'lonHostID'};
         $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};          if ($perlvar->{'lonCertificateDirectory'}) {
         $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};              if ($perlvar->{'lonnetHostnameCertificate'}) {
                   if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'}) {
                       $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};
                   }
               }
               if ($perlvar->{'lonnetPrivateKey'}) {
                   if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'}) {
                       $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};
                   }
               }
               if ($perlvar->{'lonnetCertificateAuthority'}) {
                   if (-e $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'}) {
                       $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};
                   }
               }
           }
     }      }
     if ($debug) {      if ($debug) {
         $IO::Socket::SSL::DEBUG=$debug;          $IO::Socket::SSL::DEBUG=$debug;
     }      }
     my $response;      my ($response,$stdhostname,$remotehostname,$fn);
       if ($request->uri =~ m{^https?://((?:internal\-|)([^/]+))(/raw/.+)$}) {
           $remotehostname = $1;
           $stdhostname = $2;
           $fn = $3;
           $dns_set = &setdns($remotehostid,$remotehostname);
           unless ($remotehostname =~ /^internal\-/) {
               if (($use_lc_ca && $certf && $keyf) &&
                   (&raw_redirected($remotehostid,$lonhost))) {
                   $remotehostname = 'internal-'.$stdhostname;
                   $request->uri('https://'.$remotehostname.$fn);
               }
           }
       }
     if (LWP::UserAgent->VERSION >= 6.00) {      if (LWP::UserAgent->VERSION >= 6.00) {
         my $ssl_opts;          my $ssl_opts;
         if ($use_lc_ca && $certf && $keyf) {          if ($use_lc_ca && $certf && $keyf) {
             $ssl_opts->{'SSL_use_cert'} = 1;              $ssl_opts->{'SSL_use_cert'} = 1;
             $ssl_opts->{'SSL_cert_file'} = $certf;              $ssl_opts->{'SSL_cert_file'} = $certf;
             $ssl_opts->{'SSL_key_file'} = $keyf;              $ssl_opts->{'SSL_key_file'} = $keyf;
               if ($dns_set && $remotehostname) {
                   if ($remotehostname =~ /^internal\-/) {
                       $ssl_opts->{'SSL_hostname'} = $remotehostname;
                   }
               }
         } else {          } else {
             $ssl_opts->{'SSL_use_cert'} = 0;              $ssl_opts->{'SSL_use_cert'} = 0;
         }          }
Line 65  sub makerequest { Line 100  sub makerequest {
             $ssl_opts->{'verify_hostname'} = 1;              $ssl_opts->{'verify_hostname'} = 1;
             $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;              $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
             $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';              $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
             if ($use_lc_ca) {                 if ($use_lc_ca) {
                 $ssl_opts->{'SSL_ca_file'} = $caf;                  $ssl_opts->{'SSL_ca_file'} = $caf;
             }              }
         } else {          } else {
Line 77  sub makerequest { Line 112  sub makerequest {
         if ($timeout) {          if ($timeout) {
             $ua->timeout($timeout);              $ua->timeout($timeout);
         }          }
           if ($use_lc_ca && $remotehostname && $fn) {
               $ua->requests_redirectable(undef);
           }
         if ($content ne '') {          if ($content ne '') {
             $response = $ua->request($request,$content);              $response = $ua->request($request,$content);
         } else {          } else {
             $response = $ua->request($request);              $response = $ua->request($request);
         }          }
           if (($response->code eq '302') && ($fn) && ($remotehostname) &&
               ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
               my $newurl = $response->header('Location');
               unless ($dns_set) {
                   $dns_set = &setdns($remotehostid,$remotehostname);
               }
               if ($use_lc_ca && $certf && $keyf) {
                   $ssl_opts->{'SSL_hostname'} = 'internal-'.$stdhostname;
               }
               $request->uri($newurl);
               if ($content ne '') {
                   $response = $ua->request($request,$content);
               } else {
                   $response = $ua->request($request);
               }
           }
     } else {      } else {
         {          {
             require Net::SSLGlue::LWP;              require Net::SSLGlue::LWP;
Line 90  sub makerequest { Line 144  sub makerequest {
                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;                  $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;
                 $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;                  $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;
                 $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;                  $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;
                   if ($dns_set && $remotehostname) {
                       if ($remotehostname =~ /^internal\-/) {
                           $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
                       }
                   }
             } else {              } else {
                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;                  $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;
             }              }
Line 106  sub makerequest { Line 165  sub makerequest {
             if ($timeout) {              if ($timeout) {
                 $ua->timeout($timeout);                  $ua->timeout($timeout);
             }              }
               if ($use_lc_ca && $remotehostname && $fn) {
                   $ua->requests_redirectable(undef);
               }
             if ($content ne '') {              if ($content ne '') {
                 $response = $ua->request($request,$content);                  $response = $ua->request($request,$content);
             } else {              } else {
                 $response = $ua->request($request);                  $response = $ua->request($request);
             }              }
               if (($response->code eq '302') && ($fn) && ($remotehostname) &&
                   ($response->header('Location') eq 'https://internal-'.$stdhostname.$fn)) {
                   my $newurl = $response->header('Location');
                   unless ($dns_set) {
                       $dns_set = &setdns($remotehostid,$remotehostname);
                   }
                   $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = 'internal-'.$stdhostname;
                   $request->uri($newurl);
                   if ($content ne '') {
                       $response = $ua->request($request,$content);
                   } else {
                       $response = $ua->request($request);
                   }
               }
         }          }
    }     }
      if ($dns_set) {
          $dns_set = &unsetdns();
      }
    return $response;     return $response;
 }  }
   
   sub setdns {
       my ($remotehostid,$remotehostname) = @_;
       my $ip = &Apache::lonnet::get_host_ip($remotehostid);
       if ($remotehostname =~ /^internal\-/) {
           LWP::UserAgent::DNS::Hosts->register_host(
               $remotehostname => $ip,
           );
       } else {
           LWP::UserAgent::DNS::Hosts->register_host(
               'internal-'.$remotehostname => $ip,
           );
       }
       LWP::UserAgent::DNS::Hosts->enable_override;
       return 1;
   }
   
   sub unsetdns {
       LWP::UserAgent::DNS::Hosts->clear_hosts();
       return 0;
   }
   
   sub raw_redirected {
       my ($remotehostid,$lonhost) = @_;
       my $remhostname = &Apache::lonnet::hostname($remotehostid);
       my $redirect;
       if ($remhostname) {
           my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$remotehostid);
           my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/);
           if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) {
               my $internet_names = &Apache::lonnet::get_internet_names($remotehostid);
               if (ref($internet_names) eq 'ARRAY') {
                   my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   unless (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                       my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname);
                       my $remhomedom = &Apache::lonnet::host_domain($remhomeID);
                       my %domdefaults = &Apache::lonnet::get_domain_defaults($remhomedom);
                       my $replication = $domdefaults{'replication'};
                       if (ref($replication) eq 'HASH') {
                           if (ref($replication->{'reqcerts'}) eq 'ARRAY') {
                               if (grep(/^\Q$intdom\E$/,@{$replication->{'reqcerts'}})) {
                                   $redirect = 1;
                               } else {
                                   $redirect = 0;
                               }
                           }
                           if (ref($replication->{'noreqcerts'}) eq 'ARRAY') {
                               if (grep(/^\Q$intdom\E$/,@{$replication->{'noreqcerts'}})) {
                                   $redirect = 0;
                               } else {
                                   $redirect = 1;
                               }
                           }
                       }
                   }
               }
           }
       }
       return $redirect;
   }
   
 1;  1;

Removed from v.1.1  
changed lines
  Added in v.1.2


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>