@@ -69,7 +69,7 @@ sub new {
6969 mirrors => [],
7070 mirror_only => undef ,
7171 mirror_index => undef ,
72- cpanmetadb => " http ://cpanmetadb.plackperl.org/v1.0/"
72+ cpanmetadb => " https ://cpanmetadb.plackperl.org/v1.0/"
7373 perl => $^X,
7474 argv => [],
7575 local_lib => undef ,
@@ -83,6 +83,7 @@ sub new {
8383 try_lwp => 1,
8484 try_wget => 1,
8585 try_curl => 1,
86+ use_http => 0,
8687 uninstall_shadows => ($] < 5.012),
8788 skip_installed => 1,
8889 skip_satisfied => 0,
@@ -200,6 +201,7 @@ sub parse_options {
200201 ' lwp!' => \$self -> {try_lwp },
201202 ' wget!' => \$self -> {try_wget },
202203 ' curl!' => \$self -> {try_curl },
204+ ' insecure!' => \$self -> {use_http },
203205 ' auto-cleanup=s' => \$self -> {auto_cleanup },
204206 ' man-pages!' => \$self -> {pod2man },
205207 ' scandeps' => \$self -> {scandeps },
@@ -526,7 +528,7 @@ sub numify_ver {
526528sub search_metacpan {
527529 my ($self , $module , $version , $dev_release ) = @_ ;
528530
529- my $metacpan_uri = ' http ://fastapi.metacpan.org/v1/download_url/'
531+ my $metacpan_uri = ' https ://fastapi.metacpan.org/v1/download_url/'
530532
531533 my $url = $metacpan_uri . $module ;
532534
@@ -543,7 +545,7 @@ sub search_metacpan {
543545 if ($dist_meta && $dist_meta -> {download_url }) {
544546 (my $distfile = $dist_meta -> {download_url }) =~ s !!!
545547 local $self -> {mirrors } = $self -> {mirrors };
546- $self -> {mirrors } = [ ' http ://cpan.metacpan.org'
548+ $self -> {mirrors } = [ ' https ://cpan.metacpan.org'
547549 return $self -> cpan_module($module , $distfile , $dist_meta -> {version });
548550 }
549551
@@ -619,7 +621,7 @@ sub search_cpanmetadb_history {
619621 for my $try (sort { $b -> {version_obj } cmp $a -> {version_obj } } @found ) {
620622 if ($self -> satisfy_version($module , $try -> {version_obj }, $version )) {
621623 local $self -> {mirrors } = $self -> {mirrors };
622- unshift @{$self -> {mirrors }}, ' http ://backpan.perl.org'
624+ unshift @{$self -> {mirrors }}, ' https ://backpan.perl.org'
623625 unless $try -> {latest };
624626 return $self -> cpan_module($module , $try -> {distfile }, $try -> {version });
625627 }
@@ -747,7 +749,7 @@ Options:
747749 --installdeps Only install dependencies
748750 --showdeps Only display direct dependencies
749751 --reinstall Reinstall the distribution even if you already have the latest version installed
750- --mirror Specify the base URL for the mirror (e.g. http ://cpan.cpantesters.org/)
752+ --mirror Specify the base URL for the mirror (e.g. https ://cpan.cpantesters.org/)
751753 --mirror-only Use the mirror's index file instead of the CPAN Meta DB
752754 -M,--from Use only this mirror base URL and its index file
753755 --prompt Prompt when configure/build/test fails
@@ -767,18 +769,18 @@ Examples:
767769
768770 cpanm Test::More # install Test::More
769771 cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path
770- cpanm http ://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
772+ cpanm https ://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
771773 cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file
772774 cpanm --interactive Task::Kensho # Configure interactively
773775 cpanm . # install from local directory
774776 cpanm --installdeps . # install all the deps for the current directory
775777 cpanm -L extlib Plack # install Plack and all non-core deps into extlib
776- cpanm --mirror http ://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
778+ cpanm --mirror https ://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
777779 cpanm -M https://cpan.metacpan.org App::perlbrew # use only this secure mirror and its index
778780
779781You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
780782
781- export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http ://cpan.cpantesters.org"
783+ export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror https ://cpan.cpantesters.org"
782784
783785Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
784786
@@ -1271,12 +1273,19 @@ sub chdir {
12711273sub configure_mirrors {
12721274 my $self = shift ;
12731275 unless (@{$self -> {mirrors }}) {
1274- $self -> {mirrors } = [ ' http ://www.cpan.org'
1276+ $self -> {mirrors } = [ ' https ://www.cpan.org'
12751277 }
12761278 for (@{$self -> {mirrors }}) {
12771279 s !! file:///!
12781280 s !!!
12791281 }
1282+
1283+ if ( grep { m // $self -> {mirrors }} ) {
1284+ warn " WARNING: Detected a non TLS mirror, enforcing http requests.\n "
1285+ $self -> {use_http } = 1;
1286+ }
1287+
1288+ return ;
12801289}
12811290
12821291sub self_upgrade {
@@ -1761,7 +1770,7 @@ sub cpan_dist {
17611770sub git_uri {
17621771 my ($self , $uri ) = @_ ;
17631772
1764- # similar to http ://www.pip-installer.org/en/latest/logic.html#vcs-support
1773+ # similar to https ://www.pip-installer.org/en/latest/logic.html#vcs-support
17651774 # git URL has to end with .git when you need to use pin @ commit/tag/branch
17661775
17671776 ($uri , my $commitish ) = split /(?<=\.git)@/i, $uri , 2;
@@ -2740,6 +2749,7 @@ sub mirror {
27402749 } else {
27412750 $self -> {_backends }{mirror }-> (@_ );
27422751 }
2752+
27432753}
27442754
27452755sub untar { $_ [0]-> {_backends }{untar }-> (@_ ) };
@@ -2780,7 +2790,9 @@ sub file_mirror {
27802790
27812791sub has_working_lwp {
27822792 my ($self , $mirrors ) = @_ ;
2793+
27832794 my $https = grep /^https:/, @$mirrors ;
2795+ $https = 0 if $self -> {use_http };
27842796 eval {
27852797 require LWP::UserAgent; # no fatpack
27862798 LWP::UserAgent-> VERSION(5.802);
@@ -2798,6 +2810,8 @@ sub init_tools {
27982810 $self -> chat(" You have make $self ->{make}\n "
27992811 }
28002812
2813+ my ( $http_get , $http_mirror );
2814+
28012815 # use --no-lwp if they have a broken LWP, to upgrade LWP
28022816 if ($self -> {try_lwp } && $self -> has_working_lwp($self -> {mirrors })) {
28032817 $self -> chat(" You have LWP $LWP::VERSION \n "
@@ -2810,13 +2824,13 @@ sub init_tools {
28102824 @_ ,
28112825 );
28122826 };
2813- $self -> { _backends }{ get } = sub {
2827+ $http_get = sub {
28142828 my $self = shift ;
28152829 my $res = $ua -> ()-> request(HTTP::Request-> new(GET => $_ [0]));
28162830 return unless $res -> is_success;
28172831 return $res -> decoded_content;
28182832 };
2819- $self -> { _backends }{ mirror } = sub {
2833+ $http_mirror = sub {
28202834 my $self = shift ;
28212835 my $res = $ua -> ()-> mirror(@_ );
28222836 die $res -> content if $res -> code == 501;
@@ -2829,13 +2843,13 @@ sub init_tools {
28292843 ' --retry-connrefused'
28302844 ($self -> {verbose } ? () : (' -q'
28312845 );
2832- $self -> { _backends }{ get } = sub {
2846+ $http_get = sub {
28332847 my ($self , $uri ) = @_ ;
28342848 $self -> safeexec( my $fh , $wget , $uri , @common , ' -O' ' -' or die " wget $uri : $! "
28352849 local $/ ;
28362850 <$fh >;
28372851 };
2838- $self -> { _backends }{ mirror } = sub {
2852+ $http_mirror = sub {
28392853 my ($self , $uri , $path ) = @_ ;
28402854 $self -> safeexec( my $fh , $wget , $uri , @common , ' -O' $path ) or die " wget $uri : $! "
28412855 local $/ ;
@@ -2848,13 +2862,13 @@ sub init_tools {
28482862 ' --user-agent' $self -> agent,
28492863 ($self -> {verbose } ? () : ' -s'
28502864 );
2851- $self -> { _backends }{ get } = sub {
2865+ $http_get = sub {
28522866 my ($self , $uri ) = @_ ;
28532867 $self -> safeexec( my $fh , $curl , @common , $uri ) or die " curl $uri : $! "
28542868 local $/ ;
28552869 <$fh >;
28562870 };
2857- $self -> { _backends }{ mirror } = sub {
2871+ $http_mirror = sub {
28582872 my ($self , $uri , $path ) = @_ ;
28592873 $self -> safeexec( my $fh , $curl , @common , $uri , ' -#' ' -o' $path ) or die " curl $uri : $! "
28602874 local $/ ;
@@ -2866,19 +2880,23 @@ sub init_tools {
28662880 my %common = (
28672881 agent => $self -> agent,
28682882 );
2869- $self -> { _backends }{ get } = sub {
2883+ $http_get = sub {
28702884 my $self = shift ;
28712885 my $res = HTTP::Tiny-> new(%common )-> get($_ [0]);
28722886 return unless $res -> {success };
28732887 return $res -> {content };
28742888 };
2875- $self -> { _backends }{ mirror } = sub {
2889+ $http_mirror = sub {
28762890 my $self = shift ;
28772891 my $res = HTTP::Tiny-> new(%common )-> mirror(@_ );
28782892 return $res -> {status };
28792893 };
28802894 }
28812895
2896+ # handle the insecure mode to honor and force http requests
2897+ $self -> {_backends }{get } = $self -> wrap_http_request( $http_get );
2898+ $self -> {_backends }{mirror } = $self -> wrap_http_request( $http_mirror );
2899+
28822900 my $tar = $self -> which(' tar'
28832901 my $tar_ver ;
28842902 my $maybe_bad_tar = sub { WIN32 || BAD_TAR || (($tar_ver = ` $tar --version 2>/dev/null` / GNU.*1\. 13/i
@@ -3017,6 +3035,40 @@ sub init_tools {
30173035 }
30183036}
30193037
3038+ sub wrap_http_request {
3039+ my ( $self , $code ) = @_ ;
3040+
3041+ die unless ref $code eq ' CODE'
3042+
3043+ my $wrapper = sub {
3044+ my ( $self , $uri , @extra ) = @_ ;
3045+
3046+ # certificates check, let's switch to http on demand.
3047+ $uri =~ s // http:/ if $self -> {use_http };
3048+
3049+ # call the get or mirror
3050+ my $reply = $code -> ( $self , $uri , @extra );
3051+
3052+ if ( ! $self -> {use_http } && $uri =~ m {} $self -> {has_displayed_insecure_advice } ) {
3053+ if ( !defined $reply || $reply eq 500 || $reply =~ m {} mi
3054+
3055+ die <<"DIE"
3056+ Failed to fetch $uri : $reply \n
3057+
3058+ This could be a TLS issue with the HTTP client used.
3059+ Please verify your certificates or force an HTTP-only request/mirror
3060+ using --insecure option at your own risk.
3061+ DIE
3062+ $self -> {has_displayed_insecure_advice } = 1;
3063+ }
3064+ }
3065+
3066+ return $reply ;
3067+ };
3068+
3069+ return $wrapper ;
3070+ }
3071+
30203072sub safeexec {
30213073 my $self = shift ;
30223074 my $rdr = $_ [0] ||= Symbol::gensym();
0 commit comments