#!/usr/bin/perl

# Test if our network is running at the standard Ethernet MTU size

use strict;
use warnings;

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

# configuration stuff

# Packet size = Data size + 28 bytes of header info
my $good_data_size = 1472; 
my $fail_data_size = 1473;
my $pid = $$ && 0xffff;

my $debug = 0;

use constant PINGCOUNT          => 5;
use constant PORT               => 1;    # ICMP has no port, but the socket functions need one.
use constant SIZE               => 1520; # MTU for ethernet + some extra
use constant TIMEOUT            => 1;    #in seconds

use constant ICMP_ECHO          => 8;
use constant ICMP_ECHOREPLY     => 0;
use constant ICMP_STRUCT        => "C2 n3 A"; #minimal packet.
use constant ICMP_FLAGS         => 2;    #do not fragment flag

use constant RCV_FLAGS          => 0;    #no special flags
use constant ICMP_PORT          => 0;    #icmp has no port.
use constant SUBCODE            => 0;

use constant IPPROTO_IP         => 0;
use constant IP_MTU_DISCOVER    => 10;
use constant IP_PMTUDISC_DO     => 2;
# 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 ($ping_result,$good_result,$fail_result) = 0;

        $ping_result = send_pings($target,66);  #send normalish sized ping

        if ( ! $ping_result ) {
                print "$target is down\n";
        } else {
                # send max ping that should be allowed
                $good_result = send_pings($target,$good_data_size);
                # send ping that should fail  
                $fail_result = send_pings($target,$fail_data_size);

                if ( $good_result > 0 && $fail_result == 0 ) {
                        print "$target MTU is good\n";
                }
                if ($good_result == 0) {
                        print "$target MTU is too small!\n";
                }
                if ($fail_result > 0) {
                        print "$target MTU is too large!\n";
                }
        }
}

# Send raw ping packets to a target with $data_size bytes. Mostly stolen from Net::Ping.
sub send_pings { 
        my ( $target, $data_size ) = @_;
        my $data = "E"x$data_size;

        # open a socket file handle 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: $!";

        # Turn off fragmentation so we can attempt to figure out what the MTU size is
        # Set the IPPROTO_IP (0) IP_MTU_DISCOVER (10) option to IP_PMTUDISC_DO (2)
        #setsockopt($pinger, 0, 10, pack("I*", 2));  
        setsockopt($pinger, IPPROTO_IP, IP_MTU_DISCOVER, pack("I*", IP_PMTUDISC_DO));  

        my $sent = 0;
        my $received = 0;

        # keep from blocking if there's nothing to read from the network
        my $select = IO::Select -> new ( $pinger ) or die "Could not init select : $!";

        #get address in network format
        my $target_addr = sockaddr_in( ICMP_PORT, inet_aton("$target") );


        # generate a packet to send.
        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 );

        #Send at most PINGCOUNT pings, if we receive any valid replies, we're done
        while ( $sent < PINGCOUNT && (!$received) ) {
                # if there's data to be read, then get the data
                if ( $select -> can_read( 0 ) ) {
                        my $remote = recv ( $pinger, $buff, SIZE, RCV_FLAGS );
                        if ( $debug ) { 
                                print "result from ", unpack("C*",$remote), ":",
                                       unpack ( "C*", $target_addr), "\n"; 
                        }

                        # sometimes ICMP replies come from other devices, filter those out
                        if ( $remote eq $target_addr ) {
                                $received++;
                        }
                } else {
                        # there's no I/O is waiting, so we can send another packet.
                        $sent++;
                        send ( $pinger, $msg, ICMP_FLAGS, $target_addr );

                        # sleep two tenths of a second before sending another packet
                        # to keep from creating a DOS attack
                        select(undef, undef, undef, 0.2);  
                }
        }

        # we've sent some packets, and probably caught most of them, 
        # see if we catch any more within TIMEOUT
        while ( $received < $sent && $select -> can_read( TIMEOUT ) ) {
                my $remote = recv ( $pinger, $buff, SIZE, RCV_FLAGS );
                if ( $remote eq $target_addr ) {
                        $received++;
                }
        }

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

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

sub checksum {
        # Calculate the 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

        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("n$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
}