Algorithm-ToNumberMunger

 view release on metacpan or  search on metacpan

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

C<unavailable> 5, C<unknown> 6. The numbering is essentially nominal (the
Bayes auto-learn outcome is a category, not a scale), arranged only so the
"nothing was learned" states cluster away from the ham/spam ones. The spam
I<score> is already a number for L</num>, and the spam/ham verdict a L</bool>;
this covers the one autolearn field neither derives. Numeric inputs are not
passed through.

=head2 rspamd_action_enum

    { munger => 'rspamd_action_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for rspamd's action,
numbered by B<increasing severity> so the ordinal is a usable feature on its
own: C<no action> 0, C<greylist> 1, C<add header> 2, C<rewrite subject> 3,
C<soft reject> 4, C<reject> 5. Both the space and underscore spellings rspamd
emits (C<no action>/C<no_action>, C<add header>/C<add_header>, ...) are
accepted. Numeric inputs are not passed through.

=head2 ssh_auth_method_enum

    { munger => 'ssh_auth_method_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the OpenSSH
authentication method logged by C<sshd> (the word after C<Accepted>/C<Failed>,
or the C<method=> field): C<none> 0, C<password> 1, C<keyboard-interactive> 2,
C<hostbased> 3, C<publickey> 4, C<gssapi-with-mic> 5, C<gssapi-keyex> 6, with
bare C<gssapi> aliased to C<gssapi-with-mic>. Numbered roughly
B<weakest-to-strongest> so "weaker credential than expected" is a monotone
feature; the ordering is a judgement call, not a registry. Numeric inputs are
not passed through.

=head2 amavis_category_enum

    { munger => 'amavis_category_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the amavisd-new
content category, ordered clean-to-worst: C<clean> 0, C<oversized> 1,
C<unchecked> 2, C<spammy> 3, C<spam> 4, C<badheader> 5, C<banned> 6,
C<infected> 7, C<mtablocked> 8. The hyphenated spellings (C<bad-header>,
C<mta-blocked>) and the legacy C<virus> (for C<infected>) are accepted as
aliases. The Passed/Blocked I<action> itself is a L</bool>; this is the
finer-grained reason. Numeric inputs are not passed through.

=head2 systemd_result_enum

    { munger => 'systemd_result_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for a systemd unit
C<result> (as in C<Failed with result 'timeout'>): C<success> 0, C<protocol>
1, C<timeout> 2, C<exit-code> 3, C<signal> 4, C<core-dump> 5, C<watchdog> 6,
C<start-limit-hit> 7, C<oom-kill> 8, C<resources> 9. The underscore spellings
(C<exit_code>, C<core_dump>, C<start_limit_hit>, C<oom_kill>) are accepted as
aliases. Numeric inputs are not passed through.

=head2 clamav_result_enum

    { munger => 'clamav_result_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for a ClamAV per-target
verdict as logged by C<clamd> / clamav-milter: C<OK> 0, C<FOUND> 1, C<ERROR>
2. Small but exactly the signal worth flagging (a C<FOUND> line). Numeric
inputs are not passed through.

=head2 kerberos_etype_enum

    { munger => 'kerberos_etype_enum', default => -1 }

Named-map enum for the Kerberos ticket encryption type -- Windows events
4768/4769 (logged as hex, C<0x17>) and any other AD/Kerberos source. The
values are the RFC 3961 etype numbers, which B<are> the wire encoding, so
(unlike most of the enums here) a decimal input passes through unchanged: the
map exists only to resolve the hex spellings (C<0x17> => 23, C<0x12> => 18,
...) and the RFC/MIT names (C<rc4-hmac>/C<rc4>/C<arcfour-hmac> => 23,
C<aes256-cts-hmac-sha1-96>/C<aes256> => 18, C<aes128> => 17, C<des3> => 16,
C<des-cbc-md5> => 3, C<des-cbc-crc> => 1) onto that same number. The classic
use is flagging C<rc4-hmac> (0x17) as a downgrade/roasting signal against an
C<aes256> baseline. Lookup is case-insensitive; an unlisted etype croaks
unless a numeric C<default> is given.

=head2 windows_integrity_level_enum

    { munger => 'windows_integrity_level_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the Windows / Sysmon
process integrity level, as an B<ordinal>: C<untrusted> 0, C<low> 1, C<medium>
2, C<high> 3, C<system> 4 (with C<mediumplus> folded into C<medium>). The
C<S-1-16-*> mandatory-label SIDs Windows sometimes logs in place of the word
(C<S-1-16-12288> => 3, ...) are accepted as aliases. Ordinal so "higher
privilege than expected" is a monotone feature. Numeric inputs are not passed
through.

=head2 windows_logon_status_enum

    { munger => 'windows_logon_status_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the NTSTATUS
sub-status on a failed Windows logon (events 4625/4776), collapsed to a
compact B<reason category> rather than the raw 32-bit code: C<0xC0000064>
(no such user) 0, C<0xC000006A> (bad password) 1, C<0xC000006D> (generic bad
user/pass) 2, C<0xC000006F> (outside hours) 3, C<0xC0000070> (workstation
restriction) 4, C<0xC0000071> (password expired) 5, C<0xC0000072> (disabled)
6, C<0xC0000193> (account expired) 7, C<0xC0000133> (clock skew) 8,
C<0xC0000224> (must change password) 9, C<0xC0000234> (locked out) 10,
C<0xC000015B> (logon type not granted) 11. Keys are the hex codes exactly as
logged (matched case-insensitively); only the common logon subset is baked in,
so an unlisted code croaks unless a numeric C<default> is given. Numeric
inputs are not passed through.

=head2 windows_impersonation_level_enum

    { munger => 'windows_impersonation_level_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the event 4624
impersonation level, ordered by reach: C<anonymous> 0, C<identification> 1,
C<impersonation> 2, C<delegation> 3. The C<%%1832> / C<%%1833> message tokens
Windows often emits in place of the words (Identification / Impersonation) are
accepted as aliases. Numeric inputs are not passed through.

=head2 aad_signin_error_enum

    { munger => 'aad_signin_error_enum', default => -1 }

Named-map enum for the Azure AD / Entra sign-in C<ResultType> error code,
collapsed to a compact B<reason category> rather than the raw code: C<0>
(success) 0, invalid-password (C<50126>, C<50056>) 1, no-such-user (C<50034>)
2, disabled (C<50057>) 3, locked / smart-lockout (C<50053>) 4, password-expired
(C<50055>, C<50144>) 5, MFA-required (C<50074>, C<50076>, C<50079>) 6,
MFA-failed (C<500121>, C<50158>) 7, blocked-by-conditional-access (C<53003>,
C<53000>, C<53001>, C<530032>) 8, session-expired (C<50173>) 9. Although
C<ResultType> is already numeric, the code space is huge and sparse and its
magnitude carries no signal -- this maps the common codes onto a handful of
meaningful buckets (and, unlike L</hash>, keeps related codes together). Keys
are the codes as logged; only the common subset is baked in, so an unlisted
code croaks unless a numeric C<default> is given. Because the output is a
category of our own numbering, numeric inputs are B<not> passed through.

=head2 risk_level_enum

    { munger => 'risk_level_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the Entra Identity
Protection C<riskLevel> as an B<ordinal>: C<none> 0, C<low> 1, C<medium> 2,
C<high> 3. C<hidden> and C<unknownFutureValue> are left to the C<default>
(they are not points on the scale). Numeric inputs are not passed through.

=head2 aws_principal_type_enum

    { munger => 'aws_principal_type_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the CloudTrail
C<userIdentity.type>: C<Root> 0, C<IAMUser> 1, C<AssumedRole> 2,
C<FederatedUser> 3, C<SAMLUser> 4, C<WebIdentityUser> 5, C<Directory> 6,
C<IdentityCenterUser> 7, C<AWSAccount> 8, C<AWSService> 9, C<Unknown> 10. The
numbering is nominal (distinct stable numbers, not a scale); C<Root> is the
value you actually alert on. Numeric inputs are not passed through.

=head2 aad_client_app_enum

    { munger => 'aad_client_app_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the Azure AD
C<ClientAppUsed>, numbered so the modern clients sort low (C<Browser> 0,
C<Mobile Apps and Desktop clients> 1) and the B<legacy-auth> protocols -- which
cannot satisfy MFA -- sort high (C<Exchange ActiveSync>, C<IMAP4>, C<POP3>,
C<Authenticated SMTP>, C<MAPI Over HTTP>, C<Exchange Web Services>, C<Exchange
Online PowerShell>, C<AutoDiscover>, C<Offline Address Book>, C<Other
clients>, from 2 up). A "C<< >= 2 >> means legacy auth" threshold is the
intended feature. C<imap>/C<pop>/C<mapi> short forms are accepted as aliases.
Numeric inputs are not passed through.

=head2 risk_state_enum

    { munger => 'risk_state_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the Entra Identity
Protection C<riskState>: C<none> 0, C<confirmedSafe> 1, C<remediated> 2,
C<dismissed> 3, C<atRisk> 4, C<confirmedCompromised> 5. Numeric inputs are not
passed through.

=head2 vpc_flow_log_status_enum

    { munger => 'vpc_flow_log_status_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the AWS VPC Flow Logs
C<log-status>: C<OK> 0, C<NODATA> 1, C<SKIPDATA> 2. (The per-flow
C<ACCEPT>/C<REJECT> action is a plain L</bool>; this is the capture-health
field.) Numeric inputs are not passed through.

=head2 aws_event_type_enum

    { munger => 'aws_event_type_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the CloudTrail
C<eventType>: C<AwsApiCall> 0, C<AwsServiceEvent> 1, C<AwsConsoleAction> 2,
C<AwsConsoleSignIn> 3, C<AwsCloudTrailInsight> 4. C<AwsConsoleSignIn> is the
one worth flagging. Numeric inputs are not passed through.

=head2 conditional_access_result_enum

    { munger => 'conditional_access_result_enum', default => -1 }

Named-map enum (lookup rules as L</dns_rcode_enum>) for the Azure AD sign-in
C<conditionalAccessStatus>: C<success> 0, C<notApplied> 1, C<notEnabled> 2,
C<reportOnly> 3, C<failure> 4. Numeric inputs are not passed through.

=cut

# Named-map enums: baked-in value->number maps for well-known registries,
# registered as "<name>_enum". Keys are stored lowercase; lookup lowercases
# the input, giving the case-insensitive matching the POD promises. 'numeric'
# says whether a numeric input is passed through as-is -- set only where the
# numbers are the protocol's own encoding (a qtype 28 IS AAAA on the wire);
# where they are ordinals of our own invention (tls_version, the method
# enums), passthrough would mix scales, so a number croaks like any other
# unmapped value.

# SASL mechanism names, ordered weakest-to-strongest, for sasl_mech_enum. The
# same set is numbered alphabetically for sasl_mech_iana_enum, so the two
# mungers can never end up covering different mechanisms. Includes the IANA
# registry plus the ubiquitous non-registered login/xoauth2/apop.
my @SASL_MECHS_BY_STRENGTH = 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
);

my %NAMED_ENUM = (
	dns_rcode => {
		numeric => 1,
		map     => {
			noerror   => 0,
			formerr   => 1,
			servfail  => 2,
			nxdomain  => 3,
			notimp    => 4,
			notimpl   => 4,
			refused   => 5,
			yxdomain  => 6,
			yxrrset   => 7,
			nxrrset   => 8,
			notauth   => 9,
			notzone   => 10,
			dsotypeni => 11,
			badvers   => 16,
			badsig    => 16,
			badkey    => 17,
			badtime   => 18,
			badmode   => 19,
			badname   => 20,
			badalg    => 21,
			badtrunc  => 22,
			badcookie => 23,
		},
	},

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			},
		},
	},
	aad_client_app => {
		numeric => 0,
		map     => {
			# Azure AD ClientAppUsed. Numbered so the modern clients sort low
			# and the legacy-auth protocols (which cannot do MFA) sort high --
			# a ">= 2 means legacy auth" threshold is the feature you want.
			do {
				my %m = (
					'browser'                         => 0,
					'mobile apps and desktop clients' => 1,
				);
				my @legacy = (
					'exchange activesync',
					'imap4',
					'pop3',
					'authenticated smtp',
					'smtp',
					'mapi over http',
					'exchange web services',
					'exchange online powershell',
					'autodiscover',
					'offline address book',
					'other clients',
				);
				my $i = 2;
				$m{$_}     = $i++ for @legacy;
				$m{'imap'} = $m{'imap4'};
				$m{'pop'}  = $m{'pop3'};
				$m{'mapi'} = $m{'mapi over http'};
				%m;
			},
		},
	},
	risk_state => {
		numeric => 0,
		map     => {
			# Entra Identity Protection riskState.
			none                 => 0,
			confirmedsafe        => 1,
			remediated           => 2,
			dismissed            => 3,
			atrisk               => 4,
			confirmedcompromised => 5,
		},
	},
	vpc_flow_log_status => {
		numeric => 0,
		map     => {
			# VPC Flow Logs log-status.
			ok       => 0,
			nodata   => 1,
			skipdata => 2,
		},
	},
	aws_event_type => {
		numeric => 0,
		map     => {
			# CloudTrail eventType. AwsConsoleSignIn is the one you flag.
			awsapicall           => 0,
			awsserviceevent      => 1,
			awsconsoleaction     => 2,
			awsconsolesignin     => 3,
			awscloudtrailinsight => 4,
		},
	},
	conditional_access_result => {
		numeric => 0,
		map     => {
			# Azure AD sign-in conditionalAccessStatus.
			success    => 0,
			notapplied => 1,
			notenabled => 2,
			reportonly => 3,
			failure    => 4,
		},
	},
);
for my $name ( keys %NAMED_ENUM ) {
	my $e = $NAMED_ENUM{$name};
	$BUILDERS{"${name}_enum"} = sub { _named_enum_munger( $name, $e, @_ ) };
}

# Shared closure for the named-map enums registered from %NAMED_ENUM.
sub _named_enum_munger {
	my ( $name, $e, $spec, $where ) = @_;

	my $has_default = exists $spec->{default};
	my $default     = $spec->{default};
	croak "${name}_enum munger$where: 'default' must be numeric"
		if $has_default && !looks_like_number($default);

	my ( $map, $numeric ) = @{$e}{qw(map numeric)};
	return sub {
		my ($v) = @_;
		if ( defined $v ) {
			return $v + 0 if $numeric && looks_like_number($v);
			my $k = lc $v;
			return $map->{$k} if exists $map->{$k};
		}
		return $default if $has_default;
		croak "${name}_enum munger$where: no mapping for '" . ( defined $v ? $v : 'undef' ) . "'";
	}; ## end sub
} ## end sub _named_enum_munger

=head2 bool

    { munger => 'bool' }                       # Perl truthiness -> 1/0
    { munger => 'bool', true => [ 'yes', 'Y', '1', 'true' ] }

Coerce to C<1> or C<0>. With a C<true> list, only those (string-compared) values
are C<1>; otherwise ordinary Perl truthiness is used.

=cut

sub _build_bool {
	my ( $spec, $where ) = @_;

	if ( exists $spec->{true} ) {
		croak "bool munger$where: 'true' must be an arrayref"
			unless ref $spec->{true} eq 'ARRAY';
		my %true = map { $_ => 1 } @{ $spec->{true} };
		return sub {
			my ($v) = @_;
			return exists $true{ defined $v ? $v : '' } ? 1 : 0;
		};
	}

	return sub { $_[0] ? 1 : 0 };
} ## end sub _build_bool

=head2 length

    { munger => 'length' }

The character length of the stringified input, C<undef> counting as C<0> (an
absent value is a zero-length one -- e.g. an SNI-absent TLS record). This is the
cheap shape feature behind every C<*_length> column (domain, URL, filename, SNI,
hostname, ...): tunneling and generated names run long, so raw length is a
surprisingly strong corroborator next to L</entropy>. Length is counted in
B<characters>, not bytes, so a multi-byte name is measured as a human would read
it; use L</entropy> (which is byte-oriented) when you want per-symbol randomness.

=cut

sub _build_length {
	my ( $spec, $where ) = @_;
	return sub {
		my ($v) = @_;
		return length( defined $v ? "$v" : '' );
	};
}

=head2 entropy

    { munger => 'entropy' }

Shannon entropy of the input string, in B<bits per symbol> -- i.e.
C<-sum(p*log2(p))> over the frequencies of its bytes. This is the single most
common feature in the pipeline (DGA domains, randomized filenames, forged
User-Agents, generated SNIs / hostnames / principal names), because
machine-generated strings spread their characters far more evenly than
human-chosen ones and so score high, while a real word scores low. An empty
string is C<0>; the maximum is C<8> (every byte value equally likely).

Entropy is computed over the string's B<UTF-8 bytes> (matching L</hash>), so the
value is well-defined regardless of the scalar's internal encoding flag. Like
C<hash>, this munger is XS-accelerated -- a per-byte histogram plus a C<log> per
distinct byte -- with a pure-Perl fallback that produces identical values;
C<$Algorithm::ToNumberMunger::HAVE_XS> says which
is in use.

=cut

sub _build_entropy {
	my ( $spec, $where ) = @_;
	my $fn = $HAVE_XS ? \&_entropy_xs : \&_entropy_pp;
	return sub {
		my ($v) = @_;
		return $fn->( defined $v ? "$v" : '' );
	};
}

# Pure-Perl Shannon entropy (bits), used only when the XS did not build. Byte
# view via an explicit encode so it matches the XS's SvPVutf8, and so the same
# string scores the same regardless of its internal flag.
sub _entropy_pp {
	my ($str) = @_;
	utf8::encode($str);
	my $n = length $str;
	return 0 unless $n;
	my %count;
	$count{$_}++ for unpack 'C*', $str;
	my $ln2 = log(2);
	my $h   = 0;

	for my $c ( values %count ) {
		my $p = $c / $n;
		$h -= $p * ( log($p) / $ln2 );
	}
	return $h;
} ## end sub _entropy_pp

=head2 ngram

    { munger => 'ngram', counts => { th => 152, he => 128, in => 94, ... } }
    # defaults: smoothing => 1, fold_case => 1; n is inferred from the keys

Mean per-gram surprisal of the input string against a B<precomputed, frozen>
n-gram count table: C<sum(-ln p(gram)) / gram_count>, each gram's probability
smoothed exactly as in L</frozen_freq_map>. This is C<frozen_freq_map>'s sequential cousin
and the strongest single gibberish detector: L</entropy> misses
I<pronounceable> generated names and is unreliable on short strings, while an
n-gram score against (say) hostname bigram statistics catches both -- real
words ride the common bigrams and score low, generated names keep hitting rare
ones and score high. Dividing by the gram count keeps scores comparable across
lengths.

C<counts> maps each n-gram to how often it was observed when the table was
built; all keys must be the same length, and that length B<is> C<n> (bigrams
are the usual choice -- a 26x26 table stays tiny in C<info.json>; past
C<$FROZEN_FREQ_MAP_WARN_KEYS> entries it warns like C<frozen_freq_map>). C<total> defaults
to the sum of counts and may be given larger to prune the tail, exactly as in
C<frozen_freq_map>. A gram absent from the table gets the smoothed unseen-bucket
probability -- an unseen gram is the interesting case -- so C<smoothing> must
be > 0 (default C<1>). With C<fold_case> (default on) the input is lowercased
before scoring, matching the usual lowercased table. A string with no grams
(shorter than C<n>) scores C<0>. Grams are taken over B<characters>, matching
L</length> rather than the byte-oriented C<entropy>.

=cut

sub _build_ngram {
	my ( $spec, $where ) = @_;

	my $counts = $spec->{counts};
	croak "ngram munger$where requires a non-empty 'counts' hashref"
		unless ref $counts eq 'HASH' && %$counts;

	my $n;
	my $sum = 0;
	for my $g ( keys %$counts ) {
		$n = length $g unless defined $n;
		croak "ngram munger$where: all 'counts' keys must be the same length "
			. "(that length is n); got '$g' alongside a $n-gram"
			unless length($g) == $n;

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

	return sub {
		my ($v) = @_;
		my $s   = defined $v ? "$v" : '';
		my $max = 0;
		while ( $s =~ /$re/g ) {
			$max = length $1 if length $1 > $max;
		}
		return $max;
	};
} ## end sub _build_run

=head2 count

    { munger => 'count', of => '/' }             # url_path_depth, topic_depth
    { munger => 'count', of => '.', plus => 1 }  # label_count (dots + 1)

Count non-overlapping occurrences of a literal substring C<of> in the input,
optionally adding a constant C<plus>. This is the segment/depth feature behind
C<url_path_depth> and C<topic_depth> (count of C<`/`>) and C<label_count> (dots
plus one). C<of> is matched literally, not as a pattern, so C<.> means a literal
dot.

=cut

sub _build_count {
	my ( $spec, $where ) = @_;

	my $of = $spec->{of};
	croak "count munger$where requires a non-empty 'of' string"
		unless defined $of && length $of;

	my $plus = defined $spec->{plus} ? $spec->{plus} : 0;
	croak "count munger$where: 'plus' must be numeric"
		unless looks_like_number($plus);

	# index() beats a global regex match here: no pattern engine, and no
	# per-call list of matches just to count them. Advancing by length($of)
	# keeps the non-overlapping semantics m//g had.
	my $oflen = length $of;
	return sub {
		my ($v) = @_;
		my $s   = defined $v ? "$v" : '';
		my $n   = 0;
		my $p   = 0;
		while ( ( $p = index( $s, $of, $p ) ) >= 0 ) {
			$n++;
			$p += $oflen;
		}
		return $n + $plus;
	}; ## end sub
} ## end sub _build_count

=head2 match

    { munger => 'match', pattern => '^xn--' }                       # punycode label
    { munger => 'match', pattern => '%[0-9A-Fa-f]{2}', mode => 'count' }

Match the input against a Perl regular expression C<pattern>: C<1>/C<0> under
the default C<< mode => 'bool' >>, or the number of non-overlapping matches
with C<< mode => 'count' >>. A true C<ignore_case> makes the match
case-insensitive. This is the catch-all shape test behind flags like "is this
label punycode" or "is the Host an IP literal", and counters like
percent-escapes in a URL -- anything L</char> and L</count> are not expressive
enough for. The pattern is compiled at build time, so a broken one fails at
C<write_info> rather than per row.

B<Trust note:> a pattern cannot execute code (Perl requires C<use re 'eval'>
for that, which this module does not enable), but a pathological pattern can
still backtrack catastrophically and stall a writer. Treat munger specs --
like the rest of C<info.json> -- as configuration from a trusted operator,
not as untrusted input.

=cut

sub _build_match {
	my ( $spec, $where ) = @_;

	my $pat = $spec->{pattern};
	croak "match munger$where requires a non-empty 'pattern'"
		unless defined $pat && length $pat;

	my $mode = defined $spec->{mode} ? $spec->{mode} : 'bool';
	croak "match munger$where: 'mode' must be 'bool' or 'count'"
		unless $mode eq 'bool' || $mode eq 'count';

	# qr// on spec text cannot run code -- (?{...}) needs 'use re "eval"',
	# which is not enabled here -- but it can be syntactically invalid, so
	# compile eagerly and croak at build time.
	my $re = eval { $spec->{ignore_case} ? qr/$pat/i : qr/$pat/ };
	croak "match munger$where: cannot compile pattern '$pat': $@"
		unless defined $re;

	if ( $mode eq 'bool' ) {
		return sub {
			my $s = defined $_[0] ? "$_[0]" : '';
			return $s =~ $re ? 1 : 0;
		};
	}
	return sub {
		my $s = defined $_[0] ? "$_[0]" : '';
		my $n = () = $s =~ /$re/g;
		return $n;
	};
} ## end sub _build_match

=head2 bucket

    { munger => 'bucket', bounds => [ 1024, 49152 ] }   # dest_port classes

Map a number to a bucket index by ascending C<bounds>: the result is how many
bounds the value is greater than or equal to. With C<< bounds => [1024, 49152] >>
a value under C<1024> is C<0> (well-known), C<1024>-C<49151> is C<1> (registered),
and C<49152>+ is C<2> (ephemeral) -- the classic port classing, where the literal
port number is meaningless to a threshold split but the I<class> is a real
signal. C<bounds> must be strictly ascending; N bounds yield indices C<0>..C<N>.

This generalises the C<*_enum> status-class mungers, which are the special case
of bucketing a reply code by its leading digit.

=cut

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

	}

	return sub {
		my ($v) = @_;
		croak "log munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
			unless looks_like_number($v);
		my $x = $v + $offset;
		croak "log munger$where: value+offset must be > 0 (got $x)"
			unless $x > 0;
		my $r = log($x);
		$r /= $ln_base if defined $ln_base;
		return $r;
	}; ## end sub
} ## end sub _build_log

=head2 clamp

    { munger => 'clamp', min => 0 }
    { munger => 'clamp', min => 0, max => 65535 }

Pass the number through, pinned into C<[min, max]>. Either bound may be omitted
to clamp on one side only. Unlike C<scale> this does not rescale; it only caps
outliers before they reach the model.

=cut

sub _build_clamp {
	my ( $spec, $where ) = @_;

	my ( $min, $max ) = @{$spec}{qw(min max)};
	my $have_min = defined $min;
	my $have_max = defined $max;
	croak "clamp munger$where needs at least one of 'min' or 'max'"
		unless $have_min || $have_max;
	croak "clamp munger$where: 'min' must be numeric"
		if $have_min && !looks_like_number($min);
	croak "clamp munger$where: 'max' must be numeric"
		if $have_max && !looks_like_number($max);
	croak "clamp munger$where: 'min' must be <= 'max'"
		if $have_min && $have_max && $min > $max;

	return sub {
		my ($v) = @_;
		croak "clamp munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
			unless looks_like_number($v);
		$v = $min if $have_min && $v < $min;
		$v = $max if $have_max && $v > $max;
		return $v;
	};
} ## end sub _build_clamp

=head2 num

    { munger => 'num', base => 16 }        # '0x1a' or '1a' -> 26
    { munger => 'num' }                    # plain numeric coercion

Parse a string as a number in C<base> (2-36, default 10). Base 10 simply
validates and numifies. Other bases accept the digits C<0-9a-z> below the
base, case-insensitively, an optional leading C<->, and the conventional
prefix for that base (C<0x> for 16, C<0b> for 2, C<0o> for 8). Plenty of
tooling logs flag words and IDs in hex (C<0x2f>), which the Writer would
reject as non-numeric; this munger is the bridge. Croaks on anything that is
not a clean number in the chosen base.

=cut

sub _build_num {
	my ( $spec, $where ) = @_;

	my $base = defined $spec->{base} ? $spec->{base} : 10;
	croak "num munger$where: 'base' must be an integer from 2 to 36"
		unless $base =~ /\A[0-9]+\z/ && $base >= 2 && $base <= 36;

	if ( $base == 10 ) {
		return sub {
			my ($v) = @_;
			croak "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
				unless looks_like_number($v);
			return $v + 0;
		};
	}

	my %digit;
	my $i = 0;
	$digit{$_} = $i++ for ( '0' .. '9', 'a' .. 'z' );
	# Strip only the base's own conventional prefix; for other bases a letter
	# like 'b' is just a digit, so there is nothing to disambiguate.
	my $prefix
		= $base == 16 ? qr/\A0x/
		: $base == 8  ? qr/\A0o/
		: $base == 2  ? qr/\A0b/
		:               undef;

	return sub {
		my ($v) = @_;
		my $s   = defined $v ? lc "$v" : '';
		my $err = "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a base-$base number";
		my $neg = $s =~ s/\A-//;
		$s =~ s/$prefix// if defined $prefix;
		croak $err unless length $s;
		my $n = 0;
		for my $c ( split //, $s ) {
			my $d = $digit{$c};
			croak $err unless defined $d && $d < $base;
			$n = $n * $base + $d;
		}
		return $neg ? -$n : $n;
	}; ## end sub
} ## end sub _build_num

=head2 ratio

    # 'io_ratio' is a tag; bytes_out and bytes_in are input fields
    "io_ratio": { "munger": "ratio", "from": ["bytes_out", "bytes_in"] }
    { munger => 'ratio', from => [qw(bytes_out bytes_in)], zero => -1 }

First source divided by the second: with C<< from => [a, b] >> the column gets
C<a / b>. Asymmetry between two counters is a classic feature the counters
alone cannot express -- bytes out over bytes in flags exfiltration, requests
over responses flags scanning -- and the division has to happen at munge time
because a forest split only ever sees one column. A zero denominator yields
C<zero> (default C<0>) instead of dying, since "nothing came back" is a
legitimate row, not bad input; pick a C<zero> outside the ratio's normal range
if you want those rows to stand out. Both inputs must be numeric.

This is a B<multi-input> munger: it only makes sense with several sources, so
it is only usable through L</compile> with C<from> as an arrayref of exactly
two field names (and thus C<apply_named> / C<write_named>). The sources are
raw input fields, not other columns.

=head2 combine

    { munger => 'combine', op => 'sum', from => [qw(bytes_in bytes_out)] }
    { munger => 'combine', op => 'max', from => [qw(req_time resp_time)] }

Fold two or more numeric source fields into one column with C<op>: C<sum>,
C<diff> (first minus second; exactly two sources), C<product>, C<min>, C<max>,
or C<mean>. The general-purpose sibling of L</ratio> for when the interesting
feature is a total, a gap, or an extreme across fields rather than any one
field. Every input must be numeric.

Like C<ratio>, this is a B<multi-input> munger: only usable through
L</compile> with C<from> as an arrayref of source field names.

=cut

sub _build_ratio {
	my ( $spec, $where, $nsrc ) = @_;

	croak "ratio munger$where takes exactly 2 source fields (numerator, denominator), not $nsrc"
		unless $nsrc == 2;

	my $zero = defined $spec->{zero} ? $spec->{zero} : 0;
	croak "ratio munger$where: 'zero' must be numeric"
		unless looks_like_number($zero);

	return sub {
		for my $v (@_) {
			croak "ratio munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
				unless looks_like_number($v);
		}
		return $zero if $_[1] == 0;
		return $_[0] / $_[1];
	};
} ## end sub _build_ratio

# op => fold over the already numeric-checked source values. A table so the
# error message can enumerate them and a new op is one line.
my %COMBINE_OPS = (
	sum     => sub { my $t = 0; $t += $_ for @_; return $t },
	diff    => sub { return $_[0] - $_[1] },
	product => sub { my $t = 1; $t *= $_ for @_; return $t },
	min     => sub {
		my $t = shift;
		for (@_) { $t = $_ if $_ < $t }
		return $t;
	},
	max => sub {
		my $t = shift;
		for (@_) { $t = $_ if $_ > $t }
		return $t;
	},
	mean => sub { my $t = 0; $t += $_ for @_; return $t / @_ },
);

sub _build_combine_op {
	my ( $spec, $where, $nsrc ) = @_;

	my $op = $spec->{op};
	croak "combine munger$where requires an 'op' (one of: " . join( ', ', sort keys %COMBINE_OPS ) . ')'
		unless defined $op && length $op;
	my $fold = $COMBINE_OPS{$op}
		or croak "combine munger$where: unknown op '$op' (known: " . join( ', ', sort keys %COMBINE_OPS ) . ')';
	croak "combine munger$where: op 'diff' takes exactly 2 source fields, not $nsrc"
		if $op eq 'diff' && $nsrc != 2;

	return sub {
		for my $v (@_) {
			croak "combine munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
				unless looks_like_number($v);
		}
		return $fold->(@_);
	};
} ## end sub _build_combine_op

=head2 bit

    { munger => 'bit', mask => '0x12' }                  # SYN or ACK set?
    { munger => 'bit', mask => '0x02', mode => 'all' }   # the SYN bit itself
    { munger => 'bit', mode => 'popcount' }              # how many flags at all
    { munger => 'bit', mask => '0x0f', mode => 'value' } # low nibble, 0-15
    { munger => 'bit', mask => '0x02', base => 16 }      # Suricata tcp_flags "1b"

Bit-level features from an integer flags word (TCP flags, DNS header flags,
protocol option words): the raw word is meaningless to a threshold split, but
individual bits and bit I<counts> are real signals. The input must be a
non-negative integer, in decimal or C<0x> hex (so a logged C<0x12> works
as-is); C<mask> may be written either way too.

Set C<< base => 16 >> to read the B<input> as bare hexadecimal with no C<0x>
prefix -- Suricata logs C<tcp.tcp_flags> (and C<tcp_flags_ts>/C<tcp_flags_tc>)
as e.g. C<"1b">, which is otherwise ambiguous with decimal. A C<0x> prefix on
the input is still accepted under C<< base => 16 >>. C<mask> is always written
in decimal or C<0x> hex regardless of C<base>. Modes:

=over 4

=item * C<any> (default) - C<1> if any bit of C<mask> is set in the value.

=item * C<all> - C<1> only if every bit of C<mask> is set.

=item * C<value> - the masked bits, shifted down to the mask's lowest set
bit: C<< mask => '0x0f' >> extracts the low nibble as C<0>-C<15>.

=item * C<popcount> - the number of set bits in C<value & mask>; C<mask> is
optional here and defaults to all bits. An abnormal flag I<count> (a
Christmas-tree packet) is anomalous even when each individual bit is common.

=back

C<mask> is required (and must be non-zero) for every mode except C<popcount>.

=cut

my %BIT_MODE = map { $_ => 1 } qw(any all value popcount);

# Accept an integer in decimal or 0x-hex form; returns the number, or undef
# if it is neither. Shared by bit's mask (spec) and value (input) parsing.
sub _bit_int {
	my ($v) = @_;
	return undef unless defined $v;
	return hex($v) if $v =~ /\A0x[0-9a-f]+\z/i;
	return $v + 0  if $v =~ /\A[0-9]+\z/;
	return undef;
}

# Parse an input value as bare hex (a '0x' prefix is tolerated), for bit's
# 'base => 16' mode. Suricata logs tcp_flags as "1b" with no prefix, which
# _bit_int would read as decimal (or reject), hence a separate parser opted
# into per munger rather than a change to the ambiguous default.
sub _bit_hex {
	my ($v) = @_;
	return undef unless defined $v;
	return hex($1) if $v =~ /\A(?:0x)?([0-9a-f]+)\z/i;
	return undef;
}

sub _build_bit {
	my ( $spec, $where ) = @_;

	my $mode = defined $spec->{mode} ? $spec->{mode} : 'any';
	croak "bit munger$where: unknown mode '$mode' (known: " . join( ', ', sort keys %BIT_MODE ) . ')'
		unless $BIT_MODE{$mode};

	# Input base: 10 (default, decimal or 0x hex) or 16 (bare hex, for feeds
	# like Suricata's tcp_flags). Only the per-row input parser changes; the
	# mask below is always read with _bit_int.
	my $base = defined $spec->{base} ? $spec->{base} : 10;
	croak "bit munger$where: 'base' must be 10 or 16"
		unless $base eq '10' || $base eq '16';
	my $parse_in = $base eq '16' ? \&_bit_hex : \&_bit_int;
	my $in_form  = $base eq '16' ? 'hex'      : 'decimal or 0x hex';

	my $mask;
	if ( defined $spec->{mask} ) {
		$mask = _bit_int( $spec->{mask} );
		croak "bit munger$where: 'mask' must be a non-negative integer " . '(decimal or 0x hex)'
			unless defined $mask;
		croak "bit munger$where: 'mask' must be non-zero"
			if $mask == 0 && $mode ne 'popcount';
	} elsif ( $mode ne 'popcount' ) {
		croak "bit munger$where: mode '$mode' requires a 'mask'";
	}

	# For 'value', bake in the shift down to the mask's lowest set bit.
	my $shift = 0;
	if ( $mode eq 'value' ) {
		my $m = $mask;
		until ( $m & 1 ) { $m >>= 1; $shift++; }
	}

	return sub {
		my ($v) = @_;
		my $n   = $parse_in->( defined $v ? "$v" : undef );
		croak "bit munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a non-negative integer ($in_form)"
			unless defined $n;
		$n &= $mask                          if defined $mask;
		return sprintf( '%b', $n ) =~ tr/1// if $mode eq 'popcount';
		return $n          ? 1 : 0 if $mode eq 'any';
		return $n == $mask ? 1 : 0 if $mode eq 'all';
		return $n >> $shift;    # value
	}; ## end sub
} ## end sub _build_bit

=head2 ip_class

    { munger => 'ip_class' }
    { munger => 'ip_class', default => -1 }

Collapse an IPv4 or IPv6 address to its address-space class -- to addresses
what the status-class enums are to reply codes: the literal address is
high-cardinality noise, but "an internal host suddenly talking multicast" is
a class-level signal. Classes and their emitted numbers:

    0  global       anything not covered below
    1  private      10/8, 172.16/12, 192.168/16, 100.64/10 (CGNAT), fc00::/7 (ULA)
    2  loopback     127/8, ::1
    3  link_local   169.254/16, fe80::/10
    4  multicast    224/4, ff00::/8
    5  broadcast    255.255.255.255
    6  unspecified  0.0.0.0, ::
    7  reserved     0/8, 192.0.0/24, the documentation nets (192.0.2/24,
                    198.51.100/24, 203.0.113/24, 2001:db8::/32), benchmarking
                    (198.18/15), 240/4, and the 100::/64 discard prefix

An IPv4-mapped IPv6 address (C<::ffff:a.b.c.d>) is classified as its embedded

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN


	my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where );
	my @get = map { $getter_for->($_) } @$parts;

	my ( $memo_in, @memo_out );
	my $code = sub {
		my ($v) = @_;
		return @memo_out
			if defined $v && defined $memo_in && $v eq $memo_in;
		my $t   = $parse->($v);
		my @out = map { $_->($t) } @get;
		( $memo_in, @memo_out ) = ( $v, @out );
		return @out;
	};
	return ( $code, scalar @$parts );
} ## end sub _build_datetime_multi

=head2 hash

    { munger => 'hash', buckets => 1024 }
    { munger => 'hash', buckets => 1024, seed => 7 }
    { munger => 'hash' }                          # raw 32-bit FNV-1a value

Feature hashing for high-cardinality categoricals you do not want to (or cannot)
enumerate with C<enum>. The input is stringified and run through 32-bit FNV-1a;
with C<buckets> the result is reduced modulo that many buckets (C<[0, buckets)>),
otherwise the full 32-bit hash is returned. An optional C<seed> lets you decorrelate
two hashed columns.

This is the one munger that is XS-accelerated: FNV-1a is a per-byte loop with a
32-bit modular multiply, which is slow in pure Perl and (on a 32-bit perl) fussy
to get exactly right. C<$Algorithm::ToNumberMunger::HAVE_XS>
reports whether the compiled path is in use; a pure-Perl fallback (exact on a
64-bit perl) is used otherwise, and both produce identical values.

=cut

sub _build_hash {
	my ( $spec, $where ) = @_;

	my $buckets = $spec->{buckets};
	croak "hash munger$where: 'buckets' must be a positive integer"
		if defined $buckets && $buckets !~ /\A[1-9][0-9]*\z/;

	my $seed = defined $spec->{seed} ? $spec->{seed} : 0;
	croak "hash munger$where: 'seed' must be a non-negative integer"
		if $seed !~ /\A[0-9]+\z/;

	my $fn = $HAVE_XS ? \&_fnv1a_xs : \&_fnv1a_pp;
	return sub {
		my ($v) = @_;
		my $h = $fn->( defined $v ? "$v" : '', $seed );
		return defined $buckets ? $h % $buckets : $h;
	};
} ## end sub _build_hash

# Pure-Perl 32-bit FNV-1a, used only when the XS did not build. On a 64-bit
# perl the intermediate h*16777619 (< 2**57) stays an exact integer, so the
# masked result matches the C version bit for bit. The string is always
# utf8-encoded first so a value hashes as its UTF-8 bytes no matter the internal
# flag -- the same well-defined bytes SvPVutf8 hands the XS.
sub _fnv1a_pp {
	my ( $str, $seed ) = @_;
	utf8::encode($str);
	my $h = ( 2166136261 ^ ( $seed & 0xFFFFFFFF ) ) & 0xFFFFFFFF;
	for my $c ( unpack 'C*', $str ) {
		$h ^= $c;
		$h = ( $h * 16777619 ) & 0xFFFFFFFF;
	}
	return $h;
} ## end sub _fnv1a_pp

=head2 chain

    # Shannon entropy of just the TLD: lowercase, keep the last dot-label
    { munger => 'chain',
      steps  => [ { op => 'lc' }, { op => 'split', on => '.', index => -1 } ],
      then   => { munger => 'entropy' } }

    # a hex request id buried in a token like 'req-0x2F'
    { munger => 'chain',
      steps  => [ { op => 'capture', pattern => 'req-(0x[0-9a-fA-F]+)' } ],
      then   => { munger => 'num', base => 16 } }

Run the input through a list of string pre-transforms (C<steps>, applied in
order), then hand the result to a terminal munger (C<then>) for the actual
number. Every string munger above scores the I<whole> value; C<chain> is how a
feature targets a I<piece> of it -- the entropy of the TLD alone, the length
of the first path segment, an enum over a normalized token -- without asking
the writer's caller to pre-slice its input. Each step is a hashref with an
C<op>:

=over 4

=item * C<lc> / C<uc> - case-fold the value.

=item * C<trim> - strip leading and trailing whitespace.

=item * C<split> - split on the literal separator C<on> and keep piece
C<index> (0-based; negative counts from the end, so C<-1> is a hostname's last
label). An index past either end yields the empty string.

=item * C<capture> - match the regex C<pattern> and keep capture group
C<group> (default C<1>). No match, or a group that did not participate, yields
the empty string. A true C<ignore_case> matches case-insensitively; the
L</match> trust note applies here too.

=item * C<replace> - replace every match of the regex C<pattern> with the
literal string C<with> (default: delete the matches). C<ignore_case> as above.

=back

C<then> is a full munger spec and may be any built-in that takes one value --
including another C<chain>. All step parameters and the terminal spec are
validated at build time. An undef input enters the chain as the empty string;
whether an empty result is acceptable is the terminal's call (C<entropy> and
C<length> score it C<0>, C<num> croaks).

The multi-output form works too: put C<into> on the B<chain> and the C<parts>
on the terminal, e.g. C<trim> a sloppy timestamp before a L</datetime>
C<sin>/C<cos> expansion.



( run in 1.328 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )