From bb16842f9a670da25fdebbcbc4dcdc3ee52cd76f Mon Sep 17 00:00:00 2001
From: Matt Selsky <selsky@columbia.edu>
Date: Fri, 23 Jan 2015 11:11:13 +0000
Subject: Bug 662161: enhance testserver.pl to deal with missing support for
 HTTPS. r=gerv, a=glob.

---
 testserver.pl | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'testserver.pl')

diff --git a/testserver.pl b/testserver.pl
index d827c80ea..7ee7fe929 100755
--- a/testserver.pl
+++ b/testserver.pl
@@ -26,6 +26,8 @@ my $datadir = bz_locations()->{'datadir'};
 
 eval "require LWP; require LWP::UserAgent;";
 my $lwp = $@ ? 0 : 1;
+eval "require LWP::Protocol::https;";
+my $lwpssl = $@ ? 0 : 1;
 
 if ((@ARGV != 1) || ($ARGV[0] !~ /^https?:/i))
 {
@@ -212,12 +214,16 @@ sub fetch {
     my $url = shift;
     my $rtn;
     if ($lwp) {
-        my $req = HTTP::Request->new(GET => $url);
-        my $ua = LWP::UserAgent->new;
-        my $res = $ua->request($req);
-        $rtn = ($res->is_success ? $res->content : undef);
+        if ($url =~ /^https:/i && !$lwpssl) {
+            die("You need LWP::Protocol::https installed to use https with testserver.pl");
+        } else {
+            my $req = HTTP::Request->new(GET => $url);
+            my $ua = LWP::UserAgent->new;
+            my $res = $ua->request($req);
+            $rtn = ($res->is_success ? $res->content : undef);
+        }
     } elsif ($url =~ /^https:/i) {
-        die("You need LWP installed to use https with testserver.pl");
+        die("You need LWP (and LWP::Protocol::https, for LWP 6.02 or newer) installed to use https with testserver.pl");
     } else {
         my($host, $port, $file) = ('', 80, '');
         if ($url =~ m#^http://([^:]+):(\d+)(/.*)#i) {
-- 
cgit v1.2.3-24-g4f1b