view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

	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' );