view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

	like( $@, qr/2 to 36/, 'num rejects base < 2' );
}

# ---- bit --------------------------------------------------------------------
{
	# TCP flags: FIN 0x01, SYN 0x02, RST 0x04, PSH 0x08, ACK 0x10.
	my $synack = $M->build( { munger => 'bit', mask => '0x12' } );
	is( $synack->('0x12'), 1, 'bit any: SYN|ACK set (hex input)' );
	is( $synack->(2),      1, 'bit any: SYN alone still hits' );
	is( $synack->(4),      0, 'bit any: RST alone misses' );

	my $syn = $M->build( { munger => 'bit', mask => '0x02', mode => 'all' } );
	is( $syn->(18), 1, 'bit all: SYN set in SYN|ACK' );
	is( $syn->(16), 0, 'bit all: bare ACK has no SYN' );
	my $both = $M->build( { munger => 'bit', mask => '0x12', mode => 'all' } );
	is( $both->(18), 1, 'bit all: both bits present' );
	is( $both->(2),  0, 'bit all: one of two is not all' );

	my $pop = $M->build( { munger => 'bit', mode => 'popcount' } );
	is( $pop->(0),      0, 'bit popcount of 0' );
	is( $pop->('0xff'), 8, 'bit popcount of 0xff' );
	is( $pop->(18),     2, 'bit popcount of SYN|ACK' );
	my $popm = $M->build( { munger => 'bit', mask => '0x07', mode => 'popcount' } );
	is( $popm->('0xff'), 3, 'bit popcount respects the mask' );

	my $nib = $M->build( { munger => 'bit', mask => '0xf0', mode => 'value' } );
	is( $nib->('0xab'), 10, 'bit value: high nibble, shifted down' );
	is( $nib->(0),      0,  'bit value of 0' );

	eval { $synack->('nope') };
	like( $@, qr/not a non-negative integer/, 'bit rejects non-integer input' );
	eval { $synack->(-3) };
	like( $@, qr/not a non-negative integer/, 'bit rejects negative input' );
	eval { $M->build( { munger => 'bit' } ) };
	like( $@, qr/requires a 'mask'/, 'bit requires a mask outside popcount' );
	eval { $M->build( { munger => 'bit', mask => 0 } ) };
	like( $@, qr/must be non-zero/, 'bit rejects a zero mask' );
	eval { $M->build( { munger => 'bit', mask => 'zz' } ) };
	like( $@, qr/'mask' must be/, 'bit rejects a garbage mask' );
	eval { $M->build( { munger => 'bit', mask => 1, mode => 'nope' } ) };
	like( $@, qr/unknown mode 'nope'/, 'bit rejects bad mode' );

	# base => 16: read a bare-hex input, e.g. Suricata's tcp_flags "1b".
	my $hsyn = $M->build( { munger => 'bit', mask => '0x02', base => 16 } );
	is( $hsyn->('1b'),   1, 'bit base16: SYN set in bare-hex 1b' );
	is( $hsyn->('0x1b'), 1, 'bit base16 still accepts a 0x prefix' );
	is( $hsyn->('11'),   0, 'bit base16: "11" is hex 0x11 (no SYN), not decimal' );
	my $hpop = $M->build( { munger => 'bit', mode => 'popcount', base => 16 } );
	is( $hpop->('1b'), 4, 'bit base16 popcount of 0x1b' );
	eval { $hsyn->('zz') };
	like( $@, qr/not a non-negative integer \(hex\)/, 'bit base16 rejects non-hex, names the form' );
	eval { $M->build( { munger => 'bit', mask => 1, base => 2 } ) };
	like( $@, qr/'base' must be 10 or 16/, 'bit rejects an unsupported base' );
}

# ---- Suricata named enums ---------------------------------------------------
{
	my $ap = $M->build( { munger => 'app_proto_enum', default => -1 } );
	is( $ap->('http'),    2,  'app_proto http' );
	is( $ap->('TLS'),     $ap->('tls'), 'app_proto is case-insensitive' );
	is( $ap->('ssl'),     $ap->('tls'), 'app_proto ssl aliases tls' );
	is( $ap->('ikev2'),   $ap->('ike'), 'app_proto ikev2 aliases ike' );
	is( $ap->('unknown'), 0,  'app_proto keeps unknown as a class' );
	is( $ap->('failed'),  1,  'app_proto keeps failed as a class' );
	is( $ap->('wat'),     -1, 'app_proto default for unlisted' );
	eval { $M->build( { munger => 'app_proto_enum' } )->(6) };
	like( $@, qr/no mapping for '6'/, 'app_proto does not pass a number through' );

	my $ts = $M->build( { munger => 'tcp_state_enum' } );
	is( $ts->('none'),        0,  'tcp_state none' );
	is( $ts->('ESTABLISHED'), 3,  'tcp_state established (case-insensitive)' );
	is( $ts->('closed'),      10, 'tcp_state closed' );
	ok( $ts->('syn_sent') < $ts->('established'), 'tcp_state is ordinal along the lifecycle' );

	my $fs = $M->build( { munger => 'flow_state_enum' } );
	is( $fs->('new'),          0, 'flow_state new' );
	is( $fs->('local_bypass'), 4, 'flow_state local_bypass' );

	my $fr = $M->build( { munger => 'flow_reason_enum' } );
	is( $fr->('timeout'),  0, 'flow_reason timeout' );
	is( $fr->('shutdown'), 2, 'flow_reason shutdown' );

	my $ac = $M->build( { munger => 'suricata_action_enum' } );
	is( $ac->('allowed'), 0, 'suricata_action allowed' );
	is( $ac->('blocked'), 1, 'suricata_action blocked' );
	is( $ac->('drop'),    3, 'suricata_action drop (IPS)' );
}

# ---- Postfix / mail named enums ---------------------------------------------
{
	my $ps = $M->build( { munger => 'postfix_status_enum', default => -1 } );
	is( $ps->('sent'),          0,  'postfix_status sent' );
	is( $ps->('DEFERRED'),      1,  'postfix_status is case-insensitive' );
	is( $ps->('bounced'),       2,  'postfix_status bounced' );
	is( $ps->('undeliverable'), 5,  'postfix_status undeliverable (verify)' );
	is( $ps->('whatever'),      -1, 'postfix_status default for unlisted' );
	ok( $ps->('sent') < $ps->('bounced'), 'postfix_status ordered sent-before-bounced' );

	my $spf = $M->build( { munger => 'spf_result_enum' } );
	is( $spf->('pass'),      0, 'spf pass' );
	is( $spf->('softfail'),  3, 'spf softfail' );
	is( $spf->('permerror'), 6, 'spf permerror' );
	is( $spf->('error'),     $spf->('temperror'), 'spf error aliases temperror' );
	is( $spf->('unknown'),   $spf->('permerror'), 'spf unknown aliases permerror' );

	my $dkim = $M->build( { munger => 'dkim_result_enum' } );
	is( $dkim->('pass'),   0, 'dkim pass' );
	is( $dkim->('policy'), 3, 'dkim policy' );
	is( $dkim->('fail'),   4, 'dkim fail' );

	my $dmarc = $M->build( { munger => 'dmarc_result_enum', default => -1 } );
	is( $dmarc->('pass'),          0,  'dmarc pass' );
	is( $dmarc->('fail'),          2,  'dmarc fail' );
	is( $dmarc->('bestguesspass'), 5,  'dmarc opendmarc bestguesspass' );
	is( $dmarc->('quarantine'),    -1, 'dmarc result != disposition (quarantine unlisted)' );

	eval { $M->build( { munger => 'spf_result_enum' } )->(4) };
	like( $@, qr/no mapping for '4'/, 'mail result enums do not pass a number through' );
}

# ---- Apache / Dovecot named enums -------------------------------------------