tests/fuzznet.pl

#!/usr/bin/perl
# fuzznet.pl <host> <port> <iters> <corpus-dir> — socket-level request
# fuzzer: mutates seed requests and fires them at the daemon.
use strict; use warnings;
use IO::Socket::INET;
my ($host, $port, $n, $dir) = @ARGV;
my @seeds = map {
    open my $f, '<', $_ or die "$_: $!";
    binmode $f; local $/;
    my $d = <$f> // ''; close $f; $d;
} glob("$dir/req_*");
die "no seeds" unless @seeds;
for my $i (1 .. $n) {
    srand($i * 2654435761 % 2**31);
    my $d = $seeds[int(rand(@seeds))];
    for (1 .. 1 + int(rand(8))) {
        last unless length $d;
        my $p = int(rand(length $d));
        my $op = int(rand(6));
        if    ($op == 0) { substr($d, $p, 1) = chr(int(rand(256))); }
        elsif ($op == 1) { substr($d, $p, 1) = ''; }
        elsif ($op == 2) { substr($d, $p, 0) = chr(int(rand(256))); }
        elsif ($op == 3) { $d = substr($d, 0, $p); }
        elsif ($op == 4) { $d .= substr($d, $p, int(rand(length($d) - $p)) + 1); }
        else             { substr($d, $p, 1) = substr($d, $p, 1) x (1 + int(rand(64))); }
    }
    my $s = IO::Socket::INET->new(PeerAddr => "$host:$port",
                                  Proto => 'tcp', Timeout => 2) or next;
    binmode $s;
    print $s $d;
    shutdown($s, 1);
    my $deadline = time + 3;
    while (<$s>) { last if time > $deadline; }
    close $s;
}