Algorithm-ToNumberMunger

 view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

	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' );
	is( $c->('100.128.0.1'),     0, 'ip_class just past CGNAT is global' );
	is( $c->('127.0.0.53'),      2, 'ip_class loopback' );
	is( $c->('169.254.1.1'),     3, 'ip_class v4 link-local' );
	is( $c->('224.0.0.251'),     4, 'ip_class v4 multicast' );
	is( $c->('239.255.255.250'), 4, 'ip_class multicast high edge' );
	is( $c->('255.255.255.255'), 5, 'ip_class broadcast' );
	is( $c->('0.0.0.0'),         6, 'ip_class v4 unspecified' );
	is( $c->('0.1.2.3'),         7, 'ip_class rest of 0/8 reserved' );
	is( $c->('192.0.2.55'),      7, 'ip_class TEST-NET-1 reserved' );
	is( $c->('198.51.100.7'),    7, 'ip_class TEST-NET-2 reserved' );
	is( $c->('203.0.113.9'),     7, 'ip_class TEST-NET-3 reserved' );
	is( $c->('198.18.0.1'),      7, 'ip_class benchmarking reserved' );
	is( $c->('240.0.0.1'),       7, 'ip_class 240/4 reserved' );

	# v6
	is( $c->('2600:1700::1'),      0, 'ip_class v6 global' );
	is( $c->('fd12:3456:789a::1'), 1, 'ip_class ULA private' );
	is( $c->('::1'),               2, 'ip_class v6 loopback' );
	is( $c->('fe80::1'),           3, 'ip_class v6 link-local' );
	is( $c->('ff02::fb'),          4, 'ip_class v6 multicast' );



( run in 1.726 second using v1.01-cache-2.11-cpan-7fcb06a456a )