harpy

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4 #
   5 # /etc/inittab:
   6 # ha:2345:respawn:/usr/local/sbin/harpy >>/var/log/harpy.log eth1 eth2
   7 # or
   8 # ha:2345:respawn:/usr/local/sbin/harpy >>/var/log/harpy.log eth_intra
   9
  10
  11 use bytes;
  12 sub __KERNEL__ { 1; }   # for "linux/socket.ph"
  13 use strict;
  14 use warnings;
  15 use Socket;
  16 require "linux/if_ether.ph";
  17 require "linux/socket.ph";
  18 require "linux/sockios.ph";
  19 require "linux/if_arp.ph";
  20 use Data::Dumper;
  21 sub SOCKADDR_SIZEOF { 16; }
  22
  23
  24 my $V=1;        # 2
  25
  26
  27 $|=1;
  28
  29 sub hw_ntoa($)
  30 {
  31 my($n)=@_;
  32
  33         my $a=unpack("H*",$n);
  34         $a=~s/..(?=.)/$&:/g;
  35         return $a;
  36 }
  37
  38 sub hw_aton($)
  39 {
  40 my($a)=@_;
  41
  42         $a=~tr/://d;
  43         return pack "H*",$a;
  44 }
  45
  46 sub sock($)
  47 {
  48 my($ifname)=@_;
  49
  50         my $sock;
  51         socket $sock,AF_PACKET(),SOCK_RAW(),ETH_P_ARP() or die "No ARP socket: $!";
  52
  53 local *ioctl_ifhwaddr=sub($)
  54 {
  55 my($ifname)=@_;
  56
  57         my $buf=$ifname.("\x00"x0x1000);
  58         ioctl $sock,SIOCGIFHWADDR(),$buf or die "ioctl($ifname,SIOCGIFHWADDR): $!";
  59         my($trash,$sockaddr)=unpack("a16a16",$buf);
  60         my($sa_len,$sa_data)=unpack("a2a6",$sockaddr);
  61         return $sa_data;
  62 };
  63
  64 local *ioctl_ifindex=sub($)
  65 {
  66 my($ifname)=@_;
  67
  68         my $buf=$ifname.("\x00"x0x1000);
  69         ioctl $sock,SIOCGIFINDEX(),$buf or die "ioctl($ifname,SIOCGIFINDEX): $!";
  70         my($trash,$ifindex)=unpack("a16i",$buf);
  71         return $ifindex;
  72 };
  73
  74         my $hw=ioctl_ifhwaddr($ifname);
  75         my $sockaddr_ll=pack "SniSCCa8",                # struct sockaddr_ll:
  76                         AF_PACKET(),                    # unsigned short int sll_family;
  77                         ETH_P_ARP(),                    # unsigned short int sll_protocol;
  78                         ioctl_ifindex($ifname),         # int sll_ifindex;
  79                         ARPHRD_ETHER(),                 # unsigned short int sll_hatype;
  80                         PACKET_BROADCAST(),             # unsigned char sll_pkttype;
  81                         ETH_ALEN(),                     # unsigned char sll_halen;
  82                         $hw;                            # unsigned char sll_addr[8];
  83
  84         bind $sock,$sockaddr_ll or die "bind($ifname): $!";
  85
  86         return $sock,hw_ntoa($hw);
  87 }
  88
  89 #struct ether_arp_frame {
  90 #       struct ether_header {
  91 #               u_int8_t  ether_dhost[ETH_ALEN];        /* destination eth addr */
  92 #               u_int8_t  ether_shost[ETH_ALEN];        /* source ether addr    */
  93 #               u_int16_t ether_type;                   /* packet type ID field */
  94 #               } ether_hdr;
  95 #       struct ether_arp {
  96 #               struct arphdr {         /* fixed-size header */
  97 #                       unsigned short int ar_hrd;      /* Format of hardware address.  */
  98 #                       unsigned short int ar_pro;      /* Format of protocol address.  */
  99 #                       unsigned char ar_hln;           /* Length of hardware address.  */
 100 #                       unsigned char ar_pln;           /* Length of protocol address.  */
 101 #                       unsigned short int ar_op;       /* ARP opcode (command).  */
 102 #                       } ea_hdr;
 103 #               u_int8_t arp_sha[ETH_ALEN];     /* sender hardware address */
 104 #               u_int8_t arp_spa[4];            /* sender protocol address */
 105 #               u_int8_t arp_tha[ETH_ALEN];     /* target hardware address */
 106 #               u_int8_t arp_tpa[4];            /* target protocol address */
 107 #               } arp;
 108 #       };
 109
 110 sub arp_pack($$$$)
 111 {
 112 my($dst_hw,$src_hw,$dst,$src)=@_;
 113
 114         my $msg=pack "a6a6nnnCCna6a4a6a4",
 115                 hw_aton($dst_hw),       # $ether_dhost
 116                 hw_aton($src_hw),       # $ether_shost
 117                 2054,                   # $ether_type
 118                 1,                      # $ar_hrd
 119                 2048,                   # $ar_pro
 120                 6,                      # $ar_hln
 121                 4,                      # $ar_pln
 122                 ARPOP_REPLY(),          # $ar_op
 123                 hw_aton($src_hw),       # $arp_sha
 124                 inet_aton($src),        # $arp_spa
 125                 hw_aton($dst_hw),       # $arp_tha
 126                 inet_aton($dst);        # $arp_tpa
 127         return $msg;
 128 }
 129
 130 sub arp_unpack($)
 131 {
 132 my($msg)=@_;
 133
 134         return if 42>length $msg;
 135         my(
 136                 $ether_dhost,
 137                 $ether_shost,
 138                 $ether_type,
 139                 $ar_hrd,
 140                 $ar_pro,
 141                 $ar_hln,
 142                 $ar_pln,
 143                 $ar_op,
 144                 $arp_sha,
 145                 $arp_spa,
 146                 $arp_tha,
 147                 $arp_tpa,
 148                 )=unpack "a6a6nnnCCna6a4a6a4",$msg;
 149         $V>=3 and print Data::Dumper->Dump([
 150                         $ether_dhost,
 151                         $ether_shost,
 152                         $ether_type,
 153                         $ar_hrd,
 154                         $ar_pro,
 155                         $ar_hln,
 156                         $ar_pln,
 157                         $ar_op,
 158                         $arp_sha,
 159                         $arp_spa,
 160                         $arp_tha,
 161                         $arp_tpa,
 162                 ],[
 163                         "ether_dhost",
 164                         "ether_shost",
 165                         "ether_type",
 166                         "ar_hrd",
 167                         "ar_pro",
 168                         "ar_hln",
 169                         "ar_pln",
 170                         "ar_op",
 171                         "arp_sha",
 172                         "arp_spa",
 173                         "arp_tha",
 174                         "arp_tpa",
 175                 ]);
 176         return if $ar_op!=ARPOP_REQUEST();
 177         return if $ar_hln!=6;
 178         return if $ar_pln!=4;
 179         my $tell=inet_ntoa $arp_spa;
 180         my $who_has=inet_ntoa $arp_tpa;
 181         my $tell_hw=hw_ntoa $ether_shost;
 182         return $tell,$who_has,$tell_hw;
 183 }
 184
 185
 186 my %socks;
 187 my @ifnames=@ARGV;
 188 while (@ifnames) {
 189         my $ifname=shift @ifnames;
 190         if ($ifname=~/{(\d+)-(\d+)}/) {
 191                 push @ifnames,$`.$_.$' for $1..$2;
 192                 next;
 193                 }
 194         my($sock,$hw)=sock($ifname);
 195         $socks{$ifname}={
 196                         "sock"=>$sock,
 197                         "hw"=>$hw,
 198                         };
 199         }
 200
 201 $V and print localtime()." START\n";
 202 for (;;) {
 203         my $rfds="";
 204         vec($rfds,fileno($_->{"sock"}),1)=1 for values(%socks);
 205         my $got=select $rfds,undef(),undef(),undef();
 206         die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 207
 208         while (my($ifname,$hash)=each(%socks)) {
 209                 next if !vec($rfds,fileno($hash->{"sock"}),1);
 210                 $V>=2 and print localtime()." got packet: $ifname\n";
 211                 my $msg;
 212                 defined(my $from_addr=recv $hash->{"sock"},$msg,0x1000,0) or die "recv($ifname): $!";
 213                 next if !(my($tell,$who_has,$tell_hw)=arp_unpack($msg));
 214                 $V and print localtime()." got: tell=$tell,who_has=$who_has,tell_hw=$tell_hw\n";
 215                 next if $tell eq $who_has;      # do not reply to self-detection queries
 216                 my $msg_reply=arp_pack($tell_hw,$hash->{"hw"},$tell,$who_has);
 217                 send $hash->{"sock"},$msg_reply,0,$from_addr or die "send($ifname): $!";
 218                 }
 219         }