File Coverage

blib/lib/Alien/Build/Plugin/Fetch/HostBlockList.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	5	8	62.5
condition	2	3	66.6
subroutine	7	7	100.0
pod	1	1	100.0
total	45	49	91.8

package Alien::Build::Plugin::Fetch::HostBlockList;

use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use URI;

# ABSTRACT: Reject any Alien::Build fetch requests going to hosts in the block list
our $VERSION = '0.01'; # VERSION


has '+block_hosts' => sub { [
  defined $ENV{ALIEN_BUILD_HOST_BLOCK}
  ? split /,/, $ENV{ALIEN_BUILD_HOST_BLOCK}
  : ()
] };

sub init
{
  my($self, $meta) = @_;

  my %blocked = map { $_ => 1 } @{ $self->block_hosts };

  $meta->around_hook( fetch => sub {

    my $orig = shift;
    my $build = shift;
    my $url = $_[0] || $build->meta_prop->{start_url};

    if($url =~ /:/)
    {
      my $url = URI->new($url);
      if($url->scheme ne 'file')
      {
        my $host = eval { $url->host };
        die "unable to determine host from $url: $@" if $@;
        die "The host $host is in the block list" if $blocked{$host};
      }
    }

    $orig->($build, @_);
  });
}


1;

__END__