Net::DNS::RR::APL::ApItem - DNS APL ApItem

package Net::DNS::RR::APL::ApItem;
#
# $Id: ApItem.pm 764 2008-12-24 09:36:37Z olaf $
#


use Net::DNS::Resolver::Base;
use Socket;
use strict;
BEGIN { 
    eval { require bytes; }
} 
use vars qw(@ISA $VERSION);

@ISA     = qw(Net::DNS::RR);

$VERSION = (qw$LastChangedRevision: 684 $)[1];


use Data::Dumper;

sub new {
	my $caller = shift;
	my $class = ref($caller) || $caller;
	my $self={
		  address => '',
		  addressfamily => '',
		  negation => '',
		  prefix => '',
		 };
	my $input=shift;
	bless $self, $class;
	return $self->parse($input) if defined($input);  # returns undef when parse fails
	return $self;
}



#  The textual representation of an APL RR in a DNS zone file is as
#   follows:
#
#   <owner>   IN   <TTL>   APL   {[!]afi:address/prefix}*
#
#   The data consists of zero or more strings of the address family
#   indicator <afi>, immediately followed by a colon ":", an address,
#   immediately followed by the "/" character, immediately followed by a
#   decimal numeric value for the prefix length.  Any such string may be
#   preceded by a "!" character.  The strings are separated by
#   whitespace.  The <afi> is the decimal numeric value of that
#   particular address family.

sub parse {
	my $self=shift;
	my $input=shift;
	if($input=~/(!?)([12])\:(.+)\/(\d{1,3})/){
		my $negation=$1;
		my $addressfamily=$2;
		my $address=$3;
		my $prefix=$4;
		# Sanity check
		return if ( ($addressfamily == 1) && (! Net::DNS::Resolver::Base::_ip_is_ipv4($address) || $prefix > 32 )); 
		return if ( ($addressfamily == 2) && (! Net::DNS::Resolver::Base::_ip_is_ipv6($address) || $prefix > 128 )); 
		return if ( $addressfamily > 2 );

		$self->address($address);
		$self->addressfamily($addressfamily);
		$self->prefix($prefix);
		$self->negation($negation);
		 
		return $self;
	}
	#Pattern match failed.
	return;
}
sub print {	print &string, "\n"; }

sub string {
	my $self=shift;
	my $dat= $self->negation ? "!" : "";
	$dat .= $self->addressfamily() .":" .
	  $self->address."/".$self->prefix;
	return $dat;
}




# APL RDATA format
#
#   The RDATA section consists of zero or more items (<apitem>) of the
#   form
#
#      +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
#      |                          ADDRESSFAMILY                        |
#      +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
#      |             PREFIX            | N |         AFDLENGTH         |
#      +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
#      /                            AFDPART                            /
#      |                                                               |
#      +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
#
#      ADDRESSFAMILY     16 bit unsigned value as assigned by IANA
#                        (see IANA Considerations)
#      PREFIX            8 bit unsigned binary coded prefix length.
#                        Upper and lower bounds and interpretation of
#                        this value are address family specific.
#      N                 negation flag, indicates the presence of the
#                        "!" character in the textual format.  It has
#                        the value "1" if the "!" was given, "0" else.
#      AFDLENGTH         length in octets of the following address
#                        family dependent part (7 bit unsigned).
#      AFDPART           address family dependent part.  See below.
#
#  @self

sub rdata {
	my $self=shift;
	my $rdata;
	return unless ((exists $self->{'addressfamily'}) &&
		       (exists $self->{'address'}) &&
		       (exists $self->{'prefix'}));
	
	if ($self->{'addressfamily'}==1){
		$rdata=pack ("n",0x0001);
		$rdata.=pack ("C",$self->prefix());
		my $data .= &stripzerobytes(inet_aton($self->address()));
		$rdata.=pack("C", ($self->negation()? (0x80|length($data)):length($data) ));
		$rdata.=$data;
	}elsif ($self->{'addressfamily'}==2){
		$rdata=pack ("n",0x0002);
		$rdata.=pack ("C",$self->prefix());
		my @addr = split(/:/, $self->{"address"});
		my $data=&stripzerobytes(pack("n8", map { hex $_ } @addr ));
		$rdata.=pack("C", ($self->negation()? (0x80|length($data)):length($data) ));
	        $rdata.=$data;
	}else{
		#NOT Defined, return empty A data
		return;
	}
	
	return $rdata;
}


sub stripzerobytes {
	my @a = unpack('C*',shift);
	my @b;
	my $notseenval=1;
	while (defined(my $a=pop( @a))){
		unshift @b,$a unless ($a==0 && $notseenval);
		next unless $notseenval;
		$notseenval= !$a;
	}
	return pack("C*",@b);
}

sub new_from_wire {
	my $caller = shift;
	my $class = ref($caller) || $caller;
	my ($data, $offset) = @_;
	
	my $orgoffset=$offset;
	my $self={
		  address => '',
		  addressfamily => '',
		  negation => '',
		  prefix => '',
		 };
	bless $self, $class;

	$self->addressfamily( unpack('n',substr($data,$offset,2)));
	$offset+=2;
	$self->prefix( unpack('C',substr($data,$offset,1)));
	$offset+=1;
	my $negandlength=unpack('C',substr($data,$offset,1));
	$self->negation( 0x80 == ( $negandlength & 0x80));
	$offset+=1;
	my $length= $negandlength & 0x7f;
	return if (length($data)< $offset+$length);
	if ($self->addressfamily==1){
		# pack(Cy,unpack("C*",$foo)) is a hack to pad with trailing 0s.
		$self->{"address"} = 
		  inet_ntoa(  pack("C4",unpack("C*",substr($data, $offset,$length) )));
	}elsif($self->addressfamily==2){
		my $extracted=substr($data, $offset,$length);
		# pack(Cy,unpack("C*",$foo)) is a hack to pad with trailing 0s.
		my @addr = unpack("n8", pack("C16",unpack("C*",substr($data, $offset,$length) )));
		$self->{"address"} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x", @addr);
	}else{
		#FORMERR
		return;
	}
	$offset+=$length;
	return $self,$offset;
}