Net::Packet::TCP - Transmission Control Protocol layer 4 object

   use Net::Packet::Consts qw(:tcp);
   require Net::Packet::TCP;

   # Build a layer
   my $layer = Net::Packet::TCP->new(
      dst     => 22,
      options => "\x02\x04\x05\xb4", # MSS=1460
   );
   $layer->pack;

   print 'RAW: '.unpack('H*', $layer->raw)."\n";

   # Read a raw layer
   my $layer = Net::Packet::TCP->new(raw => $raw);

   print $layer->print."\n";
   print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n"
      if $layer->payload;

#
# $Id: TCP.pm 1640 2009-11-09 17:58:27Z gomor $
#
package Net::Packet::TCP;
use strict;
use warnings;

require Net::Packet::Layer4;
our @ISA = qw(Net::Packet::Layer4);

use Net::Packet::Utils qw(inetChecksum getRandomHighPort getRandom32bitsInt
   inetAton inet6Aton);
use Net::Packet::Consts qw(:tcp :layer);

our @AS = qw(
   src
   dst
   flags
   win
   seq
   ack
   off
   x2
   checksum
   urp
   options
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

no strict 'vars';

sub new {
   shift->SUPER::new(
      src      => getRandomHighPort(),
      dst      => 0,
      seq      => getRandom32bitsInt(),
      ack      => 0,
      x2       => 0,
      off      => 0,
      flags    => NP_TCP_FLAG_SYN,
      win      => 0xffff,
      checksum => 0,
      urp      => 0,
      options  => "",
      @_,
   );
}

sub recv {
   my $self = shift;
   my ($frame) = @_;

   my $env  = $frame->env;
   my $dump = $env->dump;

   for ($dump->framesFor($frame)) {
      if (($_->l4->[$__ack] == $frame->l4->[$__seq] + 1
           || $_->l4->[$__flags] & NP_TCP_FLAG_RST)
      &&  $_->timestamp ge $frame->timestamp) {
         return $_;
      }
   }

   my $l2Key = ($frame->l2 && $frame->l2->getKeyReverse($frame))  || 'all';
   my $l3Key = ($frame->l3 && $frame->l3->is.':'.$frame->l3->src) || 'all';
   my $l4Key = ($frame->l4 && 'ICMP')                             || 'all';

   my $href = $dump->framesSorted;
   for (@{$href->{$l2Key}{$l3Key}{$l4Key}}) {
      if (($_->timestamp ge $frame->timestamp)
      &&   $_->l4->error
      &&  ($_->l4->error->l4->[$__src] == $self->[$__src])
      &&  ($_->l4->error->l4->[$__dst] == $self->[$__dst])) {
         return $_;
      }
   }
   
   undef;
}

sub pack {
   my $self = shift;

   my $offX2Flags =
      ($self->[$__off] << 12)|(0x0f00 & ($self->[$__x2] << 8))|(0x00ff & $self->[$__flags]);

   $self->[$__raw] = $self->SUPER::pack('nnNNnnnn',
      $self->[$__src],
      $self->[$__dst],
      $self->[$__seq],
      $self->[$__ack],
      $offX2Flags,
      $self->[$__win],
      $self->[$__checksum],
      $self->[$__urp],
   ) or return undef;

   if ($self->[$__options]) {
      $self->[$__raw] =
         $self->[$__raw].$self->SUPER::pack('a*', $self->[$__options])
            or return undef;
   }

   1;
}

sub unpack {
   my $self = shift;

   my ($src, $dst, $seq, $ack, $offX2Flags, $win, $checksum, $urp, $payload) =
      $self->SUPER::unpack('nnNNnnnn a*', $self->[$__raw])
         or return undef;

   $self->[$__src]      = $src;
   $self->[$__dst]      = $dst;
   $self->[$__seq]      = $seq;
   $self->[$__ack]      = $ack;
   $self->[$__off]      = ($offX2Flags & 0xf000) >> 12;
   $self->[$__x2]       = ($offX2Flags & 0x0f00) >> 8;
   $self->[$__flags]    = $offX2Flags & 0x00ff;
   $self->[$__win]      = $win;
   $self->[$__checksum] = $checksum;
   $self->[$__urp]      = $urp;
   $self->[$__payload]  = $payload;

   my ($options, $payload2) = $self->SUPER::unpack(
      'a'. $self->getOptionsLength. 'a*', $self->[$__payload]
   ) or return undef;

   $self->[$__options] = $options;
   $self->[$__payload] = $payload2;

   1;
}

sub getLength { my $self = shift; $self->[$__off] ? $self->[$__off] * 4 : 0 }
sub getHeaderLength { NP_TCP_HDR_LEN }
sub getOptionsLength {
   my $self = shift;
   my $gLen = $self->getLength;
   my $hLen = $self->getHeaderLength;
   $gLen > $hLen ? $gLen - $hLen : 0;
}

sub computeLengths {
   my $self = shift;
   my ($env, $l2, $l3, $l4, $l7) = @_;

   my $hLen = NP_TCP_HDR_LEN;
   $hLen   += length($self->[$__options]) if $self->[$__options];
   $self->[$__off] = $hLen / 4;
}

sub computeChecksums {
   my $self = shift;
   my ($env, $l2, $l3, $l4, $l7) = @_;

   my $offX2Flags = ($self->[$__off] << 12) | (0x0f00 & ($self->[$__x2] << 8))
                  | (0x00ff & $self->[$__flags]);

   my $phpkt;
   # Handle checksumming with DescL2&3
   if ($l3) {
      if ($l3->isIpv4) {
         $phpkt = $self->SUPER::pack('a4a4CCn',
            inetAton($l3->src),
            inetAton($l3->dst),
            0,
            $l3->protocol,
            $l3->getPayloadLength,
         ) or return undef;
      }
      elsif ($l3->isIpv6) {
         $phpkt = $self->SUPER::pack('a*a*NnCC',
            inet6Aton($l3->src),
            inet6Aton($l3->dst),
            $l3->payloadLength,
            0,
            0,
            $l3->nextHeader,
         ) or return undef;
      }
   }
   # Handle checksumming with DescL4
   else {
      my $totalLength = $self->getLength;
      $totalLength += $l7->getLength if $l7;

      if ($env->desc->isFamilyIpv4) {
         $phpkt = $self->SUPER::pack('a4a4CCn',
            inetAton($env->ip),
            inetAton($env->desc->target),
            0,
            $env->desc->protocol,
            $totalLength,
         ) or return undef;
      }
      elsif ($env->desc->isFamilyIpv6) {
         $phpkt = $self->SUPER::pack('a*a*NnCC',
            inet6Aton($env->ip6),
            inet6Aton($env->desc->target),
            $totalLength,
            0,
            0,
            $env->desc->protocol,
         ) or return undef;
      }
   }

   # Reset the checksum if already filled by a previous pack
   $self->[$__checksum] = 0;

   $phpkt .= $self->SUPER::pack('nnNNnnnn',
      $self->[$__src],
      $self->[$__dst],
      $self->[$__seq],
      $self->[$__ack],
      $offX2Flags,
      $self->[$__win],
      $self->[$__checksum],
      $self->[$__urp],
   ) or return undef;

   if ($self->[$__options]) {
      $phpkt .= $self->SUPER::pack('a*', $self->[$__options])
         or return undef;
   }

   if ($l7 && $l7->data) {
      $phpkt .= $self->SUPER::pack('a*', $l7->data)
         or return undef;
   }

   $self->[$__checksum] = inetChecksum($phpkt);

   1;
}

sub encapsulate { shift->[$__payload] ? NP_LAYER_7 : NP_LAYER_NONE }

sub getKey {
   my $self = shift;
   $self->is.':'.$self->[$__src].'-'.$self->[$__dst];
}

sub getKeyReverse {
   my $self = shift;
   $self->is.':'.$self->[$__dst].'-'.$self->[$__src];
}

sub print {
   my $self = shift;

   my $i = $self->is;
   my $l = $self->layer;
   my $buf = sprintf
      "$l:+$i: src:%d  dst:%d  seq:0x%04x  ack:0x%04x \n".
      "$l: $i: off:0x%02x  x2:0x%01x  flags:0x%02x  win:%d  checksum:0x%04x  ".
      "urp:0x%02x",
         $self->[$__src],
         $self->[$__dst],
         $self->[$__seq],
         $self->[$__ack],
         $self->[$__off],
         $self->[$__x2],
         $self->[$__flags],
         $self->[$__win],
         $self->[$__checksum],
         $self->[$__urp];

   if ($self->[$__options]) {
      $buf .= sprintf("\n$l: $i: optionsLength:%d  options:%s",
         $self->getOptionsLength,
         $self->SUPER::unpack('H*', $self->[$__options])
      ) or return undef;
   }

   $buf;
}

#
# Helpers
#

sub _haveFlag   { (shift->flags & shift) ? 1 : 0    }
sub haveFlagFin { shift->_haveFlag(NP_TCP_FLAG_FIN) }
sub haveFlagSyn { shift->_haveFlag(NP_TCP_FLAG_SYN) }
sub haveFlagRst { shift->_haveFlag(NP_TCP_FLAG_RST) }
sub haveFlagPsh { shift->_haveFlag(NP_TCP_FLAG_PSH) }
sub haveFlagAck { shift->_haveFlag(NP_TCP_FLAG_ACK) }
sub haveFlagUrg { shift->_haveFlag(NP_TCP_FLAG_URG) }
sub haveFlagEce { shift->_haveFlag(NP_TCP_FLAG_ECE) }
sub haveFlagCwr { shift->_haveFlag(NP_TCP_FLAG_CWR) }

1;

__END__