HttpsCheck.pl

#!/usr/bin/perl

use LWP::UserAgent;
use Storable;
use strict;

# set up our user agent
mkdir(".cache") unless -d ".cache";
my $ua = LWP::UserAgent->new(
    ssl_opts => {
	verify_hostname => 1,
	ssl_version => "TLSv1_2",
    }
);
$ua->agent("CPANchecker");
$ua->timeout(2); # note aggressive two second timeout.

# get the latest CPAN mirror list
my $r = $ua->mirror("https://www.cpan.org/MIRRORED.BY", ".cache/MIRRORED.BY");
die "can't get mirror list: $!" unless -e ".cache/MIRRORED.BY";


# build a list of unique URLs for plausible HTTPS mirrors
my %urls;
open(MIRROR, "<", ".cache/MIRRORED.BY") || die $!;
while(<MIRROR>){
    next if /^#/;
    next unless /dst_http/;
    my($url) = /"(http.+)"/;
    next unless $url;
    $url =~ s|http\:\/\/|https://|;
    $urls{$url} = 1;
    # print "add $url\n";
}
close(MIRROR);

# check to see if HTTPS with TLS 1.2 is actually available.
# use the cache if we've done this before.
my $okurlRef;
if(-e '.cache/urlrefs'){
    $okurlRef = retrieve('.cache/urlrefs');
} else {
    my %okurls;    
    foreach my $url(keys(%urls)){
	# print "try $url\n";
	my $r = $ua->get($url);
	if($r->is_success){
	    print "ok $url\n";
	    $okurls{$url}++;
	} else {
	    print "NOK $url ".$r->status_line."\n";
	}
    }
    $okurlRef = \%okurls;
    store($okurlRef, '.cache/urlrefs') or die "couldn't store urlref cache?? $!";
}

# create a "patched" MIRRORED.BY file that adds https support
# for mirrors that seem to be valid.
open(MIRROR, "<", ".cache/MIRRORED.BY") || die $!;
open(MIRRORHTTPS, ">", "MIRRORED.BY.patched") || die $!;
while(<MIRROR>){
    print MIRRORHTTPS;
    next if /^#/;
    next unless /dst_http/;
    my($url) = /"(http.+)"/;
    next unless $url;
    $url =~ s|http\:\/\/|https://|;
    if($okurlRef->{$url}){
	print MIRRORHTTPS "  dst_https        = \"".$url."\"\n";
    }
}
close(MIRROR);
close(MIRRORHTTPS);