File Coverage

blib/lib/Net/DHCP/Packet.pm

Criterion	Covered	Total	%
statement	167	319	52.3
branch	62	140	44.2
condition	11	35	31.4
subroutine	36	68	52.9
pod	22	22	100.0
total	298	584	51.0

#!/bin/false
# PODNAME: Net::DHCP::Packet
# Author : D. Hamstead
# Original Author: F. van Dun, S. Hadinger
# ABSTRACT: Object methods to create a DHCP packet.
use strict;
use warnings;
use 5.8.0;

package Net::DHCP::Packet;
$Net::DHCP::Packet::VERSION = '0.7_007'; # TRIAL

$Net::DHCP::Packet::VERSION = '0.7007';use Carp;
use Net::DHCP::Constants qw(:DEFAULT :dhcp_hashes :dhcp_other %DHO_FORMATS %SUBOPTION_FORMATS);
use Net::DHCP::Packet::Attributes qw(:all);
use Net::DHCP::Packet::IPv4Utils qw(:all);
use List::Util qw(first);

#=======================================================================

{

my %newargs = (

    Comment => \&comment,
    Op      => \&op,
    Htype   => \&htype,
    Hlen    => \&hlen,
    Hops    => \&hops,
    Xid     => \&xid,
    Secs    => \&secs,
    Flags   => \&flags,
    Ciaddr  => \&ciaddr,
    Yiaddr  => \&yiaddr,
    Siaddr  => \&siaddr,
    Giaddr  => \&giaddr,
    Chaddr  => \&chaddr,
    Sname   => \&sname,
    File    => \&file,
    Padding => \&padding,
    isDhcp  => \&isDhcp,

);

sub new {

    my $p = shift;
    my $class = ref($p) || $p;

    my $self = {
        options       => {},    # DHCP options
        options_order => [],    # order in which the options were added

        # defaults
        comment => undef,
        op      => BOOTREQUEST(),
        htype   => 1,    # 10mb ethernet
        hlen    => 6,    # Use 6 bytes MAC
        hops    => 0,
        xid     => 0x12345678,
        secs    => 0,
        flags   => 0,
        ciaddr  => "\0\0\0\0",
        yiaddr  => "\0\0\0\0",
        siaddr  => "\0\0\0\0",
        giaddr  => "\0\0\0\0",
        chaddr  => q||,
        sname   => q||,
        file    => q||,
        padding => q||,
        isDhcp  => 1,

    };

    bless $self, $class;
    if ( scalar @_ == 1 ) {     # we build the packet from a binary string
        $self->marshall(shift);
    }
    else {

        my %args         = @_;
        my @ordered_args = @_;

        for my $k (sort keys %args) { # keep the processing order consistent

            next if $k =~ m/^\d+$/; # ignore numbered args

            if ($newargs{$k}) {
                $newargs{$k}->($self, $args{$k});
                next
            }

            carp sprintf 'Ingoring unknown new() argument: %s', $k;

        }

        # TBM add DHCP option parsing
        while ( defined( my $key = shift @ordered_args ) ) {

            my $value = shift @ordered_args;
            if ($key =~ m/^\d+$/) {
                $self->addOptionValue( $key, $value );
            }
        }
    }

    return $self

}

}

sub addOptionRaw {
    my ( $self, $key, $value_bin, $sort ) = @_;
    $self->{options}->{$key} = $value_bin;
    push @{ $self->{options_order} }, $key;

    return 1 if $sort;

#FIXME    @{ $self->{options_order} } = sort optionsorder @{ $self->{options_order} };

    return 1
}

sub addOptionValue {
    my $self  = shift;
    my $code  = shift;    # option code
    my $value = shift;

    # my $value_bin;      # option value in binary format

    carp("addOptionValue: unknown format for code ($code)")
      unless exists $DHO_FORMATS{$code};

    my $format = $DHO_FORMATS{$code};

    if ( $format eq 'suboption' ) {
        carp 'Use addSubOptionValue to add sub options';
        return;
    }

    # decompose input value into an array
    my @values;
    if ( defined $value && $value ne q|| ) {
        @values =
          split( /[\s\/,;]+/, $value );    # array of values, split by space
    }

    # verify number of parameters
    if ( $format eq 'string' || $format eq 'csr' ) {
        @values = ($value);      # don't change format
    }
    elsif ( $format =~ m/s$/ ) { # ends with an 's', meaning any number of parameters
        ;
    }
    elsif ( $format =~ m/2$/ ) { # ends with a '2', meaning couples of parameters
        croak(
            "addOptionValue: only pairs of values expected for option '$code'")
          if ( ( @values % 2 ) != 0 );
    }
    else {                      # only one parameter
        croak("addOptionValue: exactly one value expected for option '$code'")
          if ( @values != 1 );
    }

    my %options = (

        inet   => sub { return packinet(shift) },
        inets  => sub { return packinets_array(@_) },
        inets2 => sub { return packinets_array(@_) },
        int    => sub { return pack( 'N', shift ) },
        short  => sub { return pack( 'n', shift ) },
        # 255 & trims the input to single octet
        byte   => sub { return pack( 'C', 255 & shift ) },
        bytes  => sub {
            return pack( 'C*', map { 255 & $_ } @_ );
        },
        string     => sub { return shift },
        clientid   => sub { return packclientid(shift) },
        sipserv    => sub { return packsipserv(shift) },
        csr        => sub { return packcsr(shift) },
        suboptions => sub { return packsuboptions(@_) },

    );

    #  } elsif ($format eq 'ids') {
    #    $value_bin = $values[0];
    #    # TBM bad format

    # decode the option if we know how, otherwise use the original value
    $self->addOptionRaw( $code, $options{$format}
        ? $options{$format}->(@values)
        : $value );

}    # end AddOptionValue

sub addSubOptionRaw {
    my ( $self, $key, $subkey, $value_bin ) = @_;
    $self->{options}->{$key}->{$subkey} = $value_bin;

    if ( !grep( /$key/, @{$self->{options_order}} ) ) {
        push @{ $self->{options_order} }, $key;
    }
    push @{ $self->{sub_options_order}{$key} }, ($subkey);
}

sub addSubOptionValue {

    my $self    = shift;
    my $code    = shift;    # option code
    my $subcode = shift;    # sub option code
    my $value   = shift;
    # my $value_bin;          # option value in binary format

    # FIXME
    carp("addSubOptionValue: unknown format for code ($code)")
      unless exists $DHO_FORMATS{$code};

    carp("addSubOptionValue: not a suboption parameter for code ($code)")
      unless ( $DHO_FORMATS{$code} eq 'suboptions' );

    carp(
"addSubOptionValue: unknown format for subcode ($subcode) on code ($code)"
      )
      unless ( $DHO_FORMATS{$code} eq 'suboptions' );

    carp("addSubOptionValue: no suboptions defined for code ($code)?")
      unless exists $SUBOPTION_CODES{$code};

    carp(
        "addSubOptionValue: suboption ($subcode) not defined for code ($code)?")
      unless exists $SUBOPTION_CODES{$code}->{$subcode};

    my $format = $SUBOPTION_FORMATS{$code}->{$subcode};

    # decompose input value into an array
    my @values;
    if ( defined $value && $value ne q|| ) {
        @values =
          split( /[\s\/,;]+/, $value );    # array of values, split by space
    }

    # verify number of parameters
    if ( $format eq 'string' ) {
        @values = ($value);                # don't change format
    }
    elsif ( $format =~ m/s$/ )
    {    # ends with an 's', meaning any number of parameters
        ;
    }
    elsif ( $format =~ m/2$/ )
    {    # ends with a '2', meaning couples of parameters
        croak(
"addSubOptionValue: only pairs of values expected for option '$code'"
        ) if ( ( @values % 2 ) != 0 );
    }
    else {    # only one parameter
        croak(
            "addSubOptionValue: exactly one value expected for option '$code'")
          if ( @values != 1 );
    }

    my %options = (
        inet   => sub { return packinet(shift) },
        inets  => sub { return packinets_array(@_) },
        inets2 => sub { return packinets_array(@_) },
        int    => sub { return pack( 'N', shift ) },
        short  => sub { return pack( 'n', shift ) },
        byte   => sub { return pack( 'C', 255 & shift ) }
        ,    # 255 & trims the input to single octet
        bytes => sub {
            return pack( 'C*', map { 255 & $_ } @_ );
        },
        string => sub { return shift },
        hexa => sub { return pack( 'H*', shift ) },
    );

    #  } elsif ($format eq 'ids') {
    #    $value_bin = $values[0];
    #    # TBM bad format

    # decode the option if we know how, otherwise use the original value
    $self->addSubOptionRaw( $code, $subcode, $options{$format}
        ? $options{$format}->(@values)
        : $value );

}

sub getOptionRaw {
    my ( $self, $key ) = @_;
    return $self->{options}->{$key}
      if exists( $self->{options}->{$key} );
    return
}

sub getOptionValue {
    my $self = shift;
    my $code = shift;

    carp("getOptionValue: unknown format for code ($code)")
      unless exists( $DHO_FORMATS{$code} );

    my $format = $DHO_FORMATS{$code};
    my $subcodes;

    if ($format eq 'suboptions') {
        $subcodes = $REV_SUBOPTION_CODES{$code} || {}
    }

    my $value_bin = $self->getOptionRaw($code);

    return unless defined $value_bin;

    # my @values;

    # hash out these options for speed and sanity
    my %options = (
        inet   => sub { return unpackinets_array(shift) },
        inets  => sub { return unpackinets_array(shift) },
        inets2 => sub { return unpackinets_array(shift) },
        int    => sub { return unpack( 'N', shift ) },
        short  => sub { return unpack( 'n', shift ) },
        shorts => sub { return unpack( 'n*', shift ) },
        byte   => sub { return unpack( 'C', shift ) },
        bytes  => sub { return unpack( 'C*', shift ) },
        string => sub { return shift },
        clientid   => sub { return unpackclientid(shift) },
        sipserv    => sub { return unpacksipserv(shift) },
        csr        => sub { return unpackcsr(shift) },
        suboptions => sub { return unpacksuboptions(shift) },

    );

    #  } elsif ($format eq 'ids') {
    #    $values[0] = $value_bin;
    #    # TBM, bad format

    # decode the options if we know the format
    if ($options{$format}) {
        $value_bin = join(q|, |,
        map { ref $_ ? sprintf '%s => %s', $subcodes->{$_->[0]} || $_->[0], # FIXME needs to guess if hex or ascii, quote if whitespace padding
            unpack('a*',$_->[1]) : $_ }
        ( $options{$format}->($value_bin) ))
    }

    # if we cant work out the format
    return $value_bin

}   # getOptionValue

sub getSubOptionRaw {
    my ( $self, $key, $subkey ) = @_;
    return $self->{options}->{$key}->{$subkey}
      if exists( $self->{options}->{$key}->{$subkey} );
    return;
}

sub getSubOptionValue {

    # FIXME
    #~ my $self = shift;
    #~ my $code = shift;
    #~
    #~ carp("getOptionValue: unknown format for code ($code)")
    #~ unless exists( $DHO_FORMATS{$code} );
    #~
    #~ my $format = $DHO_FORMATS{$code};
    #~
    #~ my $value_bin = $self->getOptionRaw($code);
    #~
    #~ return unless defined $value_bin;
    #~
    #~ my @values;
    #~
    #~ # hash out these options for speed and sanity
    #~ my %options = (
    #~ inet   => sub { return unpackinets_array(shift) },
    #~ inets  => sub { return unpackinets_array(shift) },
    #~ inets2 => sub { return unpackinets_array(shift) },
    #~ int    => sub { return unpack( 'N', shift ) },
    #~ short  => sub { return unpack( 'n', shift ) },
    #~ shorts => sub { return unpack( 'n*', shift ) },
    #~ byte   => sub { return unpack( 'C', shift ) },
    #~ bytes  => sub { return unpack( 'C*', shift ) },
    #~ string => sub { return shift },
    #~
    #~ );
    #~
    #~ #  } elsif ($format eq 'relays') {
    #~ #    @values = $self->decodeRelayAgent($value_bin);
    #~ #    # TBM, bad format
    #~ #  } elsif ($format eq 'ids') {
    #~ #    $values[0] = $value_bin;
    #~ #    # TBM, bad format
    #~
    #~ # decode the options if we know the format
    #~ return join( q| |, $options{$format}->($value_bin) )
    #~ if $options{$format};
    #~
    #~ # if we cant work out the format
    #~ return $value_bin

}    # getSubOptionValue

sub removeOption {
    my ( $self, $key ) = @_;
    if ( exists( $self->{options}->{$key} ) ) {
        my $i =
          first { $self->{options_order}->[$_] == $key }
        0 .. $#{ $self->{options_order} };

        #        for ( $i = 0 ; $i < @{ $self->{options_order} } ; $i++ ) {
        #            last if ( $self->{options_order}->[$i] == $key );
        #        }
        if ( $i < @{ $self->{options_order} } ) {
            splice @{ $self->{options_order} }, $i, 1;
        }
        delete( $self->{options}->{$key} );
    }
}

sub removeSubOption {

# FIXME
#~ my ( $self, $key ) = @_;
#~ if ( exists( $self->{options}->{$key} ) ) {
#~ my $i = first { $self->{options_order}->[$_] == $key } 0..$#{ $self->{options_order} };
#~ #        for ( $i = 0 ; $i < @{ $self->{options_order} } ; $i++ ) {
#~ #            last if ( $self->{options_order}->[$i] == $key );
#~ #        }
#~ if ( $i < @{ $self->{options_order} } ) {
#~ splice @{ $self->{options_order} }, $i, 1;
#~ }
#~ delete( $self->{options}->{$key} );
#~ }

}

#=======================================================================
my $BOOTP_FORMAT = 'C C C C N n n a4 a4 a4 a4 a16 Z64 Z128 a*';

#my $DHCP_MIN_LENGTH = length(pack($BOOTP_FORMAT));
#=======================================================================
sub serialize {
    use bytes;
    my ($self)  = shift;
    my $options = shift;    # reference to an options hash for special options
    my $bytes   = undef;

    $bytes = pack( $BOOTP_FORMAT,
        $self->{op},     $self->{htype},  $self->{hlen},   $self->{hops},
        $self->{xid},    $self->{secs},   $self->{flags},  $self->{ciaddr},
        $self->{yiaddr}, $self->{siaddr}, $self->{giaddr}, $self->{chaddr},
        $self->{sname},  $self->{file} );

    if ( $self->{isDhcp} ) {    # add MAGIC_COOKIE and options
        $bytes .= MAGIC_COOKIE();
        for my $key ( @{ $self->{options_order} } ) {
            if ( ref($self->{options}->{$key}) eq 'ARRAY' ) {
                for my $value ( @{$self->{options}->{$key}} ) {
                    $bytes .= pack( 'C',    $key );
                    $bytes .= pack( 'C/a*', $value );
                }
            } elsif ( ref($self->{options}->{$key}) eq 'HASH' ) {
                my $subbytes = q{};
                for my $subkey ( @{ $self->{sub_options_order}->{$key} } ) {
                    $subbytes .= pack( 'C',    $subkey );
                    $subbytes .= pack( 'C/a*', $self->{options}->{$key}->{$subkey} );
                }
                $bytes .= pack( 'C',    $key );
                $bytes .= pack( 'C', length $subbytes ) . $subbytes;
            } else {
                $bytes .= pack( 'C',    $key );
                $bytes .= pack( 'C/a*', $self->{options}->{$key} );
            }
        }
        $bytes .= pack( 'C', 255 );
    }

    $bytes .= $self->{padding};    # add optional padding

    # add padding if packet is less than minimum size
    my $min_padding = BOOTP_MIN_LEN() - length($bytes);
    if ( $min_padding > 0 ) {
        $bytes .= "\0" x $min_padding;
    }

    # test if packet is not bigger than absolute maximum MTU
    if ( length($bytes) > DHCP_MAX_MTU() ) {
        croak(  'serialize: packet too big ('
              . length($bytes)
              . ' greater than max MAX_MTU ('
              . DHCP_MAX_MTU() );
    }

    # test if packet length is not bigger than DHO_DHCP_MAX_MESSAGE_SIZE
    if ( $options
        && exists( $options->{ DHO_DHCP_MAX_MESSAGE_SIZE() } ) )
    {

        # maximum packet size is specified
        my $max_message_size = $options->{ DHO_DHCP_MAX_MESSAGE_SIZE() };
        if (   ( $max_message_size >= BOOTP_MIN_LEN() )
            && ( $max_message_size < DHCP_MAX_MTU() ) )
        {

            # relevant message size
            if ( length($bytes) > $max_message_size ) {
                croak(  'serialize: message is bigger than allowed ('
                      . length($bytes)
                      . '), max specified :'
                      . $max_message_size );
            }
        }
    }

    return $bytes

}    # end sub serialize

#=======================================================================
sub marshall {

    use bytes;
    my ( $self, $buf ) = @_;
    my $opt_buf;

    if ( length($buf) < BOOTP_ABSOLUTE_MIN_LEN() ) {
        croak( sprintf
            'marshall: packet too small (%d), absolute minimum size is %d',
            length($buf),
            BOOTP_ABSOLUTE_MIN_LEN() );
    }
    if ( length($buf) < BOOTP_MIN_LEN() ) {
        carp( sprintf
            'marshall: packet too small (%d), minimum size is %d',
            length($buf),
            BOOTP_MIN_LEN() );
    }
    if ( length($buf) > DHCP_MAX_MTU() ) {
        croak( sprintf
            'marshall: packet too big (%d), max MTU size is %s',
            length($buf),
            DHCP_MAX_MTU() );
    }

    # if we are re-using this object, then we need to clear out these arrays
    delete $self->{options}
      if $self->{options};
    delete $self->{options_order}
      if $self->{options_order};

    (
        $self->{op},     $self->{htype},  $self->{hlen},   $self->{hops},
        $self->{xid},    $self->{secs},   $self->{flags},  $self->{ciaddr},
        $self->{yiaddr}, $self->{siaddr}, $self->{giaddr}, $self->{chaddr},
        $self->{sname},  $self->{file},   $opt_buf
    ) = unpack( $BOOTP_FORMAT, $buf );

    $self->{isDhcp} = 0;    # default to BOOTP
    if (   ( length( $opt_buf ) > 4 )
        && ( substr( $opt_buf, 0, 4 ) eq MAGIC_COOKIE() ) )
    {

        # it is definitely DHCP
        $self->{isDhcp} = 1;

        my $pos   = 4;     # Skip magic cookie
        my $total = length($opt_buf);
        my $type;

        while ( $pos < $total ) {

            $type = ord( substr( $opt_buf, $pos++, 1 ) );
            next if ( $type eq DHO_PAD() );  # Skip padding bytes
            last if ( $type eq DHO_END() );  # Type 'FF' signals end of options.
            my $len = ord( substr( $opt_buf, $pos++, 1 ) ); # FIXME sanity check length
            my $option = substr( $opt_buf, $pos, $len );
            $pos += $len;
            $self->addOptionRaw( $type, $option, 1 );

        }

        # verify that we ended with an "END" code
        if ( $type != DHO_END() ) {
            croak('marshall: unexpected end of options');
        }

        # put remaining bytes in the padding attribute
        if ( $pos < $total ) {
            $self->{padding} = substr( $opt_buf, $pos, $total - $pos );
        }
        else {
            $self->{padding} = q||;
        }

    }
    else {

        # in bootp, everything is padding
        $self->{padding} = $opt_buf;

    }

    return $self

}   # end sub marshall

#=======================================================================
sub toString {
    my $self = shift;
    my $s;

    $s .= sprintf( "comment = %s\n", $self->comment() )
      if defined( $self->comment() );
    $s .= sprintf(
        "op = %s\n",
        (
            exists( $REV_BOOTP_CODES{ $self->op() } )
              && $REV_BOOTP_CODES{ $self->op() }
          )
          || $self->op()
    );
    $s .= sprintf(
        "htype = %s\n",
        (
            exists( $REV_HTYPE_CODES{ $self->htype() } )
              && $REV_HTYPE_CODES{ $self->htype() }
          )
          || $self->htype()
    );
    $s .= sprintf( "hlen = %s\n",   $self->hlen() );
    $s .= sprintf( "hops = %s\n",   $self->hops() );
    $s .= sprintf( "xid = %x\n",    $self->xid() );
    $s .= sprintf( "secs = %i\n",   $self->secs() );
    $s .= sprintf( "flags = %x\n",  $self->flags() );
    $s .= sprintf( "ciaddr = %s\n", $self->ciaddr() );
    $s .= sprintf( "yiaddr = %s\n", $self->yiaddr() );
    $s .= sprintf( "siaddr = %s\n", $self->siaddr() );
    $s .= sprintf( "giaddr = %s\n", $self->giaddr() );
    $s .= sprintf( "chaddr = %s\n",
        substr( $self->chaddr(), 0, 2 * $self->hlen() ) );
    $s .= sprintf( "sname = %s\n", $self->sname() );
    $s .= sprintf( "file = %s\n",  $self->file() );
    $s .= "Options : \n";

    for my $key ( @{ $self->{options_order} } ) {
        my $value;    # value of option to be printed

        if ( $key == DHO_DHCP_MESSAGE_TYPE() ) {
            $value = $self->getOptionValue($key);
            $value =
              ( exists( $REV_DHCP_MESSAGE{$value} )
                  && $REV_DHCP_MESSAGE{$value} )
              || $self->getOptionValue($key);
        }
        else {

            if ( exists( $DHO_FORMATS{$key} ) ) {
                if ( $DHO_FORMATS{$key} eq 'suboptions' ) {
                    for my $subkey ( @{ $self->{sub_options_order}->{$key} } ) {
                        my $subvalue = join( q| |, $self->getSubOptionValue($key,$subkey) );  # FIXME fix the getSubOptionValue function
                        $subvalue =~
                            s/([[:^print:]])/ sprintf q[\x%02X], ord $1 /eg;
                        $s .= sprintf( "   %s(%d) = %s\n",
                            exists $SUBOPTION_CODES{$key} ? $REV_SUBOPTION_CODES{$key}{$subkey} : '',
                            $key, $subvalue );
                    }
                    $value = 'see above';
                } else {
                    $value = join( q| |, $self->getOptionValue($key) );
                }
            }
            else {
                $value = $self->getOptionRaw($key);
		print "went here for $key\n";
            }

            # convert to printable text
            $value =~
              s/([[:^print:]])/ sprintf q[\x%02X], ord $1 /eg;
        }
        $s .= sprintf( " %s(%d) = %s\n",
            exists $REV_DHO_CODES{$key} ? $REV_DHO_CODES{$key} : '',
            $key, $value );
    }
    $s .= sprintf(
        "padding [%s] = %s\n",
        length( $self->{padding} ),
        unpack( 'H*', $self->{padding} )
    );

    return $s

}   # end toString

#=======================================================================
# internal utility functions

sub packsuboptions {
    my @relay_opt = @_
      or return;

    my $buf = '';
    for my $opt (@relay_opt) {
        my $value = pack( 'C/a*', $opt->[1]);
        $buf .= pack( 'C', $opt->[0])
             . pack( 'C', length($value))
             . $value;
    }

    return pack( 'C', length($buf) ) . $buf
}

sub unpacksuboptions {     # prints a human readable suboptions

    use bytes;
    my $opt_buf = shift or return;

    my @relay_opt;
    my $pos   = 0;
    my $total = length($opt_buf);

    while ( $pos < $total ) {
        my $type = ord( substr( $opt_buf, $pos++, 1 ) );
        my $len  = ord( substr( $opt_buf, $pos++, 1 ) ); # FIXME check this more
        my $option = substr( $opt_buf, $pos, $len );
        $pos += $len;
        push @relay_opt, [ $type, $option ];
    }

    return @relay_opt

}

sub packclientid {
   return shift
   # croak('pack clientid field still WIP');
}

sub unpackclientid {

    my $clientid = shift
      or return;

    my $type = unpack('C',substr( $clientid, 0, 1 ));

    if ($type == 0) { # text
        return substr( $clientid, 1, length($clientid) )
    }
    if ($type == 1) { # ethernet
        return unpack('H*',substr( $clientid, 1, length($clientid) ))
    }

    return $clientid

}

sub packsipserv {
   return shift
   # croak('pack sipserv field still WIP');
}

sub unpacksipserv {

    my $sipserv = shift
      or return;

    my $type = unpack('C',substr( $sipserv, 0, 1 ));

#    if ($type == 0) { # text
#        return substr( $sipserv, 1, length($clientid) )
#    }
    if ($type == 1) { # ipv4
        return unpackinet(substr( $sipserv, 1, length($sipserv) ))
    }

    return $sipserv

}

sub packcsr {
    # catch empty value
    my $results = [ '' ];

    for my $pair ( @{$_[0]} ) {
        push @$results, ''
            if (length($results->[-1]) > 255 - 8);

        my ($ip, $mask) = split /\//, $pair->[0];
        $mask = '32'
                unless (defined($mask));

        my $addr = packinet($ip);
        $addr = substr $addr, 0, int(($mask - 1)/8 + 1);

        $results->[-1] .= pack('C', $mask) . $addr;
        $results->[-1] .= packinet($pair->[1]);
    }

    return $results;
}

sub unpackcsr {
    my $csr = shift
      or return;

   croak('unpack csr field still WIP');

}

#=======================================================================

1;

__END__