#!/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 switches 
#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 over 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 through 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, and count the results.

  #If result = 0, then no response at all from host - down or firewalled.
  #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 ICMP 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] ) or 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 select : $!";

  #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 bits.

  #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_msg % 2;
  $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
  return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
}