Net::DNS::ToolKit::RR - Resource Record class loader

Net-DNS-ToolKit documentation Contained in the Net-DNS-ToolKit distribution.

Index

Code Index:

NAME

Top

Net::DNS::ToolKit::RR - Resource Record class loader

SYNOPSIS

Top

  use Net::DNS::ToolKit::RR;

  ($get,$put,$parse) = new Net::DNS::ToolKit::RR;
	or
  ($get,$put,$parse) = Net::DNS::ToolKit::RR->new;

	retrieve the next record (type unknown)
  ($newoff,$name,$type,$class,$ttl,$rdlength,$rdata,...)
	= $get->next(\$buffer,$offset);

	parse the current record (type in input fields)
  ($name,$typeTXT,$classTXT,$ttlTXT,$rdlength,$RDATA,...)
	= $parse->RR($name,$type,$class,$ttl,$rdlength,
			$rdata,...);

  ($newoff,@dnptrs)=$put->XYZ(\$buffer,$offset,\@dnptrs,
	$name,$type,$class,$ttl,$rdata,...);

  The 'get' and 'parse' operations can also be done
  by specific record type...
  ...but why would you use them instead of 'next' & 'RR'?

  ($newoff,$name,$type,$class,$ttl,$rdlength,$rdata,...)
	= $get->XYZ(\$buffer,$offset);

  ($name,$typeTXT,$classTXT,$ttlTXT,$rdlength,$RDATA,...)
	= $parse->XYZ($name,$type,$class,$ttl,$rdlength,
			$rdata,...);

	or you can use the individual methods 
	directly without calling "new"

  @output=Net::DNS::ToolKit::RR::get->next(@input);
  @output=Net::DNS::ToolKit::RR::get->XYZ(@input);
  @output=Net::DNS::ToolKit::RR::put->XYZ(@input);
  @output=Net::DNS::ToolKit::RR::parse->RR(@input);
  @output=Net::DNS::ToolKit::RR::parse->XYZ(@input);

The Question section is a special case:

  ($newoff,$name,type,class) = 
	$get->Question(\$buffer,$offset);
  ($newoff,@dnptrs) = 
	$put->Question(\$buffer,$offset,
	$name,$type,$class,\@dnptrs);
  ($name,$typeTXT,$classTXT) =
	$parse->Question($name,$type,$class);

ALTERNATE PUT METHOD SYNOPSIS

Top

An alternate method for put is available for class specific submissions. This eliminates the need to specify TYPE and CLASS when doing a put. The generic form of a put command using this method is shown below but NOT detailed in the method descriptions.

  ($get,$put,$parse) = new Net::DNS::ToolKit::RR(class_type);
	or
  ($get,$put,$parse) = Net::DNS::ToolKit::RR->new(C_IN);

The generic form of a put operation then becomes:

  ($newoff,@dnptrs)=$put->XYZ(\$buffer,$offset,\@dnptrs,
	$name,$ttl,$rdate,...)

The only class currently supported at this time is C_IN.

NOTE: the use of this alternate method changes the number of required arguments to ALL put RR operations. These changes are NOT noted below in the method descriptions.

DESCRIPTION

Top

Net::DNS::ToolKit::RR is the class loader for Resource Record classes. It provides an extensible wrapper for existing classes as well as the framework to easily add new RR classes. See: Net::DNS::ToolKit::RR::Template

  From RFC 1035

  3.2.1. Format

  All RRs have the same top level format shown below:

                                    1  1  1  1  1  1
      0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                      NAME                     |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                      TYPE                     |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                     CLASS                     |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                      TTL                      |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                   RDLENGTH                    |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--|
    |                     RDATA                     |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+

  NAME	an owner name, i.e., the name of the node to which this
	resource record pertains.

  TYPE	two octets containing one of the RR TYPE codes.

  CLASS	two octets containing one of the RR CLASS codes.

  TTL	a 32 bit signed integer that specifies the time interval
	that the resource record may be cached before the source
	of the information should again be consulted.  Zero
	values are interpreted to mean that the RR can only be
	used for the transaction in progress, and should not be
	cached.  For example, SOA records are always distributed
	with a zero TTL to prohibit caching.  Zero values can
	also be used for extremely volatile data.

  RDLENGTH an unsigned 16 bit integer that specifies the length
	in octets of the RDATA field.

  RDATA	a variable length string of octets that describes the
	resource.  The format of this information varies
	according to the TYPE and CLASS of the resource record.
* ($get,$put,$parse) = new Net::DNS::ToolKit::RR;

Retrieves the method pointers to get, put, and parse for Queston section and Resource Records of a particular type.

* ($newoff,@common,$rdata,...) = $get->next(\$buffer,$offset);

Get the next Resource Record.

  input:	pointer to buffer,
		offset into buffer

  returns:	offset to next RR or section,
		(items common to all RR's)
   i.e.	$name,$type,$class,$ttl,$rdlength,
		$rdata,.... for this RR
	    or	undef if the RR is unsupported.

HERE IS THE OPPORTUNITY FOR YOU TO ADD TO THIS PACKAGE. If your RR of interest is not supported, see:

  Net::DNS::ToolKit::RR::Template in:
  .../Net/DNS/ToolKit/Template/Template.pm

Build the support for your Resource Record and submit it to CPAN as an extension to this package.

UN-IMPLEMENTED methods: $get->[unimplemented] returns a correct offset to the following RR, correct @common data and a single $rdata element containing a null ... "\0" to be precise. This works as either a numeric 0 (zero) or an end of string.

* ($newoff,@dnptrs)=$put->XYZ(\$buffer,$offset,\@dnptrs, $name,$type,$class,$ttl,$rdata,...);

Append a resource record of type XYZ to the current buffer. This is the generic form of a put.

  input:	pointer to buffer,
		offset,	[should be end of buffer]
		pointer to compressed name array,
		(items common to all RR's)
   i.e.	$name,$type,$class,$ttl,
		$rdata,.... for this RR
		in binary form if appropriate

  returns:	offset to end of RR,
		new pointer array,
	   or	empty list if the RR type is
		unsupported

  See: note above about writing new RR's

UN-IMPLEMENTED methods: $put->[unimplemented] fails miserably with a DIE statement identifying the offending method.

* (@COMMON,$RDATA) = $parse->XYZ(@common,$rdata,...);

Convert non-printable and numeric data common to all records and the RR specific rdata into ascii text. In many cases this is a null operation. i.e. for a TXT record. However, for a RR of type A, the operation would be as follows:

	EXAMPLE
Common:

  name       is already text.
  type       numeric to text
  class      numeric to text
  ttl        numeric to text
  rdlength   is a number
  rdata      RR specific conversion

Resource Record A returns $rdata containing a packed IPv4 network address. The parse operation would be:

input:

  name       foo.bar.com
  type       1
  class      1
  ttl        123
  rdlength   4
  rdata      a packed IPv4 address

output:

  name       foo.bar.com
  type       T_A
  class      C_IN
  ttl        123 # 2m 3s
  rdlength   4
  rdata      192.168.20.40

The rdata conversion is implemented internally as:

  $dotquad = inet_ntoa($networkaddress);

  where $dotquad is a printable IP address like
	192.168.20.55

UN-IMPLEMENTED methods: $parse->[unimplemented] returns correct @common elements insofar as the type and class are present in Net::DNS::Codes. Other elements are passed through unchanged. i.e. garbage-in, garbage-out.

* ($newoff,$name,type,class) = $get->Question(\$buffer,$offset);
  Get the Question.

  input:	pointer to buffer,
		offset
  returns:	domain name,
		question type,
		question class
* ($newoff,@dnptrs) = $put->Question(\$buffer,$offset, $name,$type,$class,\@dnptrs);

Append a question to the $buffer. Returns a new pointer array for compressed names and the offset to the next RR.

NOTE: it is up to the user to update the question count. See: put_qdcount

Since the question usually is the first record to be appended to the buffer, @dnptrs may be ommitted. See the details at dn_comp.

Usage: ($newoff,@dnptrs)=$put->Question(\$buffer,$offset, $name,$type,$class);

  input:	pointer to buffer,
		offset into buffer,
		domain name,
		question type,
		question class,
		pointer to array of
		  previously compressed names,
  returns:	offset to next record,
		updated array of offsets to
		  previous compressed names
* ($name,$typeTXT,$classTXT) = $parse->Question($name,$type,$class);

Convert non-printable and numeric data into ascii text.

  input:	domain name,
		question type (numeric)
		question class (numeric)
  returns:	domain name,
		type TEXT,
		class TEXT

DEPENDENCIES

Top

	Net::DNS::ToolKit

EXPORT

Top

	none

AUTHOR

Top

Michael Robinton <michael@bizsystems.com>

COPYRIGHT

Top

    Copyright 2003, Michael Robinton <michael@bizsystems.com>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

See also:

Top

Net::DNS::Codes(3), Net::DNS::ToolKit(3), Net::DNS::ToolKit::RR::Template(3)

Net-DNS-ToolKit documentation Contained in the Net-DNS-ToolKit distribution. 
package Net::DNS::ToolKit::RR;

#use 5.006;
use strict;
#use diagnostics;
#use warnings;

use Net::DNS::Codes qw(:RRs);
use Net::DNS::ToolKit qw(
	get16
	get32
	put16
	put32
	getstring
	dn_comp
	dn_expand
);
use vars qw($VERSION $autoload *sub);
require Net::DNS::ToolKit::Question;

$VERSION = do { my @r = (q$Revision: 0.06 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

sub remoteload {
#    *sub = $autoload;
    (my $RRtype = $autoload ) =~ s/.*::(\w+):://;
    # function = $1, one of get,put,parse
    ($autoload,$_) = instantiate($RRtype,$1);
#    my $code = 'package '. __PACKAGE__ .'::'. $1 .'; '.'*'. $RRtype .'=\&'. $autoload;
    my $code = 'package '. __PACKAGE__ .'::'. $1 .'; '.'*'. $RRtype .
	q| = sub { unshift @_,'|. $autoload . q|'; &|. $_ .'};';
    eval "$code";

# print "AUTOLOAD=",*sub,";\n";
# print "subname=$autoload RRtype=$RRtype func=$1\n";
# print 'code=', $code, "\n";

#    no strict;
#    eval { *sub = sub { unshift @_,$autoload; &$_ } };
#    goto &{*sub};
    unshift @_,$autoload;
    goto &$_;
}

# return target function, target interpreter
sub instantiate {
    my($RRtype,$func) = @_;
    if ($RRtype eq 'DESTROY') {	# should never get here
	die __PACKAGE__.".pm: DESTROY must be defined internally in the calling package\n";
    } else {
	my $filename = __PACKAGE__.'::'.$RRtype.'.pm';
	$filename =~ s#::#/#g;
	my $save = $@;
	eval { local $SIG{__DIE__}; require $filename };
	if ($@) {
	    die __PACKAGE__.'::RR'.$func.' not implemented'
		if $func eq 'put';
	    $@ = $save;
	    $RRtype = 'NotImplemented';
	}
    }
    # package from local scope
    return (__PACKAGE__.'::'.$RRtype.'::'.$func, __PACKAGE__.'::RR'.$func);
}

# return instantiated function
sub make_function {
  my $type = shift;
  (caller(1))[3] =~ /RR(\w+)$/;
  my $action = $1;
  if (($_ = TypeTxt->{$type}) && $_ =~ /T_(.+)/) {	# type is real?
    my $function = __PACKAGE__.'::'.$1;
    if ($function->can($action)) {	# if function is instantiated
      return $function .= '::'.$action;
    } else {				# instantiate it or NotImplemented
      return (instantiate($1,$action))[0];
    }
  } else {
  return __PACKAGE__.'::NotImplemented::'.$action;
  }
}  

#########################################################
#	implements the common portion of...
#  ($newoff,$name,$type,$class,$ttl,$rdlength,$rdata,...)
#        = $get->next(\$buffer,$offset);

sub RRget {
  my($function,$self,$bp,$newoff) = @_;
  my ($off,$name) = dn_expand($bp,$newoff);
  (my $type, $off) = get16($bp,$off);
  (my $class, $off) = get16($bp,$off);
  (my $ttl, $off) = get32($bp,$off);
  my $rdlength = get16($bp,$off);	# scalar context, don't get offset
  $function = make_function($type) unless $function;
  no strict;
  ($off, my @results) = &$function($self,$bp,$off);
  return($off,$name,$type,$class,$ttl,$rdlength,@results);
}

#########################################################
#	implements the common portions of...
#  ($newoff,@dnptrs)=$put->XYZ(\$buffer,$offset,\@dnptrs,
#        $name,$type,$class,$ttl,$rdata,...);

sub RRput {
  # extract common elements from input, shrink input
  # input was: $function,$self,\$buffer,$offset,\@dnptrs,$name,$type,$class,$ttl,@rdata
  my ($func,$put,$bp,$off,$dnp,$name,$type,$class,$ttl) = @_;
  if (exists $_[1]->{class}) {
    ($func,$put,$bp,$off,$dnp,$name,$ttl) = splice(@_,0,7);
    $class = $put->{class};
    $func =~ /.+::(.+)::put$/;
    $type = 'T_'.$1;
    no strict;
    $type = &$type;
  } else {
    ($func,$put,$bp,$off,$dnp,$name,$type,$class,$ttl) = splice(@_,0,9);
  }
  # input is now: @rdata
  ($off, my @dnptrs) = dn_comp($bp,$off,\$name,$dnp);
  unless (@dnptrs) {		# if not valid return
    while(shift) {};		# empty the input array
    return ();			# error
  }
  return () unless ($off = put16($bp,$off,$type));
  # the rest should work since offset has been checked
  $off = put16($bp,$off,$class);# class
  $off = put32($bp,$off,$ttl);# ttl
  no strict;
  &$func($self,$bp,$off,\@dnptrs,@_);
}

####################################################################
#	implements the common portion of...
#  ($name,$typeTXT,$classTXT,$ttl,$rdlength,$RDATA,...)
#        = $parse->XYZ($name,$type,$class,$ttl,$rdlength,$rdata,...)

sub RRparse {
  # extract common elements from input, shrink input
  # input was: $function,$self,$name,$type,$class,$ttl,$rdlength,@rdata
  my $function = shift;
  # input is now: $name,$type,$class,$ttl,$rdlength,@rdata
  my ($name,$type,$class,$ttl,$rdlength) = splice(@_,1,5);	# pass @_ to $function call
  $name .= '.';	# terminate domain name
  $function = make_function($type) unless $function;
  no strict;
  return($name,TypeTxt->{$type},ClassTxt->{$class},$ttl,$rdlength,&{$function}(@_));
}

#####################################################################
######################### sub PACKAGES ##############################
#####################################################################

{
  package Net::DNS::ToolKit::RR::NotImplemented;

  sub get {
    my($self,$bp,$offset) = @_;
    (my $rdlength, $offset) = &Net::DNS::ToolKit::get16($bp,$offset);
    $offset += $rdlength;
    return($offset,"\0");
  }

# die in loader, unimplemented
#  sub put {
#    my($bp,$off,$dp) = @_;
#    return($off,@$dp);
#  }
  
  sub parse {
    shift;	# $self
    return(@_);	# garbage in, garbage out
  }
}

{
    package Net::DNS::ToolKit::RR::get;
    use vars qw($AUTOLOAD);

    # preload Question
    *Question = \&Net::DNS::ToolKit::Question::get;

    sub AUTOLOAD {
	$Net::DNS::ToolKit::RR::autoload = $AUTOLOAD;
	goto &Net::DNS::ToolKit::RR::remoteload;
    }
    sub next {
      unshift @_,undef;	# flag to RRget;
      goto &Net::DNS::ToolKit::RR::RRget;
    }
    sub EmptyList {()};
    sub DESTROY {};
}

{
    package Net::DNS::ToolKit::RR::put;
    use vars qw($AUTOLOAD);

    # preload Question
    *Question = \&Net::DNS::ToolKit::Question::put;

    sub AUTOLOAD {
	$Net::DNS::ToolKit::RR::autoload = $AUTOLOAD;
	goto &Net::DNS::ToolKit::RR::remoteload;
    }
    sub DESTROY {};
}

{
    package Net::DNS::ToolKit::RR::parse;
    use vars qw($AUTOLOAD);

    # preload Question
    *Question = \&Net::DNS::ToolKit::Question::parse;

    sub AUTOLOAD {
	$Net::DNS::ToolKit::RR::autoload = $AUTOLOAD;
	goto &Net::DNS::ToolKit::RR::remoteload;
    }
    sub RR {
      unshift @_,undef; # flag to RRparse; 
      goto &Net::DNS::ToolKit::RR::RRparse;
    }
    sub DESTROY {};
}


sub new {
  my ($proto,$class) = @_;
  my $package = ref($proto) || $proto;
  my $get  = {};
  bless ($get, "${package}::get");
  my $put = ($class && ClassTxt->{$class})
	? { class => $class, } : {};
  bless ($put, "${package}::put");
  my $parse = {};
  bless ($parse, "${package}::parse");
  return ($get,$put,$parse);
}


1;
__END__


1;