POE::Component::Pcap - POE Interface to Net::Pcap

  ## Need an IO::Handle to $kernel->select_read() upon
  $heap->{fdh} = IO::Handle->new_from_fd( $heap->{fd}, "r" )
    or die "Can't create IO::Handle from pcap fd: $!\n";

  use POE::Component::Pcap;

  POE::Component::Pcap->spawn(
			      Alias => 'pcap',
			      Device => 'eth0',
			      Filter => 'host fooble or host blort',
			      Dispatch => 'got_packet',
			      Session => $my_session_id,
			     );

  $poe_kernel->post( pcap => open_live =>
		     'eth0', 80, 1, 100 );

  $poe_kernel->post( pcap => set_filter => 'arp or host zooble' );

  $poe_kernel->post( pcap => set_dispatch => 'target_state' );

  $poe_kernel->post( pcap => 'run' );

  $poe_kernel->post( pcap => 'shutdown' );

#!/usr/bin/perl
##
## $Id: Pcap.pm,v 1.3 2003/07/08 15:09:54 fletch Exp $
##
package POE::Component::Pcap;

use strict;
use Carp qw( croak carp );

$POE::Component::Pcap::VERSION = q{0.04};

use POE;

use Symbol qw( gensym );

use IO::Handle;
use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );

use Net::Pcap;

##
## POE::Component::Pcap->spawn(
##			       [ Alias => 'pcap' ],
##			       [ Device => 'eth0' ],
##			       [ Filter => 'pcap filter' ],
##			       [ Dispatch => dispatch_state ],
##			       [ Session => dispatch_session ],
##			      )
##
sub spawn {
  my $class = shift;
  my %args = @_;

  ## Set default alias if none was given
  $args{ Alias } ||= 'pcap';

  POE::Session->create(
		       inline_states => {
					 _start => \&_start,
					 _stop => \&_stop,
#					 _signal => \&_signal,
					 open_live => \&open_live,
					 set_filter => \&set_filter,
					 set_dispatch => \&set_dispatch,
					 run => \&run,
					 pause => \&pause,
					 _dispatch => \&_dispatch,
					 shutdown => \&shutdown,
					},
		       args => [
				$args{Alias},	# ARG0
				$args{Filter},	# ARG1
				$args{Session}, # ARG2
				$args{Dispatch},# ARG3
				$args{Device},	# ARG4
			       ],
		      );

  return $args{ Alias };
}

sub _start {
  my ($kernel, $heap, $session,
      $alias, $filter, $target_session, $target_state, $device )
    = @_[ KERNEL, HEAP, SESSION, ARG0..ARG4 ];

#  print "In state_start for sid ", $session->ID, ", alias $alias\n";

  ## Set alias for ourselves and remember it
  $kernel->alias_set( $alias );
  $heap->{Alias} = $alias;


  ## Set dispatch target session and state if it was given
  if( defined( $target_state ) ) {
    $heap->{'target_session'} = $target_session;
    $heap->{'target_state'} = $target_state;
  }

  ## Post an open_live event if device was passed
  $kernel->post( $session => open_live => $device )
    if defined( $device );

  ## Set filter if it was given
  $kernel->post( $session => set_filter => $filter )
    if defined( $filter );

#  print "Out state_start for sid ", $session->ID, ", alias $alias\n";
}

##
## $kernel->post( pcap => open_live =>
##		  [device], [snaplen], [promisc?], [timeout] )
##
sub open_live {
  my ( $kernel, $heap,
       $device, $snaplen, $promisc, $timeout,
     ) = @_[ KERNEL, HEAP, ARG0..ARG3 ];

  my $err;

  ## Lookup default device if undef was passed
  unless( $device ) {
    $device = Net::Pcap::lookupdev( \$err )
      or croak "Can't lookupdev: $err\n";
  }

  ## Set `reasonable' defaults for other values
  $snaplen = 80 unless defined( $snaplen );
  $promisc = 1 unless defined( $promisc );
  $timeout = 100 unless defined( $timeout );

  $heap->{'pcap_t'} = Net::Pcap::open_live( $device, $snaplen,
					    $promisc, $timeout, \$err )
    or croak "Can't Net::Pcap::open_live $device: $err\n";

  @{$heap}{ qw/device snaplen
	       promisc timeout fd/ } =
		 (
		  $device, $snaplen, $promisc,
		  $timeout,
		  Net::Pcap::fileno( $heap->{'pcap_t'} ),
		 );

  $heap->{fdh} = gensym;
  open( $heap->{fdh}, "<&".$heap->{fd} )
    or die "Can't dup handle from pcap fd: $!\n";

  1;
}

sub set_filter {
  my ( $kernel, $heap, $filter ) = @_[ KERNEL, HEAP, ARG0 ];

  croak "open must be called before set_filter \n"
    unless exists $heap->{'pcap_t'};

  my( $net, $netmask, $err );
  Net::Pcap::lookupnet( $heap->{'device'}, \$net, \$netmask, \$err );

  my $filter_t;
  Net::Pcap::compile( $heap->{'pcap_t'},
		      \$filter_t, $filter, 1, $netmask ) == 0
			or die "Can't compile filter `$filter'\n";

  Net::Pcap::setfilter( $heap->{'pcap_t'}, $filter_t );
}

##
## $kernel->post( pcap => set_dispatch =>
##		  'target_state', 'target_session' )
##
sub set_dispatch {
  my ( $heap, $sender, $target_state, $target_session )
    = @_[ HEAP, SENDER, ARG0, ARG1 ];

  ## Target session defaults to the sender
  $target_session ||= $sender;

  if( defined( $target_state ) ) {
    ## Remember whom to forward packets to
    $heap->{'target_session'} = $target_session;
    $heap->{'target_state'} = $target_state;
  } else {
    ## Clear target
    delete $heap->{'target_session'};
    delete $heap->{'target_state'};
  }
}

sub run {
  my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

  my $flags;

  ## Can't run unless we've got a pcap_t to work with
  croak "open must be called before run \n"
    unless exists $heap->{'pcap_t'};

  ## XXX Need to save off flags for OpenBSD
  if( $^O eq 'openbsd' ) {
    $flags = fcntl($heap->{fdh}, F_GETFL, 0)
      or croak "fcntl fails with F_GETFL: $!\n";
  }

  $kernel->select_read( $heap->{fdh} => '_dispatch' );

  ## XXX OpenBSD's pcap / bpf devices don't like being set to
  ## non-blocking for some reason, so restore the saved flags
  if( $^O eq 'openbsd' ) {
    $flags = fcntl($heap->{fdh}, F_SETFL, $flags )
      or croak "fcntl fails with F_SETFL: $!\n";
  }

}

sub _dispatch {
  my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

  if( exists $heap->{'target_session'} ) {
    my @pending;

    ## Get Pcap to pass us any pending packets
    Net::Pcap::dispatch( $heap->{'pcap_t'}, -1,
			 sub {
			   push @{$_[0]}, [ @_[1,2] ]
			 },
			 \@pending
		       );

    $kernel->post( $heap->{'target_session'},
		   $heap->{'target_state'},
		   \@pending,
		 );
  }
}

sub pause {
  ## Remove read select on pcap handle
  $_[KERNEL]->select_read( $_[HEAP]->{fdh} ) if exists $_[HEAP]->{fdh};
}

sub shutdown {
  my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

  ## Remove read select on pcap handle
  $kernel->select_read( $heap->{fdh} ) if exists $heap->{fdh};

  ## Get Net::Pcap to shut down pcap_t
  if( exists $heap->{'pcap_t'} ) {
    Net::Pcap::close( $heap->{'pcap_t'} );
    delete @{$heap}{qw/pcap_t fd fdh/}
  }

  $kernel->alias_remove( $heap->{Alias} );
}

sub _stop {
  my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
  my $alias = $heap->{Alias};

#  print "In state_stop for sid ", $session->ID, ", alias $alias\n";

#  print "Out state_stop for sid ", $session->ID, ", alias $alias\n";
}

sub _signal {
  my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];

#  print "Got signal ", $_[ARG0], "\n";

  return 1;
}

1;

__END__