gosa-si/modules/ArpWatch.pm

   1 #!/usr/bin/perl
   2 package POE::Component::ArpWatch;
   3
   4 use strict;
   5
   6 use POE;
   7
   8 use POE::Component::Pcap;
   9
  10 use NetPacket::Ethernet qw( :types );
  11 use NetPacket::ARP qw( :opcodes );
  12
  13 ## Map arp opcode #'s to strings
  14 my %arp_opcodes = (
  15                    NetPacket::ARP::ARP_OPCODE_REQUEST, 'ARP Request',
  16                    NetPacket::ARP::ARP_OPCODE_REPLY, 'ARP Reply',
  17                    NetPacket::ARP::RARP_OPCODE_REQUEST, 'RARP Request',
  18                    NetPacket::ARP::RARP_OPCODE_REPLY, 'RARP Reply',
  19                   );
  20
  21 ##
  22 ## POE::Component::ArpWatch->spawn(
  23 ##                                 [ Alias => 'arp_watch' ],
  24 ##                                 [ Device => 'eth0' ],
  25 ##                                 [ Dispatch => dispatch_state ],
  26 ##                                 [ Session => dispatch_session ],
  27 ##                                )
  28 ##
  29 sub spawn {
  30   my $class = shift;
  31   my %args = @_;
  32
  33   $args{ Alias } ||= 'arp_watch';
  34
  35   POE::Session->create(
  36                        inline_states => {
  37                                          _start => \&_start,
  38 #                                        _signal => \&_signal,
  39                                          _stop => \&_stop,,
  40                                          _dispatch => \&_dispatch,
  41                                          set_dispatch => \&set_dispatch,
  42                                          run => \&run,
  43                                          pause => \&pause,
  44                                          shutdown => \&shutdown,
  45                                         },
  46                        args => [
  47                                 $args{ Alias },   # ARG0
  48                                 $args{ Device },  # ARG1
  49                                 $args{ Dispatch },# ARG2
  50                                 $args{ Session }, # ARG3
  51                                ],
  52                       );
  53
  54   return $args{ Alias };
  55 }
  56
  57 sub _start {
  58   my ($kernel, $heap, $session,
  59       $alias, $device, $target_state, $target_session )
  60     = @_[ KERNEL, HEAP, SESSION, ARG0..ARG3 ];
  61
  62   POE::Component::Pcap->spawn(
  63                               Alias => $alias . '_pcap',
  64                               Device => $device,
  65                               Filter => 'arp',
  66                               Dispatch => '_dispatch',
  67                               Session => $session,
  68                              );
  69
  70   $heap->{'pcap_session'} = $kernel->alias_resolve( $alias . '_pcap' );
  71
  72   ## Set alias for ourselves and remember it
  73   $kernel->alias_set( $alias );
  74   $heap->{Alias} = $alias;
  75
  76   ## Set dispatch target session and state if it was given
  77   if( defined( $target_session ) ) {
  78     $heap->{'target_session'} = $target_session;
  79     $heap->{'target_state'} = $target_state;
  80   }
  81 }
  82
  83 sub set_dispatch {
  84   my( $heap, $sender, $target ) = @_[ HEAP, SENDER, ARG0 ];
  85
  86   if( defined $target ) {
  87     ## Remember whome to forward results to
  88     $heap->{'target_session'} = $sender;
  89     $heap->{'target_state'} = $target;
  90   } else {
  91     ## Clear target
  92     delete $heap->{'target_session'};
  93     delete $heap->{'target_state'};
  94   }
  95 }
  96
  97 sub run {
  98   $_[KERNEL]->post( $_[HEAP]->{'pcap_session'} => 'run' );
  99 }
 100
 101 sub pause {
 102   $_[KERNEL]->post( $_[HEAP]->{'pcap_session'} => 'pause' );
 103 }
 104
 105 sub _dispatch {
 106   my( $kernel, $heap, $packets ) =
 107     @_[ KERNEL, HEAP, ARG0 ];
 108
 109   if( exists $heap->{'target_session'} ) {
 110     $kernel->post( $heap->{'target_session'},
 111                    $heap->{'target_state'},
 112                    _process_packet( @{ $_ } ) ) foreach( @{$packets} );
 113   }
 114 }
 115
 116 sub _signal {
 117   # print "Got signal ", $_[ARG0], "\n";
 118
 119   $_[KERNEL]->post( pcap => 'shutdown' );
 120
 121   return 1
 122 }
 123
 124 sub shutdown {
 125   my ( $kernel, $heap, $session, $sender )
 126     = @_[ KERNEL, HEAP, SESSION, SENDER ];
 127   my $alias = $heap->{Alias};
 128
 129 #  print "In shutdown for sid ", $session->ID, ", alias $alias\n";
 130 #  print "shutdown by ", $sender->ID, "\n";
 131
 132   $kernel->post( $heap->{'pcap_session'} => 'shutdown' );
 133
 134   $kernel->alias_remove( $alias );
 135
 136 #  print "Out shutdown for sid ", $session->ID, ", alias $alias\n";
 137 }
 138
 139 sub _stop {
 140   my ( $kernel, $heap, $session ) = @_[ KERNEL, HEAP, SESSION ];
 141   my $alias = $heap->{Alias};
 142
 143 #  print "In state_stop for sid ", $session->ID, ", alias $alias\n";
 144
 145 #  print "Out state_stop for sid ", $session->ID, ", alias $alias\n";
 146 }
 147
 148 sub _process_packet {
 149   my( $hdr, $pkt ) = @_;
 150
 151   my $arp =
 152     NetPacket::ARP->decode( NetPacket::Ethernet->decode($pkt)->{data} );
 153
 154   ## Return hashref with apropriate fields
 155   return {
 156           type => $arp_opcodes{ $arp->{opcode} },
 157           tv_sec => $hdr->{tv_sec},
 158           tv_usec => $hdr->{tv_usec},
 159           source_haddr => _phys( $arp->{sha} ),
 160           source_ipaddr => _ipaddr( $arp->{spa} ),
 161           target_haddr => _phys( $arp->{tha} ),
 162           target_ipaddr => _ipaddr( $arp->{tpa} ),
 163          }
 164 }
 165
 166 ## Pretty printing subs for addresses
 167 sub _ipaddr { join( ".", unpack( "C4", pack( "N", oct( "0x". shift ) ) ) ) }
 168 sub _phys { join( ":", grep {length} split( /(..)/, shift ) ) }
 169
 170 1;
 171
 172 __END__