Permit multiple machines on a single segment.

diff --git a/harpy b/harpy
index f493fb7..ecb0e6c 100755 (executable)
--- a/harpy
+++ b/harpy
@@ -19,9 +19,16 @@ require "linux/sockios.ph";
 require "linux/if_arp.ph";
 use Data::Dumper;
 sub SOCKADDR_SIZEOF { 16; }
 require "linux/if_arp.ph";
 use Data::Dumper;
 sub SOCKADDR_SIZEOF { 16; }

+require POSIX;
+use Getopt::Long;

 
 
 my $V=1;       # 2
 
 
 my $V=1;       # 2

+my $opt_timeout=0.5;   # [sec]
+die if !GetOptions(
+               "t|timeout=s",\$opt_timeout,
+               "v|verbose+",\$V,
+               );

 
 
 $|=1;
 
 
 $|=1;


@@ -61,6 +68,17 @@ my($ifname)=@_;
        return $sa_data;
 };
 
        return $sa_data;
 };
 

+local *ioctl_ifipaddr=sub($)
+{
+my($ifname)=@_;
+
+       my $buf=$ifname.("\x00"x0x1000);
+       ioctl $sock,SIOCGIFADDR(),$buf or die "ioctl($ifname,SIOCGIFADDR): $!";
+       my($trash,$sockaddr)=unpack("a16a16",$buf);
+       my($sa_len,$sin_port,$sin_addr)=unpack("a2a2a4",$sockaddr);
+       return $sin_addr;
+};
+

 local *ioctl_ifindex=sub($)
 {
 my($ifname)=@_;
 local *ioctl_ifindex=sub($)
 {
 my($ifname)=@_;


@@ -72,6 +90,7 @@ my($ifname)=@_;
 };
 
        my $hw=ioctl_ifhwaddr($ifname);
 };
 
        my $hw=ioctl_ifhwaddr($ifname);

+       my $ip=ioctl_ifipaddr($ifname);

        my $sockaddr_ll=pack "SniSCCa8",                # struct sockaddr_ll:
                        AF_PACKET(),                    # unsigned short int sll_family;
                        ETH_P_ARP(),                    # unsigned short int sll_protocol;
        my $sockaddr_ll=pack "SniSCCa8",                # struct sockaddr_ll:
                        AF_PACKET(),                    # unsigned short int sll_family;
                        ETH_P_ARP(),                    # unsigned short int sll_protocol;


@@ -83,7 +102,7 @@ my($ifname)=@_;
 
        bind $sock,$sockaddr_ll or die "bind($ifname): $!";
 
 
        bind $sock,$sockaddr_ll or die "bind($ifname): $!";
 

-       return $sock,hw_ntoa($hw);
+       return $sock,hw_ntoa($hw),inet_ntoa($ip);

 }
 
 #struct ether_arp_frame {
 }
 
 #struct ether_arp_frame {


@@ -107,10 +126,14 @@ my($ifname)=@_;
 #              } arp;
 #      };
 
 #              } arp;
 #      };
 

-sub arp_pack($$$$)
+sub arp_pack($$$$$)

 {
 {

-my($dst_hw,$src_hw,$dst,$src)=@_;
+my($dst_hw,$src_hw,$dst,$src,$type)=@_;

 
 

+       my $type_bin;
+       $type_bin=ARPOP_REQUEST() if $type eq "REQUEST";
+       $type_bin=ARPOP_REPLY()   if $type eq "REPLY";
+       die "INTERNAL" if !defined $type_bin;

        my $msg=pack "a6a6nnnCCna6a4a6a4",
                hw_aton($dst_hw),       # $ether_dhost
                hw_aton($src_hw),       # $ether_shost
        my $msg=pack "a6a6nnnCCna6a4a6a4",
                hw_aton($dst_hw),       # $ether_dhost
                hw_aton($src_hw),       # $ether_shost


@@ -119,7 +142,7 @@ my($dst_hw,$src_hw,$dst,$src)=@_;
                2048,                   # $ar_pro
                6,                      # $ar_hln
                4,                      # $ar_pln
                2048,                   # $ar_pro
                6,                      # $ar_hln
                4,                      # $ar_pln

-               ARPOP_REPLY(),          # $ar_op
+               $type_bin,              # $ar_op

                hw_aton($src_hw),       # $arp_sha
                inet_aton($src),        # $arp_spa
                hw_aton($dst_hw),       # $arp_tha
                hw_aton($src_hw),       # $arp_sha
                inet_aton($src),        # $arp_spa
                hw_aton($dst_hw),       # $arp_tha


@@ -173,13 +196,22 @@ my($msg)=@_;
                        "arp_tha",
                        "arp_tpa",
                ]);
                        "arp_tha",
                        "arp_tpa",
                ]);

-       return if $ar_op!=ARPOP_REQUEST();
+       my $type;
+       $type="REQUEST" if $ar_op==ARPOP_REQUEST();
+       $type="REPLY"   if $ar_op==ARPOP_REPLY();
+       return if !$type;

        return if $ar_hln!=6;
        return if $ar_pln!=4;
        my $tell=inet_ntoa $arp_spa;
        my $who_has=inet_ntoa $arp_tpa;
        my $tell_hw=hw_ntoa $ether_shost;
        return if $ar_hln!=6;
        return if $ar_pln!=4;
        my $tell=inet_ntoa $arp_spa;
        my $who_has=inet_ntoa $arp_tpa;
        my $tell_hw=hw_ntoa $ether_shost;

-       return $tell,$who_has,$tell_hw;
+       return $tell,$who_has,$tell_hw,$type;
+}
+
+my $clock_ticks=POSIX::sysconf(&POSIX::_SC_CLK_TCK);
+sub now()
+{
+       return (POSIX::times())[0]/$clock_ticks;

 }
 
 
 }
 
 


@@ -191,18 +223,53 @@ while (@ifnames) {
                push @ifnames,$`.$_.$' for $1..$2;
                next;
                }
                push @ifnames,$`.$_.$' for $1..$2;
                next;
                }

-       my($sock,$hw)=sock($ifname);
+       my($sock,$hw,$ip)=sock($ifname);

        $socks{$ifname}={
                        "sock"=>$sock,
                        "hw"=>$hw,
        $socks{$ifname}={
                        "sock"=>$sock,
                        "hw"=>$hw,

+                       "ip"=>$ip,

                        };
        }
                        };
        }

+$V>=2 and print Dumper(\%socks);

 
 

+# $pending{$who_has}=[{"when"=>now()+$timeout,"sock"=>$hash->{"sock"},...}...];
+my %pending;

 $V and print localtime()." START\n";
 for (;;) {
        my $rfds="";
        vec($rfds,fileno($_->{"sock"}),1)=1 for values(%socks);
 $V and print localtime()." START\n";
 for (;;) {
        my $rfds="";
        vec($rfds,fileno($_->{"sock"}),1)=1 for values(%socks);

-       my $got=select $rfds,undef(),undef(),undef();
+       my $first;
+       while (my($who_has,$arrayref)=each(%pending)) {
+               my $deleted=0;
+               for my $pendingi (0..$#$arrayref) {
+                       my $pending=$arrayref->[$pendingi-$deleted];
+                       my $when=$pending->{"when"};
+                       if ($when<=now()) {
+                               my $sock_hash=$socks{$pending->{"ifname"}};
+                               my $msg_reply=arp_pack(
+                                               $pending->{"tell_hw"},  # dst_hw
+                                               $sock_hash->{"hw"},     # src_hw
+                                               $pending->{"tell"},     # dst
+                                               $pending->{"who_has"},  # src
+                                               "REPLY",                # type
+                                               );
+                               send $sock_hash->{"sock"},$msg_reply,0,$pending->{"from_addr"}
+                                               or die "send(".$pending->{"ifname"}."): $!";
+                               splice @$arrayref,$pendingi-$deleted,1;
+                               $deleted++;
+                               $V and print localtime()." replied: type=REPLY,"
+                                               .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
+                               }
+                       else {
+                               $first=$when if !$first || $when<=$first;
+                               }
+                       }
+               delete $pending{$who_has} if !@$arrayref;
+               }
+       my $now=now();
+       $first=$now if $first && $first<$now;
+       $V>=3 and print Data::Dumper->Dump([\%pending],['\%pending']);
+       my $got=select $rfds,undef(),undef(),(!$first ? undef() : $first-$now);

        die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 
        while (my($ifname,$hash)=each(%socks)) {
        die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 
        while (my($ifname,$hash)=each(%socks)) {


@@ -210,10 +277,40 @@ for (;;) {
                $V>=2 and print localtime()." got packet: $ifname\n";
                my $msg;
                defined(my $from_addr=recv $hash->{"sock"},$msg,0x1000,0) or die "recv($ifname): $!";
                $V>=2 and print localtime()." got packet: $ifname\n";
                my $msg;
                defined(my $from_addr=recv $hash->{"sock"},$msg,0x1000,0) or die "recv($ifname): $!";

-               next if !(my($tell,$who_has,$tell_hw)=arp_unpack($msg));
-               $V and print localtime()." got: tell=$tell,who_has=$who_has,tell_hw=$tell_hw\n";
-               next if $tell eq $who_has;      # do not reply to self-detection queries
-               my $msg_reply=arp_pack($tell_hw,$hash->{"hw"},$tell,$who_has);
-               send $hash->{"sock"},$msg_reply,0,$from_addr or die "send($ifname): $!";
+               next if !(my($tell,$who_has,$tell_hw,$type)=arp_unpack($msg));
+               $V and print localtime()." got: type=$type,tell=$tell,who_has=$who_has,tell_hw=$tell_hw\n";
+               if ($type eq "REQUEST") {
+                       next if $tell eq $who_has;      # do not reply to self-detection queries
+                       my $msg_reply=arp_pack(
+                                       "FF:FF:FF:FF:FF:FF",    # dst_hw
+                                       $hash->{"hw"},          # src_hw
+                                       $who_has,               # dst
+                                       $hash->{"ip"},          # src
+                                       "REQUEST",              # type
+                                       );
+                       send $hash->{"sock"},$msg_reply,0,$from_addr or die "send($ifname): $!";
+                       $V and print localtime()." probing: type=REQUEST,"
+                                       ."tell=".$hash->{"ip"}.",who_has=$who_has,tell_hw=".$hash->{"hw"}."\n";
+                       push @{$pending{$who_has}},{
+                                       "when"=>now()+$opt_timeout,
+                                       "ifname"=>$ifname,
+                                       "tell"   =>$tell,
+                                       "who_has"=>$who_has,
+                                       "tell_hw"=>$tell_hw,
+                                       "from_addr"=>$from_addr,
+                                       };
+                       }
+               elsif ($type eq "REPLY") {
+                       # Rename the fields a bit for REPLY
+                       my($told,$who,$is_at_hw)=($who_has,$tell,$tell_hw);
+                       for my $pending (@{$pending{$who}}) {
+                               $V and print localtime()." discarded: "
+                                               .join(",",map(("$_=".$pending->{$_}),qw(tell who_has tell_hw)))."\n";
+                               }
+                       delete $pending{$who};
+                       }
+               else {
+                       die "NOTREACHED";
+                       }

                }
        }
                }
        }