--- loncom/LWPReq.pm	2016/07/02 17:55:57	1.1
+++ loncom/LWPReq.pm	2016/07/25 19:49:45	1.2
@@ -1,8 +1,8 @@
 # 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.
 #
-# $Id: LWPReq.pm,v 1.1 2016/07/02 17:55:57 raeburn Exp $
+# $Id: LWPReq.pm,v 1.2 2016/07/25 19:49:45 raeburn Exp $
 #
 # The LearningOnline Network with CAPA
 #
@@ -36,28 +36,63 @@ use lib '/home/httpd/perl/lib';
 use LONCAPA::Configuration;
 use IO::Socket::SSL();
 use LWP::UserAgent();
+use LWP::UserAgent::DNS::Hosts();
+use Apache::lonnet;
 
 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') {
         $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') {
-        $certf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetHostnameCertificate'};
-        $keyf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetPrivateKey'};
-        $caf = $perlvar->{'lonCertificateDirectory'}.'/'.$perlvar->{'lonnetCertificateAuthority'};
+        $lonhost = $perlvar->{'lonHostID'};
+        if ($perlvar->{'lonCertificateDirectory'}) {
+            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) {
         $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) {
         my $ssl_opts;
         if ($use_lc_ca && $certf && $keyf) {
             $ssl_opts->{'SSL_use_cert'} = 1;
             $ssl_opts->{'SSL_cert_file'} = $certf;
             $ssl_opts->{'SSL_key_file'} = $keyf;
+            if ($dns_set && $remotehostname) {
+                if ($remotehostname =~ /^internal\-/) {
+                    $ssl_opts->{'SSL_hostname'} = $remotehostname;
+                }
+            }
         } else {
             $ssl_opts->{'SSL_use_cert'} = 0;
         }
@@ -65,7 +100,7 @@ sub makerequest {
             $ssl_opts->{'verify_hostname'} = 1;
             $ssl_opts->{'SSL_verify_mode'} = IO::Socket::SSL::SSL_VERIFY_PEER;
             $ssl_opts->{'SSL_version'} = 'SSLv23:!SSLv3:!SSLv2';
-            if ($use_lc_ca) {   
+            if ($use_lc_ca) {
                 $ssl_opts->{'SSL_ca_file'} = $caf;
             }
         } else {
@@ -77,11 +112,30 @@ sub makerequest {
         if ($timeout) {
             $ua->timeout($timeout);
         }
+        if ($use_lc_ca && $remotehostname && $fn) {
+            $ua->requests_redirectable(undef);
+        }
         if ($content ne '') {
             $response = $ua->request($request,$content);
         } else {
             $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 {
         {
             require Net::SSLGlue::LWP;
@@ -90,6 +144,11 @@ sub makerequest {
                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 1;
                 $Net::SSLGlue::LWP::SSLopts{'SSL_cert_file'} = $certf;
                 $Net::SSLGlue::LWP::SSLopts{'SSL_key_file'} = $keyf;
+                if ($dns_set && $remotehostname) {
+                    if ($remotehostname =~ /^internal\-/) {
+                        $Net::SSLGlue::LWP::SSLopts{'SSL_hostname'} = $remotehostname;
+                    }
+                }
             } else {
                 $Net::SSLGlue::LWP::SSLopts{'SSL_use_cert'} = 0;
             }
@@ -106,14 +165,94 @@ sub makerequest {
             if ($timeout) {
                 $ua->timeout($timeout);
             }
+            if ($use_lc_ca && $remotehostname && $fn) {
+                $ua->requests_redirectable(undef);
+            }
             if ($content ne '') {
                 $response = $ua->request($request,$content);
             } else {
                 $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;
 }
 
+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;