NetPacket::IP - Assemble and disassemble IP (Internet Protocol) packets.

  use NetPacket::IP;

  $ip_obj = NetPacket::IP->decode($raw_pkt);
  $ip_pkt = NetPacket::IP->encode($ip_obj);
  $ip_data = NetPacket::IP::strip($raw_pkt);

  #!/usr/bin/perl -w

  use strict;
  use Net::PcapUtils;
  use NetPacket::Ethernet qw(:strip);
  use NetPacket::IP;

  sub process_pkt {
      my ($user, $hdr, $pkt) = @_;

      my $ip_obj = NetPacket::IP->decode(eth_strip($pkt));
      print("$ip_obj->{src_ip}:$ip_obj->{dest_ip} $ip_obj->{proto}\n");
  }

  Net::PcapUtils::loop(\&process_pkt, FILTER => 'ip');

#
# NetPacket::IP - Decode and encode IP (Internet Protocol) packets. 
#
# Encoding part by Stephanie Wehner, atrak@itsx.com

package NetPacket::IP;
BEGIN {
  $NetPacket::IP::AUTHORITY = 'cpan:yanick';
}
BEGIN {
  $NetPacket::IP::VERSION = '1.1.2';
}
# ABSTRACT: Assemble and disassemble IP (Internet Protocol) packets.

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use NetPacket;

BEGIN {
    @ISA = qw(Exporter NetPacket);

# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)

    @EXPORT = qw(
    );

# Other items we are prepared to export if requested

    @EXPORT_OK = qw(ip_strip
		    IP_PROTO_IP IP_PROTO_ICMP IP_PROTO_IGMP
		    IP_PROTO_IPIP IP_PROTO_TCP IP_PROTO_UDP
		    IP_VERSION_IPv4
		    IP_FLAG_MOREFRAGS IP_FLAG_DONTFRAG IP_FLAG_CONGESTION
                    IP_MAXPACKET
    );

# Tags:

    %EXPORT_TAGS = (
    ALL         => [@EXPORT, @EXPORT_OK],
    protos      => [qw(IP_PROTO_IP IP_PROTO_ICMP IP_PROTO_IGMP IP_PROTO_IPIP
		       IP_PROTO_TCP IP_PROTO_UDP)],
    versions    => [qw(IP_VERSION_IPv4)],
    strip       => [qw(ip_strip)],
    flags       => [qw(IP_FLAG_MOREFRAGS IP_FLAG_DONTFRAG IP_FLAG_CONGESTION)],
);

}

#
# Partial list of IP protocol values from RFC 1700
#

use constant IP_PROTO_IP   => 0;       # Dummy protocol for TCP
use constant IP_PROTO_ICMP => 1;       # Internet Control Message Protocol
use constant IP_PROTO_IGMP => 2;       # Internet Group Management Protocol
use constant IP_PROTO_IPIP => 4;       # IP in IP encapsulation
use constant IP_PROTO_TCP  => 6;       # Transmission Control Protocol
use constant IP_PROTO_UDP  => 17;      # User Datagram Protocol

#
# Partial list of IP version numbers from RFC 1700
#

use constant IP_VERSION_IPv4 => 4;     # IP version 4

#
# Flag values
#

use constant IP_FLAG_MOREFRAGS  => 1;     # More fragments coming
use constant IP_FLAG_DONTFRAG   => 2;     # Don't fragment me
use constant IP_FLAG_CONGESTION => 4;     # Congestion present

# Maximum IP Packet size
use constant IP_MAXPACKET => 65535;

# Convert 32-bit IP address to dotted quad notation

sub to_dotquad {
    my($net) = @_ ;
    my($na, $nb, $nc, $nd);

    $na = $net >> 24 & 255;
    $nb = $net >> 16 & 255;
    $nc = $net >>  8 & 255;
    $nd = $net & 255;

    return ("$na.$nb.$nc.$nd");
}

#
# Decode the packet
#

sub decode {
    my $class = shift;
    my($pkt, $parent, @rest) = @_;
    my $self = {};

    # Class fields

    $self->{_parent} = $parent;
    $self->{_frame} = $pkt;

    # Decode IP packet

    if (defined($pkt)) {
	my $tmp;

	($tmp, $self->{tos},$self->{len}, $self->{id}, $self->{foffset},
	 $self->{ttl}, $self->{proto}, $self->{cksum}, $self->{src_ip},
	 $self->{dest_ip}, $self->{options}) = unpack('CCnnnCCnNNa*' , $pkt);

	# Extract bit fields
	
	$self->{ver} = ($tmp & 0xf0) >> 4;
	$self->{hlen} = $tmp & 0x0f;
	
	$self->{flags} = $self->{foffset} >> 13;
	$self->{foffset} = ($self->{foffset} & 0x1fff) << 3;

	# Decode variable length header options and remaining data in field

	my $olen = $self->{hlen} - 5;
	$olen = 0 if $olen < 0;  # Check for bad hlen

	# Option length is number of 32 bit words

        $olen = $olen * 4;

	($self->{options}, $self->{data}) = unpack("a" . $olen .
						   "a*", $self->{options});

    my $length = $self->{hlen};
    $length = 5 if $length < 5;  # precaution against bad header

    # truncate data to the length given by the header
    $self->{data} = substr $self->{data}, 0, $self->{len} - 4 * $length;

	# Convert 32 bit ip addresses to dotted quad notation

	$self->{src_ip} = to_dotquad($self->{src_ip});
	$self->{dest_ip} = to_dotquad($self->{dest_ip});
    }

    return bless $self, $class;
}

#
# Strip header from packet and return the data contained in it
#

undef &ip_strip;           # Create ip_strip alias
*ip_strip = \&strip;

sub strip {
    my ($pkt, @rest) = @_;

    my $ip_obj = NetPacket::IP->decode($pkt);
    return $ip_obj->{data};
}   

#
# Encode a packet
#

sub encode {

    my $self = shift;
    my ($hdr,$packet,$zero,$tmp,$offset);
    my ($src_ip, $dest_ip);

    # create a zero variable
    $zero = 0;

    # adjust the length of the packet 
    $self->{len} = ($self->{hlen} * 4) + length($self->{data});

    $tmp = $self->{hlen} & 0x0f;
    $tmp = $tmp | (($self->{ver} << 4) & 0xf0);

    $offset = $self->{flags} << 13;
    $offset = $offset | (($self->{foffset} >> 3) & 0x1fff);

    # convert the src and dst ip
    $src_ip = gethostbyname($self->{src_ip});
    $dest_ip = gethostbyname($self->{dest_ip});

    # construct header to calculate the checksum
    $hdr = pack('CCnnnCCna4a4a*', $tmp, $self->{tos},$self->{len}, 
         $self->{id}, $offset, $self->{ttl}, $self->{proto}, 
         $zero, $src_ip, $dest_ip, $self->{options});

    $self->{cksum} = NetPacket::htons(NetPacket::in_cksum($hdr));

    # make the entire packet
    $packet = pack('CCnnnCCna4a4a*a*', $tmp, $self->{tos},$self->{len}, 
         $self->{id}, $offset, $self->{ttl}, $self->{proto}, 
         $self->{cksum}, $src_ip, $dest_ip, $self->{options},
         $self->{data});

    return($packet);

}

#
# Module initialisation
#

1;

# autoloaded methods go after the END token (&& pod) below

__END__


# any real autoloaded methods go after this line