view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

}

# ---- 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 -------------------------------------------
{
	# The full mechanism set the two SASL mungers share.
	my @mechs = qw(
		anonymous plain login apop cram-md5 digest-md5 ntlm skey otp securid
		rpa kerberos_v4 srp scram-sha-1 scram-sha-1-plus scram-sha-256
		scram-sha-256-plus xoauth2 oauthbearer openid20 saml20 gssapi gs2-krb5
		gss-spnego external
	);
	is( scalar(@mechs), 25, 'fuller SASL registry has 25 mechanisms' );

	my $s = $M->build( { munger => 'sasl_mech_enum',      default => -1 } );
	my $i = $M->build( { munger => 'sasl_mech_iana_enum', default => -1 } );

	# Both mungers cover exactly the same set, distinctly numbered.
	my ( %seen_s, %seen_i, $dup_s, $dup_i );
	for my $m (@mechs) {
		$dup_s++ if $seen_s{ $s->($m) }++;
		$dup_i++ if $seen_i{ $i->($m) }++;
		isnt( $s->($m), -1, "sasl_mech knows '$m'" );
		isnt( $i->($m), -1, "sasl_mech_iana knows '$m'" );
	}
	ok( !$dup_s, 'sasl_mech numbers are distinct' );
	ok( !$dup_i, 'sasl_mech_iana numbers are distinct' );

	# strength order: anonymous/cleartext low, external highest.
	is( $s->('anonymous'), 0,  'sasl_mech anonymous is weakest' );
	ok( $s->('plain') < $s->('scram-sha-256'), 'sasl_mech: plain weaker than scram' );
	ok( $s->('scram-sha-256') < $s->('external'), 'sasl_mech: external strongest tier' );
	# iana order: alphabetical, so anonymous first, xoauth2 last.
	is( $i->('anonymous'), 0,  'sasl_mech_iana anonymous sorts first' );
	is( $i->('xoauth2'),   24, 'sasl_mech_iana xoauth2 sorts last' );

	is( $s->('CRAM-MD5'), $s->('cram-md5'), 'sasl_mech is case-insensitive' );
	is( $s->('wat'),      -1, 'sasl_mech default for unlisted' );
	eval { $M->build( { munger => 'sasl_mech_enum' } )->(2) };
	like( $@, qr/no mapping for '2'/, 'sasl_mech does not pass a number through' );

	# http_version: access-log, bare, and ALPN shorthands all land together.
	my $hv = $M->build( { munger => 'http_version_enum', default => -1 } );
	is( $hv->('HTTP/0.9'), 0, 'http_version HTTP/0.9' );
	is( $hv->('HTTP/1.1'), 2, 'http_version HTTP/1.1' );
	is( $hv->('1.1'),      2, 'http_version bare 1.1' );
	is( $hv->('h2'),       3, 'http_version ALPN h2' );
	is( $hv->('h2c'),      3, 'http_version cleartext h2c' );
	is( $hv->('2'),        3, 'http_version "2" is version 2.0, not the integer' );
	is( $hv->('HTTP/3'),   4, 'http_version HTTP/3 without .0' );
	is( $hv->('h3'),       4, 'http_version ALPN h3' );
	ok( $hv->('HTTP/1.0') < $hv->('HTTP/2.0'), 'http_version is ordinal' );
	is( $hv->('SPDY'),     -1, 'http_version default for unknown' );
}

# ---- SpamAssassin / rspamd / sshd / amavis / systemd / clamav enums ---------
{