File Coverage

blib/lib/Net/Packet/Shell.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#
# $Id: Shell.pm 8 2010-06-04 11:43:42Z gomor $
#
package Net::Packet::Shell;
use strict;
use warnings;

our $VERSION = '0.22';

my @subList = qw(
   F sr sd sd2 sd3 sniff dsniff read
);

my @layerList = qw(
   ETH RAW SLL NULL ARP IPv4 IPv6 TCP UDP VLAN ICMPv4 PPPoE PPP PPPLCP LLC CDP
   STP OSPF IGMPv4
);

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = (
   'nps',
   '$Env',
   @subList,
   @layerList,
   @Net::Packet::Env::EXPORT_OK,
   @Net::Packet::Utils::EXPORT_OK,
   @Net::Packet::Consts::EXPORT_OK,
);

use Net::Packet;
use Net::Write::Layer2;
use Net::Write::Layer3;
use Data::Dumper;
use Term::ReadLine;

$Env->noFrameAutoDesc(1);
$Env->noFrameAutoDump(1);
$Env->noDescAutoSet(1);
$Env->noDumpAutoSet(0);
$Env->doFrameReturnList(1);

_resetEnv();

sub _resetEnv {
   $Env->noFramePadding(1);
   $Env->noFrameComputeLengths(0);
   $Env->noFrameComputeChecksums(0);
   $Env->doIPv4Checksum(0);
}

sub _frame {
   my $f = Net::Packet::Frame->new;
   for my $l (@_) {
      do { $f->l2($l); next } if $l->isLayer2;
      do { $f->l3($l); next } if $l->isLayer3;
      do { $f->l4($l); next } if $l->isLayer4;
      do { $f->l7($l); next } if $l->isLayer7;
   }
   $f->pack;
   $f;
}

*F = sub { _frame(@_) };

{
   no strict 'refs';
   for my $l (@layerList) {
      *$l = sub { my $r = "Net::Packet::$l"->new(@_); $r->pack; $r };
   }
}

sub sr {
   do { print "Nothing to send\n"; return } unless $_[0];

   my $d = Net::Write::Layer2->new(dev => $Env->dev);
   $d->open;
   $d->send(shift());
   $d->close;
}

sub sd {
   do { print "Nothing to send\n"; return } unless $_[0];

   return sd2(@_) if $_[0]->l2;
   return sd3(@_) if $_[0]->l3;
}

sub sd2 {
   my ($f) = @_;

   do { print "Nothing to send\n"; return } unless $f;

   $Env->doIPv4Checksum(1);
   $Env->noFrameComputeLengths(0);
   $Env->noFrameComputeChecksums(0);

   $f->pack;

   my $d = Net::Write::Layer2->new(dev => $Env->dev);
   $d->open;
   $d->send($f->raw);
   $d->close;

   _resetEnv();
}

sub sd3 {
   my ($f) = @_;

   do { print "Nothing to send\n"; return } unless $f;

   do { print "We can only send IPv4 frames at layer 3\n"; return }
      if ($f->l2 || ($f->l3 && ! $f->l3->isIpv4));

   $Env->doIPv4Checksum(0);
   $Env->noFrameComputeLengths(0);
   $Env->noFrameComputeChecksums(0);

   my $dst = $f->l3->dst;
   $f->pack;

   my $d = Net::Write::Layer3->new(dev => $Env->dev, dst => $dst);
   $d->open;
   $d->send($f->raw);
   $d->close;

   _resetEnv();
}

sub sniff {
   my ($filter) = @_;
   my $d = Net::Packet::Dump->new(
      noStore => 1,
   );
   $d->filter($filter) if $filter;
   $d->start;
   while (1) {
      if (my $f = $d->next) {
         for (@$f) {
            print $_->l2->print."\n" if $_->l2;
            print $_->l3->print."\n" if $_->l3;
            print $_->l4->print."\n" if $_->l4;
            print $_->l7->print."\n" if $_->l7;
         }
      }
   }
}

sub dsniff {
   my ($filter) = @_;
   my $d = Net::Packet::Dump->new(
      noStore => 1,
   );
   $d->filter($filter) if $filter;
   $d->start;
   while (1) {
      if (my $f = $d->next) {
         for my $c (@$f) {
            if ($c->l7) {
               my $data = $c->l7->data;
               next unless $data =~ /^user\s+|^pass\s+/i;
               print $c->l3->dst.':'.$c->l4->dst.'> '.$data."\n";
            }
         }
      }
   }
}

sub read {
   my ($file) = @_;
   do { print "Please specify a pcap file to read\n"; return } unless $file;

   my $d = Net::Packet::Dump->new(
      file          => $file,
      mode          => NP_DUMP_MODE_OFFLINE,
      overwrite     => 0,
      unlinkOnClean => 0,
      noStore       => 1,
   );
   $d->start;

   my $n = 0;
   while (my $fr = $d->next) {
      ++$n;
      print 'Number of frames in chunk: '.scalar(@$fr)."\n";
      for (@$fr) {
         print 'Frame number: '.$n."\n";
         print $_->print."\n";
      }
      print "\n";
   }

   $d->stop;
   $d->clean;
}

sub nps {
   my $prompt = 'nps> ';
   my $name   = 'NPS';
   my $term   = Term::ReadLine->new($name);
   $term->ornaments(0);

   $term->Attribs->{completion_function} = sub {
      ( @subList, @layerList )
   };

   {
      no strict;

      while (my $line = $term->readline($prompt)) {
         $line =~ s/s*read/Net::Packet::Shell::read/;
         eval($line);
         warn($@) if $@;
         print "\n";
      }
   }

   print "\n";
}

END {
   if ($Env->dump) {
      $Env->dump->stop;
      $Env->dump->clean;
   }
}

1;

__END__