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 require POSIX;
  23 use Getopt::Long;
  24
  25
  26 my $V=1;        # 2
  27 my $opt_timeout=0.5;    # [sec]
  28 die if !GetOptions(
  29                 "t|timeout=s",\$opt_timeout,
  30                 "v|verbose+",\$V,
  31                 );
  32
  33
  34 $|=1;
  35
  36 sub hw_ntoa($)
  37 {
  38 my($n)=@_;
  39
  40         my $a=unpack("H*",$n);
  41         $a=~s/..(?=.)/$&:/g;
  42         return $a;
  43 }
  44
  45 sub hw_aton($)
  46 {
  47 my($a)=@_;
  48
  49         $a=~tr/://d;
  50         return pack "H*",$a;
  51 }
  52
  53 sub sock($)
  54 {
  55 my($ifname)=@_;
  56
  57         my $sock;
  58         socket $sock,AF_PACKET(),SOCK_RAW(),ETH_P_ARP() or die "No ARP socket: $!";
  59
  60 local *ioctl_ifhwaddr=sub($)
  61 {
  62 my($ifname)=@_;
  63
  64         my $buf=$ifname.("\x00"x0x1000);
  65         ioctl $sock,SIOCGIFHWADDR(),$buf or die "ioctl($ifname,SIOCGIFHWADDR): $!";
  66         my($trash,$sockaddr)=unpack("a16a16",$buf);
  67         my($sa_len,$sa_data)=unpack("a2a6",$sockaddr);
  68         return $sa_data;
  69 };
  70
  71 local *ioctl_ifipaddr=sub($)
  72 {
  73 my($ifname)=@_;
  74
  75         my $buf=$ifname.("\x00"x0x1000);
  76         ioctl $sock,SIOCGIFADDR(),$buf or die "ioctl($ifname,SIOCGIFADDR): $!";
  77         my($trash,$sockaddr)=unpack("a16a16",$buf);
  78         my($sa_len,$sin_port,$sin_addr)=unpack("a2a2a4",$sockaddr);
  79         return $sin_addr;
  80 };
  81
  82 local *ioctl_ifindex=sub($)
  83 {
  84 my($ifname)=@_;
  85
  86         my $buf=$ifname.("\x00"x0x1000);
  87         ioctl $sock,SIOCGIFINDEX(),$buf or die "ioctl($ifname,SIOCGIFINDEX): $!";
  88         my($trash,$ifindex)=unpack("a16i",$buf);
  89         return $ifindex;
  90 };
  91
  92         my $hw=ioctl_ifhwaddr($ifname);
  93         my $ip=ioctl_ifipaddr($ifname);
  94         my $sockaddr_ll=pack "SniSCCa8",                # struct sockaddr_ll:
  95                         AF_PACKET(),                    # unsigned short int sll_family;
  96                         ETH_P_ARP(),                    # unsigned short int sll_protocol;
  97                         ioctl_ifindex($ifname),         # int sll_ifindex;
  98                         ARPHRD_ETHER(),                 # unsigned short int sll_hatype;
  99                         PACKET_BROADCAST(),             # unsigned char sll_pkttype;
 100                         ETH_ALEN(),                     # unsigned char sll_halen;
 101                         $hw;                            # unsigned char sll_addr[8];
 102
 103         bind $sock,$sockaddr_ll or die "bind($ifname): $!";
 104
 105         return $sock,hw_ntoa($hw),inet_ntoa($ip);
 106 }
 107
 108 #struct ether_arp_frame {
 109 #       struct ether_header {
 110 #               u_int8_t  ether_dhost[ETH_ALEN];        /* destination eth addr */
 111 #               u_int8_t  ether_shost[ETH_ALEN];        /* source ether addr    */
 112 #               u_int16_t ether_type;                   /* packet type ID field */
 113 #               } ether_hdr;
 114 #       struct ether_arp {
 115 #               struct arphdr {         /* fixed-size header */
 116 #                       unsigned short int ar_hrd;      /* Format of hardware address.  */
 117 #                       unsigned short int ar_pro;      /* Format of protocol address.  */
 118 #                       unsigned char ar_hln;           /* Length of hardware address.  */
 119 #                       unsigned char ar_pln;           /* Length of protocol address.  */
 120 #                       unsigned short int ar_op;       /* ARP opcode (command).  */
 121 #                       } ea_hdr;
 122 #               u_int8_t arp_sha[ETH_ALEN];     /* sender hardware address */
 123 #               u_int8_t arp_spa[4];            /* sender protocol address */
 124 #               u_int8_t arp_tha[ETH_ALEN];     /* target hardware address */
 125 #               u_int8_t arp_tpa[4];            /* target protocol address */
 126 #               } arp;
 127 #       };
 128
 129 sub arp_pack($$$$$)
 130 {
 131 my($dst_hw,$src_hw,$dst,$src,$type)=@_;
 132
 133         my $type_bin;
 134         $type_bin=ARPOP_REQUEST() if $type eq "REQUEST";
 135         $type_bin=ARPOP_REPLY()   if $type eq "REPLY";
 136         die "INTERNAL" if !defined $type_bin;
 137         my $msg=pack "a6a6nnnCCna6a4a6a4",
 138                 hw_aton($dst_hw),       # $ether_dhost
 139                 hw_aton($src_hw),       # $ether_shost
 140                 2054,                   # $ether_type
 141                 1,                      # $ar_hrd
 142                 2048,                   # $ar_pro
 143                 6,                      # $ar_hln
 144                 4,                      # $ar_pln
 145                 $type_bin,              # $ar_op
 146                 hw_aton($src_hw),       # $arp_sha
 147                 inet_aton($src),        # $arp_spa
 148                 hw_aton($dst_hw),       # $arp_tha
 149                 inet_aton($dst);        # $arp_tpa
 150         return $msg;
 151 }
 152
 153 sub arp_unpack($)
 154 {
 155 my($msg)=@_;
 156
 157         return if 42>length $msg;
 158         my(
 159                 $ether_dhost,
 160                 $ether_shost,
 161                 $ether_type,
 162                 $ar_hrd,
 163                 $ar_pro,
 164                 $ar_hln,
 165                 $ar_pln,
 166                 $ar_op,
 167                 $arp_sha,
 168                 $arp_spa,
 169                 $arp_tha,
 170                 $arp_tpa,
 171                 )=unpack "a6a6nnnCCna6a4a6a4",$msg;
 172         $V>=3 and print Data::Dumper->Dump([
 173                         $ether_dhost,
 174                         $ether_shost,
 175                         $ether_type,
 176                         $ar_hrd,
 177                         $ar_pro,
 178                         $ar_hln,
 179                         $ar_pln,
 180                         $ar_op,
 181                         $arp_sha,
 182                         $arp_spa,
 183                         $arp_tha,
 184                         $arp_tpa,
 185                 ],[
 186                         "ether_dhost",
 187                         "ether_shost",
 188                         "ether_type",
 189                         "ar_hrd",
 190                         "ar_pro",
 191                         "ar_hln",
 192                         "ar_pln",
 193                         "ar_op",
 194                         "arp_sha",
 195                         "arp_spa",
 196                         "arp_tha",
 197                         "arp_tpa",
 198                 ]);
 199         my $type;
 200         $type="REQUEST" if $ar_op==ARPOP_REQUEST();
 201         $type="REPLY"   if $ar_op==ARPOP_REPLY();
 202         return if !$type;
 203         return if $ar_hln!=6;
 204         return if $ar_pln!=4;
 205         my $tell=inet_ntoa $arp_spa;
 206         my $who_has=inet_ntoa $arp_tpa;
 207         my $tell_hw=hw_ntoa $ether_shost;
 208         return $tell,$who_has,$tell_hw,$type;
 209 }
 210
 211 my $clock_ticks=POSIX::sysconf(&POSIX::_SC_CLK_TCK);
 212 sub now()
 213 {
 214         return (POSIX::times())[0]/$clock_ticks;
 215 }
 216
 217
 218 my %socks;
 219 my @ifnames=@ARGV;
 220 while (@ifnames) {
 221         my $ifname=shift @ifnames;
 222         if ($ifname=~/{(\d+)-(\d+)}/) {
 223                 push @ifnames,$`.$_.$' for $1..$2;
 224                 next;
 225                 }
 226         my($sock,$hw,$ip)=sock($ifname);
 227         $socks{$ifname}={
 228                         "sock"=>$sock,
 229                         "hw"=>$hw,
 230                         "ip"=>$ip,
 231                         };
 232         }
 233 $V>=2 and print Dumper(\%socks);
 234
 235 # $pending{$who_has}=[{"when"=>now()+$timeout,"sock"=>$hash->{"sock"},...}...];
 236 my %pending;
 237 $V and print localtime()." START\n";
 238 for (;;) {
 239         my $rfds="";
 240         vec($rfds,fileno($_->{"sock"}),1)=1 for values(%socks);
 241         my $first;
 242         while (my($who_has,$arrayref)=each(%pending)) {
 243                 my $deleted=0;
 244                 for my $pendingi (0..$#$arrayref) {
 245                         my $pending=$arrayref->[$pendingi-$deleted];
 246                         my $when=$pending->{"when"};
 247                         if ($when<=now()) {
 248                                 my $sock_hash=$socks{$pending->{"ifname"}};
 249                                 my $msg_reply=arp_pack(
 250                                                 $pending->{"tell_hw"},  # dst_hw
 251                                                 $sock_hash->{"hw"},     # src_hw
 252                                                 $pending->{"tell"},     # dst
 253                                                 $pending->{"who_has"},  # src
 254                                                 "REPLY",                # type
 255                                                 );
 256                                 send $sock_hash->{"sock"},$msg_reply,0,$pending->{"from_addr"}
 257                                                 or die "send(".$pending->{"ifname"}."): $!";
 258                                 splice @$arrayref,$pendingi-$deleted,1;
 259                                 $deleted++;
 260                                 $V and print localtime()." replied: type=REPLY,"
 261                                                 .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
 262                                 }
 263                         else {
 264                                 $first=$when if !$first || $when<=$first;
 265                                 }
 266                         }
 267                 delete $pending{$who_has} if !@$arrayref;
 268                 }
 269         my $now=now();
 270         $first=$now if $first && $first<$now;
 271         $V>=3 and print Data::Dumper->Dump([\%pending],['\%pending']);
 272         my $got=select $rfds,undef(),undef(),(!$first ? undef() : $first-$now);
 273         die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 274
 275         while (my($ifname,$hash)=each(%socks)) {
 276                 next if !vec($rfds,fileno($hash->{"sock"}),1);
 277                 $V>=2 and print localtime()." got packet: $ifname\n";
 278                 my $msg;
 279                 defined(my $from_addr=recv $hash->{"sock"},$msg,0x1000,0) or die "recv($ifname): $!";
 280                 next if !(my($tell,$who_has,$tell_hw,$type)=arp_unpack($msg));
 281                 $V and print localtime()." got: type=$type,tell=$tell,who_has=$who_has,tell_hw=$tell_hw\n";
 282                 if ($type eq "REQUEST") {
 283                         next if $tell eq $who_has;      # do not reply to self-detection queries
 284                         my $msg_reply=arp_pack(
 285                                         "FF:FF:FF:FF:FF:FF",    # dst_hw
 286                                         $hash->{"hw"},          # src_hw
 287                                         $who_has,               # dst
 288                                         $hash->{"ip"},          # src
 289                                         "REQUEST",              # type
 290                                         );
 291                         send $hash->{"sock"},$msg_reply,0,$from_addr or die "send($ifname): $!";
 292                         $V and print localtime()." probing: type=REQUEST,"
 293                                         ."tell=".$hash->{"ip"}.",who_has=$who_has,tell_hw=".$hash->{"hw"}."\n";
 294                         push @{$pending{$who_has}},{
 295                                         "when"=>now()+$opt_timeout,
 296                                         "ifname"=>$ifname,
 297                                         "tell"   =>$tell,
 298                                         "who_has"=>$who_has,
 299                                         "tell_hw"=>$tell_hw,
 300                                         "from_addr"=>$from_addr,
 301                                         };
 302                         }
 303                 elsif ($type eq "REPLY") {
 304                         # Rename the fields a bit for REPLY
 305                         my($told,$who,$is_at_hw)=($who_has,$tell,$tell_hw);
 306                         for my $pending (@{$pending{$who}}) {
 307                                 $V and print localtime()." discarded: "
 308                                                 .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
 309                                 }
 310                         delete $pending{$who};
 311                         }
 312                 else {
 313                         die "NOTREACHED";
 314                         }
 315                 }
 316         }