view release on metacpan or  search on metacpan

xt/fuzz_structured.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use EV::Kafka;

# Structured/mutation parser fuzzing. xt/fuzz_decode.t feeds UNIFORM
# RANDOM bytes to the parsers — that can never build a valid response
# envelope around a poisoned length field, which is exactly why the
# fetch-response int32 overflow (batch_length 0x7FFFFFF9, a one-packet
# remote segfault) survived it at 20k iterations.
#
# Here we build VALID response envelopes (same byte-builder style as the
# t/18/t/21 goldens), record the offset of every length/count/varint
# field while building, then splice hostile values into those fields:
# negative, 0, INT32_MAX, INT32_MIN, off-by-one vs the remaining byte
# count, and huge/overlong uvarints. The parser must return undef or a
# hashref (arrayref for the batch decoder) and never crash, panic, or
# die.

plan skip_all => 'set RELEASE_TESTING' unless $ENV{RELEASE_TESTING};

my $iters = $ENV{FUZZ_ITERS} || 2_000;
plan tests => 11;

sub i16 { pack 'n',  $_[0] }
sub i32 { pack 'N',  $_[0] }
sub i64 { pack 'q>', $_[0] }
sub kstr { my $s = shift; i16(length $s) . $s }

# --- Template builders ---------------------------------------------------
# Each returns ($bytes, \@sites) where a site is [offset, kind, width]:
# kind 'i32'/'i16' overwrite in place, kind 'uvar' splices width bytes.

# Metadata v1: brokers, topics, partitions, replica/isr arrays.
sub tpl_metadata_v1 {
    my @sites;
    my $b = '';
    my $at = sub { push @sites, [length($b), $_[0], $_[1]] };
    $at->('i32', 4); $b .= i32(1);                 # brokers count
    $b .= i32(0);                                  # node_id
    $at->('i16', 2); $b .= kstr('host1');          # host
    $b .= i32(9092);                               # port
    $at->('i16', 2); $b .= i16(-1);                # rack: null
    $b .= i32(0);                                  # controller_id
    $at->('i32', 4); $b .= i32(1);                 # topics count
    $b .= i16(0);                                  # topic error
    $at->('i16', 2); $b .= kstr('t1');             # topic name
    $b .= chr(0);                                  # is_internal
    $at->('i32', 4); $b .= i32(1);                 # partitions count
    $b .= i16(0) . i32(0) . i32(0);                # err, pid, leader
    $at->('i32', 4); $b .= i32(1) . i32(0);        # replicas: [0]
    $at->('i32', 4); $b .= i32(1) . i32(0);        # isr: [0]
    return ($b, \@sites);
}

# Metadata v9 (flexible): compact arrays/strings — uvarint length fields.
sub tpl_metadata_v9 {
    my @sites;
    my $b = '';
    my $at = sub { push @sites, [length($b), 'uvar', $_[0]] };
    $b .= i32(0);                                  # throttle
    $at->(1); $b .= "\x02";                        # brokers: 1
    $b .= i32(0);                                  # node_id
    $at->(1); $b .= "\x06" . 'host1';              # host: compact
    $b .= i32(9092);                               # port
    $at->(1); $b .= "\x00";                        # rack: null
    $b .= "\x00";                                  # tagged fields
    $at->(1); $b .= "\x00";                        # cluster_id: null
    $b .= i32(0);                                  # controller_id
    $at->(1); $b .= "\x01";                        # topics: 0