frame.pm

SinFP是一种新的识别对方计算机操作系统类型的工具

#
# $Id: Frame.pm,v 1.3.2.9 2006/10/29 12:36:41 gomor Exp $
#
package Net::Packet::Frame;
use warnings;
use strict;
use Carp;

require Class::Gomor::Array;
our @ISA = qw(Class::Gomor::Array);

require Net::Packet::Dump;
require Net::Packet::ETH;
require Net::Packet::ARP;
require Net::Packet::IPv4;
require Net::Packet::IPv6;
require Net::Packet::TCP;
require Net::Packet::UDP;
require Net::Packet::ICMPv4;
require Net::Packet::Layer7;
require Net::Packet::NULL;
require Net::Packet::RAW;
require Net::Packet::SLL;

use Time::HiRes qw(gettimeofday);
use Net::Packet::Env qw($Env);
use Net::Packet::Consts qw(:dump :layer :arp);

our @AS = qw(
   env
   raw
   padding
   l2
   l3
   l4
   l7
   reply
   timestamp
   noPadding
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

no strict 'vars';

sub _gettimeofday {
   my ($sec, $usec) = gettimeofday();
   sprintf("%d.%06d", $sec, $usec);
}

sub new {
   my $self = shift->SUPER::new(
      timestamp => _gettimeofday(),
      env       => $Env,
      noPadding => 0,
      @_,
   );

   my $env = $self->[$__env];

   if (! $env->noFrameAutoDesc && ! $env->desc) {
      if ($self->[$__l2]) {
         require Net::Packet::DescL2;
         $env->desc(Net::Packet::DescL2->new);
         $self->cgDebugPrint(1, "DescL2 object created");
      }
      elsif ($self->[$__l3]) {
         require Net::Packet::DescL3;
         $env->desc(Net::Packet::DescL3->new(
            target => $self->[$__l3]->dst,
         ));
         $self->cgDebugPrint(1, "DescL3 object created");
      }
      elsif ($self->[$__l4]) {
         confess("@{[(caller(0))[3]]}: you must manually create a DescL4 ".
                 "object\n");
      }
   }

   if (! $env->noFrameAutoDump && ! $env->dump) {
      require Net::Packet::Dump;
      my $dumpFilter = ($env->dump && $env->dump->filter);
      $env->dump(
         Net::Packet::Dump->new(
            filter => $dumpFilter || $self->getFilter,
         ),
      );
      $self->cgDebugPrint(1, "Dump object created");
   }

   $self->[$__raw] ? $self->unpack : $self->pack;
}

sub getLengthFromL7 {
   my $self = shift;
   $self->[$__l7] ? $self->[$__l7]->getLength : 0;
}
sub getLengthFromL4 {
   my $self = shift;
   my $len  = 0;
   $len    += $self->[$__l4]->getLength if $self->[$__l4];
   $len    += $self->getLengthFromL7;
   $len || 0;
}
sub getLengthFromL3 {
   my $self = shift;
   my $len  = 0;
   $len    += $self->[$__l3]->getLength if $self->[$__l3];
   $len    += $self->getLengthFromL4;
   $len || 0;
}
sub getLengthFromL2 {
   my $self = shift;
   my $len  = 0;
   $len    += $self->[$__l2]->getLength if $self->[$__l2];
   $len    += $self->getLengthFromL3;
   $len || 0;
}
sub getLength { shift->getLengthFromL3 }

sub _unpackFromL3 {
   my $self = shift;

   my $nextLayer;
   while (1) {
      my $l3;

      # First, try IPv4
      $l3 = Net::Packet::IPv4->new(raw => $self->[$__raw]) or return undef;
      unless ($l3->version == 4) {
         # Then IPv6
         $l3 = Net::Packet::IPv6->new(raw => $self->[$__raw]) or return undef;
         unless ($l3->version == 6) {
            # Then ARP
            $l3 = Net::Packet::ARP->new(raw => $self->[$__raw]) or return undef;
            unless ($l3->hType eq NP_ARP_HTYPE_ETH) {
               carp("@{[(caller(0))[3]]}: unknown frame, unable to unpack\n");
               return undef;
            }
         }
      }

      if ($l3->encapsulate eq NP_LAYER_UNKNOWN) {
         carp("@{[(caller(0))[3]]}: unknown Layer4 protocol\n");
         last;
      }

      $self->[$__l3] = $l3;

      last if $self->[$__l3]->encapsulate eq NP_LAYER_NONE;
      $nextLayer = NP_LAYER. $self->[$__l3]->encapsulate;

      $self->[$__l4] = $nextLayer->new(raw => $self->[$__l3]->payload)
         or return undef;

      # Here, no check; it is just raw layer 7 application data
      last if $self->[$__l4]->encapsulate eq NP_LAYER_NONE;
      $nextLayer = NP_LAYER. $self->[$__l4]->encapsulate;

      $self->[$__l7] = $nextLayer->new(raw => $self->[$__l4]->payload)
         or return undef;
   
      last;
   }

   $self;
}

sub unpack {
   my $self = shift;

   my $whichLink = {
      NP_DUMP_LINK_NULL()   =>
         sub { Net::Packet::NULL->new(raw => $self->[$__raw]) },
      NP_DUMP_LINK_EN10MB() =>
         sub { Net::Packet::ETH->new(raw => $self->[$__raw])  },
      NP_DUMP_LINK_RAW()    =>
         sub { Net::Packet::RAW->new(raw => $self->[$__raw])  },
      NP_DUMP_LINK_SLL()    =>
         sub { Net::Packet::SLL->new(raw => $self->[$__raw])  },
   };

   my $nextLayer;
   while (1) {
      unless (exists $whichLink->{$self->[$__env]->dump->link}) {
         carp("Unable to unpack Frame for this datalink type: ".
              "@{[$self->[$__env]->dump->link]}\n");
         last;
      }

      my $l2 = $whichLink->{$self->[$__env]->dump->link}() or return undef;

      $self->[$__l2] = $l2;

      # For example, with a raw Datalink type (RAW.pm),
      # we don't know what is encapsulated
      if ($self->[$__l2]->encapsulate eq NP_LAYER_UNKNOWN) {
         return $self->_unpackFromL3;
      }

      last if $self->[$__l2]->encapsulate eq NP_LAYER_NONE;
      $nextLayer = NP_LAYER. $self->[$__l2]->encapsulate;

      $self->[$__l3] = $nextLayer->new(raw => $l2->payload)
         or return undef;

      if ($self->[$__l3]->encapsulate eq NP_LAYER_UNKNOWN) {
         carp("@{[(caller(0))[3]]}: unknown Layer4 protocol\n");
         last;
      }

      $self->_fixWithIpLen  if $self->isIpv4;
      $self->_getArpPadding if $self->isArp;

      last if $self->[$__l3]->encapsulate eq NP_LAYER_NONE;
      $nextLayer = NP_LAYER. $self->[$__l3]->encapsulate;

      $self->[$__l4] = $nextLayer->new(raw => $self->[$__l3]->payload)
         or return undef;

      last if $self->[$__l4]->encapsulate eq NP_LAYER_NONE;
      $nextLayer = NP_LAYER. $self->[$__l4]->encapsulate;

      $self->[$__l7] = $nextLayer->new(raw => $self->[$__l4]->payload)
         or return undef;

      last;
   }

   $self;
}

sub pack {
   my $self = shift;

   #燭hey all need info about other layers, to do their work
   if ($self->[$__l2]) {
      $self->[$__l2]->computeLengths($self)   or return undef;
      $self->[$__l2]->computeChecksums($self) or return undef;
      $self->[$__l2]->pack                    or return undef;
   }
   if ($self->[$__l3]) {
      $self->[$__l3]->computeLengths($self)   or return undef;
      $self->[$__l3]->computeChecksums($self) or return undef;
      $self->[$__l3]->pack                    or return undef;
   }
   if ($self->[$__l4]) {
      $self->[$__l4]->computeLengths($self)   or return undef;
      $self->[$__l4]->computeChecksums($self) or return undef;
      $self->[$__l4]->pack                    or return undef;
   }
   if ($self->[$__l7]) {
      $self->[$__l7]->computeLengths($self)   or return undef;
      $self->[$__l7]->computeChecksums($self) or return undef;
      $self->[$__l7]->pack                    or return undef;
   }

   my $raw;
   $raw .= $self->[$__l2]->raw if $self->[$__l2];
   $raw .= $self->[$__l3]->raw if $self->[$__l3];
   $raw .= $self->[$__l4]->raw if $self->[$__l4];
   $raw .= $self->[$__l7]->raw if $self->[$__l7];

   if ($raw) {
      $self->[$__raw] = $raw;

      $self->_padFrame unless $self->[$__noPadding];
   }

   $self;
}

sub _padFrame {
   my $self = shift;

   # Pad this frame, this we send at layer 2
   if ($self->[$__l2] && $self->[$__env]->desc->isDescL2) {
      my $rawLength = length($self->[$__raw]);
      if ($rawLength < 60) {
         $self->[$__padding] = ('G' x (60 - $rawLength));
         $self->[$__raw] = $self->[$__raw].$self->[$__padding];
      }
   }
}

# Will wipe out the trailing memory disclosure found in the packet
# and put it into padding instance data
sub _fixWithIpLen {
   my $self = shift;

   my $oldLen = length($self->[$__l3]->payload);

   my $truncated =
      substr($self->[$__l3]->payload, 0, $self->[$__l3]->getPayloadLength);
   my $truncLen = length($truncated);
   my $padding  =
      substr($self->[$__l3]->payload, $truncLen, $oldLen - $truncLen);

   $self->[$__l3]->payload($truncated);
   $self->[$__padding] = $padding;
}

# Same as previous, but ARP version
sub _getArpPadding {
   my $self = shift;

   my $len = length($self->[$__raw]);
   ($len > 42)
      ? do { $self->[$__padding] = substr($self->[$__raw], 42, $len - 42) }
      : do { $self->[$__padding] = ''};
}

sub send {
   my $self = shift;

   my $env = $self->[$__env];

   if ($env->dump && ! $env->dump->isRunning) {
      $env->dump->start;
      $self->cgDebugPrint(1, "Dump object started");
   }

   if ($env->debug >= 3) {
      if ($self->isEth) {