Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
that maps one raw value to one number, so a caller can build its mungers once
from configuration and then apply them per row with no re-parsing. All
configuration errors are caught at build time; the returned closure only croaks
on genuinely un-mungeable I<input>.
=head1 CLASS METHODS
=head2 build
my $code = ...->build( \%spec );
my $code = ...->build( \%spec, $tag_name ); # $tag_name only sharpens errors
Compile a single munger spec into a coderef. C<%spec> must contain a C<munger>
key naming one of the L</BUILT-IN MUNGERS>; the remaining keys are that munger's
parameters. Croaks on an unknown munger name or an invalid parameter set. The
optional second argument is only used to make error messages point at a tag.
=cut
# name => builder. Each builder validates its slice of the spec up front and
# returns the per-value closure. Keeping them in a table (rather than a big
# if/elsif) is what makes known_mungers() and has_munger() cheap and honest.
my %BUILDERS = (
enum => \&_build_enum,
frozen_freq_map => \&_build_frozen_freq_map,
bool => \&_build_bool,
length => \&_build_length,
entropy => \&_build_entropy,
ngram => \&_build_ngram,
char => \&_build_char,
run => \&_build_run,
count => \&_build_count,
match => \&_build_match,
bucket => \&_build_bucket,
quantile => \&_build_quantile,
scale => \&_build_scale,
zscore => \&_build_zscore,
log => \&_build_log,
clamp => \&_build_clamp,
num => \&_build_num,
bit => \&_build_bit,
ip_class => \&_build_ip_class,
cidr => \&_build_cidr,
datetime => \&_build_datetime,
hash => \&_build_hash,
chain => \&_build_chain,
eps => \&_build_eps,
mgcp_enum => \&_build_mgcp_enum,
);
# Status-class mungers (http_enum, smtp_enum, sip_enum, ...) are one transform
# -- collapse a numeric reply code to its leading digit, int(code/div), with a
# divisor of 100 (10 for gemini's two-digit codes) -- differing only in which
# range 'strict' accepts. Register them all from this table so a new protocol
# is a single line and they can never drift apart. mgcp_enum is deliberately
# NOT a row here: its strict range has a hole (8xx exists, 6xx/7xx do not),
# which a single [lo, hi] cannot express, so it has its own builder below.
my %STATUS_PROTO = (
http => [ 100, 599 ], # 1xx-5xx
smtp => [ 200, 599 ], # 2xx-5xx; SMTP never issues 1yz in practice
sip => [ 100, 699 ], # 1xx-6xx; SIP adds a 6xx global-failure class
ftp => [ 100, 599 ], # 1xx-5xx FTP reply codes
rtsp => [ 100, 599 ], # RTSP (RFC 2326) reuses HTTP's status scheme
nntp => [ 100, 599 ], # 1xx-5xx NNTP (RFC 3977), SMTP-convention codes
dict => [ 100, 599 ], # DICT (RFC 2229) uses SMTP-style codes
gemini => [ 10, 69, 10 ], # two-digit codes, 1x-6x; class = int(code/10)
);
for my $proto ( keys %STATUS_PROTO ) {
my ( $lo, $hi, $div ) = @{ $STATUS_PROTO{$proto} };
$div = 100 unless defined $div;
$BUILDERS{"${proto}_enum"}
= sub { _status_class_munger( $proto, $lo, $hi, $div, @_ ) };
}
# ratio and combine consume several source fields at once, so they are only
# buildable through compile()'s multi-input form ('from' as an arrayref) -- a
# scalar build can never hand them more than one value. Registering a stub
# keeps known_mungers() honest and turns "used it as a scalar munger" into a
# pointed error instead of an unknown-munger one.
for my $name (qw(ratio combine)) {
$BUILDERS{$name} = sub {
my ( $spec, $where ) = @_;
croak "$name munger$where combines several inputs; it is only usable "
. "via compile() with 'from' as an arrayref of source fields";
};
}
sub build {
my ( $class, $spec, $tag ) = @_;
my $where = defined $tag ? " for tag '$tag'" : '';
croak "munger spec$where must be a hashref"
unless ref $spec eq 'HASH';
my $name = $spec->{munger};
croak "munger spec$where has no 'munger' name"
unless defined $name && length $name;
my $builder = $BUILDERS{$name}
or croak "unknown munger '$name'$where (known: " . join( ', ', $class->known_mungers ) . ')';
return $builder->( $spec, $where );
} ## end sub build
=head2 build_all
my $by_tag = ...->build_all( $info->{mungers} );
Compile a whole C<mungers> hash (tag name => spec) into a hash of tag name =>
coderef. A false/absent argument yields an empty hashref (every tag is raw).
Croaks if any spec is invalid, naming the offending tag.
=cut
sub build_all {
my ( $class, $mungers ) = @_;
return {} unless $mungers;
croak "'mungers' must be a hashref"
unless ref $mungers eq 'HASH';
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
# raw count -> emitted number under the chosen mode.
my $emit_for = sub {
my ($c) = @_;
return $c if $mode eq 'count';
return log( 1 + $c ) if $mode eq 'log_count';
my $p = ( $c + $s ) / $denom;
return $p if $mode eq 'freq';
return -log($p); # neg_log_prob
};
my %emit = map { $_ => $emit_for->( $counts->{$_} ) } keys %$counts;
my $unseen_value = $unseen eq 'rare' ? $emit_for->(0) : $unseen;
return sub {
my ($v) = @_;
return defined $v && exists $emit{$v} ? $emit{$v} : $unseen_value;
};
} ## end sub _build_frozen_freq_map
=head2 http_enum
{ munger => 'http_enum' }
{ munger => 'http_enum', strict => 1 }
Collapse an HTTP status code to its class: C<1xx> to C<1>, C<2xx> to C<2>, C<3xx>
to C<3>, and so on (i.e. C<int(code / 100)>). This is the usual bucketing for an
HTTP status column -- the forest cares far more about "was this a 4xx vs a 2xx"
than about C<403> vs C<404>, and it keeps the feature low-cardinality without
having to spell out every code in an C<enum> C<map>. The input must be numeric.
By default any numeric input is bucketed, so a bogus C<700> would quietly become
C<7>. With a true C<strict>, inputs outside the valid HTTP status range
(C<100>-C<599>) croak instead, so a malformed code is caught at write time rather
than smuggled into the model as a spurious class.
=head2 smtp_enum
{ munger => 'smtp_enum' }
{ munger => 'smtp_enum', strict => 1 }
The SMTP counterpart of L</http_enum>: collapse an SMTP reply code to its leading
digit (C<int(code / 100)>), since that digit I<is> the reply's meaning -- C<2yz>
completion, C<3yz> intermediate, C<4yz> transient failure, C<5yz> permanent
failure. As with C<http_enum> this keeps the column low-cardinality and lets the
forest weigh "a 5xx where a 2xx was expected" without enumerating every code.
With a true C<strict>, inputs outside the valid SMTP reply range (C<200>-C<599>)
croak. SMTP never issues C<1yz> replies in practice (no command permits a
positive-preliminary reply), so the strict floor is C<200> rather than
C<http_enum>'s C<100>.
=head2 sip_enum
{ munger => 'sip_enum' }
{ munger => 'sip_enum', strict => 1 }
The SIP counterpart of L</http_enum>: collapse a SIP status code to its leading
digit (C<int(code / 100)>). SIP reuses HTTP's class scheme but adds a sixth
class -- C<1xx> provisional, C<2xx> success, C<3xx> redirection, C<4xx> client
error, C<5xx> server error, C<6xx> global failure.
With a true C<strict>, inputs outside the valid SIP status range (C<100>-C<699>)
croak. The ceiling is C<699> rather than C<http_enum>'s C<599> precisely because
of that C<6xx> global-failure class.
=head2 ftp_enum
{ munger => 'ftp_enum' }
{ munger => 'ftp_enum', strict => 1 }
The FTP counterpart of L</http_enum>, for FTP reply codes: C<int(code / 100)>,
bucketing into C<1yz>-C<5yz>. With a true C<strict>, inputs outside C<100>-C<599>
croak.
=head2 rtsp_enum
{ munger => 'rtsp_enum' }
{ munger => 'rtsp_enum', strict => 1 }
The RTSP counterpart of L</http_enum>. RTSP (RFC 2326) deliberately reuses
HTTP's status scheme, so codes collapse to their leading digit the same way.
With a true C<strict>, inputs outside C<100>-C<599> croak.
=head2 nntp_enum
{ munger => 'nntp_enum' }
{ munger => 'nntp_enum', strict => 1 }
The NNTP counterpart of L</http_enum>, for NNTP (RFC 3977) reply codes, which
follow the SMTP convention -- C<1xx> informational, C<2xx> success, C<3xx>
send-more-input, C<4xx> transient failure, C<5xx> permanent failure. Unlike
SMTP, NNTP does issue C<1xx> replies (help text, capability lists), so the
strict floor is C<100> rather than C<smtp_enum>'s C<200>. With a true
C<strict>, inputs outside C<100>-C<599> croak.
=head2 dict_enum
{ munger => 'dict_enum' }
{ munger => 'dict_enum', strict => 1 }
The DICT counterpart of L</http_enum>, for DICT protocol (RFC 2229) status
codes, which use the SMTP-style code classes. With a true C<strict>, inputs
outside C<100>-C<599> croak.
=head2 gemini_enum
{ munger => 'gemini_enum' }
{ munger => 'gemini_enum', strict => 1 }
Like L</http_enum> but for the Gemini protocol, whose status codes are B<two>
digits -- C<1x> input expected, C<2x> success, C<3x> redirect, C<4x> temporary
failure, C<5x> permanent failure, C<6x> client certificate required -- so the
class is C<int(code / 10)>. With a true C<strict>, inputs outside C<10>-C<69>
croak.
=cut
# Shared closure for the status-class mungers registered from %STATUS_PROTO.
sub _status_class_munger {
my ( $proto, $lo, $hi, $div, $spec, $where ) = @_;
my $strict = $spec->{strict} ? 1 : 0;
return sub {
my ($v) = @_;
croak "${proto}_enum munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a numeric status code"
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
alnum => '[A-Za-z0-9]',
non_alnum => '[^A-Za-z0-9]',
ascii => '[\x00-\x7f]',
non_ascii => '[^\x00-\x7f]',
digit => '[0-9]',
alpha => '[A-Za-z]',
upper => '[A-Z]',
lower => '[a-z]',
vowel => '[aeiouAEIOU]',
consonant => '[b-df-hj-np-tv-zB-DF-HJ-NP-TV-Z]',
xdigit => '[0-9A-Fa-f]',
space => '\s',
punct => '[[:punct:]]',
);
sub _build_run {
my ( $spec, $where ) = @_;
my $class = $spec->{class};
croak "run munger$where requires a 'class'"
unless defined $class;
my $cc = $RUN_RE{$class}
or croak "run munger$where: unknown class '$class' (known: " . join( ', ', sort keys %RUN_RE ) . ')';
my $re = qr/((?:$cc)+)/;
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;
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
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
IPv4 address. An unparseable input croaks, or yields the numeric C<default>
when one is given. IPv6 parsing uses L<Socket>'s C<inet_pton>, loaded lazily
the way L</datetime> loads Time::Piece. For B<site-specific> zones (DMZ,
server VLAN, guest Wi-Fi) use L</cidr>, which knows your networks instead of
the RFCs'.
=head2 cidr
{ munger => 'cidr',
nets => [ '10.10.0.0/16', '10.20.0.0/16', '2001:db8:5::/48' ],
default => -1 }
Membership in a list of CIDR networks: the result is the (0-based) index of
the B<first> net in C<nets> containing the address -- L</bucket> for address
space, and the way a site encodes its own zones (DMZ vs. server VLAN vs.
guest Wi-Fi) that L</ip_class>'s generic RFC classes cannot know about.
C<nets> may mix IPv4 and IPv6; an address is only tested against nets of its
own family. Overlapping nets are fine -- list the most specific first, since
the first match wins. An input that is unparseable or in none of the listed
nets croaks, or yields the numeric C<default> when one is given (a catch-all
C<default> is the usual configuration).
=cut
# Parse an IP address string: (4, $int) for IPv4, (6, $bytes16) for IPv6, or
# an empty list for neither. v4 goes through a regex (also pinning the
# dotted-quad form, so inet_pton's odd shorthands never sneak in); v6 leans
# on Socket's inet_pton, loaded lazily so no munger that skips IPs pays for
# it.
sub _parse_ip {
my ($s) = @_;
if ( $s =~ /\A([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\z/ ) {
return unless $1 <= 255 && $2 <= 255 && $3 <= 255 && $4 <= 255;
return ( 4, ( $1 << 24 ) | ( $2 << 16 ) | ( $3 << 8 ) | $4 );
}
if ( index( $s, ':' ) >= 0 ) {
require Socket;
my $b = eval { Socket::inet_pton( Socket::AF_INET6(), $s ) };
return ( 6, $b ) if defined $b && length $b == 16;
}
return;
} ## end sub _parse_ip
# The ip_class class names, pinned to their emitted numbers.
my %IP_CLASS = (
global => 0,
private => 1,
loopback => 2,
link_local => 3,
multicast => 4,
broadcast => 5,
unspecified => 6,
reserved => 7,
);
sub _ip4_class {
my ($n) = @_;
return 'unspecified' if $n == 0;
return 'broadcast' if $n == 0xffffffff;
my $a = $n >> 24;
my $b = ( $n >> 16 ) & 0xff;
my $c = ( $n >> 8 ) & 0xff;
return 'reserved' if $a == 0; # 0/8 "this network"
return 'private' if $a == 10;
return 'private' if $a == 100 && $b >= 64 && $b <= 127; # CGNAT 100.64/10
return 'loopback' if $a == 127;
return 'link_local' if $a == 169 && $b == 254;
return 'private' if $a == 172 && $b >= 16 && $b <= 31;
return 'reserved' if $a == 192 && $b == 0 && ( $c == 0 || $c == 2 );
return 'private' if $a == 192 && $b == 168;
return 'reserved' if $a == 198 && ( $b == 18 || $b == 19 ); # benchmarking
return 'reserved' if $a == 198 && $b == 51 && $c == 100; # TEST-NET-2
return 'reserved' if $a == 203 && $b == 0 && $c == 113; # TEST-NET-3
return 'multicast' if $a >= 224 && $a <= 239;
return 'reserved' if $a >= 240; # 240/4 future use
return 'global';
} ## end sub _ip4_class
sub _ip6_class {
my ($bytes) = @_;
my @o = unpack 'C16', $bytes;
my $lead0 = 1;
for my $i ( 0 .. 14 ) { $lead0 &&= $o[$i] == 0 }
if ($lead0) {
return 'unspecified' if $o[15] == 0;
return 'loopback' if $o[15] == 1;
}
# v4-mapped ::ffff:a.b.c.d -- classify as the embedded v4 address.
my $map = 1;
for my $i ( 0 .. 9 ) { $map &&= $o[$i] == 0 }
return _ip4_class( ( $o[12] << 24 ) | ( $o[13] << 16 ) | ( $o[14] << 8 ) | $o[15] )
if $map && $o[10] == 0xff && $o[11] == 0xff;
return 'multicast' if $o[0] == 0xff;
return 'private' if ( $o[0] & 0xfe ) == 0xfc; # ULA fc00::/7
return 'link_local' if $o[0] == 0xfe && ( $o[1] & 0xc0 ) == 0x80; # fe80::/10
return 'reserved' if $o[0] == 0x20 && $o[1] == 0x01 && $o[2] == 0x0d && $o[3] == 0xb8; # 2001:db8::/32
my $discard = $o[0] == 0x01; # 100::/64
for my $i ( 1 .. 7 ) { $discard &&= $o[$i] == 0 }
return 'reserved' if $discard;
return 'global';
} ## end sub _ip6_class
sub _build_ip_class {
my ( $spec, $where ) = @_;
my $has_default = exists $spec->{default};
my $default = $spec->{default};
croak "ip_class munger$where: 'default' must be numeric"
if $has_default && !looks_like_number($default);
return sub {
my ($v) = @_;
my ( $fam, $p ) = _parse_ip( defined $v ? "$v" : '' );
if ($fam) {
return $IP_CLASS{ $fam == 4 ? _ip4_class($p) : _ip6_class($p) };
}
return $default if $has_default;
croak "ip_class munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a parseable IP address";
};
} ## end sub _build_ip_class
# Build a 16-byte netmask string for an IPv6 prefix length.
sub _v6_mask {
my ($len) = @_;
my $mask = "\xff" x int( $len / 8 );
$mask .= chr( ( 0xff << ( 8 - $len % 8 ) ) & 0xff ) if $len % 8;
return $mask . ( "\0" x ( 16 - length $mask ) );
}
sub _build_cidr {
my ( $spec, $where ) = @_;
my $nets = $spec->{nets};
croak "cidr munger$where requires a non-empty 'nets' arrayref"
unless ref $nets eq 'ARRAY' && @$nets;
# [family, masked network, mask] per net; & on the 16-byte v6 strings is
# Perl's bitwise string AND, so both families match the same way.
my @match;
for my $i ( 0 .. $#$nets ) {
my $net = $nets->[$i];
croak "cidr munger$where: nets[$i] ('"
. ( defined $net ? $net : 'undef' )
. "') is not in 'address/prefix' form"
unless defined $net && $net =~ m{\A(.+)/([0-9]{1,3})\z};
my ( $addr, $len ) = ( $1, $2 );
my ( $fam, $p ) = _parse_ip($addr);
croak "cidr munger$where: nets[$i] ('$net') has an unparseable address"
unless $fam;
my $max = $fam == 4 ? 32 : 128;
croak "cidr munger$where: nets[$i] ('$net') prefix length must be 0-$max"
if $len > $max;
my $mask
= $fam == 4
? ( $len == 0 ? 0 : ( 0xffffffff << ( 32 - $len ) ) & 0xffffffff )
: _v6_mask($len);
push @match, [ $fam, $p & $mask, $mask ];
} ## end for my $i ( 0 .. $#$nets )
my $has_default = exists $spec->{default};
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
sub _build_chain {
my ( $spec, $where ) = @_;
my $ops = _chain_steps( $spec, $where );
my ( $then, $name ) = _chain_terminal_spec( $spec, $where );
my $builder = $BUILDERS{$name}
or croak "chain munger$where: unknown terminal munger '$name' (known: "
. join( ', ', sort keys %BUILDERS ) . ')';
my $term = $builder->( $then, "$where (chain terminal)" );
return sub {
my $s = defined $_[0] ? "$_[0]" : '';
$s = $_->($s) for @$ops;
return $term->($s);
};
} ## end sub _build_chain
# Multi-output chain: the same pre-transforms, but the terminal is one of the
# multi-output ('into') mungers. Returns ($list_returning_code, $arity) like
# every multi builder; the arity is the terminal's.
sub _build_chain_multi {
my ( $spec, $where ) = @_;
my $ops = _chain_steps( $spec, $where );
my ( $then, $name ) = _chain_terminal_spec( $spec, $where );
my $builder = $MULTI_BUILDERS{$name}
or croak "chain munger$where: terminal munger '$name' does not support "
. "multiple outputs ('into'); only these do: "
. join( ', ', sort keys %MULTI_BUILDERS );
my ( $term, $arity ) = $builder->( $then, "$where (chain terminal)" );
my $code = sub {
my $s = defined $_[0] ? "$_[0]" : '';
$s = $_->($s) for @$ops;
return $term->($s);
};
return ( $code, $arity );
} ## end sub _build_chain_multi
=head2 eps
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip' }
{ munger => 'eps', prefix => 'dns-nxd:', from => 'src_ip',
read => 'rate', mark => 0 }
# multi-output: one daemon round trip fills several columns
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip',
parts => [ 'rate', 'count' ], into => [ 'req_rate', 'req_count' ] }
Per-entity sliding-window event rates via the C<iqbi-damiq> daemon shipped with
L<Algorithm::EventsPerSecond> (see
L<Algorithm::EventsPerSecond::Sukkal>). The input value becomes a meter B<key>
(after C<prefix> is prepended); by default the munger B<marks> one event against
that key and returns the key's current events-per-second, using the daemon's
C<MARKRATE> command -- mark and query in a single command with a single reply.
This is the munger behind rate columns like a per-source request rate: every
event marks its source's meter and stores the rate the meter now reads.
Unlike every other munger this one consults external state -- but the state
lives in the daemon, not here, so the munger itself remains a stateless client
and rows stay reproducible I<given> the daemon. Because the daemon is shared,
multiple writer processes marking the same keys see one B<global> rate, which an
in-process meter could never give.
Spec keys:
=over 4
=item * C<socket> - unix socket path of the daemon. Defaults to
C<$Algorithm::ToNumberMunger::EPS_SOCKET>
(C</var/run/iqbi-damiq.sock>).
=item * C<prefix> - string prepended to the input to form the key, namespacing
this column's meters (two columns keyed on the same field need different
prefixes or they share meters). No whitespace/control characters. Default C<''>.
=item * C<mark> - whether to mark the key (default C<1>). Marking rides
C<MARKRATE>: with C<< read => 'rate' >> that one command is the whole exchange;
with C<count>/C<total> the read is pipelined after it (the C<MARKRATE> rate
reply is discarded), so a marking failure still comes back as an ordinary
first reply. With C<< mark => 0 >> the munger only reads, for columns whose
marking is done elsewhere -- e.g. an NXDOMAIN rate is I<marked> by the pipeline
only on NXDOMAIN responses but I<read> on every row.
=item * C<read> - what to read: C<rate> (events/sec over the daemon's window,
default), C<count> (events inside the window), or C<total> (lifetime).
=item * C<parts> + C<into> - multi-output form (see L</compile>): read several
of C<rate>/C<count>/C<total> for the one key in a single round trip, filling one
column each. When marking, the C<MARKRATE> reply itself serves the first C<rate>
part, so C<< parts => ['rate', 'count'] >> costs exactly two commands.
=item * C<on_error> - C<'die'> (default) croaks the write when the daemon is
unreachable or replies C<ERR>; a number is returned instead as a quiet fallback.
Note C<0> is indistinguishable from a genuinely idle key, so quiet fallback
biases the column -- loud is the default on purpose.
=item * C<timeout> - per-operation socket timeout in seconds (default 5,
best-effort via C<SO_RCVTIMEO>/C<SO_SNDTIMEO>), so a wedged daemon cannot hang a
writer forever.
=back
Semantics worth knowing: a marked read B<includes the event just marked>; keys
have whitespace/control bytes replaced with C<_> to satisfy the daemon's key
rules; connections are made lazily on first use and kept open (reconnecting
transparently after a fork or an error), so compiling a plan -- including the
eager validation in C<write_info> -- needs no running daemon. Each eps column
costs one unix-socket round trip per row; the multi-output form exists so
rate+count of the same key costs one round trip, not two.
=cut
# Default socket path of the iqbi-damiq daemon.
our $EPS_SOCKET = '/var/run/iqbi-damiq.sock';
# Persistent daemon connections, keyed by socket path, shared by every eps
# munger in the process. Entries record the pid that opened them so a forked
# writer transparently reopens instead of sharing a socket with its parent.
# Connections are made lazily on first use -- never at munger build time, so a
# plan can compile (eager validation) with no daemon running.
my %EPS_CONN;
( run in 1.945 second using v1.01-cache-2.11-cpan-7fcb06a456a )