Network Duplex speed test

[Preceptor]

We are currently having oodles of fun with a new backup server, and problems with autonegotiation settings with switches. The problem is, essentially, that we have a number of switches that don't negotiate properly. We have been directed to set everything to force 100-full duplex.

As anyone who's experienced network duplex settings is aware, this can cause chaos and intermittent errors, especially when it comes time to run your backups.

So I knocked together this script to test servers on our local subnet to see if they were running full duplex. This avoids the awkwardness of logging in to each server (NT, 2K, Solaris, AIX, IRIX) and on each pulling a mac address, and the interface settings, and comparing those with network switches.
For my usage, I ran this on a 100/full machine, against other machines of a similar speed. (in theory).
It's less likely to work for things on a separate subnet (although you might be able to), and less likely still on a firewalled subnet.

Thanks to that Author of Net::Ping, Rob Brown, this was made much easier. And now I have about 50 less servers running half duplex.

And yes, there is a potential malicious use for this, in a fairly trivial fashion, but if you're smart enough to figure it out, or be aware of it, then this fairly trivial bit of code won't make the _slightest_ difference.

#!/usr/bin/perl

#This utility is designed to test a remote host to see if it's network
+ interface is running at 
#full or half duplex. 
#
#We have had a lot of problems with this, since we've got a batch of s
+witches 
#that don't negotiate properly.
#
#It's loosely based on Net::Ping, since there were a number of useful 
+reference
#points in there (like packet checksumming).

#in essence, what it does is send a rapid burst of packets that are ov
+er the ethernet
#MTU size. This triggers a burst of responses from the remote end. (if
+ not firewalled etc.)
#A machine that is running half duplex, will respond to significantly 
+less of these packets,
#than a machine that is running full duplex.

use strict;
use warnings;

use IO::Select;
use Socket;
use FileHandle;

#configuration stuff

my $data_size = 10240; 
my $pid = $$ && 0xffff;
my $data = "E"x10240;

my $debug = 0;

use constant PINGCOUNT => 500;
use constant TOO_FEW => 0.4;   #what proportion of packets must get th
+rough in order to be considered
                               #'full duplex'. Yes, 60% packet loss is
+ horrible, but so is hitting things
                               #with 10k of fragmented ICMP packets.

use constant PORT => 1;        #set to 1 because ICMP has no port, but
+ the socket functions need one.
use constant SIZE => 1500;      #MTU for ethernet

use constant TIMEOUT => 5;     #2 seconds 

use constant ICMP_ECHO         => 8;
use constant ICMP_ECHOREPLY     => 0;
use constant ICMP_STRUCT     => "C2 S3 A"; #minimal packet.
use constant ICMP_FLAGS     => 0; #no special flags in this case.
use constant ICMP_PORT         => 0; #icmp has no port.
use constant SUBCODE        => 0;

# end of config
my $buff;

if ( $< != 0 )
{
  die "This program needs to be run as root.\n";
}

my @targets = () ;
if ( $#ARGV >= 0 )
{
  @targets = @ARGV;
}
else
{
  print "usage: $0 <hosts to ping>\n";
}

foreach my $target ( @targets )
{
  my $result = 0;
  $result = burst_ping($target);  #send lots of pings at the target, a
+nd count the results.

  #If result = 0, then no response at all from host - down or firewall
+ed.
  #if result > PINGCOUNT * TOO_FEW (eg. more than 40% of packets have 
+been recieved) then
  #the remote host is probably full duplex.
  #If less responses are recieved, but more than 0, then the system is
+ probably half duplex.
  #typical results for half duplex are <10%

  if ( $result > 0 ) 
  {
    print $target,": ", $result, "/", PINGCOUNT, 
          $result < PINGCOUNT * TOO_FEW
          ? " system is running at half-duplex.\n" 
          : " system is running full-duplex.\n" ;
  } 
  else 
  {
    print "$target is down\n";
  } 

  if ( $result < PINGCOUNT * TOO_FEW ) { sleep TIMEOUT } #to allow ICM
+P messages to catch up
                     #since this script is going to be run on a batch 
+of hosts at once.
}

sub burst_ping
{
  my ( $target ) = @_;

  #open a file handler to use for sending and recieveing ICMP messages
+. 
  my $pinger = FileHandle -> new();
  $pinger -> autoflush(1);
  socket ( $pinger, PF_INET, SOCK_RAW, (getprotobyname('icmp'))[2] ) o
+r die "couldn't open socket: $!";

  my $sent = 0;
  my $received = 0;
  
  #we need to use select, because recv is a blocking call - if there's
+ nothing to recv, then it'll
  #wait. We don't want to do that.
  my $select = IO::Select -> new ( $pinger ) or die "Could not init se
+lect : $!";

  #get a socket flavour address.
  my $target_addr = sockaddr_in( ICMP_PORT, inet_aton("$target") );
  

  #Now generate a packet to send. Loosely stolen from Net::Ping.
  my $checksum = 0;
  my $msg = pack(ICMP_STRUCT . $data_size, ICMP_ECHO, SUBCODE,
            $checksum, $pid, $sent % 65536, $data );
  $checksum = checksum($msg);
  $msg = pack(ICMP_STRUCT . $data_size, ICMP_ECHO, SUBCODE,
             $checksum, $pid, $sent % 65536, $data );

  while ( $sent < PINGCOUNT )
  {
    #if there's data to be read, then we do
    if ( $select -> can_read( 0 ) )
    {
      my $remote = recv ( $pinger, $buff, SIZE, ICMP_FLAGS );
      if ( $debug ) { print "result from ", unpack("C*",$remote), ":",
                                  unpack ( "C*", $target_addr), "\n"; 
+}

     #sometimes we get ICMP traffic from other sources, so we want to 
+filter it.
     if ( $remote eq $target_addr )
     {
        ++$received;
     }
    }
    else #no io waiting, so we can send another packet.
    {
      ++$sent;
      send ( $pinger, $msg, ICMP_FLAGS, $target_addr );
    }
  }

  #sent an few, and probably caught most of them. Here is to tidy up
  #note that this time we wait for TIMEOUT, to allow any of the slower
+ packets to get back to
  #us.
  while ( $select -> can_read( TIMEOUT ) )
  {
    my $remote = recv ( $pinger, $buff, SIZE, ICMP_FLAGS );
    if ( $remote eq $target_addr )
    {
      ++$received;
    }
  }

  if ( $debug ) { print "$received/$sent\n";}

  $pinger -> flush();
  close ( $pinger ) ;
  return $received;
} #sub 

sub checksum
{
  # Description:  Do a checksum on the message.  Basically sum all of
  # the short words and fold the high order bits into the low order bi
+ts.

  #stolen from Net::Ping. Thanks to Rob Brown. Not essential, but much
+ more 
  #elegant than sending packets with bad checksums.

  my ( $msg ) = @_;   # the packet to checksum
  my ($len_msg,       # Length of the message
      $num_short,     # The number of short words in the message
      $short,         # One short word
      $chk            # The checksum
      );

  $len_msg = length($msg);
  $num_short = int($len_msg / 2);
  $chk = 0;
  foreach $short (unpack("S$num_short", $msg))
  {
    $chk += $short;
  }                                           # Add the odd byte in
  $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_ms
+g % 2;
  $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
  return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
}

[NetWallah]

Interesting little program - I'm curious - is there a reason you decided to use sockets and hand-craft packets, instead of using pcap ?

Also - I'm surprised you didn't build-in a subnet scanner into this. Perhaps you were trying to get basic functionality into this, and have a higher-level control program , which you could perhaps share ??

I'm thinking this would be useful to probe and discover the less-reliable parts of a switched network, and perhaps uncover faulty wiring, flaky switches, or even unauthorized network extensions. Perhaps even as an indicator of network segment performance at different times of the day.

[Preceptor]

I've used pcap in different programs, and essentially, the route I went to develop it didn't really go near pcap :). I've always thought of pcap as a way to write custom packet sniffing tools (I've got one that just logs host and service of machines that access a particular server. Used just prior to decommissioning it to check if anything would break horribly when we did)

I started with a need to send pings, so started using Net::Ping. Then, when that proved no use for my needs, I started looking at the source code, and adapting from there.
The reason I didn't include a subnet scanner, was partially because as is, this program fulfills my need, and partially because sending a large number of fragmented ICMP packets counts as a DOS. So hitting a whole subnet with them is a very rude thing to do.
For subnet scanning, I use nmap. It's fairly easy to do a pingsweep in nmap, and feed the results through to this script :)

I hadn't really considered using it as a network performance indicator. I suppose that as the network load drops, the quantity of returned packets will increase, but my primary aim was to track down the few machines that were slowing us down (backups primarily) by running half duplex.

[melora]

Looks like a handy bit of code. I'm trying to use it on our dinky LAN, just testing and hoping to do some benchmarking and learning more about network programming in Perl. However, I'm getting errors from the recv() calls - they are resulting in undefined $remote. I'm giving the program IP addresses on our local LAN (e.g. 10.0.0.20), ones that I can successfully ping. Where do I go from here? (ooh, I opened myself up that time). melora

[Anonymous Monk]

My guess would be because the pcap interface is severely broken/outdated/whatever.