Update changelog.
[l2tpns.git] / test / ping-sweep
1 #! /usr/bin/perl -w
2
3 # Ping test: run through packet sizes (default: 56-3000)
4
5 use strict;
6 use Socket;
7
8 use constant TRIES                      => 4;
9 use constant TIMEOUT                    => 3; # 3s
10 use constant MAXPACK                    => 16*1024;
11
12 use constant ICMP_TYPE_ECHOREPLY        => 0; # ICMP packet types
13 use constant ICMP_TYPE_ECHO             => 8;
14 use constant ICMP_CODE                  => 0; # No ICMP code for ECHO and ECHOREPLY
15
16 use constant SOL_IP                     => 0;
17 use constant IP_MTU_DISCOVER            => 10;
18 use constant IP_PMTUDISC_DONT           => 0;
19 use constant IP_PMTUDISC_WANT           => 1;
20 use constant IP_PMTUDISC_DO             => 2;
21
22 my $verbose = shift if @ARGV and $ARGV[0] =~ /^--?v(erbose)?$/;
23 my ($host, $min, $max) = @ARGV;
24
25 die "Usage: $0 [-v] HOST [MIN [MAX]]\n" unless $host;
26 my $addr = inet_aton $host or die "$0: invalid host $host\n";
27 my $sin = sockaddr_in 0, $addr;
28
29 $min =   56 if @ARGV < 2;
30 $max = 3000 if @ARGV < 3;
31 $max = $min if $min > $max;
32
33 my $icmp = getprotobyname 'icmp' or die "$0: can't get ICMP proto ($!)\n";
34 socket my $sock, PF_INET, SOCK_RAW, $icmp
35     or die "$0: can't create ICMP socket ($!)\n";
36
37 setsockopt $sock, SOL_IP, IP_MTU_DISCOVER, IP_PMTUDISC_DONT
38     or die "$0: can't disable PMTU discovery ($!)\n";
39
40 {
41     my $seq = 0;
42     sub icmp_out
43     {
44         my $len = shift;
45
46         # fill data with the *$len*$len*$len*...
47         my $d = sprintf '*%d', $len;
48         my $data = $d x (int ($len / length $d) + 1);
49
50         my $s = 0 + $seq++;
51         $seq %= 65536;
52
53         my $pack = pack "C C n n n a$len" =>
54             ICMP_TYPE_ECHO,     # icmp_type
55             ICMP_CODE,          # icmp_code
56             0,                  # icmp_cksum
57             $$,                 # icmp_id
58             $s,                 # icmp_seq
59             $data;              # payload
60
61         my $cksum = 0;
62         $cksum += $_ for unpack 'n*' => $pack . "\x00";
63         my $wrap;
64         $cksum = ($cksum & 0xffff) + $wrap while ($wrap = ($cksum >> 16));
65
66         substr $pack, 2, 2, pack n => ~$cksum;
67         ($s, $pack);
68     }
69 }
70
71 sub icmp_in
72 {
73     my ($pack, $seq) = @_;
74     return unless length $pack >= 28;
75     my ($type, $code, $cksum, $id, $s) = unpack 'C C n n n' => substr $pack, 20;
76     return $type == ICMP_TYPE_ECHOREPLY
77         and $code == ICMP_CODE
78         and $id == $$
79         and $s == $seq;
80 }
81
82 $|++ if $verbose;
83
84 for (my $size = $min; $size <= $max; $size++)
85 {
86     my ($seq, $pack) = icmp_out $size;
87
88     print "$size: " if $verbose;
89     my $res = 0;
90
91     for (my $t = 0; $t < TRIES; $t++)
92     {
93         send $sock, $pack, 0, $sin
94             or die "$0: sendto failed ($!)\n";
95
96         my $rin = '';
97         (vec $rin, fileno $sock, 1) = 1;
98         select $rin, undef, undef, TIMEOUT or next;
99         
100         my $peer = recv $sock, my $buf, MAXPACK, 0
101             or die "$0: recvfrom failed ($!)\n";
102
103         next unless (sockaddr_in $peer)[1] eq $addr
104             and icmp_in $buf, $seq;
105
106         # OK
107         $res++;
108         last;
109     }
110
111     if ($verbose)
112     {
113         print +($res ? 'OK' : 'FAIL'), "\n";
114     }
115     else
116     {
117         print "$size\n" unless $res;
118     }
119 }
120
121 1;