6 # ha:2345:respawn:/usr/local/sbin/harpy >>/var/log/harpy.log eth1 eth2
8 # ha:2345:respawn:/usr/local/sbin/harpy >>/var/log/harpy.log eth_intra
12 sub __KERNEL__ { 1; } # for "linux/socket.ph"
16 require "linux/if_ether.ph";
17 require "linux/socket.ph";
18 require "linux/sockios.ph";
19 require "linux/if_arp.ph";
21 sub SOCKADDR_SIZEOF { 16; }
27 my $opt_timeout=0.5; # [sec]
29 "t|timeout=s",\$opt_timeout,
40 my $a=unpack("H*",$n);
58 socket $sock,AF_PACKET(),SOCK_RAW(),ETH_P_ARP() or die "No ARP socket: $!";
60 local *ioctl_ifhwaddr=sub($)
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);
71 local *ioctl_ifipaddr=sub($)
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);
82 local *ioctl_ifindex=sub($)
86 my $buf=$ifname.("\x00"x0x1000);
87 ioctl $sock,SIOCGIFINDEX(),$buf or die "ioctl($ifname,SIOCGIFINDEX): $!";
88 my($trash,$ifindex)=unpack("a16i",$buf);
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];
103 bind $sock,$sockaddr_ll or die "bind($ifname): $!";
105 return $sock,hw_ntoa($hw),inet_ntoa($ip);
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 */
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). */
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 */
131 my($dst_hw,$src_hw,$dst,$src,$type)=@_;
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
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
157 return if 42>length $msg;
171 )=unpack "a6a6nnnCCna6a4a6a4",$msg;
172 $V>=3 and print Data::Dumper->Dump([
200 $type="REQUEST" if $ar_op==ARPOP_REQUEST();
201 $type="REPLY" if $ar_op==ARPOP_REPLY();
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;
211 my $clock_ticks=POSIX::sysconf(&POSIX::_SC_CLK_TCK);
214 return (POSIX::times())[0]/$clock_ticks;
221 my $ifname=shift @ifnames;
222 if ($ifname=~/{(\d+)-(\d+)}/) {
223 push @ifnames,$`.$_.$' for $1..$2;
226 my($sock,$hw,$ip)=sock($ifname);
233 $V>=2 and print Dumper(\%socks);
235 # $pending{$who_has}=[{"when"=>now()+$timeout,"sock"=>$hash->{"sock"},...}...];
237 $V and print localtime()." START\n";
240 vec($rfds,fileno($_->{"sock"}),1)=1 for values(%socks);
242 while (my($who_has,$arrayref)=each(%pending)) {
244 for my $pendingi (0..$#$arrayref) {
245 my $pending=$arrayref->[$pendingi-$deleted];
246 my $when=$pending->{"when"};
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
256 send $sock_hash->{"sock"},$msg_reply,0,$pending->{"from_addr"}
257 or die "send(".$pending->{"ifname"}."): $!";
258 splice @$arrayref,$pendingi-$deleted,1;
260 $V and print localtime()." replied: type=REPLY,"
261 .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
264 $first=$when if !$first || $when<=$first;
267 delete $pending{$who_has} if !@$arrayref;
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;
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";
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 next if $tell eq "0.0.0.0"; # self-detection by Red Hat 7.3
285 my $msg_reply=arp_pack(
286 "FF:FF:FF:FF:FF:FF", # dst_hw
287 $hash->{"hw"}, # src_hw
292 send $hash->{"sock"},$msg_reply,0,$from_addr or die "send($ifname): $!";
293 $V and print localtime()." probing: type=REQUEST,"
294 ."tell=".$hash->{"ip"}.",who_has=$who_has,tell_hw=".$hash->{"hw"}."\n";
295 push @{$pending{$who_has}},{
296 "when"=>now()+$opt_timeout,
301 "from_addr"=>$from_addr,
304 elsif ($type eq "REPLY") {
305 # Rename the fields a bit for REPLY
306 my($told,$who,$is_at_hw)=($who_has,$tell,$tell_hw);
307 for my $pending (@{$pending{$who}}) {
308 $V and print localtime()." discarded: "
309 .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
311 delete $pending{$who};