ip_watcher/ip_watcher.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # ip_watcher.pl
   4 #
   5 # Copyright IBM Corp. 2003, 2006.
   6 # Author(s): Utz Bacher <utz.bacher@de.ibm.com>
   7 #
   8 # looks for addresses in the HiperSockets and sets them as Proxy ARP on the
   9 # OSAs. Also adds routing entries towards the HiperSockets interfaces for
  10 # all IP addresses in it
  11
  12 # $OPERATING_MODE="routing_only";
  13 #   ip_watcher just takes care of adapting the routing entries. ipv4
  14 #   forwarding needs to be switched on, if desired mrouted or some multicast
  15 #   routing daemon should run. ip_watcher also sets the proxy arp entries
  16 #   of all hsi addresses on the osa device.
  17 #
  18 # $OPERATING_MODE="full_bridging";
  19 #   this is like routing_only mode, plus xcec-bridge will bridge all
  20 #   kinds of traffic (uni-, multi-, broadcast) between the interfaces,
  21 #   so the stack will not do forwarding.
  22 #   if interfaces come and go, xcec-bridge will be sent a SIGUSR1.
  23 #
  24 # $OPERATING_MODE="mc_bridging";
  25 #   this is a mixture of the above -- ipv4 forwarding of unicast packets
  26 #   is done by the kernel, multi- and broadcast traffic is bridged by
  27 #   xcec-bridge.
  28 #
  29 # $OPERATING_MODE="bc_bridging";
  30 #   this is another mixture of the above -- ipv4 forwarding of unicast
  31 #   packets is done by the kernel, multicast is handled by mrouted or some
  32 #   multicast router, and broadcast traffic is bridged by xcec-bridge.
  33
  34 $OPERATING_MODE="mc_bridging";
  35
  36 $XCEC_BRIDGE="xcec-bridge";
  37 $XCEC_BRIDGE_FULL_PARAM="also_unicast";
  38 $XCEC_BRIDGE_MC_PARAM="";
  39 $XCEC_BRIDGE_BC_PARAM="only_broadcast";
  40
  41 $KILLALL="killall";
  42 $SIGNAL="-USR1";
  43
  44 $MASK_PARAM="netmask";
  45 $DEV_PARAM="dev";
  46 $QETHARP="qetharp -c -q";
  47 $ROUTE_ADD_CMD='route add -net ';
  48 $ROUTE_DEL_CMD='route del -net ';
  49 $PA_ADD_CMD='qethconf parp add -x';
  50 $PA_DEL_CMD='qethconf parp del -x';
  51 # $PA_ADD_CMD='echo add_rxip4';
  52 # $PA_DEL_CMD='echo del_rxip4';
  53 # $PA_ADD_POST_CMD='>/proc/qeth_ipa_takeover';
  54 # $PA_DEL_POST_CMD='>/proc/qeth_ipa_takeover';
  55
  56 $QETH_PROC_FILE="/proc/qeth";
  57 $CHECK_ONLY="no";
  58
  59 $nextarg=0;
  60 if ($#ARGV>=$nextarg) {
  61         if ($ARGV[$nextarg] eq "--check") {
  62                 $CHECK_ONLY="yes";
  63                 $nextarg++;
  64         }
  65 }
  66
  67 # if there is a parameter to ip_watcher.pl, the parameter will be the
  68 # Proxy ARP interface (i.e. the outgoing OSA interface). In this case,
  69 # xcec-bridge will not be started, so that only unicast is forwarded.
  70
  71 # eth0 is default OSA interface
  72 if ($#ARGV>=$nextarg) {
  73         $PA_INTERFACE=$ARGV[$nextarg];
  74         $START_XCEC_BRIDGE="no";
  75 } else {
  76         $PA_INTERFACE="";
  77         $START_XCEC_BRIDGE="yes";
  78 }
  79
  80 $PROXY_ARP_INTERFACE='( ((index($if_name,"eth")==0) && ($rtr eq "mc")) ||
  81         ((index($if_name,"eth")==0) && ($rtr eq "mc+")) ||
  82         ((index($if_name,"tr")==0) && ($rtr eq "mc")) ||
  83         ((index($if_name,"tr")==0) && ($rtr eq "mc+")) )';
  84
  85 $SLEEP_TIME=2;
  86 #$TIME_LIMIT=4;
  87 #@time_array=(time,time-1,time-2);
  88
  89
  90 # all relevant interfaces are no routers
  91 # $RELEVANT_INTERFACE='($rtr eq "no")';
  92 # all interfaces start with "hsi"
  93 # $RELEVANT_INTERFACE='($if_name=~/^hsi/)';
  94 # all relevant interfaces are connectors
  95 # $RELEVANT_INTERFACE='(($rtr eq "p.c") || ($rtr eq "s.c") ||
  96 #                       ($rtr eq "p+c") || ($rtr eq "s+c"))';
  97
  98 $RELEVANT_INTERFACE='(($rtr eq "p.c") || ($rtr eq "s.c") ||
  99                       ($rtr eq "p+c") || ($rtr eq "s+c"))';
 100
 101
 102 sub print_list($@)
 103 {
 104         my($h)=shift;
 105         my(@a)=@_;
 106         my($i);
 107         foreach $i (@a) {
 108                 print "DEBUG ". $h .": ". $i ."\n";
 109         }
 110 }
 111
 112
 113 # get outgoing OSA interface (connecting the CECs)
 114 sub get_proxy_arp_interface
 115 {
 116         my($devnos);
 117         my($chpid);
 118         my($if_name);
 119         my($type);
 120         my($port);
 121         my($chksum);
 122         my($prio);
 123         my($rtr);
 124         my($rest);
 125
 126         if (open(FD,"<" . $QETH_PROC_FILE)) {
 127                 <FD>; # header line
 128                 <FD>; # ------ line
 129
 130                 while (<FD>) {
 131                         chop;
 132                         s/[\t]{1,}/ /g;
 133                         s/ {2,}/ /g;
 134                         ($devnos,$chpid,$if_name,$type,
 135                                 $port,$chksum,$prio,$rtr,$rest)=split(/\s/);
 136                         if (eval $PROXY_ARP_INTERFACE) {
 137                                 $PA_INTERFACE=$if_name;
 138                         }
 139                 }
 140
 141                 close(FD);
 142         } elsif (opendir(SYSQETH, "/sys/devices/qeth")) {
 143                 @ALLDEV = grep { /^.+\..+\..+$/ } readdir SYSQETH;
 144                 closedir SYSQETH;
 145
 146                 foreach $DEV (@ALLDEV) {
 147                         open(IFNAME, "</sys/devices/qeth/$DEV/if_name") or next;
 148                         chomp($if_name = readline(IFNAME));
 149                         close(IFNAME);
 150                         open(RTR, "</sys/devices/qeth/$DEV/route4") or next;
 151                         chomp($rtr = readline(RTR));
 152                         close(RTR);
 153                         if ( $if_name =~ /^tr|eth.+/ and $rtr =~ /^multicast.+/ ) {
 154                                 $PA_INTERFACE=$if_name;
 155                         }
 156                 }
 157         } else {
 158                 die "could not get availabe qeth interfaces\n";
 159         }
 160
 161         if ($PA_INTERFACE eq "") {
 162                 die "no multicast router defined or no " .
 163                         "LAN interface specified as parameter.\n";
 164         }
 165 }
 166
 167 # get all interfaces to poll ip addresses from
 168 sub update_interface_list
 169 {
 170         my($devnos);
 171         my($chpid);
 172         my($if_name);
 173         my($type);
 174         my($port);
 175         my($chksum);
 176         my($prio);
 177         my($rtr);
 178         my($rest);
 179         my(@if_list)=();
 180
 181         if (open(FD,"<" . $QETH_PROC_FILE)) {
 182                 <FD>; # header line
 183                 <FD>; # ------ line
 184                 while (<FD>) {
 185                         chop;
 186                         s/[\t]{1,}/ /g;
 187                         s/ {2,}/ /g;
 188                         ($devnos,$chpid,$if_name,$type,
 189                                 $port,$chksum,$prio,$rtr,$rest)=split(/\s/);
 190                         if (eval $RELEVANT_INTERFACE) {
 191                                 push(@if_list,$if_name);
 192                         }
 193
 194                 }
 195                 close(FD);
 196         } elsif (opendir(SYSQETH, "/sys/devices/qeth")) {
 197                 @ALLDEV = grep { /^.+\..+\..+$/ } readdir SYSQETH;
 198                 closedir SYSQETH;
 199
 200                 foreach $DEV (@ALLDEV) {
 201                         open(IFNAME, "</sys/devices/qeth/$DEV/if_name") or next;
 202                         chomp($if_name = readline(IFNAME));
 203                         close(IFNAME);
 204                         open(RTR, "</sys/devices/qeth/$DEV/route4") or next;
 205                         chomp($rtr = readline(RTR));
 206                         close(RTR);
 207                         if ( $rtr =~ /^.+connector.*/ ) {
 208                                 push(@if_list,$if_name);
 209                         }
 210                 }
 211         } else {
 212                 print STDERR "could not get availabe qeth interfaces\n";
 213                 return ();
 214         }
 215         return @if_list
 216 }
 217
 218 # only returns with a maximal frequency
 219 sub limit_frequency
 220 {
 221 #       my($t_now)=time;
 222 #       my($t_last);
 223 #       my($sleep_time);
 224
 225 #       unshift(@time_array,$t_now);
 226 #       $t_last=pop(@time_array);
 227 #       $sleep_time=$TIME_LIMIT-($t_now-$t_last);
 228 #       if ($sleep_time>0) {
 229 #               sleep($sleep_time);
 230 #       }
 231         sleep($SLEEP_TIME);
 232 }
 233
 234 # creates a 0x01020304 out of a 1.2.3.4
 235 sub convert_ip_string_to_number($)
 236 {
 237         my($ip_str)=shift;
 238         my(@ip);
 239         my($ip_oct1);
 240         my($ip_oct2);
 241         my($ip_oct3);
 242         my($ip_oct4);
 243
 244         @ip=split(/\./,$ip_str);
 245
 246 # check for parsing error
 247         if ($#ip<3) {
 248                 return 0;
 249         }
 250
 251         ($ip_oct1,$ip_oct2,$ip_oct3,$ip_oct4)=@ip;
 252
 253         if ( ($ip_oct1<0) || ($ip_oct1>255) ||
 254                 ($ip_oct2<0) || ($ip_oct2>255) ||
 255                 ($ip_oct3<0) || ($ip_oct3>255) ||
 256                 ($ip_oct4<0) || ($ip_oct4>255) ) {
 257                 return 0;
 258         }
 259
 260         return ($ip_oct1<<24)+($ip_oct2<<16)+($ip_oct3<<8)+($ip_oct4);
 261 }
 262
 263 # returns sorted list of ips (in integer format like __u32) of the interface
 264 sub get_ips_on_interface($)
 265 {
 266         my($interface)=shift;
 267         my($cmdline)="$QETHARP $interface |";
 268         my(@ip_list)=();
 269         my($OUTPUT);
 270         my($ip);
 271
 272         unless (open(OUTPUT,$cmdline)) {
 273                 print STDERR "can't open $cmdline";
 274                 return @ip_list;
 275         }
 276         while (<OUTPUT>) {
 277                 chop;
 278                 $ip=convert_ip_string_to_number($_);
 279                 if ($ip>0) {
 280                         push(@ip_list,$ip);
 281                 }
 282         }
 283         close(OUTPUT) || print STDERR "can't close $cmdline";
 284
 285         return sort @ip_list;
 286 }
 287
 288 # creates a 1.2.3.4 out of a 0x1020304
 289 sub convert_string_to_ip($)
 290 {
 291         my($ip)=shift;
 292         my($ip_oct1);
 293         my($ip_oct2);
 294         my($ip_oct3);
 295         my($ip_oct4);
 296
 297         $ip_oct4=$ip&0xff;
 298         $ip>>=8;
 299         $ip_oct3=$ip&0xff;
 300         $ip>>=8;
 301         $ip_oct2=$ip&0xff;
 302         $ip>>=8;
 303         $ip_oct1=$ip&0xff;
 304
 305         return "$ip_oct1.$ip_oct2.$ip_oct3.$ip_oct4";
 306 }
 307
 308 sub __min($$)
 309 {
 310         my($a)=shift;
 311         my($b)=shift;
 312         if ($a<$b) {
 313                 return $a;
 314         } else {
 315                 return $b;
 316         }
 317 }
 318
 319 # will create an array of routes in string format
 320 sub get_routes_of_ip_list(@)
 321 {
 322         my(@ip_list)=@_;
 323         my(@route_list)=();
 324         my($ip);
 325         my($ips_left);
 326         my($ips_to_combine);
 327         my($ip_shifted);
 328         my($ips_found);
 329         my($end);
 330         my($order);
 331         my($mask);
 332         my($ip_str);
 333         my($mask_str);
 334         my($ips_fetched);
 335
 336         while ($#ip_list>=0) {
 337                 # ips_left is the number of ips left in the list
 338                 $ips_left=$#ip_list;
 339                 $ip=shift(@ip_list);
 340                 $ips_to_combine=1;
 341                 $ip_shifted=$ip;
 342                 while ($ip_shifted%2==0) {
 343                         $ips_to_combine<<=1;
 344                         $ip_shifted>>=1;
 345                         # 0 should never be in the list, anyway...
 346                         if (!$ip_shifted) {
 347                                 last;
 348                         }
 349                 }
 350                 # ips_to_combine is a power of 2 and contains the max number
 351                 # of entries that could compressed into one route due to its
 352                 # alignment
 353                 $end=__min($ips_to_combine-1,$ips_left);
 354                 $order=1;
 355                 $ips_found=1;
 356                 while ($ips_found<=$end) {
 357                         # ips_found-1, as we have shifted the first ip
 358                         # already
 359                         if ($ip_list[$ips_found-1]!=$ip+$ips_found) {
 360                                 last;
 361                         }
 362                         $ips_found++;
 363                         if ($ips_found==2*$order) {
 364                                 $order<<=1;
 365                         }
 366                 }
 367                 # ips_found is now the number of subsequent ips that we can
 368                 # subsum (one of which is shifted already)
 369                 $mask=(-$order)&0xffffffff;
 370                 $ips_fetched=1;
 371                 while ($ips_fetched<$order) {
 372                         $ips_fetched++;
 373                         shift(@ip_list);
 374                 }
 375                 $mask_str=convert_string_to_ip($mask);
 376                 $ip_str=convert_string_to_ip($ip);
 377                 unshift(@route_list,"$ip_str $MASK_PARAM $mask_str");
 378         }
 379
 380         return @route_list;
 381 }
 382
 383 # will create an array of rxips in string format
 384 sub get_pas_of_ip_list(@)
 385 {
 386         my(@ip_list)=@_;
 387         my(@pa_list)=();
 388
 389         foreach $ip (@ip_list) {
 390                 unshift(@pa_list,"" . sprintf("%08x",$ip));
 391         }
 392
 393         return @pa_list;
 394 }
 395
 396 sub is_in_list($@)
 397 {
 398         my($item)=shift;
 399         my(@list)=@_;
 400         my($i);
 401
 402         foreach $i (@list) {
 403                 if ($i eq $item) {
 404                         return 1;
 405                 }
 406         }
 407         return 0;
 408 }
 409
 410 sub exec_for_diff($@@)
 411 {
 412         my($cmd)=shift;
 413         my($new_list,$old_list)=@_;
 414
 415         foreach $line (@$new_list) {
 416                 unless (is_in_list($line,@$old_list)) {
 417                         system($cmd . $line . "> /dev/null 2>&1");
 418                 }
 419         }
 420 }
 421
 422 sub wait_for_changes()
 423 {
 424 # blocking ioctl to be informed on SETIP/DELIPs (once it's implemented in
 425 # hardware) or sleep for X timeunits
 426 }
 427
 428 sub main()
 429 {
 430         my(@routes)=();
 431         my(@pas)=();
 432         my(@new_routes);
 433         my(@new_pas);
 434         my(@interface_list)=();
 435         my(@old_if_list);
 436         my($interface);
 437         my(@ip_list);
 438         my($route);
 439         my(@tmp_routes);
 440
 441         get_proxy_arp_interface();
 442
 443         if ($CHECK_ONLY eq "yes") {
 444                 exit 0;
 445         }
 446
 447         if ($START_XCEC_BRIDGE eq "yes") {
 448                 if ($OPERATING_MODE eq "full_bridging") {
 449                         system("$XCEC_BRIDGE $XCEC_BRIDGE_FULL_PARAM &")==0 ||
 450                                 die "can't fork $XCEC_BRIDGE: $?";
 451                 }
 452                 if ($OPERATING_MODE eq "mc_bridging") {
 453                         system("$XCEC_BRIDGE $XCEC_BRIDGE_MC_PARAM &")==0 ||
 454                                 die "can't fork $XCEC_BRIDGE: $?";
 455                 }
 456                 if ($OPERATING_MODE eq "bc_bridging") {
 457                         system("$XCEC_BRIDGE $XCEC_BRIDGE_BC_PARAM &")==0 ||
 458                                 die "can't fork $XCEC_BRIDGE: $?";
 459                 }
 460         }
 461
 462         for (;;) {
 463                 if ( ($OPERATING_MODE eq "mc_bridging") ||
 464                      ($OPERATING_MODE eq "bc_bridging") ||
 465                      ($OPERATING_MODE eq "full_bridging") ) {
 466                         @old_if_list=@interface_list;
 467                 }
 468                 @interface_list=update_interface_list();
 469                 if ( ($OPERATING_MODE eq "mc_bridging") ||
 470                      ($OPERATING_MODE eq "bc_bridging") ||
 471                      ($OPERATING_MODE eq "full_bridging") ) {
 472                         if ( join(':',@old_if_list) ne
 473                                 join(':',@interface_list) ) {
 474                                 if ($START_XCEC_BRIDGE eq "yes") {
 475                                 system("$KILLALL $SIGNAL $XCEC_BRIDGE")==0 ||
 476                                         print STDERR "can't send signal " .
 477                                         "to $XCEC_BRIDGE to update " .
 478                                         "interfaces.\n";
 479                                 }
 480                         }
 481                 }
 482                 @new_routes=();
 483                 @new_pas=();
 484                 foreach $interface (@interface_list) {
 485                         @ip_list=get_ips_on_interface($interface);
 486
 487                         @tmp_routes=get_routes_of_ip_list(@ip_list);
 488                         foreach $route (@tmp_routes) {
 489                                 unshift(@new_routes,
 490                                    "$route $DEV_PARAM $interface");
 491                         }
 492
 493                         @tmp_pas=get_pas_of_ip_list(@ip_list);
 494                         foreach $pa (@tmp_pas) {
 495                                 unshift(@new_pas,
 496                                         "$pa $PA_INTERFACE");
 497                         }
 498                 }
 499
 500                 exec_for_diff($ROUTE_ADD_CMD,\@new_routes,\@routes);
 501                 exec_for_diff($ROUTE_DEL_CMD,\@routes,\@new_routes);
 502                 @routes=@new_routes;
 503
 504                 exec_for_diff($PA_ADD_CMD,\@new_pas,\@pas);
 505                 exec_for_diff($PA_DEL_CMD,\@pas,\@new_pas);
 506                 @pas=@new_pas;
 507
 508                 wait_for_changes();
 509                 limit_frequency();
 510         }
 511 }
 512
 513 main();