package W3C::Validator::UserAgent;

use LWP::UserAgent  1.90 qw(); # Need 1.90 for protocols_(allowed|forbidden)
use Net::hostent         qw(gethostbyname);
use Net::IP              qw();
use Socket6              qw(inet_ntop);

use base qw(LWP::UserAgent);

sub new {
  my ($proto, $CFG, $File, @rest) = @_;
  my $class = ref($proto) || $proto;
  my $self = $class->SUPER::new(@rest);
  $self->{'W3C::Validator::CFG'}  = $CFG;
  $self->{'W3C::Validator::File'} = $File;
  return $self; 
}

sub redirect_ok { 
  my ($self, $req, $res) = @_;
  return $self->SUPER::redirect_ok($req, $res) && $self->uri_ok($req->uri());
} 

sub uri_ok {
  my ($self, $uri) = @_;
  return 1 if ($self->{'W3C::Validator::CFG'}->{'Allow Private IPs'} or
               !$uri->can('host'));

  my $addr = my $iptype = my $host = undef;
  if ( $host = gethostbyname($uri->host())) {
    $addr = inet_ntop($host->addrtype,$host->addr()) if $host->addr();
    if ($addr && (my $ip = Net::IP->new($addr))) {
      $iptype = $ip->iptype();
    }
  }
  
  if ( $uri->host() == "[::1]" || ($iptype && $iptype ne 'PUBLIC') ) {
    my $File = $self->{'W3C::Validator::File'};
    $File->{'Error Flagged'} = 1;
    $File->{Templates}->{Error}->param(fatal_ip_error    => 1);
    $File->{Templates}->{Error}->param(fatal_ip_hostname => 1)
      if $addr and $uri->host() ne $addr;
    $File->{Templates}->{Error}->param(fatal_ip_host =>
                                       ($uri->host() || 'undefined') );
     return 0;
  }
  return 1;
}