121 lines
2.6 KiB
Perl
Executable file
121 lines
2.6 KiB
Perl
Executable file
#! /usr/bin/perl -w
|
|
|
|
# Ping test: run through packet sizes (default: 56-3000)
|
|
|
|
use strict;
|
|
use Socket;
|
|
|
|
use constant TRIES => 4;
|
|
use constant TIMEOUT => 3; # 3s
|
|
use constant MAXPACK => 16*1024;
|
|
|
|
use constant ICMP_TYPE_ECHOREPLY => 0; # ICMP packet types
|
|
use constant ICMP_TYPE_ECHO => 8;
|
|
use constant ICMP_CODE => 0; # No ICMP code for ECHO and ECHOREPLY
|
|
|
|
use constant SOL_IP => 0;
|
|
use constant IP_MTU_DISCOVER => 10;
|
|
use constant IP_PMTUDISC_DONT => 0;
|
|
use constant IP_PMTUDISC_WANT => 1;
|
|
use constant IP_PMTUDISC_DO => 2;
|
|
|
|
my $verbose = shift if @ARGV and $ARGV[0] =~ /^--?v(erbose)?$/;
|
|
my ($host, $min, $max) = @ARGV;
|
|
|
|
die "Usage: $0 [-v] HOST [MIN [MAX]]\n" unless $host;
|
|
my $addr = inet_aton $host or die "$0: invalid host $host\n";
|
|
my $sin = sockaddr_in 0, $addr;
|
|
|
|
$min = 56 if @ARGV < 2;
|
|
$max = 3000 if @ARGV < 3;
|
|
$max = $min if $min > $max;
|
|
|
|
my $icmp = getprotobyname 'icmp' or die "$0: can't get ICMP proto ($!)\n";
|
|
socket my $sock, PF_INET, SOCK_RAW, $icmp
|
|
or die "$0: can't create ICMP socket ($!)\n";
|
|
|
|
setsockopt $sock, SOL_IP, IP_MTU_DISCOVER, IP_PMTUDISC_DONT
|
|
or die "$0: can't disable PMTU discovery ($!)\n";
|
|
|
|
{
|
|
my $seq = 0;
|
|
sub icmp_out
|
|
{
|
|
my $len = shift;
|
|
|
|
# fill data with the *$len*$len*$len*...
|
|
my $d = sprintf '*%d', $len;
|
|
my $data = $d x (int ($len / length $d) + 1);
|
|
|
|
my $s = 0 + $seq++;
|
|
$seq %= 65536;
|
|
|
|
my $pack = pack "C C n n n a$len" =>
|
|
ICMP_TYPE_ECHO, # icmp_type
|
|
ICMP_CODE, # icmp_code
|
|
0, # icmp_cksum
|
|
$$, # icmp_id
|
|
$s, # icmp_seq
|
|
$data; # payload
|
|
|
|
my $cksum = 0;
|
|
$cksum += $_ for unpack 'n*' => $pack . "\x00";
|
|
my $wrap;
|
|
$cksum = ($cksum & 0xffff) + $wrap while ($wrap = ($cksum >> 16));
|
|
|
|
substr $pack, 2, 2, pack n => ~$cksum;
|
|
($s, $pack);
|
|
}
|
|
}
|
|
|
|
sub icmp_in
|
|
{
|
|
my ($pack, $seq) = @_;
|
|
return unless length $pack >= 28;
|
|
my ($type, $code, $cksum, $id, $s) = unpack 'C C n n n' => substr $pack, 20;
|
|
return $type == ICMP_TYPE_ECHOREPLY
|
|
and $code == ICMP_CODE
|
|
and $id == $$
|
|
and $s == $seq;
|
|
}
|
|
|
|
$|++ if $verbose;
|
|
|
|
for (my $size = $min; $size <= $max; $size++)
|
|
{
|
|
my ($seq, $pack) = icmp_out $size;
|
|
|
|
print "$size: " if $verbose;
|
|
my $res = 0;
|
|
|
|
for (my $t = 0; $t < TRIES; $t++)
|
|
{
|
|
send $sock, $pack, 0, $sin
|
|
or die "$0: sendto failed ($!)\n";
|
|
|
|
my $rin = '';
|
|
(vec $rin, fileno $sock, 1) = 1;
|
|
select $rin, undef, undef, TIMEOUT or next;
|
|
|
|
my $peer = recv $sock, my $buf, MAXPACK, 0
|
|
or die "$0: recvfrom failed ($!)\n";
|
|
|
|
next unless (sockaddr_in $peer)[1] eq $addr
|
|
and icmp_in $buf, $seq;
|
|
|
|
# OK
|
|
$res++;
|
|
last;
|
|
}
|
|
|
|
if ($verbose)
|
|
{
|
|
print +($res ? 'OK' : 'FAIL'), "\n";
|
|
}
|
|
else
|
|
{
|
|
print "$size\n" unless $res;
|
|
}
|
|
}
|
|
|
|
1;
|