view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

	# 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 ---------
{
	my $al = $M->build( { munger => 'spamassassin_autolearn_enum', default => -1 } );
	is( $al->('no'),          0,  'sa autolearn no' );
	is( $al->('HAM'),         1,  'sa autolearn is case-insensitive' );
	is( $al->('spam'),        2,  'sa autolearn spam' );
	is( $al->('unavailable'), 5,  'sa autolearn unavailable' );
	is( $al->('bogus'),       -1, 'sa autolearn default for unlisted' );

	my $ra = $M->build( { munger => 'rspamd_action_enum', default => -1 } );
	is( $ra->('no action'),       0, 'rspamd no action' );
	is( $ra->('no_action'),       0, 'rspamd no_action underscore alias' );
	is( $ra->('greylist'),        1, 'rspamd greylist' );
	is( $ra->('add header'),      2, 'rspamd add header' );
	is( $ra->('add_header'),      2, 'rspamd add_header underscore alias' );
	is( $ra->('rewrite subject'), 3, 'rspamd rewrite subject' );
	is( $ra->('soft reject'),     4, 'rspamd soft reject' );
	is( $ra->('reject'),          5, 'rspamd reject' );
	ok( $ra->('greylist') < $ra->('reject'), 'rspamd_action ordered by severity' );

	my $sm = $M->build( { munger => 'ssh_auth_method_enum', default => -1 } );
	is( $sm->('none'),                 0,  'ssh none' );
	is( $sm->('password'),             1,  'ssh password' );
	is( $sm->('keyboard-interactive'), 2,  'ssh keyboard-interactive' );
	is( $sm->('publickey'),            4,  'ssh publickey' );
	is( $sm->('gssapi'),  $sm->('gssapi-with-mic'), 'ssh gssapi aliases gssapi-with-mic' );
	ok( $sm->('password') < $sm->('publickey'), 'ssh_auth_method weakest-to-strongest' );
	is( $sm->('magic'),                -1, 'ssh_auth_method default for unlisted' );

	my $am = $M->build( { munger => 'amavis_category_enum', default => -1 } );
	is( $am->('clean'),      0, 'amavis clean' );
	is( $am->('spam'),       4, 'amavis spam' );
	is( $am->('bad-header'), $am->('badheader'), 'amavis bad-header aliases badheader' );
	is( $am->('virus'),      $am->('infected'),  'amavis virus aliases infected' );
	ok( $am->('clean') < $am->('infected'), 'amavis_category ordered clean-to-worst' );

	my $sr = $M->build( { munger => 'systemd_result_enum', default => -1 } );
	is( $sr->('success'),         0, 'systemd success' );
	is( $sr->('timeout'),         2, 'systemd timeout' );
	is( $sr->('exit-code'),       3, 'systemd exit-code' );
	is( $sr->('exit_code'),       $sr->('exit-code'), 'systemd exit_code underscore alias' );
	is( $sr->('oom_kill'),        $sr->('oom-kill'),  'systemd oom_kill underscore alias' );

	my $cv = $M->build( { munger => 'clamav_result_enum', default => -1 } );
	is( $cv->('OK'),      0,  'clamav OK (case-insensitive)' );
	is( $cv->('FOUND'),   1,  'clamav FOUND' );
	is( $cv->('error'),   2,  'clamav error' );
	is( $cv->('whatnow'), -1, 'clamav default for unlisted' );

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

# ---- Windows / Kerberos named enums -----------------------------------------
{
	# kerberos_etype: hex spellings and names resolve to the RFC 3961 etype
	# number, and a decimal (the wire value) passes straight through.
	my $ke = $M->build( { munger => 'kerberos_etype_enum', default => -1 } );
	is( $ke->('0x17'),        23, 'kerberos_etype hex 0x17 is rc4-hmac' );
	is( $ke->('rc4-hmac'),    23, 'kerberos_etype rc4-hmac name' );
	is( $ke->('RC4'),         23, 'kerberos_etype rc4 alias, case-insensitive' );
	is( $ke->('0x12'),        18, 'kerberos_etype hex 0x12 is aes256' );
	is( $ke->('aes256'),      18, 'kerberos_etype aes256 name' );
	is( $ke->(23),            23, 'kerberos_etype decimal 23 passes through (wire value)' );
	is( $ke->('0x17'), $ke->('rc4-hmac'), 'kerberos_etype hex and name agree' );
	ok( $ke->('rc4-hmac') > $ke->('aes256'), 'kerberos_etype rc4 sorts above aes256 (downgrade signal)' );
	is( $ke->('0xdead'),      -1, 'kerberos_etype default for unlisted' );

	my $il = $M->build( { munger => 'windows_integrity_level_enum', default => -1 } );
	is( $il->('Untrusted'),   0,  'integrity untrusted (case-insensitive)' );
	is( $il->('Medium'),      2,  'integrity medium' );
	is( $il->('System'),      4,  'integrity system' );
	is( $il->('mediumplus'),  2,  'integrity mediumplus folds into medium' );
	is( $il->('S-1-16-12288'), 3, 'integrity high mandatory-label SID' );
	ok( $il->('Low') < $il->('System'), 'windows_integrity_level is ordinal' );
	is( $il->('bogus'),       -1, 'integrity default for unlisted' );

	my $ls = $M->build( { munger => 'windows_logon_status_enum', default => -1 } );
	is( $ls->('0xC0000064'),  0,  'logon_status no-such-user (case-insensitive hex)' );
	is( $ls->('0xc000006a'),  1,  'logon_status bad password' );
	is( $ls->('0xc0000234'),  10, 'logon_status locked out' );
	is( $ls->('0xc000015b'),  11, 'logon_status type not granted' );
	is( $ls->('0x0'),         -1, 'logon_status default for a success/unlisted code' );

	my $im = $M->build( { munger => 'windows_impersonation_level_enum', default => -1 } );
	is( $im->('Anonymous'),      0, 'impersonation anonymous' );
	is( $im->('Impersonation'),  2, 'impersonation impersonation' );
	is( $im->('Delegation'),     3, 'impersonation delegation' );
	is( $im->('%%1832'),         1, 'impersonation %%1832 token is identification' );
	is( $im->('%%1833'),         2, 'impersonation %%1833 token is impersonation' );
	ok( $im->('anonymous') < $im->('delegation'), 'windows_impersonation_level ordered by reach' );

	eval { $M->build( { munger => 'windows_integrity_level_enum' } )->(3) };
	like( $@, qr/no mapping for '3'/, 'windows ordinal enums do not pass a number through' );
}

# ---- O365 / Azure AD / AWS cloud named enums --------------------------------
{
	# aad_signin_error: the sparse ResultType code space collapsed to reasons.
	my $se = $M->build( { munger => 'aad_signin_error_enum', default => -1 } );
	is( $se->('0'),        0,  'aad_signin_error 0 is success' );
	is( $se->('50126'),    1,  'aad_signin_error 50126 bad-password' );
	is( $se->('50056'),    $se->('50126'), 'aad_signin_error 50056 shares bad-password bucket' );
	is( $se->('50144'),    $se->('50055'), 'aad_signin_error 50144 shares password-expired bucket' );
	is( $se->('53000'),    8,  'aad_signin_error 53000 blocked-by-CA bucket' );
	is( $se->(50053),      4,  'aad_signin_error accepts an integer code' );
	is( $se->('99999'),    -1, 'aad_signin_error default for an unlisted code' );

	my $rl = $M->build( { munger => 'risk_level_enum', default => -1 } );
	is( $rl->('none'),   0,  'risk_level none' );
	is( $rl->('High'),   3,  'risk_level high (case-insensitive)' );
	is( $rl->('hidden'), -1, 'risk_level hidden is off-scale (default)' );
	ok( $rl->('low') < $rl->('high'), 'risk_level is ordinal' );

	my $pt = $M->build( { munger => 'aws_principal_type_enum', default => -1 } );
	is( $pt->('Root'),        0,  'aws_principal_type root (the alert signal)' );
	is( $pt->('AssumedRole'), 2,  'aws_principal_type assumedrole' );
	is( $pt->('IAMUser'),     1,  'aws_principal_type iamuser (case-insensitive)' );
	is( $pt->('nope'),        -1, 'aws_principal_type default for unlisted' );

	# aad_client_app: modern < 2, legacy >= 2 (the legacy-auth threshold).
	my $ca = $M->build( { munger => 'aad_client_app_enum', default => -1 } );
	is( $ca->('Browser'),                         0, 'aad_client_app browser is modern' );
	is( $ca->('Mobile Apps and Desktop clients'), 1, 'aad_client_app modern desktop' );
	ok( $ca->('IMAP4') >= 2,  'aad_client_app IMAP4 is legacy (>= 2)' );
	ok( $ca->('POP3')  >= 2,  'aad_client_app POP3 is legacy (>= 2)' );
	is( $ca->('imap'), $ca->('IMAP4'), 'aad_client_app imap short alias' );
	ok( $ca->('Browser') < 2 && $ca->('Other clients') >= 2,
		'aad_client_app: modern sorts below the legacy-auth threshold' );

	my $rs = $M->build( { munger => 'risk_state_enum', default => -1 } );
	is( $rs->('none'),                 0, 'risk_state none' );
	is( $rs->('atRisk'),               4, 'risk_state atRisk (case-insensitive)' );
	is( $rs->('confirmedCompromised'), 5, 'risk_state confirmedCompromised' );

	my $ls = $M->build( { munger => 'vpc_flow_log_status_enum', default => -1 } );
	is( $ls->('OK'),       0,  'vpc_flow_log_status OK' );
	is( $ls->('NODATA'),   1,  'vpc_flow_log_status NODATA' );
	is( $ls->('SKIPDATA'), 2,  'vpc_flow_log_status SKIPDATA' );

	my $et = $M->build( { munger => 'aws_event_type_enum', default => -1 } );
	is( $et->('AwsApiCall'),       0, 'aws_event_type AwsApiCall' );
	is( $et->('AwsConsoleSignIn'), 3, 'aws_event_type AwsConsoleSignIn (the signal)' );

	my $cs = $M->build( { munger => 'conditional_access_result_enum', default => -1 } );
	is( $cs->('success'),    0, 'conditional_access success' );
	is( $cs->('notApplied'), 1, 'conditional_access notApplied (case-insensitive)' );
	is( $cs->('failure'),    4, 'conditional_access failure' );

	eval { $M->build( { munger => 'aws_principal_type_enum' } )->(0) };
	like( $@, qr/no mapping for '0'/, 'cloud category enums do not pass a number through' );
}

# ---- ip_class ---------------------------------------------------------------
{
	my $c = $M->build( { munger => 'ip_class' } );

	# v4: one probe per class
	is( $c->('8.8.8.8'),         0, 'ip_class v4 global' );
	is( $c->('10.1.2.3'),        1, 'ip_class 10/8 private' );
	is( $c->('172.16.0.1'),      1, 'ip_class 172.16/12 private' );
	is( $c->('172.32.0.1'),      0, 'ip_class 172.32 is NOT private' );
	is( $c->('192.168.99.1'),    1, 'ip_class 192.168/16 private' );
	is( $c->('100.64.0.1'),      1, 'ip_class CGNAT counts as private' );