| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Algorithm::ToNumberMunger; |
|
2
|
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
496073
|
use 5.006; |
|
|
5
|
|
|
|
|
24
|
|
|
4
|
5
|
|
|
5
|
|
29
|
use strict; |
|
|
5
|
|
|
|
|
20
|
|
|
|
5
|
|
|
|
|
138
|
|
|
5
|
5
|
|
|
5
|
|
24
|
use warnings; |
|
|
5
|
|
|
|
|
20
|
|
|
|
5
|
|
|
|
|
316
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
22
|
use Carp qw(carp croak); |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
270
|
|
|
8
|
5
|
|
|
5
|
|
35
|
use Scalar::Util qw(looks_like_number); |
|
|
5
|
|
|
|
|
5
|
|
|
|
5
|
|
|
|
|
89026
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Algorithm::ToNumberMunger - Compile declarative specs into closures that munge raw values into numbers. |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Version 0.0.1 |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.0.1'; |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Feature hashing (the 'hash' munger) is a tight per-byte FNV-1a loop with a |
|
23
|
|
|
|
|
|
|
# 32-bit modular multiply. That is exactly the kind of work XS is good at and |
|
24
|
|
|
|
|
|
|
# pure Perl is bad at (both for speed and, on a 32-bit perl, for correctness of |
|
25
|
|
|
|
|
|
|
# the wrap-around), so we compile it in C when we can. Everything else here is a |
|
26
|
|
|
|
|
|
|
# hash lookup or a couple of flops -- crossing the XS boundary per row would |
|
27
|
|
|
|
|
|
|
# only make those slower, so they stay pure Perl. If the XS did not build (no |
|
28
|
|
|
|
|
|
|
# compiler at install time) we fall back to a pure-Perl FNV-1a, which is exact |
|
29
|
|
|
|
|
|
|
# on a 64-bit perl. |
|
30
|
|
|
|
|
|
|
our $HAVE_XS = 0; |
|
31
|
|
|
|
|
|
|
eval { |
|
32
|
|
|
|
|
|
|
require XSLoader; |
|
33
|
|
|
|
|
|
|
XSLoader::load( __PACKAGE__, $VERSION ); |
|
34
|
|
|
|
|
|
|
$HAVE_XS = 1; |
|
35
|
|
|
|
|
|
|
1; |
|
36
|
|
|
|
|
|
|
}; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
use Algorithm::ToNumberMunger; |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# one munger from a spec hash |
|
43
|
|
|
|
|
|
|
my $code = Algorithm::ToNumberMunger->build( |
|
44
|
|
|
|
|
|
|
{ munger => 'enum', map => { GET => 0, POST => 1, PUT => 2 } }, |
|
45
|
|
|
|
|
|
|
); |
|
46
|
|
|
|
|
|
|
my $n = $code->('POST'); # 1 |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# a whole table of them at once, from a 'field => spec' hash |
|
49
|
|
|
|
|
|
|
my $by_tag = Algorithm::ToNumberMunger->build_all( |
|
50
|
|
|
|
|
|
|
\%mungers, |
|
51
|
|
|
|
|
|
|
); |
|
52
|
|
|
|
|
|
|
my $row_value = $by_tag->{method}->($raw{method}); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Many numeric pipelines -- anomaly detectors, feature stores, CSV loaders -- |
|
57
|
|
|
|
|
|
|
want every column to be a number, but the values they are handed are not always |
|
58
|
|
|
|
|
|
|
numbers to begin with: an HTTP method is a string, a timestamp is a formatted |
|
59
|
|
|
|
|
|
|
date, a high-cardinality label wants bucketing. An B turns such a |
|
60
|
|
|
|
|
|
|
raw value into a single number. Munging happens on the input side, before a row |
|
61
|
|
|
|
|
|
|
is stored. |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Mungers are declared as a plain data spec -- a hash naming a built-in munger and |
|
64
|
|
|
|
|
|
|
carrying that munger's parameters -- so a table of them can be read straight out |
|
65
|
|
|
|
|
|
|
of JSON or a config file: |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
{ |
|
68
|
|
|
|
|
|
|
"method": { "munger": "enum", "map": { "GET": 0, "POST": 1 } }, |
|
69
|
|
|
|
|
|
|
"bytes": { "munger": "log", "offset": 1 }, |
|
70
|
|
|
|
|
|
|
"label": { "munger": "hash", "buckets": 1024 } |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
B and is passed through unchanged; this module |
|
74
|
|
|
|
|
|
|
is only concerned with fields that name a munger. |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
This class does not read or write files. It B a spec into a closure |
|
77
|
|
|
|
|
|
|
that maps one raw value to one number, so a caller can build its mungers once |
|
78
|
|
|
|
|
|
|
from configuration and then apply them per row with no re-parsing. All |
|
79
|
|
|
|
|
|
|
configuration errors are caught at build time; the returned closure only croaks |
|
80
|
|
|
|
|
|
|
on genuinely un-mungeable I. |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 CLASS METHODS |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 build |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $code = ...->build( \%spec ); |
|
87
|
|
|
|
|
|
|
my $code = ...->build( \%spec, $tag_name ); # $tag_name only sharpens errors |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Compile a single munger spec into a coderef. C<%spec> must contain a C |
|
90
|
|
|
|
|
|
|
key naming one of the L; the remaining keys are that munger's |
|
91
|
|
|
|
|
|
|
parameters. Croaks on an unknown munger name or an invalid parameter set. The |
|
92
|
|
|
|
|
|
|
optional second argument is only used to make error messages point at a tag. |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=cut |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# name => builder. Each builder validates its slice of the spec up front and |
|
97
|
|
|
|
|
|
|
# returns the per-value closure. Keeping them in a table (rather than a big |
|
98
|
|
|
|
|
|
|
# if/elsif) is what makes known_mungers() and has_munger() cheap and honest. |
|
99
|
|
|
|
|
|
|
my %BUILDERS = ( |
|
100
|
|
|
|
|
|
|
enum => \&_build_enum, |
|
101
|
|
|
|
|
|
|
frozen_freq_map => \&_build_frozen_freq_map, |
|
102
|
|
|
|
|
|
|
bool => \&_build_bool, |
|
103
|
|
|
|
|
|
|
length => \&_build_length, |
|
104
|
|
|
|
|
|
|
entropy => \&_build_entropy, |
|
105
|
|
|
|
|
|
|
ngram => \&_build_ngram, |
|
106
|
|
|
|
|
|
|
char => \&_build_char, |
|
107
|
|
|
|
|
|
|
run => \&_build_run, |
|
108
|
|
|
|
|
|
|
count => \&_build_count, |
|
109
|
|
|
|
|
|
|
match => \&_build_match, |
|
110
|
|
|
|
|
|
|
bucket => \&_build_bucket, |
|
111
|
|
|
|
|
|
|
quantile => \&_build_quantile, |
|
112
|
|
|
|
|
|
|
scale => \&_build_scale, |
|
113
|
|
|
|
|
|
|
zscore => \&_build_zscore, |
|
114
|
|
|
|
|
|
|
log => \&_build_log, |
|
115
|
|
|
|
|
|
|
clamp => \&_build_clamp, |
|
116
|
|
|
|
|
|
|
num => \&_build_num, |
|
117
|
|
|
|
|
|
|
bit => \&_build_bit, |
|
118
|
|
|
|
|
|
|
ip_class => \&_build_ip_class, |
|
119
|
|
|
|
|
|
|
cidr => \&_build_cidr, |
|
120
|
|
|
|
|
|
|
datetime => \&_build_datetime, |
|
121
|
|
|
|
|
|
|
hash => \&_build_hash, |
|
122
|
|
|
|
|
|
|
chain => \&_build_chain, |
|
123
|
|
|
|
|
|
|
eps => \&_build_eps, |
|
124
|
|
|
|
|
|
|
mgcp_enum => \&_build_mgcp_enum, |
|
125
|
|
|
|
|
|
|
); |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Status-class mungers (http_enum, smtp_enum, sip_enum, ...) are one transform |
|
128
|
|
|
|
|
|
|
# -- collapse a numeric reply code to its leading digit, int(code/div), with a |
|
129
|
|
|
|
|
|
|
# divisor of 100 (10 for gemini's two-digit codes) -- differing only in which |
|
130
|
|
|
|
|
|
|
# range 'strict' accepts. Register them all from this table so a new protocol |
|
131
|
|
|
|
|
|
|
# is a single line and they can never drift apart. mgcp_enum is deliberately |
|
132
|
|
|
|
|
|
|
# NOT a row here: its strict range has a hole (8xx exists, 6xx/7xx do not), |
|
133
|
|
|
|
|
|
|
# which a single [lo, hi] cannot express, so it has its own builder below. |
|
134
|
|
|
|
|
|
|
my %STATUS_PROTO = ( |
|
135
|
|
|
|
|
|
|
http => [ 100, 599 ], # 1xx-5xx |
|
136
|
|
|
|
|
|
|
smtp => [ 200, 599 ], # 2xx-5xx; SMTP never issues 1yz in practice |
|
137
|
|
|
|
|
|
|
sip => [ 100, 699 ], # 1xx-6xx; SIP adds a 6xx global-failure class |
|
138
|
|
|
|
|
|
|
ftp => [ 100, 599 ], # 1xx-5xx FTP reply codes |
|
139
|
|
|
|
|
|
|
rtsp => [ 100, 599 ], # RTSP (RFC 2326) reuses HTTP's status scheme |
|
140
|
|
|
|
|
|
|
nntp => [ 100, 599 ], # 1xx-5xx NNTP (RFC 3977), SMTP-convention codes |
|
141
|
|
|
|
|
|
|
dict => [ 100, 599 ], # DICT (RFC 2229) uses SMTP-style codes |
|
142
|
|
|
|
|
|
|
gemini => [ 10, 69, 10 ], # two-digit codes, 1x-6x; class = int(code/10) |
|
143
|
|
|
|
|
|
|
); |
|
144
|
|
|
|
|
|
|
for my $proto ( keys %STATUS_PROTO ) { |
|
145
|
|
|
|
|
|
|
my ( $lo, $hi, $div ) = @{ $STATUS_PROTO{$proto} }; |
|
146
|
|
|
|
|
|
|
$div = 100 unless defined $div; |
|
147
|
|
|
|
|
|
|
$BUILDERS{"${proto}_enum"} |
|
148
|
|
|
|
|
|
|
= sub { _status_class_munger( $proto, $lo, $hi, $div, @_ ) }; |
|
149
|
|
|
|
|
|
|
} |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# ratio and combine consume several source fields at once, so they are only |
|
152
|
|
|
|
|
|
|
# buildable through compile()'s multi-input form ('from' as an arrayref) -- a |
|
153
|
|
|
|
|
|
|
# scalar build can never hand them more than one value. Registering a stub |
|
154
|
|
|
|
|
|
|
# keeps known_mungers() honest and turns "used it as a scalar munger" into a |
|
155
|
|
|
|
|
|
|
# pointed error instead of an unknown-munger one. |
|
156
|
|
|
|
|
|
|
for my $name (qw(ratio combine)) { |
|
157
|
|
|
|
|
|
|
$BUILDERS{$name} = sub { |
|
158
|
|
|
|
|
|
|
my ( $spec, $where ) = @_; |
|
159
|
|
|
|
|
|
|
croak "$name munger$where combines several inputs; it is only usable " |
|
160
|
|
|
|
|
|
|
. "via compile() with 'from' as an arrayref of source fields"; |
|
161
|
|
|
|
|
|
|
}; |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub build { |
|
165
|
273
|
|
|
273
|
1
|
236322
|
my ( $class, $spec, $tag ) = @_; |
|
166
|
273
|
100
|
|
|
|
797
|
my $where = defined $tag ? " for tag '$tag'" : ''; |
|
167
|
|
|
|
|
|
|
|
|
168
|
273
|
50
|
|
|
|
884
|
croak "munger spec$where must be a hashref" |
|
169
|
|
|
|
|
|
|
unless ref $spec eq 'HASH'; |
|
170
|
|
|
|
|
|
|
|
|
171
|
273
|
|
|
|
|
514
|
my $name = $spec->{munger}; |
|
172
|
273
|
50
|
33
|
|
|
1251
|
croak "munger spec$where has no 'munger' name" |
|
173
|
|
|
|
|
|
|
unless defined $name && length $name; |
|
174
|
|
|
|
|
|
|
|
|
175
|
273
|
100
|
|
|
|
907
|
my $builder = $BUILDERS{$name} |
|
176
|
|
|
|
|
|
|
or croak "unknown munger '$name'$where (known: " . join( ', ', $class->known_mungers ) . ')'; |
|
177
|
|
|
|
|
|
|
|
|
178
|
272
|
|
|
|
|
717
|
return $builder->( $spec, $where ); |
|
179
|
|
|
|
|
|
|
} ## end sub build |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 build_all |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
my $by_tag = ...->build_all( $info->{mungers} ); |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Compile a whole C hash (tag name => spec) into a hash of tag name => |
|
186
|
|
|
|
|
|
|
coderef. A false/absent argument yields an empty hashref (every tag is raw). |
|
187
|
|
|
|
|
|
|
Croaks if any spec is invalid, naming the offending tag. |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=cut |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub build_all { |
|
192
|
2
|
|
|
2
|
1
|
643
|
my ( $class, $mungers ) = @_; |
|
193
|
2
|
100
|
|
|
|
12
|
return {} unless $mungers; |
|
194
|
|
|
|
|
|
|
|
|
195
|
1
|
50
|
|
|
|
5
|
croak "'mungers' must be a hashref" |
|
196
|
|
|
|
|
|
|
unless ref $mungers eq 'HASH'; |
|
197
|
|
|
|
|
|
|
|
|
198
|
1
|
|
|
|
|
2
|
my %by_tag; |
|
199
|
1
|
|
|
|
|
22
|
for my $tag ( keys %$mungers ) { |
|
200
|
2
|
|
|
|
|
11
|
$by_tag{$tag} = $class->build( $mungers->{$tag}, $tag ); |
|
201
|
|
|
|
|
|
|
} |
|
202
|
1
|
|
|
|
|
5
|
return \%by_tag; |
|
203
|
|
|
|
|
|
|
} ## end sub build_all |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 compile |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my $plan = ...->compile( tags => \@tags, mungers => $info->{mungers} ); |
|
208
|
|
|
|
|
|
|
my $row = $plan->apply_named( \%named_input ); # numbers, in tags order |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Compile a set's C and (optional) C into a B object that maps |
|
211
|
|
|
|
|
|
|
one input record to a fully-numeric row in tag order. Unlike L (which |
|
212
|
|
|
|
|
|
|
just compiles each spec in isolation), C understands the whole set: |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=over 4 |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=item * a scalar munger, keyed by its output tag, fills that one column; its |
|
217
|
|
|
|
|
|
|
input is read from the tag's own name, or from C<< from => 'other' >> to alias a |
|
218
|
|
|
|
|
|
|
source field; |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item * an B munger, keyed by any label and carrying C<< into => |
|
221
|
|
|
|
|
|
|
[tag, ...] >>, reads one source (C, defaulting to the label) and fills |
|
222
|
|
|
|
|
|
|
several columns at once -- this is how a single timestamp becomes both a |
|
223
|
|
|
|
|
|
|
C/C pair without the two ever drifting apart (see L); |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=item * a B munger, keyed by its output tag and carrying a C |
|
226
|
|
|
|
|
|
|
B (C<< from => ['bytes_out', 'bytes_in'] >>), reads several source |
|
227
|
|
|
|
|
|
|
fields and fills that one column -- this is how a ratio becomes a single |
|
228
|
|
|
|
|
|
|
feature without precomputing it upstream (see L and L). The |
|
229
|
|
|
|
|
|
|
sources are raw input fields, not other (possibly munged) columns; |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item * every remaining tag is B and passed through unchanged. |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=back |
|
234
|
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Coverage is validated up front: C croaks if two mungers write the same |
|
236
|
|
|
|
|
|
|
column, if an C names a column not in C, if a munger key is neither a |
|
237
|
|
|
|
|
|
|
tag nor an expander, if an expander's output count does not match its C, |
|
238
|
|
|
|
|
|
|
or if a C list is given to a munger that cannot combine inputs. The |
|
239
|
|
|
|
|
|
|
returned plan has two methods, both returning an arrayref of numbers in C |
|
240
|
|
|
|
|
|
|
order: C (keyed by field name, the only form that supports |
|
241
|
|
|
|
|
|
|
expanders and combiners) and C (positional; croaks if |
|
242
|
|
|
|
|
|
|
the set has any expanding or combining munger, since a shared or combined |
|
243
|
|
|
|
|
|
|
source cannot be expressed by position). |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# name => builder returning ($list_returning_code, $arity), for the mungers that |
|
248
|
|
|
|
|
|
|
# can fan one input out into several columns via 'into'. |
|
249
|
|
|
|
|
|
|
my %MULTI_BUILDERS = ( |
|
250
|
|
|
|
|
|
|
datetime => \&_build_datetime_multi, |
|
251
|
|
|
|
|
|
|
eps => \&_build_eps_multi, |
|
252
|
|
|
|
|
|
|
chain => \&_build_chain_multi, |
|
253
|
|
|
|
|
|
|
); |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub _build_multi { |
|
256
|
9
|
|
|
9
|
|
24
|
my ( $class, $spec, $where ) = @_; |
|
257
|
9
|
|
|
|
|
19
|
my $name = $spec->{munger}; |
|
258
|
9
|
50
|
33
|
|
|
51
|
croak "munger spec$where has no 'munger' name" |
|
259
|
|
|
|
|
|
|
unless defined $name && length $name; |
|
260
|
9
|
100
|
|
|
|
207
|
my $builder = $MULTI_BUILDERS{$name} |
|
261
|
|
|
|
|
|
|
or croak "munger '$name'$where does not support multiple outputs " |
|
262
|
|
|
|
|
|
|
. "('into'); only these do: " |
|
263
|
|
|
|
|
|
|
. join( ', ', sort keys %MULTI_BUILDERS ); |
|
264
|
8
|
|
|
|
|
28
|
return $builder->( $spec, $where ); |
|
265
|
|
|
|
|
|
|
} ## end sub _build_multi |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# name => builder returning the N-input closure, for the mungers that combine |
|
268
|
|
|
|
|
|
|
# several source fields ('from' as an arrayref) into one column. The builder is |
|
269
|
|
|
|
|
|
|
# handed the source count so arity errors surface at compile time. |
|
270
|
|
|
|
|
|
|
my %COMBINE_BUILDERS = ( |
|
271
|
|
|
|
|
|
|
ratio => \&_build_ratio, |
|
272
|
|
|
|
|
|
|
combine => \&_build_combine_op, |
|
273
|
|
|
|
|
|
|
); |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub _build_combine { |
|
276
|
14
|
|
|
14
|
|
32
|
my ( $class, $spec, $where, $nsrc ) = @_; |
|
277
|
14
|
|
|
|
|
23
|
my $name = $spec->{munger}; |
|
278
|
14
|
50
|
33
|
|
|
51
|
croak "munger spec$where has no 'munger' name" |
|
279
|
|
|
|
|
|
|
unless defined $name && length $name; |
|
280
|
14
|
100
|
|
|
|
245
|
my $builder = $COMBINE_BUILDERS{$name} |
|
281
|
|
|
|
|
|
|
or croak "munger '$name'$where does not support multiple inputs " |
|
282
|
|
|
|
|
|
|
. "(a 'from' list); only these do: " |
|
283
|
|
|
|
|
|
|
. join( ', ', sort keys %COMBINE_BUILDERS ); |
|
284
|
13
|
|
|
|
|
32
|
return $builder->( $spec, $where, $nsrc ); |
|
285
|
|
|
|
|
|
|
} ## end sub _build_combine |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub compile { |
|
288
|
24
|
|
|
24
|
1
|
146040
|
my ( $class, %args ) = @_; |
|
289
|
|
|
|
|
|
|
|
|
290
|
24
|
|
|
|
|
56
|
my $tags = $args{tags}; |
|
291
|
24
|
50
|
33
|
|
|
156
|
croak "compile requires a non-empty 'tags' arrayref" |
|
292
|
|
|
|
|
|
|
unless ref $tags eq 'ARRAY' && @$tags; |
|
293
|
24
|
|
100
|
|
|
69
|
my $mungers = $args{mungers} || {}; |
|
294
|
24
|
50
|
|
|
|
64
|
croak "compile: 'mungers' must be a hashref" |
|
295
|
|
|
|
|
|
|
unless ref $mungers eq 'HASH'; |
|
296
|
|
|
|
|
|
|
|
|
297
|
24
|
|
|
|
|
40
|
my %pos; |
|
298
|
24
|
|
|
|
|
81
|
for my $i ( 0 .. $#$tags ) { |
|
299
|
|
|
|
|
|
|
croak "compile: duplicate tag '$tags->[$i]'" |
|
300
|
39
|
50
|
|
|
|
95
|
if exists $pos{ $tags->[$i] }; |
|
301
|
39
|
|
|
|
|
105
|
$pos{ $tags->[$i] } = $i; |
|
302
|
|
|
|
|
|
|
} |
|
303
|
|
|
|
|
|
|
|
|
304
|
24
|
|
|
|
|
45
|
my ( @scalar, @expand, @combine, %claimed ); |
|
305
|
|
|
|
|
|
|
my $claim = sub { |
|
306
|
23
|
|
|
23
|
|
41
|
my ( $tag, $by ) = @_; |
|
307
|
|
|
|
|
|
|
croak "munger '$by' targets unknown column '$tag'" |
|
308
|
23
|
100
|
|
|
|
214
|
unless exists $pos{$tag}; |
|
309
|
|
|
|
|
|
|
croak "two mungers write column '$tag'" |
|
310
|
22
|
100
|
|
|
|
249
|
if $claimed{$tag}++; |
|
311
|
24
|
|
|
|
|
131
|
}; |
|
312
|
|
|
|
|
|
|
|
|
313
|
24
|
|
|
|
|
103
|
for my $key ( sort keys %$mungers ) { |
|
314
|
31
|
|
|
|
|
67
|
my $spec = $mungers->{$key}; |
|
315
|
31
|
50
|
|
|
|
84
|
croak "munger '$key' spec must be a hashref" |
|
316
|
|
|
|
|
|
|
unless ref $spec eq 'HASH'; |
|
317
|
31
|
100
|
|
|
|
82
|
my $from = defined $spec->{from} ? $spec->{from} : $key; |
|
318
|
|
|
|
|
|
|
|
|
319
|
31
|
100
|
|
|
|
88
|
if ( ref $from eq 'ARRAY' ) { |
|
|
|
100
|
|
|
|
|
|
|
320
|
17
|
100
|
|
|
|
194
|
croak "munger '$key': a 'from' list needs at least 2 source fields" |
|
321
|
|
|
|
|
|
|
unless @$from >= 2; |
|
322
|
|
|
|
|
|
|
croak "munger '$key': 'into' cannot be combined with a 'from' list" |
|
323
|
16
|
100
|
|
|
|
189
|
if defined $spec->{into}; |
|
324
|
|
|
|
|
|
|
croak "munger '$key' is not a declared tag and has no 'into'" |
|
325
|
15
|
100
|
|
|
|
219
|
unless exists $pos{$key}; |
|
326
|
14
|
|
|
|
|
49
|
my $code = $class->_build_combine( $spec, " for '$key'", scalar @$from ); |
|
327
|
9
|
|
|
|
|
21
|
$claim->( $key, $key ); |
|
328
|
9
|
|
|
|
|
35
|
push @combine, { tag => $key, from => [@$from], code => $code }; |
|
329
|
|
|
|
|
|
|
} elsif ( defined $spec->{into} ) { |
|
330
|
9
|
|
|
|
|
18
|
my $into = $spec->{into}; |
|
331
|
9
|
50
|
33
|
|
|
46
|
croak "munger '$key': 'into' must be a non-empty arrayref" |
|
332
|
|
|
|
|
|
|
unless ref $into eq 'ARRAY' && @$into; |
|
333
|
9
|
|
|
|
|
41
|
my ( $code, $arity ) = $class->_build_multi( $spec, " for '$key'" ); |
|
334
|
7
|
100
|
|
|
|
165
|
croak "munger '$key' produces $arity value(s) but 'into' lists " . scalar(@$into) |
|
335
|
|
|
|
|
|
|
unless $arity == @$into; |
|
336
|
6
|
|
|
|
|
17
|
$claim->( $_, $key ) for @$into; |
|
337
|
5
|
|
|
|
|
25
|
push @expand, { from => $from, into => [@$into], code => $code }; |
|
338
|
|
|
|
|
|
|
} else { |
|
339
|
|
|
|
|
|
|
croak "munger '$key' is not a declared tag and has no 'into'" |
|
340
|
5
|
100
|
|
|
|
164
|
unless exists $pos{$key}; |
|
341
|
4
|
|
|
|
|
11
|
$claim->( $key, $key ); |
|
342
|
3
|
|
|
|
|
9
|
push @scalar, { tag => $key, from => $from, code => $class->build( $spec, $key ) }; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
} ## end for my $key ( sort keys %$mungers ) |
|
345
|
|
|
|
|
|
|
|
|
346
|
10
|
|
|
|
|
17
|
for my $tag (@$tags) { |
|
347
|
|
|
|
|
|
|
push @scalar, { tag => $tag, from => $tag, code => undef } |
|
348
|
24
|
100
|
|
|
|
84
|
unless $claimed{$tag}; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
|
|
351
|
10
|
|
|
|
|
122
|
return bless { |
|
352
|
|
|
|
|
|
|
tags => [@$tags], |
|
353
|
|
|
|
|
|
|
pos => \%pos, |
|
354
|
|
|
|
|
|
|
scalar => \@scalar, |
|
355
|
|
|
|
|
|
|
expand => \@expand, |
|
356
|
|
|
|
|
|
|
combine => \@combine, |
|
357
|
|
|
|
|
|
|
}, |
|
358
|
|
|
|
|
|
|
"${class}::Plan"; |
|
359
|
|
|
|
|
|
|
} ## end sub compile |
|
360
|
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head2 known_mungers |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my @names = ...->known_mungers; |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
The sorted list of built-in munger names this version understands. |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head2 has_munger |
|
368
|
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
if ( ...->has_munger('enum') ) { ... } |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
True if the named munger is built in. |
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=cut |
|
374
|
|
|
|
|
|
|
|
|
375
|
2
|
|
|
2
|
1
|
78
|
sub known_mungers { my @names = sort keys %BUILDERS; return @names } |
|
|
2
|
|
|
|
|
280
|
|
|
376
|
4
|
|
|
4
|
1
|
136212
|
sub has_munger { return exists $BUILDERS{ $_[1] } } |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head1 BUILT-IN MUNGERS |
|
379
|
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
Every munger returns a plain number and, where the input cannot be interpreted, |
|
381
|
|
|
|
|
|
|
croaks -- the Writer would reject a non-numeric field anyway, so failing at the |
|
382
|
|
|
|
|
|
|
munger gives a better message. Parameters are validated when the munger is |
|
383
|
|
|
|
|
|
|
built, not per row. |
|
384
|
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 enum |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
{ munger => 'enum', map => { GET => 0, POST => 1 }, default => -1 } |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Categorical string to number via an explicit C |
|
390
|
|
|
|
|
|
|
numeric. Without a C, an unmapped input croaks; with one, unmapped |
|
391
|
|
|
|
|
|
|
inputs (including C) yield the default. |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=cut |
|
394
|
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub _build_enum { |
|
396
|
4
|
|
|
4
|
|
9
|
my ( $spec, $where ) = @_; |
|
397
|
|
|
|
|
|
|
|
|
398
|
4
|
|
|
|
|
30
|
my $map = $spec->{map}; |
|
399
|
4
|
50
|
|
|
|
14
|
croak "enum munger$where requires a 'map' hashref" |
|
400
|
|
|
|
|
|
|
unless ref $map eq 'HASH'; |
|
401
|
|
|
|
|
|
|
|
|
402
|
4
|
|
|
|
|
15
|
for my $k ( keys %$map ) { |
|
403
|
|
|
|
|
|
|
croak "enum munger$where: map value for '$k' ('" |
|
404
|
|
|
|
|
|
|
. ( defined $map->{$k} ? $map->{$k} : 'undef' ) |
|
405
|
|
|
|
|
|
|
. "') is not numeric" |
|
406
|
7
|
0
|
|
|
|
30
|
unless looks_like_number( $map->{$k} ); |
|
|
|
50
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
4
|
|
|
|
|
10
|
my $has_default = exists $spec->{default}; |
|
410
|
4
|
|
|
|
|
9
|
my $default = $spec->{default}; |
|
411
|
4
|
50
|
66
|
|
|
17
|
croak "enum munger$where: 'default' must be numeric" |
|
412
|
|
|
|
|
|
|
if $has_default && !looks_like_number($default); |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# Copy so a later edit of the caller's spec cannot mutate a live munger. |
|
415
|
4
|
|
|
|
|
15
|
my %m = %$map; |
|
416
|
|
|
|
|
|
|
return sub { |
|
417
|
7
|
|
|
7
|
|
31
|
my ($v) = @_; |
|
418
|
7
|
100
|
100
|
|
|
44
|
return $m{$v} if defined $v && exists $m{$v}; |
|
419
|
3
|
100
|
|
|
|
10
|
return $default if $has_default; |
|
420
|
1
|
50
|
|
|
|
147
|
croak "enum munger$where: no mapping for '" . ( defined $v ? $v : 'undef' ) . "'"; |
|
421
|
4
|
|
|
|
|
25
|
}; |
|
422
|
|
|
|
|
|
|
} ## end sub _build_enum |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head2 frozen_freq_map |
|
425
|
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
{ munger => 'frozen_freq_map', counts => { jpg => 40213, exe => 12, scr => 3 }, |
|
427
|
|
|
|
|
|
|
total => 67560 } |
|
428
|
|
|
|
|
|
|
# defaults: mode => 'neg_log_prob', smoothing => 1, unseen => 'rare' |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Frequency-encoding from a B count table: the rarer a value |
|
431
|
|
|
|
|
|
|
was when the table was built, the more anomalous it scores. This is C's |
|
432
|
|
|
|
|
|
|
cousin -- a value-to-number map -- except the numbers are derived from observed |
|
433
|
|
|
|
|
|
|
C rather than hand-authored, with the smoothing and unseen-value policy |
|
434
|
|
|
|
|
|
|
that "rare = interesting" needs. It stays a stateless munger: the table is |
|
435
|
|
|
|
|
|
|
computed offline and shipped in C; this class only I it. |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
C maps each value to how many times it was seen. C is the overall |
|
438
|
|
|
|
|
|
|
observation count; it defaults to the sum of C, but may be given |
|
439
|
|
|
|
|
|
|
explicitly and larger so you can B out of C while |
|
440
|
|
|
|
|
|
|
still computing correct probabilities. The emitted number depends on C: |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=over 4 |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=item * C (default) - self-information C<-ln(prob)>: rare values |
|
445
|
|
|
|
|
|
|
score high, common ones low. This is the axis "rare = interesting" describes and |
|
446
|
|
|
|
|
|
|
what an Isolation Forest splits on most naturally. |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=item * C - the probability itself, C<(count + smoothing) / denom>. |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item * C - C, the count with its heavy tail tamed. |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=item * C - the raw count. |
|
453
|
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=back |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
Probabilities use add-one style C (default C<1>), treating "unseen" as |
|
457
|
|
|
|
|
|
|
one aggregate bucket: C |
|
458
|
|
|
|
|
|
|
where C is the number of listed values. C controls what a value absent |
|
459
|
|
|
|
|
|
|
from the table maps to -- C<'rare'> (default) emits that value under the current |
|
460
|
|
|
|
|
|
|
mode as if it had been seen zero times (for C/C this is the |
|
461
|
|
|
|
|
|
|
smoothed unseen bucket, for C/C it is C<0>), or a number to |
|
462
|
|
|
|
|
|
|
force a fixed default. Because an unseen value is usually the very thing you are |
|
463
|
|
|
|
|
|
|
hunting, mapping it to "maximally rare" rather than erroring is the point. |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
C only suits B columns (extensions, |
|
466
|
|
|
|
|
|
|
vendor classes, named pipes, keyboard layouts, link addresses): the table lives |
|
467
|
|
|
|
|
|
|
in C, so a huge one bloats every read -- building one past |
|
468
|
|
|
|
|
|
|
C<$Algorithm::ToNumberMunger::FROZEN_FREQ_MAP_WARN_KEYS> |
|
469
|
|
|
|
|
|
|
values (default 10000) warns. For unbounded cardinality (JA3, full user-agents) |
|
470
|
|
|
|
|
|
|
use L instead, which needs no table but keeps only decorrelation, not |
|
471
|
|
|
|
|
|
|
commonness. |
|
472
|
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=cut |
|
474
|
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# name => 1 for the recognized frozen_freq_map output modes. |
|
476
|
|
|
|
|
|
|
my %FREQ_MODE = map { $_ => 1 } qw(neg_log_prob freq log_count count); |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# Building a table larger than this warns: info.json ships the whole map, so a |
|
479
|
|
|
|
|
|
|
# high-cardinality column belongs in the 'hash' munger instead. |
|
480
|
|
|
|
|
|
|
our $FROZEN_FREQ_MAP_WARN_KEYS = 10_000; |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
sub _build_frozen_freq_map { |
|
483
|
10
|
|
|
10
|
|
14
|
my ( $spec, $where ) = @_; |
|
484
|
|
|
|
|
|
|
|
|
485
|
10
|
|
|
|
|
16
|
my $counts = $spec->{counts}; |
|
486
|
10
|
100
|
66
|
|
|
157
|
croak "frozen_freq_map munger$where requires a non-empty 'counts' hashref" |
|
487
|
|
|
|
|
|
|
unless ref $counts eq 'HASH' && %$counts; |
|
488
|
|
|
|
|
|
|
|
|
489
|
9
|
|
|
|
|
13
|
my $sum = 0; |
|
490
|
9
|
|
|
|
|
24
|
for my $k ( keys %$counts ) { |
|
491
|
13
|
|
|
|
|
17
|
my $c = $counts->{$k}; |
|
492
|
13
|
0
|
33
|
|
|
47
|
croak "frozen_freq_map munger$where: count for '$k' ('" |
|
|
|
50
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
. ( defined $c ? $c : 'undef' ) |
|
494
|
|
|
|
|
|
|
. "') is not a non-negative number" |
|
495
|
|
|
|
|
|
|
unless looks_like_number($c) && $c >= 0; |
|
496
|
13
|
|
|
|
|
29
|
$sum += $c; |
|
497
|
|
|
|
|
|
|
} |
|
498
|
|
|
|
|
|
|
|
|
499
|
9
|
|
|
|
|
15
|
my $V = keys %$counts; |
|
500
|
9
|
100
|
|
|
|
144
|
carp "frozen_freq_map munger$where: 'counts' has $V keys; a table this large bloats " |
|
501
|
|
|
|
|
|
|
. "info.json -- consider the 'hash' munger for unbounded cardinality" |
|
502
|
|
|
|
|
|
|
if $V > $FROZEN_FREQ_MAP_WARN_KEYS; |
|
503
|
|
|
|
|
|
|
|
|
504
|
9
|
100
|
|
|
|
25
|
my $total = defined $spec->{total} ? $spec->{total} : $sum; |
|
505
|
9
|
50
|
|
|
|
20
|
croak "frozen_freq_map munger$where: 'total' must be numeric" |
|
506
|
|
|
|
|
|
|
unless looks_like_number($total); |
|
507
|
9
|
100
|
|
|
|
125
|
croak "frozen_freq_map munger$where: 'total' ($total) must be >= sum of counts ($sum)" |
|
508
|
|
|
|
|
|
|
if $total < $sum; |
|
509
|
|
|
|
|
|
|
|
|
510
|
8
|
100
|
|
|
|
31
|
my $mode = defined $spec->{mode} ? $spec->{mode} : 'neg_log_prob'; |
|
511
|
|
|
|
|
|
|
croak "frozen_freq_map munger$where: unknown mode '$mode' (known: " . join( ', ', sort keys %FREQ_MODE ) . ')' |
|
512
|
8
|
100
|
|
|
|
141
|
unless $FREQ_MODE{$mode}; |
|
513
|
|
|
|
|
|
|
|
|
514
|
7
|
100
|
|
|
|
13
|
my $s = defined $spec->{smoothing} ? $spec->{smoothing} : 1; |
|
515
|
7
|
50
|
33
|
|
|
34
|
croak "frozen_freq_map munger$where: 'smoothing' must be a non-negative number" |
|
516
|
|
|
|
|
|
|
unless looks_like_number($s) && $s >= 0; |
|
517
|
|
|
|
|
|
|
|
|
518
|
7
|
100
|
|
|
|
923
|
my $unseen = defined $spec->{unseen} ? $spec->{unseen} : 'rare'; |
|
519
|
7
|
50
|
66
|
|
|
22
|
croak "frozen_freq_map munger$where: 'unseen' must be 'rare' or a number" |
|
520
|
|
|
|
|
|
|
unless $unseen eq 'rare' || looks_like_number($unseen); |
|
521
|
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# An unseen value under neg_log_prob has probability s/denom; with no |
|
523
|
|
|
|
|
|
|
# smoothing that is 0 and -ln(0) is infinite, which would poison the column. |
|
524
|
|
|
|
|
|
|
# Refuse to build rather than emit inf. |
|
525
|
7
|
100
|
66
|
|
|
137
|
croak "frozen_freq_map munger$where: mode 'neg_log_prob' with unseen => 'rare' needs " |
|
|
|
|
100
|
|
|
|
|
|
526
|
|
|
|
|
|
|
. "smoothing > 0 (an unseen value would otherwise be infinitely surprising)" |
|
527
|
|
|
|
|
|
|
if $mode eq 'neg_log_prob' && $unseen eq 'rare' && $s == 0; |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# Smoothed-probability denominator, treating "unseen" as one extra bucket. |
|
530
|
6
|
|
|
|
|
10
|
my $denom = $total + $s * ( $V + 1 ); |
|
531
|
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# raw count -> emitted number under the chosen mode. |
|
533
|
|
|
|
|
|
|
my $emit_for = sub { |
|
534
|
15
|
|
|
15
|
|
21
|
my ($c) = @_; |
|
535
|
15
|
100
|
|
|
|
35
|
return $c if $mode eq 'count'; |
|
536
|
8
|
50
|
|
|
|
12
|
return log( 1 + $c ) if $mode eq 'log_count'; |
|
537
|
8
|
|
|
|
|
12
|
my $p = ( $c + $s ) / $denom; |
|
538
|
8
|
100
|
|
|
|
17
|
return $p if $mode eq 'freq'; |
|
539
|
5
|
|
|
|
|
18
|
return -log($p); # neg_log_prob |
|
540
|
6
|
|
|
|
|
32
|
}; |
|
541
|
|
|
|
|
|
|
|
|
542
|
6
|
|
|
|
|
20
|
my %emit = map { $_ => $emit_for->( $counts->{$_} ) } keys %$counts; |
|
|
10
|
|
|
|
|
18
|
|
|
543
|
6
|
100
|
|
|
|
16
|
my $unseen_value = $unseen eq 'rare' ? $emit_for->(0) : $unseen; |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
return sub { |
|
546
|
13
|
|
|
13
|
|
61
|
my ($v) = @_; |
|
547
|
13
|
100
|
66
|
|
|
74
|
return defined $v && exists $emit{$v} ? $emit{$v} : $unseen_value; |
|
548
|
6
|
|
|
|
|
76
|
}; |
|
549
|
|
|
|
|
|
|
} ## end sub _build_frozen_freq_map |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head2 http_enum |
|
552
|
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
{ munger => 'http_enum' } |
|
554
|
|
|
|
|
|
|
{ munger => 'http_enum', strict => 1 } |
|
555
|
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Collapse an HTTP status code to its class: C<1xx> to C<1>, C<2xx> to C<2>, C<3xx> |
|
557
|
|
|
|
|
|
|
to C<3>, and so on (i.e. C). This is the usual bucketing for an |
|
558
|
|
|
|
|
|
|
HTTP status column -- the forest cares far more about "was this a 4xx vs a 2xx" |
|
559
|
|
|
|
|
|
|
than about C<403> vs C<404>, and it keeps the feature low-cardinality without |
|
560
|
|
|
|
|
|
|
having to spell out every code in an C C |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
By default any numeric input is bucketed, so a bogus C<700> would quietly become |
|
563
|
|
|
|
|
|
|
C<7>. With a true C, inputs outside the valid HTTP status range |
|
564
|
|
|
|
|
|
|
(C<100>-C<599>) croak instead, so a malformed code is caught at write time rather |
|
565
|
|
|
|
|
|
|
than smuggled into the model as a spurious class. |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head2 smtp_enum |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
{ munger => 'smtp_enum' } |
|
570
|
|
|
|
|
|
|
{ munger => 'smtp_enum', strict => 1 } |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
The SMTP counterpart of L: collapse an SMTP reply code to its leading |
|
573
|
|
|
|
|
|
|
digit (C), since that digit I the reply's meaning -- C<2yz> |
|
574
|
|
|
|
|
|
|
completion, C<3yz> intermediate, C<4yz> transient failure, C<5yz> permanent |
|
575
|
|
|
|
|
|
|
failure. As with C this keeps the column low-cardinality and lets the |
|
576
|
|
|
|
|
|
|
forest weigh "a 5xx where a 2xx was expected" without enumerating every code. |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
With a true C, inputs outside the valid SMTP reply range (C<200>-C<599>) |
|
579
|
|
|
|
|
|
|
croak. SMTP never issues C<1yz> replies in practice (no command permits a |
|
580
|
|
|
|
|
|
|
positive-preliminary reply), so the strict floor is C<200> rather than |
|
581
|
|
|
|
|
|
|
C's C<100>. |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 sip_enum |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
{ munger => 'sip_enum' } |
|
586
|
|
|
|
|
|
|
{ munger => 'sip_enum', strict => 1 } |
|
587
|
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
The SIP counterpart of L: collapse a SIP status code to its leading |
|
589
|
|
|
|
|
|
|
digit (C). SIP reuses HTTP's class scheme but adds a sixth |
|
590
|
|
|
|
|
|
|
class -- C<1xx> provisional, C<2xx> success, C<3xx> redirection, C<4xx> client |
|
591
|
|
|
|
|
|
|
error, C<5xx> server error, C<6xx> global failure. |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
With a true C, inputs outside the valid SIP status range (C<100>-C<699>) |
|
594
|
|
|
|
|
|
|
croak. The ceiling is C<699> rather than C's C<599> precisely because |
|
595
|
|
|
|
|
|
|
of that C<6xx> global-failure class. |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head2 ftp_enum |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
{ munger => 'ftp_enum' } |
|
600
|
|
|
|
|
|
|
{ munger => 'ftp_enum', strict => 1 } |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
The FTP counterpart of L, for FTP reply codes: C, |
|
603
|
|
|
|
|
|
|
bucketing into C<1yz>-C<5yz>. With a true C, inputs outside C<100>-C<599> |
|
604
|
|
|
|
|
|
|
croak. |
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=head2 rtsp_enum |
|
607
|
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
{ munger => 'rtsp_enum' } |
|
609
|
|
|
|
|
|
|
{ munger => 'rtsp_enum', strict => 1 } |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
The RTSP counterpart of L. RTSP (RFC 2326) deliberately reuses |
|
612
|
|
|
|
|
|
|
HTTP's status scheme, so codes collapse to their leading digit the same way. |
|
613
|
|
|
|
|
|
|
With a true C, inputs outside C<100>-C<599> croak. |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head2 nntp_enum |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
{ munger => 'nntp_enum' } |
|
618
|
|
|
|
|
|
|
{ munger => 'nntp_enum', strict => 1 } |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
The NNTP counterpart of L, for NNTP (RFC 3977) reply codes, which |
|
621
|
|
|
|
|
|
|
follow the SMTP convention -- C<1xx> informational, C<2xx> success, C<3xx> |
|
622
|
|
|
|
|
|
|
send-more-input, C<4xx> transient failure, C<5xx> permanent failure. Unlike |
|
623
|
|
|
|
|
|
|
SMTP, NNTP does issue C<1xx> replies (help text, capability lists), so the |
|
624
|
|
|
|
|
|
|
strict floor is C<100> rather than C's C<200>. With a true |
|
625
|
|
|
|
|
|
|
C, inputs outside C<100>-C<599> croak. |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head2 dict_enum |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
{ munger => 'dict_enum' } |
|
630
|
|
|
|
|
|
|
{ munger => 'dict_enum', strict => 1 } |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
The DICT counterpart of L, for DICT protocol (RFC 2229) status |
|
633
|
|
|
|
|
|
|
codes, which use the SMTP-style code classes. With a true C, inputs |
|
634
|
|
|
|
|
|
|
outside C<100>-C<599> croak. |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
=head2 gemini_enum |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
{ munger => 'gemini_enum' } |
|
639
|
|
|
|
|
|
|
{ munger => 'gemini_enum', strict => 1 } |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Like L but for the Gemini protocol, whose status codes are B |
|
642
|
|
|
|
|
|
|
digits -- C<1x> input expected, C<2x> success, C<3x> redirect, C<4x> temporary |
|
643
|
|
|
|
|
|
|
failure, C<5x> permanent failure, C<6x> client certificate required -- so the |
|
644
|
|
|
|
|
|
|
class is C. With a true C, inputs outside C<10>-C<69> |
|
645
|
|
|
|
|
|
|
croak. |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=cut |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# Shared closure for the status-class mungers registered from %STATUS_PROTO. |
|
650
|
|
|
|
|
|
|
sub _status_class_munger { |
|
651
|
16
|
|
|
16
|
|
46
|
my ( $proto, $lo, $hi, $div, $spec, $where ) = @_; |
|
652
|
16
|
100
|
|
|
|
41
|
my $strict = $spec->{strict} ? 1 : 0; |
|
653
|
|
|
|
|
|
|
return sub { |
|
654
|
62
|
|
|
62
|
|
2981
|
my ($v) = @_; |
|
655
|
62
|
50
|
|
|
|
574
|
croak "${proto}_enum munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a numeric status code" |
|
|
|
100
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
657
|
59
|
100
|
100
|
|
|
2325
|
croak "${proto}_enum munger$where: status code '$v' is out of range " . "($lo-$hi)" |
|
|
|
|
100
|
|
|
|
|
|
658
|
|
|
|
|
|
|
if $strict && ( $v < $lo || $v > $hi ); |
|
659
|
47
|
|
|
|
|
271
|
return int( $v / $div ); |
|
660
|
16
|
|
|
|
|
131
|
}; |
|
661
|
|
|
|
|
|
|
} ## end sub _status_class_munger |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=head2 mgcp_enum |
|
664
|
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
{ munger => 'mgcp_enum' } |
|
666
|
|
|
|
|
|
|
{ munger => 'mgcp_enum', strict => 1 } |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
The MGCP counterpart of L, for MGCP (RFC 3435) response codes: |
|
669
|
|
|
|
|
|
|
C. MGCP's classes are C<1xx> provisional, C<2xx> success, |
|
670
|
|
|
|
|
|
|
C<4xx> transient error, C<5xx> permanent error, and C<8xx> package-specific -- |
|
671
|
|
|
|
|
|
|
there are no C<6xx> or C<7xx> codes, so the valid set has a B in it. |
|
672
|
|
|
|
|
|
|
With a true C, inputs outside C<100>-C<599> B outside |
|
673
|
|
|
|
|
|
|
C<800>-C<899> croak. (That hole is why this is a hand-written builder rather |
|
674
|
|
|
|
|
|
|
than another row of the shared status-class table, which can only express one |
|
675
|
|
|
|
|
|
|
contiguous range.) |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
# MGCP's strict range is [100,599] union [800,899] -- 8xx package-specific |
|
680
|
|
|
|
|
|
|
# codes are real, 6xx/7xx are not -- which %STATUS_PROTO's single [lo, hi] |
|
681
|
|
|
|
|
|
|
# cannot express, hence this dedicated builder. |
|
682
|
|
|
|
|
|
|
sub _build_mgcp_enum { |
|
683
|
2
|
|
|
2
|
|
5
|
my ( $spec, $where ) = @_; |
|
684
|
2
|
100
|
|
|
|
8
|
my $strict = $spec->{strict} ? 1 : 0; |
|
685
|
|
|
|
|
|
|
return sub { |
|
686
|
15
|
|
|
15
|
|
1942
|
my ($v) = @_; |
|
687
|
15
|
50
|
|
|
|
230
|
croak "mgcp_enum munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a numeric status code" |
|
|
|
100
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
689
|
14
|
100
|
100
|
|
|
641
|
croak "mgcp_enum munger$where: status code '$v' is out of range " . "(100-599 or 800-899)" |
|
|
|
|
100
|
|
|
|
|
|
690
|
|
|
|
|
|
|
if $strict && !( ( $v >= 100 && $v <= 599 ) || ( $v >= 800 && $v <= 899 ) ); |
|
691
|
10
|
|
|
|
|
64
|
return int( $v / 100 ); |
|
692
|
2
|
|
|
|
|
19
|
}; |
|
693
|
|
|
|
|
|
|
} ## end sub _build_mgcp_enum |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=head2 dns_rcode_enum |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
{ munger => 'dns_rcode_enum' } |
|
698
|
|
|
|
|
|
|
{ munger => 'dns_rcode_enum', default => -1 } |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
The first of the B: like L, except the C |
|
701
|
|
|
|
|
|
|
in from a well-known registry instead of hand-authored (and inevitably |
|
702
|
|
|
|
|
|
|
typo'd). All named-map enums share the same lookup rules: names are matched |
|
703
|
|
|
|
|
|
|
B; where the emitted numbers are the protocol's own wire |
|
704
|
|
|
|
|
|
|
encoding (as here -- rcode C<3> I C), a numeric input is passed |
|
705
|
|
|
|
|
|
|
through unchanged, so mixed feeds (one tool logs C, another logs |
|
706
|
|
|
|
|
|
|
C<3>) land in one consistent column; and an unmapped value croaks unless the |
|
707
|
|
|
|
|
|
|
spec supplies a numeric C. As with C, an unrecognized value is |
|
708
|
|
|
|
|
|
|
often exactly the anomaly worth keeping, so C<< default => -1 >> is the usual |
|
709
|
|
|
|
|
|
|
escape hatch. |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
This one maps DNS RCODE names to their IANA values: C 0, C |
|
712
|
|
|
|
|
|
|
1, C 2, C 3, C 4 (alias C), C 5, |
|
713
|
|
|
|
|
|
|
C 6, C 7, C 8, C 9, C 10, |
|
714
|
|
|
|
|
|
|
C 11, and the extended rcodes C/C 16, C |
|
715
|
|
|
|
|
|
|
17, C 18, C 19, C 20, C 21, C 22, |
|
716
|
|
|
|
|
|
|
C 23. |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head2 dns_qtype_enum |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
{ munger => 'dns_qtype_enum', default => -1 } |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Named-map enum (lookup rules as L; numeric inputs pass |
|
723
|
|
|
|
|
|
|
through) mapping DNS RR type names to their IANA numbers: C 1, C 2, |
|
724
|
|
|
|
|
|
|
C 5, C 6, C 10, C 12, C 15, C 16, C 28, |
|
725
|
|
|
|
|
|
|
C 33, C 35, C 43, C 46, C 48, C 52, |
|
726
|
|
|
|
|
|
|
C 64, C 65, C 252, C (or C<*>) 255, C 256, |
|
727
|
|
|
|
|
|
|
C 257, and the rest of the commonly-observed registry. The query-type mix |
|
728
|
|
|
|
|
|
|
is a classic DNS-tunneling feature -- C/C-heavy traffic where |
|
729
|
|
|
|
|
|
|
C/C is normal. |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head2 syslog_severity_enum |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
{ munger => 'syslog_severity_enum' } |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Named-map enum (lookup rules as L; numeric inputs pass |
|
736
|
|
|
|
|
|
|
through) mapping syslog severity names to their RFC 5424 codes: C 0 |
|
737
|
|
|
|
|
|
|
(alias C), C 1, C 2, C 3 (alias C), |
|
738
|
|
|
|
|
|
|
C 4 (alias C), C 5, C 6 (alias |
|
739
|
|
|
|
|
|
|
C), C 7. Genuinely ordinal -- lower is more severe -- |
|
740
|
|
|
|
|
|
|
so a threshold split on it is meaningful. |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head2 syslog_facility_enum |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
{ munger => 'syslog_facility_enum' } |
|
745
|
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Named-map enum (lookup rules as L; numeric inputs pass |
|
747
|
|
|
|
|
|
|
through) mapping syslog facility names to their RFC 5424 codes: C 0, |
|
748
|
|
|
|
|
|
|
C 1, C 2, C 3, C 4 (alias C), C 5, |
|
749
|
|
|
|
|
|
|
C 6, C 7, C 8, C 9, C 10, C 11, C |
|
750
|
|
|
|
|
|
|
12, C 13, C 14, C 15, and C-C 16-23. |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head2 ip_proto_enum |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
{ munger => 'ip_proto_enum', default => -1 } |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Named-map enum (lookup rules as L; numeric inputs pass |
|
757
|
|
|
|
|
|
|
through) mapping IP protocol names to their IANA protocol numbers: C 1, |
|
758
|
|
|
|
|
|
|
C 2, C 4 (alias C), C 6, C 8, C 17, |
|
759
|
|
|
|
|
|
|
C 33, C 41, C 46, C 47, C 50, C 51, |
|
760
|
|
|
|
|
|
|
C 58 (alias C), C 89, C 103, C 132, |
|
761
|
|
|
|
|
|
|
C 136. The map is frozen here rather than delegated to |
|
762
|
|
|
|
|
|
|
C so a value munges to the same number on every host. |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head2 tls_version_enum |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
{ munger => 'tls_version_enum', default => -1 } |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) mapping a TLS/SSL protocol |
|
769
|
|
|
|
|
|
|
version name to an B: C 0, C 1, C 2, C |
|
770
|
|
|
|
|
|
|
3, C 4, C 5, with the common spelling variants (C, |
|
771
|
|
|
|
|
|
|
C, ...) accepted. Ordinal so "older than expected" is a monotone |
|
772
|
|
|
|
|
|
|
feature a threshold split can express. Because these ordinals are this |
|
773
|
|
|
|
|
|
|
module's invention rather than a wire encoding, numeric inputs are B |
|
774
|
|
|
|
|
|
|
passed through -- a C<1.2> would land on the wrong scale -- and croak like |
|
775
|
|
|
|
|
|
|
any other unmapped value (or take the C). |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=head2 http_method_enum |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
{ munger => 'http_method_enum', default => -1 } |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the registered HTTP |
|
782
|
|
|
|
|
|
|
request methods: C 0, C 1, C 2, C 3, C 4, |
|
783
|
|
|
|
|
|
|
C 5, C 6, C 7, C 8. HTTP has no numeric |
|
784
|
|
|
|
|
|
|
method encoding, so these are unordered ordinals of this module's invention |
|
785
|
|
|
|
|
|
|
(a canonical map beats every set inventing its own numbering) and numeric |
|
786
|
|
|
|
|
|
|
inputs are not passed through. An unlisted -- possibly probing -- method |
|
787
|
|
|
|
|
|
|
croaks unless a C is given, and that unlisted-method signal is often |
|
788
|
|
|
|
|
|
|
the interesting one. |
|
789
|
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=head2 sip_method_enum |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
{ munger => 'sip_method_enum', default => -1 } |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the SIP request |
|
795
|
|
|
|
|
|
|
methods: C 0, C 1, C 2, C 3, C 4, |
|
796
|
|
|
|
|
|
|
C 5, C 6, C 7, C 8, C 9, |
|
797
|
|
|
|
|
|
|
C 10, C 11, C 12, C 13. Like |
|
798
|
|
|
|
|
|
|
L these are ordinals of this module's invention, so |
|
799
|
|
|
|
|
|
|
numeric inputs are not passed through. |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 dhcp_msgtype_enum |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
{ munger => 'dhcp_msgtype_enum' } |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Named-map enum (lookup rules as L; numeric inputs pass |
|
806
|
|
|
|
|
|
|
through) mapping DHCP message-type names to their option-53 values: |
|
807
|
|
|
|
|
|
|
C 1, C 2, C 3, C 4, C 5, C 6, |
|
808
|
|
|
|
|
|
|
C 7, C 8 -- each also accepted with the C prefix |
|
809
|
|
|
|
|
|
|
(C, ...) that most tooling logs. |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head2 app_proto_enum |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
{ munger => 'app_proto_enum', default => -1 } |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for Suricata's |
|
816
|
|
|
|
|
|
|
C field -- the detected application-layer protocol on a flow or |
|
817
|
|
|
|
|
|
|
alert (C, C, C, C, C, C, C, ...), |
|
818
|
|
|
|
|
|
|
including C and C, which are usually the very rows worth |
|
819
|
|
|
|
|
|
|
keeping. These are unordered ordinals of this module's invention (Suricata |
|
820
|
|
|
|
|
|
|
logs a string, not a number), so numeric inputs are B passed through. |
|
821
|
|
|
|
|
|
|
C is accepted as an alias for C and C for C. This is |
|
822
|
|
|
|
|
|
|
distinct from L, which numbers the L4 protocol |
|
823
|
|
|
|
|
|
|
(C/C/...) rather than the app layer riding on it. |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head2 tcp_state_enum |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
{ munger => 'tcp_state_enum', default => -1 } |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) mapping the TCP state |
|
830
|
|
|
|
|
|
|
machine, as Suricata logs it under C, to an B along |
|
831
|
|
|
|
|
|
|
the connection lifecycle: C 0, C 1, C 2, |
|
832
|
|
|
|
|
|
|
C 3, C 4, C 5, C 6, C |
|
833
|
|
|
|
|
|
|
7, C 8, C 9, C 10. Ordinal so "further along |
|
834
|
|
|
|
|
|
|
teardown than expected" is a monotone feature a threshold split can express. |
|
835
|
|
|
|
|
|
|
Being ordinals of our own invention, numeric inputs are not passed through. |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 flow_state_enum |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
{ munger => 'flow_state_enum', default => -1 } |
|
840
|
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for Suricata's |
|
842
|
|
|
|
|
|
|
C: C 0, C 1, C 2, C 3, |
|
843
|
|
|
|
|
|
|
C 4 -- roughly ordinal along the flow lifecycle. Numeric inputs |
|
844
|
|
|
|
|
|
|
are not passed through. |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
=head2 flow_reason_enum |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
{ munger => 'flow_reason_enum', default => -1 } |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for Suricata's |
|
851
|
|
|
|
|
|
|
C, why a flow was logged out: C 0, C 1, |
|
852
|
|
|
|
|
|
|
C 2, C 3. Numeric inputs are not passed through. |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=head2 suricata_action_enum |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
{ munger => 'suricata_action_enum', default => -1 } |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for Suricata's |
|
859
|
|
|
|
|
|
|
C and the related rule/drop actions: C 0, C |
|
860
|
|
|
|
|
|
|
1, C 2, C 3, C 4, C 5. In IDS mode the field is |
|
861
|
|
|
|
|
|
|
C/C; the rule-action names are accepted too for IPS feeds |
|
862
|
|
|
|
|
|
|
and C events. Numeric inputs are not passed through. |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=head2 postfix_status_enum |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
{ munger => 'postfix_status_enum', default => -1 } |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for Postfix's delivery |
|
869
|
|
|
|
|
|
|
C disposition, numbered in a rough sent-to-failed severity order so |
|
870
|
|
|
|
|
|
|
a threshold split is meaningful: C 0, C 1, C 2, |
|
871
|
|
|
|
|
|
|
C 3, C 4, C 5, C 6, C 7, |
|
872
|
|
|
|
|
|
|
C 8, C 9, C 10. Stock delivery agents emit only |
|
873
|
|
|
|
|
|
|
C/C/C/C; C/C come |
|
874
|
|
|
|
|
|
|
from address verification (C), and the remainder cover HOLD/DISCARD |
|
875
|
|
|
|
|
|
|
actions and values common log normalizers emit. Being labels of this module's |
|
876
|
|
|
|
|
|
|
numbering, numeric inputs are not passed through. |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=head2 spf_result_enum |
|
879
|
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
{ munger => 'spf_result_enum', default => -1 } |
|
881
|
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for an SPF check result |
|
883
|
|
|
|
|
|
|
(RFC 7208), as logged by policyd-spf or carried in an C |
|
884
|
|
|
|
|
|
|
header, numbered pass-to-fail: C 0, C 1, C 2, C |
|
885
|
|
|
|
|
|
|
3, C 4, C 5, C 6. The older spellings C |
|
886
|
|
|
|
|
|
|
(for C) and C (for C) are accepted as aliases. |
|
887
|
|
|
|
|
|
|
Numeric inputs are not passed through. |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=head2 dkim_result_enum |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
{ munger => 'dkim_result_enum', default => -1 } |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for a DKIM verification |
|
894
|
|
|
|
|
|
|
result (RFC 8601), as logged by opendkim or carried in an |
|
895
|
|
|
|
|
|
|
C header, numbered pass-to-fail: C 0, C |
|
896
|
|
|
|
|
|
|
1, C 2, C 3, C 4, C 5, C 6. The older |
|
897
|
|
|
|
|
|
|
spellings C (for C) and C (for C) are |
|
898
|
|
|
|
|
|
|
accepted as aliases. Numeric inputs are not passed through. |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head2 dmarc_result_enum |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
{ munger => 'dmarc_result_enum', default => -1 } |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for a DMARC evaluation |
|
905
|
|
|
|
|
|
|
result (RFC 7489 / RFC 8601), as logged by opendmarc or carried in an |
|
906
|
|
|
|
|
|
|
C header: C 0, C 1, C 2, C |
|
907
|
|
|
|
|
|
|
3, C 4, and opendmarc's C 5. This is the DMARC |
|
908
|
|
|
|
|
|
|
I (did the message pass alignment), not the policy I |
|
909
|
|
|
|
|
|
|
(C/C/C) -- for that, use a plain L. Numeric |
|
910
|
|
|
|
|
|
|
inputs are not passed through. |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=head2 sasl_mech_enum |
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
{ munger => 'sasl_mech_enum', default => -1 } |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the SASL |
|
917
|
|
|
|
|
|
|
authentication mechanism -- as Dovecot logs C, Postfix logs |
|
918
|
|
|
|
|
|
|
C, and submission/IMAP/POP3 auth report -- numbered in a rough |
|
919
|
|
|
|
|
|
|
B order so the ordinal carries a little signal on its |
|
920
|
|
|
|
|
|
|
own: the cleartext and C mechanisms sort low, the legacy |
|
921
|
|
|
|
|
|
|
challenge-response ones (C, C, C, ...) in the |
|
922
|
|
|
|
|
|
|
middle, then C/C, the OAuth/federated tokens, and finally the |
|
923
|
|
|
|
|
|
|
Kerberos/GSS and certificate (C) mechanisms. About two dozen |
|
924
|
|
|
|
|
|
|
mechanisms are baked in, covering the IANA registry plus the ubiquitous |
|
925
|
|
|
|
|
|
|
non-registered C, C, and C. Being ordinals of this |
|
926
|
|
|
|
|
|
|
module's numbering, numeric inputs are not passed through; an unlisted |
|
927
|
|
|
|
|
|
|
mechanism croaks unless a numeric C is given. |
|
928
|
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
If you would rather the number carry B implied gradient, see |
|
930
|
|
|
|
|
|
|
L, which numbers the same set alphabetically. |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=head2 sasl_mech_iana_enum |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
{ munger => 'sasl_mech_iana_enum', default => -1 } |
|
935
|
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
The nominal counterpart of L: the B set of SASL |
|
937
|
|
|
|
|
|
|
mechanisms (the two share one list, so they can never cover different |
|
938
|
|
|
|
|
|
|
mechanisms), but numbered B rather than by strength -- a |
|
939
|
|
|
|
|
|
|
purely categorical encoding for when a strength gradient would be a |
|
940
|
|
|
|
|
|
|
misleading feature. Lookup rules and the no-numeric-passthrough behaviour are |
|
941
|
|
|
|
|
|
|
as L. |
|
942
|
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=head2 http_version_enum |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
{ munger => 'http_version_enum', default => -1 } |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) mapping the HTTP protocol |
|
948
|
|
|
|
|
|
|
version to an B: C 0, C 1, C 2, |
|
949
|
|
|
|
|
|
|
C 3, C 4. The access-log spelling (C), the bare |
|
950
|
|
|
|
|
|
|
number (C<1.1>), and the ALPN/shorthand forms (C, C, C) are all |
|
951
|
|
|
|
|
|
|
accepted, so an Apache/nginx C<%H> field and a Suricata C land |
|
952
|
|
|
|
|
|
|
in one column. Ordinal so "older than expected" (a C<0.9>/C<1.0> request from |
|
953
|
|
|
|
|
|
|
a scanner) is a monotone feature a threshold split can express. Because these |
|
954
|
|
|
|
|
|
|
are ordinals of our own numbering -- and a logged C<2> denotes version C<2.0>, |
|
955
|
|
|
|
|
|
|
not the integer two -- numeric inputs are B passed through. |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=head2 spamassassin_autolearn_enum |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
{ munger => 'spamassassin_autolearn_enum', default => -1 } |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for SpamAssassin's |
|
962
|
|
|
|
|
|
|
C field: C 0, C 1, C 2, C 3, C 4, |
|
963
|
|
|
|
|
|
|
C 5, C 6. The numbering is essentially nominal (the |
|
964
|
|
|
|
|
|
|
Bayes auto-learn outcome is a category, not a scale), arranged only so the |
|
965
|
|
|
|
|
|
|
"nothing was learned" states cluster away from the ham/spam ones. The spam |
|
966
|
|
|
|
|
|
|
I is already a number for L, and the spam/ham verdict a L; |
|
967
|
|
|
|
|
|
|
this covers the one autolearn field neither derives. Numeric inputs are not |
|
968
|
|
|
|
|
|
|
passed through. |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=head2 rspamd_action_enum |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
{ munger => 'rspamd_action_enum', default => -1 } |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for rspamd's action, |
|
975
|
|
|
|
|
|
|
numbered by B so the ordinal is a usable feature on its |
|
976
|
|
|
|
|
|
|
own: C 0, C 1, C 2, C 3, |
|
977
|
|
|
|
|
|
|
C 4, C 5. Both the space and underscore spellings rspamd |
|
978
|
|
|
|
|
|
|
emits (C/C, C/C, ...) are |
|
979
|
|
|
|
|
|
|
accepted. Numeric inputs are not passed through. |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=head2 ssh_auth_method_enum |
|
982
|
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
{ munger => 'ssh_auth_method_enum', default => -1 } |
|
984
|
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the OpenSSH |
|
986
|
|
|
|
|
|
|
authentication method logged by C (the word after C/C, |
|
987
|
|
|
|
|
|
|
or the C field): C 0, C 1, C 2, |
|
988
|
|
|
|
|
|
|
C 3, C 4, C 5, C 6, with |
|
989
|
|
|
|
|
|
|
bare C aliased to C. Numbered roughly |
|
990
|
|
|
|
|
|
|
B so "weaker credential than expected" is a monotone |
|
991
|
|
|
|
|
|
|
feature; the ordering is a judgement call, not a registry. Numeric inputs are |
|
992
|
|
|
|
|
|
|
not passed through. |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=head2 amavis_category_enum |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
{ munger => 'amavis_category_enum', default => -1 } |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the amavisd-new |
|
999
|
|
|
|
|
|
|
content category, ordered clean-to-worst: C 0, C 1, |
|
1000
|
|
|
|
|
|
|
C 2, C 3, C 4, C 5, C 6, |
|
1001
|
|
|
|
|
|
|
C 7, C 8. The hyphenated spellings (C, |
|
1002
|
|
|
|
|
|
|
C) and the legacy C (for C) are accepted as |
|
1003
|
|
|
|
|
|
|
aliases. The Passed/Blocked I itself is a L; this is the |
|
1004
|
|
|
|
|
|
|
finer-grained reason. Numeric inputs are not passed through. |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=head2 systemd_result_enum |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
{ munger => 'systemd_result_enum', default => -1 } |
|
1009
|
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for a systemd unit |
|
1011
|
|
|
|
|
|
|
C (as in C): C 0, C |
|
1012
|
|
|
|
|
|
|
1, C 2, C 3, C 4, C 5, C 6, |
|
1013
|
|
|
|
|
|
|
C 7, C 8, C 9. The underscore spellings |
|
1014
|
|
|
|
|
|
|
(C, C, C, C) are accepted as |
|
1015
|
|
|
|
|
|
|
aliases. Numeric inputs are not passed through. |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=head2 clamav_result_enum |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
{ munger => 'clamav_result_enum', default => -1 } |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for a ClamAV per-target |
|
1022
|
|
|
|
|
|
|
verdict as logged by C / clamav-milter: C 0, C 1, C |
|
1023
|
|
|
|
|
|
|
2. Small but exactly the signal worth flagging (a C line). Numeric |
|
1024
|
|
|
|
|
|
|
inputs are not passed through. |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head2 kerberos_etype_enum |
|
1027
|
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
{ munger => 'kerberos_etype_enum', default => -1 } |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
Named-map enum for the Kerberos ticket encryption type -- Windows events |
|
1031
|
|
|
|
|
|
|
4768/4769 (logged as hex, C<0x17>) and any other AD/Kerberos source. The |
|
1032
|
|
|
|
|
|
|
values are the RFC 3961 etype numbers, which B the wire encoding, so |
|
1033
|
|
|
|
|
|
|
(unlike most of the enums here) a decimal input passes through unchanged: the |
|
1034
|
|
|
|
|
|
|
map exists only to resolve the hex spellings (C<0x17> => 23, C<0x12> => 18, |
|
1035
|
|
|
|
|
|
|
...) and the RFC/MIT names (C/C/C => 23, |
|
1036
|
|
|
|
|
|
|
C/C => 18, C => 17, C => 16, |
|
1037
|
|
|
|
|
|
|
C => 3, C => 1) onto that same number. The classic |
|
1038
|
|
|
|
|
|
|
use is flagging C (0x17) as a downgrade/roasting signal against an |
|
1039
|
|
|
|
|
|
|
C baseline. Lookup is case-insensitive; an unlisted etype croaks |
|
1040
|
|
|
|
|
|
|
unless a numeric C is given. |
|
1041
|
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head2 windows_integrity_level_enum |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
{ munger => 'windows_integrity_level_enum', default => -1 } |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the Windows / Sysmon |
|
1047
|
|
|
|
|
|
|
process integrity level, as an B: C 0, C 1, C |
|
1048
|
|
|
|
|
|
|
2, C 3, C 4 (with C folded into C). The |
|
1049
|
|
|
|
|
|
|
C mandatory-label SIDs Windows sometimes logs in place of the word |
|
1050
|
|
|
|
|
|
|
(C => 3, ...) are accepted as aliases. Ordinal so "higher |
|
1051
|
|
|
|
|
|
|
privilege than expected" is a monotone feature. Numeric inputs are not passed |
|
1052
|
|
|
|
|
|
|
through. |
|
1053
|
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head2 windows_logon_status_enum |
|
1055
|
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
{ munger => 'windows_logon_status_enum', default => -1 } |
|
1057
|
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the NTSTATUS |
|
1059
|
|
|
|
|
|
|
sub-status on a failed Windows logon (events 4625/4776), collapsed to a |
|
1060
|
|
|
|
|
|
|
compact B rather than the raw 32-bit code: C<0xC0000064> |
|
1061
|
|
|
|
|
|
|
(no such user) 0, C<0xC000006A> (bad password) 1, C<0xC000006D> (generic bad |
|
1062
|
|
|
|
|
|
|
user/pass) 2, C<0xC000006F> (outside hours) 3, C<0xC0000070> (workstation |
|
1063
|
|
|
|
|
|
|
restriction) 4, C<0xC0000071> (password expired) 5, C<0xC0000072> (disabled) |
|
1064
|
|
|
|
|
|
|
6, C<0xC0000193> (account expired) 7, C<0xC0000133> (clock skew) 8, |
|
1065
|
|
|
|
|
|
|
C<0xC0000224> (must change password) 9, C<0xC0000234> (locked out) 10, |
|
1066
|
|
|
|
|
|
|
C<0xC000015B> (logon type not granted) 11. Keys are the hex codes exactly as |
|
1067
|
|
|
|
|
|
|
logged (matched case-insensitively); only the common logon subset is baked in, |
|
1068
|
|
|
|
|
|
|
so an unlisted code croaks unless a numeric C is given. Numeric |
|
1069
|
|
|
|
|
|
|
inputs are not passed through. |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=head2 windows_impersonation_level_enum |
|
1072
|
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
{ munger => 'windows_impersonation_level_enum', default => -1 } |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the event 4624 |
|
1076
|
|
|
|
|
|
|
impersonation level, ordered by reach: C 0, C 1, |
|
1077
|
|
|
|
|
|
|
C 2, C 3. The C<%%1832> / C<%%1833> message tokens |
|
1078
|
|
|
|
|
|
|
Windows often emits in place of the words (Identification / Impersonation) are |
|
1079
|
|
|
|
|
|
|
accepted as aliases. Numeric inputs are not passed through. |
|
1080
|
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
=head2 aad_signin_error_enum |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
{ munger => 'aad_signin_error_enum', default => -1 } |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
Named-map enum for the Azure AD / Entra sign-in C error code, |
|
1086
|
|
|
|
|
|
|
collapsed to a compact B rather than the raw code: C<0> |
|
1087
|
|
|
|
|
|
|
(success) 0, invalid-password (C<50126>, C<50056>) 1, no-such-user (C<50034>) |
|
1088
|
|
|
|
|
|
|
2, disabled (C<50057>) 3, locked / smart-lockout (C<50053>) 4, password-expired |
|
1089
|
|
|
|
|
|
|
(C<50055>, C<50144>) 5, MFA-required (C<50074>, C<50076>, C<50079>) 6, |
|
1090
|
|
|
|
|
|
|
MFA-failed (C<500121>, C<50158>) 7, blocked-by-conditional-access (C<53003>, |
|
1091
|
|
|
|
|
|
|
C<53000>, C<53001>, C<530032>) 8, session-expired (C<50173>) 9. Although |
|
1092
|
|
|
|
|
|
|
C is already numeric, the code space is huge and sparse and its |
|
1093
|
|
|
|
|
|
|
magnitude carries no signal -- this maps the common codes onto a handful of |
|
1094
|
|
|
|
|
|
|
meaningful buckets (and, unlike L, keeps related codes together). Keys |
|
1095
|
|
|
|
|
|
|
are the codes as logged; only the common subset is baked in, so an unlisted |
|
1096
|
|
|
|
|
|
|
code croaks unless a numeric C is given. Because the output is a |
|
1097
|
|
|
|
|
|
|
category of our own numbering, numeric inputs are B passed through. |
|
1098
|
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
=head2 risk_level_enum |
|
1100
|
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
{ munger => 'risk_level_enum', default => -1 } |
|
1102
|
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the Entra Identity |
|
1104
|
|
|
|
|
|
|
Protection C as an B: C 0, C 1, C 2, |
|
1105
|
|
|
|
|
|
|
C 3. C and C are left to the C |
|
1106
|
|
|
|
|
|
|
(they are not points on the scale). Numeric inputs are not passed through. |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=head2 aws_principal_type_enum |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
{ munger => 'aws_principal_type_enum', default => -1 } |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the CloudTrail |
|
1113
|
|
|
|
|
|
|
C: C 0, C 1, C 2, |
|
1114
|
|
|
|
|
|
|
C 3, C 4, C 5, C 6, |
|
1115
|
|
|
|
|
|
|
C 7, C 8, C 9, C 10. The |
|
1116
|
|
|
|
|
|
|
numbering is nominal (distinct stable numbers, not a scale); C is the |
|
1117
|
|
|
|
|
|
|
value you actually alert on. Numeric inputs are not passed through. |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
=head2 aad_client_app_enum |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
{ munger => 'aad_client_app_enum', default => -1 } |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the Azure AD |
|
1124
|
|
|
|
|
|
|
C, numbered so the modern clients sort low (C 0, |
|
1125
|
|
|
|
|
|
|
C 1) and the B protocols -- which |
|
1126
|
|
|
|
|
|
|
cannot satisfy MFA -- sort high (C, C, C, |
|
1127
|
|
|
|
|
|
|
C, C, C, C
|
|
1128
|
|
|
|
|
|
|
Online PowerShell>, C, C, C
|
|
1129
|
|
|
|
|
|
|
clients>, from 2 up). A "C<< >= 2 >> means legacy auth" threshold is the |
|
1130
|
|
|
|
|
|
|
intended feature. C/C/C short forms are accepted as aliases. |
|
1131
|
|
|
|
|
|
|
Numeric inputs are not passed through. |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
=head2 risk_state_enum |
|
1134
|
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
{ munger => 'risk_state_enum', default => -1 } |
|
1136
|
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the Entra Identity |
|
1138
|
|
|
|
|
|
|
Protection C: C 0, C 1, C 2, |
|
1139
|
|
|
|
|
|
|
C 3, C 4, C 5. Numeric inputs are not |
|
1140
|
|
|
|
|
|
|
passed through. |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head2 vpc_flow_log_status_enum |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
{ munger => 'vpc_flow_log_status_enum', default => -1 } |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the AWS VPC Flow Logs |
|
1147
|
|
|
|
|
|
|
C: C 0, C 1, C 2. (The per-flow |
|
1148
|
|
|
|
|
|
|
C/C action is a plain L; this is the capture-health |
|
1149
|
|
|
|
|
|
|
field.) Numeric inputs are not passed through. |
|
1150
|
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=head2 aws_event_type_enum |
|
1152
|
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
{ munger => 'aws_event_type_enum', default => -1 } |
|
1154
|
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the CloudTrail |
|
1156
|
|
|
|
|
|
|
C: C 0, C 1, C 2, |
|
1157
|
|
|
|
|
|
|
C 3, C 4. C is the |
|
1158
|
|
|
|
|
|
|
one worth flagging. Numeric inputs are not passed through. |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=head2 conditional_access_result_enum |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
{ munger => 'conditional_access_result_enum', default => -1 } |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
Named-map enum (lookup rules as L) for the Azure AD sign-in |
|
1165
|
|
|
|
|
|
|
C: C 0, C 1, C 2, |
|
1166
|
|
|
|
|
|
|
C 3, C 4. Numeric inputs are not passed through. |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=cut |
|
1169
|
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
# Named-map enums: baked-in value->number maps for well-known registries, |
|
1171
|
|
|
|
|
|
|
# registered as "_enum". Keys are stored lowercase; lookup lowercases |
|
1172
|
|
|
|
|
|
|
# the input, giving the case-insensitive matching the POD promises. 'numeric' |
|
1173
|
|
|
|
|
|
|
# says whether a numeric input is passed through as-is -- set only where the |
|
1174
|
|
|
|
|
|
|
# numbers are the protocol's own encoding (a qtype 28 IS AAAA on the wire); |
|
1175
|
|
|
|
|
|
|
# where they are ordinals of our own invention (tls_version, the method |
|
1176
|
|
|
|
|
|
|
# enums), passthrough would mix scales, so a number croaks like any other |
|
1177
|
|
|
|
|
|
|
# unmapped value. |
|
1178
|
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
# SASL mechanism names, ordered weakest-to-strongest, for sasl_mech_enum. The |
|
1180
|
|
|
|
|
|
|
# same set is numbered alphabetically for sasl_mech_iana_enum, so the two |
|
1181
|
|
|
|
|
|
|
# mungers can never end up covering different mechanisms. Includes the IANA |
|
1182
|
|
|
|
|
|
|
# registry plus the ubiquitous non-registered login/xoauth2/apop. |
|
1183
|
|
|
|
|
|
|
my @SASL_MECHS_BY_STRENGTH = qw( |
|
1184
|
|
|
|
|
|
|
anonymous plain login |
|
1185
|
|
|
|
|
|
|
apop cram-md5 digest-md5 ntlm skey otp securid rpa kerberos_v4 |
|
1186
|
|
|
|
|
|
|
srp scram-sha-1 scram-sha-1-plus scram-sha-256 scram-sha-256-plus |
|
1187
|
|
|
|
|
|
|
xoauth2 oauthbearer openid20 saml20 |
|
1188
|
|
|
|
|
|
|
gssapi gs2-krb5 gss-spnego external |
|
1189
|
|
|
|
|
|
|
); |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
my %NAMED_ENUM = ( |
|
1192
|
|
|
|
|
|
|
dns_rcode => { |
|
1193
|
|
|
|
|
|
|
numeric => 1, |
|
1194
|
|
|
|
|
|
|
map => { |
|
1195
|
|
|
|
|
|
|
noerror => 0, |
|
1196
|
|
|
|
|
|
|
formerr => 1, |
|
1197
|
|
|
|
|
|
|
servfail => 2, |
|
1198
|
|
|
|
|
|
|
nxdomain => 3, |
|
1199
|
|
|
|
|
|
|
notimp => 4, |
|
1200
|
|
|
|
|
|
|
notimpl => 4, |
|
1201
|
|
|
|
|
|
|
refused => 5, |
|
1202
|
|
|
|
|
|
|
yxdomain => 6, |
|
1203
|
|
|
|
|
|
|
yxrrset => 7, |
|
1204
|
|
|
|
|
|
|
nxrrset => 8, |
|
1205
|
|
|
|
|
|
|
notauth => 9, |
|
1206
|
|
|
|
|
|
|
notzone => 10, |
|
1207
|
|
|
|
|
|
|
dsotypeni => 11, |
|
1208
|
|
|
|
|
|
|
badvers => 16, |
|
1209
|
|
|
|
|
|
|
badsig => 16, |
|
1210
|
|
|
|
|
|
|
badkey => 17, |
|
1211
|
|
|
|
|
|
|
badtime => 18, |
|
1212
|
|
|
|
|
|
|
badmode => 19, |
|
1213
|
|
|
|
|
|
|
badname => 20, |
|
1214
|
|
|
|
|
|
|
badalg => 21, |
|
1215
|
|
|
|
|
|
|
badtrunc => 22, |
|
1216
|
|
|
|
|
|
|
badcookie => 23, |
|
1217
|
|
|
|
|
|
|
}, |
|
1218
|
|
|
|
|
|
|
}, |
|
1219
|
|
|
|
|
|
|
dns_qtype => { |
|
1220
|
|
|
|
|
|
|
numeric => 1, |
|
1221
|
|
|
|
|
|
|
map => { |
|
1222
|
|
|
|
|
|
|
a => 1, |
|
1223
|
|
|
|
|
|
|
ns => 2, |
|
1224
|
|
|
|
|
|
|
cname => 5, |
|
1225
|
|
|
|
|
|
|
soa => 6, |
|
1226
|
|
|
|
|
|
|
mb => 7, |
|
1227
|
|
|
|
|
|
|
mg => 8, |
|
1228
|
|
|
|
|
|
|
mr => 9, |
|
1229
|
|
|
|
|
|
|
'null' => 10, |
|
1230
|
|
|
|
|
|
|
wks => 11, |
|
1231
|
|
|
|
|
|
|
ptr => 12, |
|
1232
|
|
|
|
|
|
|
hinfo => 13, |
|
1233
|
|
|
|
|
|
|
minfo => 14, |
|
1234
|
|
|
|
|
|
|
mx => 15, |
|
1235
|
|
|
|
|
|
|
txt => 16, |
|
1236
|
|
|
|
|
|
|
rp => 17, |
|
1237
|
|
|
|
|
|
|
afsdb => 18, |
|
1238
|
|
|
|
|
|
|
sig => 24, |
|
1239
|
|
|
|
|
|
|
key => 25, |
|
1240
|
|
|
|
|
|
|
aaaa => 28, |
|
1241
|
|
|
|
|
|
|
loc => 29, |
|
1242
|
|
|
|
|
|
|
srv => 33, |
|
1243
|
|
|
|
|
|
|
naptr => 35, |
|
1244
|
|
|
|
|
|
|
kx => 36, |
|
1245
|
|
|
|
|
|
|
cert => 37, |
|
1246
|
|
|
|
|
|
|
dname => 39, |
|
1247
|
|
|
|
|
|
|
opt => 41, |
|
1248
|
|
|
|
|
|
|
ds => 43, |
|
1249
|
|
|
|
|
|
|
sshfp => 44, |
|
1250
|
|
|
|
|
|
|
ipseckey => 45, |
|
1251
|
|
|
|
|
|
|
rrsig => 46, |
|
1252
|
|
|
|
|
|
|
nsec => 47, |
|
1253
|
|
|
|
|
|
|
dnskey => 48, |
|
1254
|
|
|
|
|
|
|
dhcid => 49, |
|
1255
|
|
|
|
|
|
|
nsec3 => 50, |
|
1256
|
|
|
|
|
|
|
nsec3param => 51, |
|
1257
|
|
|
|
|
|
|
tlsa => 52, |
|
1258
|
|
|
|
|
|
|
smimea => 53, |
|
1259
|
|
|
|
|
|
|
hip => 55, |
|
1260
|
|
|
|
|
|
|
cds => 59, |
|
1261
|
|
|
|
|
|
|
cdnskey => 60, |
|
1262
|
|
|
|
|
|
|
openpgpkey => 61, |
|
1263
|
|
|
|
|
|
|
csync => 62, |
|
1264
|
|
|
|
|
|
|
zonemd => 63, |
|
1265
|
|
|
|
|
|
|
svcb => 64, |
|
1266
|
|
|
|
|
|
|
https => 65, |
|
1267
|
|
|
|
|
|
|
eui48 => 108, |
|
1268
|
|
|
|
|
|
|
eui64 => 109, |
|
1269
|
|
|
|
|
|
|
tkey => 249, |
|
1270
|
|
|
|
|
|
|
tsig => 250, |
|
1271
|
|
|
|
|
|
|
ixfr => 251, |
|
1272
|
|
|
|
|
|
|
axfr => 252, |
|
1273
|
|
|
|
|
|
|
any => 255, |
|
1274
|
|
|
|
|
|
|
'*' => 255, |
|
1275
|
|
|
|
|
|
|
uri => 256, |
|
1276
|
|
|
|
|
|
|
caa => 257, |
|
1277
|
|
|
|
|
|
|
}, |
|
1278
|
|
|
|
|
|
|
}, |
|
1279
|
|
|
|
|
|
|
syslog_severity => { |
|
1280
|
|
|
|
|
|
|
numeric => 1, |
|
1281
|
|
|
|
|
|
|
map => { |
|
1282
|
|
|
|
|
|
|
emerg => 0, |
|
1283
|
|
|
|
|
|
|
panic => 0, |
|
1284
|
|
|
|
|
|
|
alert => 1, |
|
1285
|
|
|
|
|
|
|
crit => 2, |
|
1286
|
|
|
|
|
|
|
err => 3, |
|
1287
|
|
|
|
|
|
|
error => 3, |
|
1288
|
|
|
|
|
|
|
warning => 4, |
|
1289
|
|
|
|
|
|
|
warn => 4, |
|
1290
|
|
|
|
|
|
|
notice => 5, |
|
1291
|
|
|
|
|
|
|
info => 6, |
|
1292
|
|
|
|
|
|
|
informational => 6, |
|
1293
|
|
|
|
|
|
|
debug => 7, |
|
1294
|
|
|
|
|
|
|
}, |
|
1295
|
|
|
|
|
|
|
}, |
|
1296
|
|
|
|
|
|
|
syslog_facility => { |
|
1297
|
|
|
|
|
|
|
numeric => 1, |
|
1298
|
|
|
|
|
|
|
map => { |
|
1299
|
|
|
|
|
|
|
kern => 0, |
|
1300
|
|
|
|
|
|
|
user => 1, |
|
1301
|
|
|
|
|
|
|
mail => 2, |
|
1302
|
|
|
|
|
|
|
daemon => 3, |
|
1303
|
|
|
|
|
|
|
auth => 4, |
|
1304
|
|
|
|
|
|
|
security => 4, |
|
1305
|
|
|
|
|
|
|
syslog => 5, |
|
1306
|
|
|
|
|
|
|
lpr => 6, |
|
1307
|
|
|
|
|
|
|
news => 7, |
|
1308
|
|
|
|
|
|
|
uucp => 8, |
|
1309
|
|
|
|
|
|
|
cron => 9, |
|
1310
|
|
|
|
|
|
|
authpriv => 10, |
|
1311
|
|
|
|
|
|
|
ftp => 11, |
|
1312
|
|
|
|
|
|
|
ntp => 12, |
|
1313
|
|
|
|
|
|
|
audit => 13, |
|
1314
|
|
|
|
|
|
|
alert => 14, |
|
1315
|
|
|
|
|
|
|
clock => 15, |
|
1316
|
|
|
|
|
|
|
( map { ( "local$_" => 16 + $_ ) } 0 .. 7 ), |
|
1317
|
|
|
|
|
|
|
}, |
|
1318
|
|
|
|
|
|
|
}, |
|
1319
|
|
|
|
|
|
|
ip_proto => { |
|
1320
|
|
|
|
|
|
|
numeric => 1, |
|
1321
|
|
|
|
|
|
|
map => { |
|
1322
|
|
|
|
|
|
|
icmp => 1, |
|
1323
|
|
|
|
|
|
|
igmp => 2, |
|
1324
|
|
|
|
|
|
|
ipip => 4, |
|
1325
|
|
|
|
|
|
|
ipencap => 4, |
|
1326
|
|
|
|
|
|
|
tcp => 6, |
|
1327
|
|
|
|
|
|
|
egp => 8, |
|
1328
|
|
|
|
|
|
|
udp => 17, |
|
1329
|
|
|
|
|
|
|
dccp => 33, |
|
1330
|
|
|
|
|
|
|
ipv6 => 41, |
|
1331
|
|
|
|
|
|
|
rsvp => 46, |
|
1332
|
|
|
|
|
|
|
gre => 47, |
|
1333
|
|
|
|
|
|
|
esp => 50, |
|
1334
|
|
|
|
|
|
|
ah => 51, |
|
1335
|
|
|
|
|
|
|
icmpv6 => 58, |
|
1336
|
|
|
|
|
|
|
'ipv6-icmp' => 58, |
|
1337
|
|
|
|
|
|
|
ospf => 89, |
|
1338
|
|
|
|
|
|
|
pim => 103, |
|
1339
|
|
|
|
|
|
|
sctp => 132, |
|
1340
|
|
|
|
|
|
|
udplite => 136, |
|
1341
|
|
|
|
|
|
|
}, |
|
1342
|
|
|
|
|
|
|
}, |
|
1343
|
|
|
|
|
|
|
tls_version => { |
|
1344
|
|
|
|
|
|
|
numeric => 0, |
|
1345
|
|
|
|
|
|
|
map => { |
|
1346
|
|
|
|
|
|
|
sslv2 => 0, |
|
1347
|
|
|
|
|
|
|
ssl2 => 0, |
|
1348
|
|
|
|
|
|
|
sslv3 => 1, |
|
1349
|
|
|
|
|
|
|
ssl3 => 1, |
|
1350
|
|
|
|
|
|
|
tlsv1 => 2, |
|
1351
|
|
|
|
|
|
|
'tlsv1.0' => 2, |
|
1352
|
|
|
|
|
|
|
tls1 => 2, |
|
1353
|
|
|
|
|
|
|
'tls1.0' => 2, |
|
1354
|
|
|
|
|
|
|
'tlsv1.1' => 3, |
|
1355
|
|
|
|
|
|
|
'tls1.1' => 3, |
|
1356
|
|
|
|
|
|
|
'tlsv1.2' => 4, |
|
1357
|
|
|
|
|
|
|
'tls1.2' => 4, |
|
1358
|
|
|
|
|
|
|
'tlsv1.3' => 5, |
|
1359
|
|
|
|
|
|
|
'tls1.3' => 5, |
|
1360
|
|
|
|
|
|
|
}, |
|
1361
|
|
|
|
|
|
|
}, |
|
1362
|
|
|
|
|
|
|
http_method => { |
|
1363
|
|
|
|
|
|
|
numeric => 0, |
|
1364
|
|
|
|
|
|
|
map => { |
|
1365
|
|
|
|
|
|
|
get => 0, |
|
1366
|
|
|
|
|
|
|
head => 1, |
|
1367
|
|
|
|
|
|
|
post => 2, |
|
1368
|
|
|
|
|
|
|
put => 3, |
|
1369
|
|
|
|
|
|
|
delete => 4, |
|
1370
|
|
|
|
|
|
|
connect => 5, |
|
1371
|
|
|
|
|
|
|
options => 6, |
|
1372
|
|
|
|
|
|
|
trace => 7, |
|
1373
|
|
|
|
|
|
|
patch => 8, |
|
1374
|
|
|
|
|
|
|
}, |
|
1375
|
|
|
|
|
|
|
}, |
|
1376
|
|
|
|
|
|
|
sip_method => { |
|
1377
|
|
|
|
|
|
|
numeric => 0, |
|
1378
|
|
|
|
|
|
|
map => { |
|
1379
|
|
|
|
|
|
|
invite => 0, |
|
1380
|
|
|
|
|
|
|
ack => 1, |
|
1381
|
|
|
|
|
|
|
bye => 2, |
|
1382
|
|
|
|
|
|
|
cancel => 3, |
|
1383
|
|
|
|
|
|
|
register => 4, |
|
1384
|
|
|
|
|
|
|
options => 5, |
|
1385
|
|
|
|
|
|
|
prack => 6, |
|
1386
|
|
|
|
|
|
|
subscribe => 7, |
|
1387
|
|
|
|
|
|
|
notify => 8, |
|
1388
|
|
|
|
|
|
|
publish => 9, |
|
1389
|
|
|
|
|
|
|
info => 10, |
|
1390
|
|
|
|
|
|
|
refer => 11, |
|
1391
|
|
|
|
|
|
|
message => 12, |
|
1392
|
|
|
|
|
|
|
update => 13, |
|
1393
|
|
|
|
|
|
|
}, |
|
1394
|
|
|
|
|
|
|
}, |
|
1395
|
|
|
|
|
|
|
dhcp_msgtype => { |
|
1396
|
|
|
|
|
|
|
numeric => 1, |
|
1397
|
|
|
|
|
|
|
map => { |
|
1398
|
|
|
|
|
|
|
( |
|
1399
|
|
|
|
|
|
|
map { ( $_->[0] => $_->[1], "dhcp$_->[0]" => $_->[1] ) } [ discover => 1 ], |
|
1400
|
|
|
|
|
|
|
[ offer => 2 ], |
|
1401
|
|
|
|
|
|
|
[ request => 3 ], |
|
1402
|
|
|
|
|
|
|
[ decline => 4 ], |
|
1403
|
|
|
|
|
|
|
[ ack => 5 ], |
|
1404
|
|
|
|
|
|
|
[ nak => 6 ], |
|
1405
|
|
|
|
|
|
|
[ release => 7 ], |
|
1406
|
|
|
|
|
|
|
[ inform => 8 ] |
|
1407
|
|
|
|
|
|
|
), |
|
1408
|
|
|
|
|
|
|
}, |
|
1409
|
|
|
|
|
|
|
}, |
|
1410
|
|
|
|
|
|
|
app_proto => { |
|
1411
|
|
|
|
|
|
|
numeric => 0, |
|
1412
|
|
|
|
|
|
|
map => { |
|
1413
|
|
|
|
|
|
|
# Ordinals of our own invention (Suricata's app_proto is a string |
|
1414
|
|
|
|
|
|
|
# label with no wire number), assigned from a fixed order so a value |
|
1415
|
|
|
|
|
|
|
# munges to the same number on every host. 'failed'/'unknown' are |
|
1416
|
|
|
|
|
|
|
# kept as their own classes -- an un-parsed app layer is often the |
|
1417
|
|
|
|
|
|
|
# interesting row. |
|
1418
|
|
|
|
|
|
|
do { |
|
1419
|
|
|
|
|
|
|
my @order = qw( |
|
1420
|
|
|
|
|
|
|
unknown failed http http2 ftp ftp-data smtp imap |
|
1421
|
|
|
|
|
|
|
tls ssh smb dcerpc dns modbus enip dnp3 nfs ntp |
|
1422
|
|
|
|
|
|
|
tftp ike krb5 quic dhcp snmp sip rfb mqtt rdp |
|
1423
|
|
|
|
|
|
|
telnet pgsql ldap websocket bittorrent-dht |
|
1424
|
|
|
|
|
|
|
); |
|
1425
|
|
|
|
|
|
|
my %m = map { $order[$_] => $_ } 0 .. $#order; |
|
1426
|
|
|
|
|
|
|
$m{ssl} = $m{tls}; # Suricata's older spelling |
|
1427
|
|
|
|
|
|
|
$m{ikev2} = $m{ike}; |
|
1428
|
|
|
|
|
|
|
%m; |
|
1429
|
|
|
|
|
|
|
}, |
|
1430
|
|
|
|
|
|
|
}, |
|
1431
|
|
|
|
|
|
|
}, |
|
1432
|
|
|
|
|
|
|
tcp_state => { |
|
1433
|
|
|
|
|
|
|
numeric => 0, |
|
1434
|
|
|
|
|
|
|
map => { |
|
1435
|
|
|
|
|
|
|
# The TCP state machine (flow.tcp.state), numbered along the |
|
1436
|
|
|
|
|
|
|
# connection lifecycle so the ordinal is meaningful. |
|
1437
|
|
|
|
|
|
|
do { |
|
1438
|
|
|
|
|
|
|
my @order = qw( |
|
1439
|
|
|
|
|
|
|
none syn_sent syn_recv established |
|
1440
|
|
|
|
|
|
|
fin_wait1 fin_wait2 closing time_wait |
|
1441
|
|
|
|
|
|
|
close_wait last_ack closed |
|
1442
|
|
|
|
|
|
|
); |
|
1443
|
|
|
|
|
|
|
map { $order[$_] => $_ } 0 .. $#order; |
|
1444
|
|
|
|
|
|
|
}, |
|
1445
|
|
|
|
|
|
|
}, |
|
1446
|
|
|
|
|
|
|
}, |
|
1447
|
|
|
|
|
|
|
flow_state => { |
|
1448
|
|
|
|
|
|
|
numeric => 0, |
|
1449
|
|
|
|
|
|
|
map => { |
|
1450
|
|
|
|
|
|
|
new => 0, |
|
1451
|
|
|
|
|
|
|
established => 1, |
|
1452
|
|
|
|
|
|
|
closed => 2, |
|
1453
|
|
|
|
|
|
|
bypassed => 3, |
|
1454
|
|
|
|
|
|
|
local_bypass => 4, |
|
1455
|
|
|
|
|
|
|
}, |
|
1456
|
|
|
|
|
|
|
}, |
|
1457
|
|
|
|
|
|
|
flow_reason => { |
|
1458
|
|
|
|
|
|
|
numeric => 0, |
|
1459
|
|
|
|
|
|
|
map => { |
|
1460
|
|
|
|
|
|
|
timeout => 0, |
|
1461
|
|
|
|
|
|
|
forced => 1, |
|
1462
|
|
|
|
|
|
|
shutdown => 2, |
|
1463
|
|
|
|
|
|
|
unknown => 3, |
|
1464
|
|
|
|
|
|
|
}, |
|
1465
|
|
|
|
|
|
|
}, |
|
1466
|
|
|
|
|
|
|
suricata_action => { |
|
1467
|
|
|
|
|
|
|
numeric => 0, |
|
1468
|
|
|
|
|
|
|
map => { |
|
1469
|
|
|
|
|
|
|
allowed => 0, |
|
1470
|
|
|
|
|
|
|
blocked => 1, |
|
1471
|
|
|
|
|
|
|
pass => 2, |
|
1472
|
|
|
|
|
|
|
drop => 3, |
|
1473
|
|
|
|
|
|
|
reject => 4, |
|
1474
|
|
|
|
|
|
|
alert => 5, |
|
1475
|
|
|
|
|
|
|
}, |
|
1476
|
|
|
|
|
|
|
}, |
|
1477
|
|
|
|
|
|
|
postfix_status => { |
|
1478
|
|
|
|
|
|
|
numeric => 0, |
|
1479
|
|
|
|
|
|
|
map => { |
|
1480
|
|
|
|
|
|
|
sent => 0, |
|
1481
|
|
|
|
|
|
|
deferred => 1, |
|
1482
|
|
|
|
|
|
|
bounced => 2, |
|
1483
|
|
|
|
|
|
|
expired => 3, |
|
1484
|
|
|
|
|
|
|
deliverable => 4, |
|
1485
|
|
|
|
|
|
|
undeliverable => 5, |
|
1486
|
|
|
|
|
|
|
hold => 6, |
|
1487
|
|
|
|
|
|
|
discard => 7, |
|
1488
|
|
|
|
|
|
|
filtered => 8, |
|
1489
|
|
|
|
|
|
|
reject => 9, |
|
1490
|
|
|
|
|
|
|
softbounce => 10, |
|
1491
|
|
|
|
|
|
|
}, |
|
1492
|
|
|
|
|
|
|
}, |
|
1493
|
|
|
|
|
|
|
spf_result => { |
|
1494
|
|
|
|
|
|
|
numeric => 0, |
|
1495
|
|
|
|
|
|
|
map => { |
|
1496
|
|
|
|
|
|
|
pass => 0, |
|
1497
|
|
|
|
|
|
|
neutral => 1, |
|
1498
|
|
|
|
|
|
|
none => 2, |
|
1499
|
|
|
|
|
|
|
softfail => 3, |
|
1500
|
|
|
|
|
|
|
fail => 4, |
|
1501
|
|
|
|
|
|
|
temperror => 5, |
|
1502
|
|
|
|
|
|
|
error => 5, # older spelling of temperror |
|
1503
|
|
|
|
|
|
|
permerror => 6, |
|
1504
|
|
|
|
|
|
|
unknown => 6, # older spelling of permerror |
|
1505
|
|
|
|
|
|
|
}, |
|
1506
|
|
|
|
|
|
|
}, |
|
1507
|
|
|
|
|
|
|
dkim_result => { |
|
1508
|
|
|
|
|
|
|
numeric => 0, |
|
1509
|
|
|
|
|
|
|
map => { |
|
1510
|
|
|
|
|
|
|
pass => 0, |
|
1511
|
|
|
|
|
|
|
neutral => 1, |
|
1512
|
|
|
|
|
|
|
none => 2, |
|
1513
|
|
|
|
|
|
|
policy => 3, |
|
1514
|
|
|
|
|
|
|
fail => 4, |
|
1515
|
|
|
|
|
|
|
temperror => 5, |
|
1516
|
|
|
|
|
|
|
error => 5, # older spelling of temperror |
|
1517
|
|
|
|
|
|
|
permerror => 6, |
|
1518
|
|
|
|
|
|
|
unknown => 6, # older spelling of permerror |
|
1519
|
|
|
|
|
|
|
}, |
|
1520
|
|
|
|
|
|
|
}, |
|
1521
|
|
|
|
|
|
|
dmarc_result => { |
|
1522
|
|
|
|
|
|
|
numeric => 0, |
|
1523
|
|
|
|
|
|
|
map => { |
|
1524
|
|
|
|
|
|
|
pass => 0, |
|
1525
|
|
|
|
|
|
|
none => 1, |
|
1526
|
|
|
|
|
|
|
fail => 2, |
|
1527
|
|
|
|
|
|
|
temperror => 3, |
|
1528
|
|
|
|
|
|
|
permerror => 4, |
|
1529
|
|
|
|
|
|
|
bestguesspass => 5, |
|
1530
|
|
|
|
|
|
|
}, |
|
1531
|
|
|
|
|
|
|
}, |
|
1532
|
|
|
|
|
|
|
sasl_mech => { |
|
1533
|
|
|
|
|
|
|
numeric => 0, |
|
1534
|
|
|
|
|
|
|
map => { |
|
1535
|
|
|
|
|
|
|
do { |
|
1536
|
|
|
|
|
|
|
my @o = @SASL_MECHS_BY_STRENGTH; |
|
1537
|
|
|
|
|
|
|
map { $o[$_] => $_ } 0 .. $#o; |
|
1538
|
|
|
|
|
|
|
}, |
|
1539
|
|
|
|
|
|
|
}, |
|
1540
|
|
|
|
|
|
|
}, |
|
1541
|
|
|
|
|
|
|
sasl_mech_iana => { |
|
1542
|
|
|
|
|
|
|
numeric => 0, |
|
1543
|
|
|
|
|
|
|
map => { |
|
1544
|
|
|
|
|
|
|
do { |
|
1545
|
|
|
|
|
|
|
my @o = sort @SASL_MECHS_BY_STRENGTH; |
|
1546
|
|
|
|
|
|
|
map { $o[$_] => $_ } 0 .. $#o; |
|
1547
|
|
|
|
|
|
|
}, |
|
1548
|
|
|
|
|
|
|
}, |
|
1549
|
|
|
|
|
|
|
}, |
|
1550
|
|
|
|
|
|
|
http_version => { |
|
1551
|
|
|
|
|
|
|
numeric => 0, # a logged "2" is version 2.0, not the integer two |
|
1552
|
|
|
|
|
|
|
map => { |
|
1553
|
|
|
|
|
|
|
# Ordinal so "older than expected" is a monotone feature. Accepts |
|
1554
|
|
|
|
|
|
|
# the access-log spelling (HTTP/1.1), the bare number (1.1), and |
|
1555
|
|
|
|
|
|
|
# the ALPN/h2 shorthands. |
|
1556
|
|
|
|
|
|
|
do { |
|
1557
|
|
|
|
|
|
|
my %v = ( |
|
1558
|
|
|
|
|
|
|
'http/0.9' => 0, |
|
1559
|
|
|
|
|
|
|
'http/1.0' => 1, |
|
1560
|
|
|
|
|
|
|
'http/1.1' => 2, |
|
1561
|
|
|
|
|
|
|
'http/2.0' => 3, |
|
1562
|
|
|
|
|
|
|
'http/3.0' => 4, |
|
1563
|
|
|
|
|
|
|
); |
|
1564
|
|
|
|
|
|
|
$v{'0.9'} = 0; |
|
1565
|
|
|
|
|
|
|
$v{'1.0'} = 1; |
|
1566
|
|
|
|
|
|
|
$v{'1.1'} = 2; |
|
1567
|
|
|
|
|
|
|
$v{'2.0'} = $v{'2'} = $v{'http/2'} = $v{'h2'} = $v{'h2c'} = 3; |
|
1568
|
|
|
|
|
|
|
$v{'3.0'} = $v{'3'} = $v{'http/3'} = $v{'h3'} = 4; |
|
1569
|
|
|
|
|
|
|
%v; |
|
1570
|
|
|
|
|
|
|
}, |
|
1571
|
|
|
|
|
|
|
}, |
|
1572
|
|
|
|
|
|
|
}, |
|
1573
|
|
|
|
|
|
|
spamassassin_autolearn => { |
|
1574
|
|
|
|
|
|
|
numeric => 0, |
|
1575
|
|
|
|
|
|
|
map => { |
|
1576
|
|
|
|
|
|
|
# SpamAssassin's autolearn= field. Nominal, but ordered so |
|
1577
|
|
|
|
|
|
|
# "no learning happened" sorts below the ham/spam outcomes. |
|
1578
|
|
|
|
|
|
|
no => 0, |
|
1579
|
|
|
|
|
|
|
ham => 1, |
|
1580
|
|
|
|
|
|
|
spam => 2, |
|
1581
|
|
|
|
|
|
|
disabled => 3, |
|
1582
|
|
|
|
|
|
|
failed => 4, |
|
1583
|
|
|
|
|
|
|
unavailable => 5, |
|
1584
|
|
|
|
|
|
|
unknown => 6, |
|
1585
|
|
|
|
|
|
|
}, |
|
1586
|
|
|
|
|
|
|
}, |
|
1587
|
|
|
|
|
|
|
rspamd_action => { |
|
1588
|
|
|
|
|
|
|
numeric => 0, |
|
1589
|
|
|
|
|
|
|
map => { |
|
1590
|
|
|
|
|
|
|
# rspamd's action, ordered by severity. Accept both the space |
|
1591
|
|
|
|
|
|
|
# and underscore spellings rspamd emits across its outputs. |
|
1592
|
|
|
|
|
|
|
do { |
|
1593
|
|
|
|
|
|
|
my %a = ( |
|
1594
|
|
|
|
|
|
|
'no action' => 0, |
|
1595
|
|
|
|
|
|
|
'greylist' => 1, |
|
1596
|
|
|
|
|
|
|
'add header' => 2, |
|
1597
|
|
|
|
|
|
|
'rewrite subject' => 3, |
|
1598
|
|
|
|
|
|
|
'soft reject' => 4, |
|
1599
|
|
|
|
|
|
|
'reject' => 5, |
|
1600
|
|
|
|
|
|
|
); |
|
1601
|
|
|
|
|
|
|
$a{'no_action'} = $a{'noaction'} = 0; |
|
1602
|
|
|
|
|
|
|
$a{'add_header'} = 2; |
|
1603
|
|
|
|
|
|
|
$a{'rewrite_subject'} = 3; |
|
1604
|
|
|
|
|
|
|
$a{'soft_reject'} = $a{'soft-reject'} = 4; |
|
1605
|
|
|
|
|
|
|
%a; |
|
1606
|
|
|
|
|
|
|
}, |
|
1607
|
|
|
|
|
|
|
}, |
|
1608
|
|
|
|
|
|
|
}, |
|
1609
|
|
|
|
|
|
|
ssh_auth_method => { |
|
1610
|
|
|
|
|
|
|
numeric => 0, |
|
1611
|
|
|
|
|
|
|
map => { |
|
1612
|
|
|
|
|
|
|
# OpenSSH authentication method, ordered by credential strength |
|
1613
|
|
|
|
|
|
|
# (weakest first) so "weaker than expected" is monotone. The |
|
1614
|
|
|
|
|
|
|
# ordering is a judgement call, not an IANA registry. |
|
1615
|
|
|
|
|
|
|
do { |
|
1616
|
|
|
|
|
|
|
my @o = qw( |
|
1617
|
|
|
|
|
|
|
none password keyboard-interactive |
|
1618
|
|
|
|
|
|
|
hostbased publickey |
|
1619
|
|
|
|
|
|
|
gssapi-with-mic gssapi-keyex |
|
1620
|
|
|
|
|
|
|
); |
|
1621
|
|
|
|
|
|
|
my %m = map { $o[$_] => $_ } 0 .. $#o; |
|
1622
|
|
|
|
|
|
|
$m{'gssapi'} = $m{'gssapi-with-mic'}; |
|
1623
|
|
|
|
|
|
|
%m; |
|
1624
|
|
|
|
|
|
|
}, |
|
1625
|
|
|
|
|
|
|
}, |
|
1626
|
|
|
|
|
|
|
}, |
|
1627
|
|
|
|
|
|
|
amavis_category => { |
|
1628
|
|
|
|
|
|
|
numeric => 0, |
|
1629
|
|
|
|
|
|
|
map => { |
|
1630
|
|
|
|
|
|
|
# amavisd-new content category, ordered clean -> worst. |
|
1631
|
|
|
|
|
|
|
do { |
|
1632
|
|
|
|
|
|
|
my @o = qw( |
|
1633
|
|
|
|
|
|
|
clean oversized unchecked spammy spam |
|
1634
|
|
|
|
|
|
|
badheader banned infected mtablocked |
|
1635
|
|
|
|
|
|
|
); |
|
1636
|
|
|
|
|
|
|
my %m = map { $o[$_] => $_ } 0 .. $#o; |
|
1637
|
|
|
|
|
|
|
$m{'bad-header'} = $m{'badheader'}; |
|
1638
|
|
|
|
|
|
|
$m{'virus'} = $m{'infected'}; |
|
1639
|
|
|
|
|
|
|
$m{'mta-blocked'} = $m{'mtablocked'}; |
|
1640
|
|
|
|
|
|
|
%m; |
|
1641
|
|
|
|
|
|
|
}, |
|
1642
|
|
|
|
|
|
|
}, |
|
1643
|
|
|
|
|
|
|
}, |
|
1644
|
|
|
|
|
|
|
systemd_result => { |
|
1645
|
|
|
|
|
|
|
numeric => 0, |
|
1646
|
|
|
|
|
|
|
map => { |
|
1647
|
|
|
|
|
|
|
# systemd unit "result" (e.g. "Failed with result 'timeout'"). |
|
1648
|
|
|
|
|
|
|
do { |
|
1649
|
|
|
|
|
|
|
my @o = qw( |
|
1650
|
|
|
|
|
|
|
success protocol timeout exit-code signal |
|
1651
|
|
|
|
|
|
|
core-dump watchdog start-limit-hit oom-kill resources |
|
1652
|
|
|
|
|
|
|
); |
|
1653
|
|
|
|
|
|
|
my %m = map { $o[$_] => $_ } 0 .. $#o; |
|
1654
|
|
|
|
|
|
|
$m{'exit_code'} = $m{'exit-code'}; |
|
1655
|
|
|
|
|
|
|
$m{'core_dump'} = $m{'core-dump'}; |
|
1656
|
|
|
|
|
|
|
$m{'start_limit_hit'} = $m{'start-limit-hit'}; |
|
1657
|
|
|
|
|
|
|
$m{'oom_kill'} = $m{'oom-kill'}; |
|
1658
|
|
|
|
|
|
|
%m; |
|
1659
|
|
|
|
|
|
|
}, |
|
1660
|
|
|
|
|
|
|
}, |
|
1661
|
|
|
|
|
|
|
}, |
|
1662
|
|
|
|
|
|
|
clamav_result => { |
|
1663
|
|
|
|
|
|
|
numeric => 0, |
|
1664
|
|
|
|
|
|
|
map => { |
|
1665
|
|
|
|
|
|
|
# clamd / clamav-milter per-target verdict. |
|
1666
|
|
|
|
|
|
|
ok => 0, |
|
1667
|
|
|
|
|
|
|
found => 1, |
|
1668
|
|
|
|
|
|
|
error => 2, |
|
1669
|
|
|
|
|
|
|
}, |
|
1670
|
|
|
|
|
|
|
}, |
|
1671
|
|
|
|
|
|
|
kerberos_etype => { |
|
1672
|
|
|
|
|
|
|
numeric => 1, # RFC 3961 etype numbers are the wire value; a logged 23 IS rc4 |
|
1673
|
|
|
|
|
|
|
map => { |
|
1674
|
|
|
|
|
|
|
# Windows logs the ticket encryption type as hex ("0x17"); the |
|
1675
|
|
|
|
|
|
|
# RFC/MIT names appear in other Kerberos logs. Everything resolves |
|
1676
|
|
|
|
|
|
|
# to the decimal etype number, so a decimal input passes through. |
|
1677
|
|
|
|
|
|
|
do { |
|
1678
|
|
|
|
|
|
|
my %e = ( |
|
1679
|
|
|
|
|
|
|
'des-cbc-crc' => 1, |
|
1680
|
|
|
|
|
|
|
'des-cbc-md5' => 3, |
|
1681
|
|
|
|
|
|
|
'des3-cbc-sha1' => 16, |
|
1682
|
|
|
|
|
|
|
'aes128-cts-hmac-sha1-96' => 17, |
|
1683
|
|
|
|
|
|
|
'aes256-cts-hmac-sha1-96' => 18, |
|
1684
|
|
|
|
|
|
|
'rc4-hmac' => 23, |
|
1685
|
|
|
|
|
|
|
'rc4-hmac-exp' => 24, |
|
1686
|
|
|
|
|
|
|
); |
|
1687
|
|
|
|
|
|
|
$e{'des3'} = 16; |
|
1688
|
|
|
|
|
|
|
$e{'aes128'} = 17; |
|
1689
|
|
|
|
|
|
|
$e{'aes256'} = 18; |
|
1690
|
|
|
|
|
|
|
$e{'arcfour-hmac'} = $e{'rc4'} = 23; |
|
1691
|
|
|
|
|
|
|
$e{'0x1'} = 1; |
|
1692
|
|
|
|
|
|
|
$e{'0x3'} = 3; |
|
1693
|
|
|
|
|
|
|
$e{'0x10'} = 16; |
|
1694
|
|
|
|
|
|
|
$e{'0x11'} = 17; |
|
1695
|
|
|
|
|
|
|
$e{'0x12'} = 18; |
|
1696
|
|
|
|
|
|
|
$e{'0x17'} = 23; |
|
1697
|
|
|
|
|
|
|
$e{'0x18'} = 24; |
|
1698
|
|
|
|
|
|
|
%e; |
|
1699
|
|
|
|
|
|
|
}, |
|
1700
|
|
|
|
|
|
|
}, |
|
1701
|
|
|
|
|
|
|
}, |
|
1702
|
|
|
|
|
|
|
windows_integrity_level => { |
|
1703
|
|
|
|
|
|
|
numeric => 0, |
|
1704
|
|
|
|
|
|
|
map => { |
|
1705
|
|
|
|
|
|
|
# Sysmon IntegrityLevel; ordinal so "higher privilege than |
|
1706
|
|
|
|
|
|
|
# expected" is monotone. Text labels plus the S-1-16-* mandatory |
|
1707
|
|
|
|
|
|
|
# label SIDs Windows sometimes logs in their place. |
|
1708
|
|
|
|
|
|
|
do { |
|
1709
|
|
|
|
|
|
|
my %m = ( |
|
1710
|
|
|
|
|
|
|
untrusted => 0, |
|
1711
|
|
|
|
|
|
|
low => 1, |
|
1712
|
|
|
|
|
|
|
medium => 2, |
|
1713
|
|
|
|
|
|
|
high => 3, |
|
1714
|
|
|
|
|
|
|
system => 4, |
|
1715
|
|
|
|
|
|
|
); |
|
1716
|
|
|
|
|
|
|
$m{'mediumplus'} = 2; |
|
1717
|
|
|
|
|
|
|
$m{'s-1-16-0'} = 0; |
|
1718
|
|
|
|
|
|
|
$m{'s-1-16-4096'} = 1; |
|
1719
|
|
|
|
|
|
|
$m{'s-1-16-8192'} = 2; |
|
1720
|
|
|
|
|
|
|
$m{'s-1-16-12288'} = 3; |
|
1721
|
|
|
|
|
|
|
$m{'s-1-16-16384'} = 4; |
|
1722
|
|
|
|
|
|
|
%m; |
|
1723
|
|
|
|
|
|
|
}, |
|
1724
|
|
|
|
|
|
|
}, |
|
1725
|
|
|
|
|
|
|
}, |
|
1726
|
|
|
|
|
|
|
windows_logon_status => { |
|
1727
|
|
|
|
|
|
|
numeric => 0, |
|
1728
|
|
|
|
|
|
|
map => { |
|
1729
|
|
|
|
|
|
|
# Common NTSTATUS sub-status codes on failed logons (4625/4776), |
|
1730
|
|
|
|
|
|
|
# mapped to a compact reason category -- the raw 32-bit value is |
|
1731
|
|
|
|
|
|
|
# not itself a useful feature. Keys are the hex codes as logged. |
|
1732
|
|
|
|
|
|
|
'0xc0000064' => 0, # user name does not exist |
|
1733
|
|
|
|
|
|
|
'0xc000006a' => 1, # bad password |
|
1734
|
|
|
|
|
|
|
'0xc000006d' => 2, # bad user name or password (generic) |
|
1735
|
|
|
|
|
|
|
'0xc000006f' => 3, # outside authorized hours |
|
1736
|
|
|
|
|
|
|
'0xc0000070' => 4, # workstation restriction |
|
1737
|
|
|
|
|
|
|
'0xc0000071' => 5, # password expired |
|
1738
|
|
|
|
|
|
|
'0xc0000072' => 6, # account disabled |
|
1739
|
|
|
|
|
|
|
'0xc0000193' => 7, # account expired |
|
1740
|
|
|
|
|
|
|
'0xc0000133' => 8, # clock skew between client and server |
|
1741
|
|
|
|
|
|
|
'0xc0000224' => 9, # must change password at next logon |
|
1742
|
|
|
|
|
|
|
'0xc0000234' => 10, # account locked out |
|
1743
|
|
|
|
|
|
|
'0xc000015b' => 11, # logon type not granted |
|
1744
|
|
|
|
|
|
|
}, |
|
1745
|
|
|
|
|
|
|
}, |
|
1746
|
|
|
|
|
|
|
windows_impersonation_level => { |
|
1747
|
|
|
|
|
|
|
numeric => 0, |
|
1748
|
|
|
|
|
|
|
map => { |
|
1749
|
|
|
|
|
|
|
# 4624 ImpersonationLevel; ordinal by reach. Text labels plus the |
|
1750
|
|
|
|
|
|
|
# two "%%18xx" message tokens Windows most often emits in place. |
|
1751
|
|
|
|
|
|
|
anonymous => 0, |
|
1752
|
|
|
|
|
|
|
identification => 1, |
|
1753
|
|
|
|
|
|
|
impersonation => 2, |
|
1754
|
|
|
|
|
|
|
delegation => 3, |
|
1755
|
|
|
|
|
|
|
'%%1832' => 1, |
|
1756
|
|
|
|
|
|
|
'%%1833' => 2, |
|
1757
|
|
|
|
|
|
|
}, |
|
1758
|
|
|
|
|
|
|
}, |
|
1759
|
|
|
|
|
|
|
aad_signin_error => { |
|
1760
|
|
|
|
|
|
|
numeric => 0, |
|
1761
|
|
|
|
|
|
|
map => { |
|
1762
|
|
|
|
|
|
|
# Azure AD / Entra sign-in ResultType codes collapsed to a compact |
|
1763
|
|
|
|
|
|
|
# reason category -- the raw code is a huge sparse space whose |
|
1764
|
|
|
|
|
|
|
# magnitude carries no signal. Keys are the numeric codes as |
|
1765
|
|
|
|
|
|
|
# logged; only the common subset is baked in, the rest take the |
|
1766
|
|
|
|
|
|
|
# default. |
|
1767
|
|
|
|
|
|
|
'0' => 0, # success |
|
1768
|
|
|
|
|
|
|
'50126' => 1, # invalid username or password |
|
1769
|
|
|
|
|
|
|
'50056' => 1, # invalid or null password |
|
1770
|
|
|
|
|
|
|
'50034' => 2, # user does not exist in directory |
|
1771
|
|
|
|
|
|
|
'50057' => 3, # account disabled |
|
1772
|
|
|
|
|
|
|
'50053' => 4, # account locked / smart lockout |
|
1773
|
|
|
|
|
|
|
'50055' => 5, # password expired |
|
1774
|
|
|
|
|
|
|
'50144' => 5, # AD password expired |
|
1775
|
|
|
|
|
|
|
'50074' => 6, # strong auth (MFA) required |
|
1776
|
|
|
|
|
|
|
'50076' => 6, # MFA required by conditional access |
|
1777
|
|
|
|
|
|
|
'50079' => 6, # user must enroll for MFA |
|
1778
|
|
|
|
|
|
|
'500121' => 7, # MFA denied / authentication failed |
|
1779
|
|
|
|
|
|
|
'50158' => 7, # external security challenge not satisfied |
|
1780
|
|
|
|
|
|
|
'53003' => 8, # blocked by conditional access |
|
1781
|
|
|
|
|
|
|
'53000' => 8, # device not compliant (CA) |
|
1782
|
|
|
|
|
|
|
'53001' => 8, # device not domain joined (CA) |
|
1783
|
|
|
|
|
|
|
'530032' => 8, # blocked by security policy (CA) |
|
1784
|
|
|
|
|
|
|
'50173' => 9, # fresh auth token required (session expired) |
|
1785
|
|
|
|
|
|
|
}, |
|
1786
|
|
|
|
|
|
|
}, |
|
1787
|
|
|
|
|
|
|
risk_level => { |
|
1788
|
|
|
|
|
|
|
numeric => 0, |
|
1789
|
|
|
|
|
|
|
map => { |
|
1790
|
|
|
|
|
|
|
# Entra Identity Protection riskLevel, ordinal. hidden / |
|
1791
|
|
|
|
|
|
|
# unknownFutureValue are left to the default. |
|
1792
|
|
|
|
|
|
|
none => 0, |
|
1793
|
|
|
|
|
|
|
low => 1, |
|
1794
|
|
|
|
|
|
|
medium => 2, |
|
1795
|
|
|
|
|
|
|
high => 3, |
|
1796
|
|
|
|
|
|
|
}, |
|
1797
|
|
|
|
|
|
|
}, |
|
1798
|
|
|
|
|
|
|
aws_principal_type => { |
|
1799
|
|
|
|
|
|
|
numeric => 0, |
|
1800
|
|
|
|
|
|
|
map => { |
|
1801
|
|
|
|
|
|
|
# CloudTrail userIdentity.type. Nominal (distinct stable numbers); |
|
1802
|
|
|
|
|
|
|
# 'root' is the value you actually alert on. |
|
1803
|
|
|
|
|
|
|
do { |
|
1804
|
|
|
|
|
|
|
my @o = qw( |
|
1805
|
|
|
|
|
|
|
root iamuser assumedrole federateduser samluser |
|
1806
|
|
|
|
|
|
|
webidentityuser directory identitycenteruser |
|
1807
|
|
|
|
|
|
|
awsaccount awsservice unknown |
|
1808
|
|
|
|
|
|
|
); |
|
1809
|
|
|
|
|
|
|
map { $o[$_] => $_ } 0 .. $#o; |
|
1810
|
|
|
|
|
|
|
}, |
|
1811
|
|
|
|
|
|
|
}, |
|
1812
|
|
|
|
|
|
|
}, |
|
1813
|
|
|
|
|
|
|
aad_client_app => { |
|
1814
|
|
|
|
|
|
|
numeric => 0, |
|
1815
|
|
|
|
|
|
|
map => { |
|
1816
|
|
|
|
|
|
|
# Azure AD ClientAppUsed. Numbered so the modern clients sort low |
|
1817
|
|
|
|
|
|
|
# and the legacy-auth protocols (which cannot do MFA) sort high -- |
|
1818
|
|
|
|
|
|
|
# a ">= 2 means legacy auth" threshold is the feature you want. |
|
1819
|
|
|
|
|
|
|
do { |
|
1820
|
|
|
|
|
|
|
my %m = ( |
|
1821
|
|
|
|
|
|
|
'browser' => 0, |
|
1822
|
|
|
|
|
|
|
'mobile apps and desktop clients' => 1, |
|
1823
|
|
|
|
|
|
|
); |
|
1824
|
|
|
|
|
|
|
my @legacy = ( |
|
1825
|
|
|
|
|
|
|
'exchange activesync', |
|
1826
|
|
|
|
|
|
|
'imap4', |
|
1827
|
|
|
|
|
|
|
'pop3', |
|
1828
|
|
|
|
|
|
|
'authenticated smtp', |
|
1829
|
|
|
|
|
|
|
'smtp', |
|
1830
|
|
|
|
|
|
|
'mapi over http', |
|
1831
|
|
|
|
|
|
|
'exchange web services', |
|
1832
|
|
|
|
|
|
|
'exchange online powershell', |
|
1833
|
|
|
|
|
|
|
'autodiscover', |
|
1834
|
|
|
|
|
|
|
'offline address book', |
|
1835
|
|
|
|
|
|
|
'other clients', |
|
1836
|
|
|
|
|
|
|
); |
|
1837
|
|
|
|
|
|
|
my $i = 2; |
|
1838
|
|
|
|
|
|
|
$m{$_} = $i++ for @legacy; |
|
1839
|
|
|
|
|
|
|
$m{'imap'} = $m{'imap4'}; |
|
1840
|
|
|
|
|
|
|
$m{'pop'} = $m{'pop3'}; |
|
1841
|
|
|
|
|
|
|
$m{'mapi'} = $m{'mapi over http'}; |
|
1842
|
|
|
|
|
|
|
%m; |
|
1843
|
|
|
|
|
|
|
}, |
|
1844
|
|
|
|
|
|
|
}, |
|
1845
|
|
|
|
|
|
|
}, |
|
1846
|
|
|
|
|
|
|
risk_state => { |
|
1847
|
|
|
|
|
|
|
numeric => 0, |
|
1848
|
|
|
|
|
|
|
map => { |
|
1849
|
|
|
|
|
|
|
# Entra Identity Protection riskState. |
|
1850
|
|
|
|
|
|
|
none => 0, |
|
1851
|
|
|
|
|
|
|
confirmedsafe => 1, |
|
1852
|
|
|
|
|
|
|
remediated => 2, |
|
1853
|
|
|
|
|
|
|
dismissed => 3, |
|
1854
|
|
|
|
|
|
|
atrisk => 4, |
|
1855
|
|
|
|
|
|
|
confirmedcompromised => 5, |
|
1856
|
|
|
|
|
|
|
}, |
|
1857
|
|
|
|
|
|
|
}, |
|
1858
|
|
|
|
|
|
|
vpc_flow_log_status => { |
|
1859
|
|
|
|
|
|
|
numeric => 0, |
|
1860
|
|
|
|
|
|
|
map => { |
|
1861
|
|
|
|
|
|
|
# VPC Flow Logs log-status. |
|
1862
|
|
|
|
|
|
|
ok => 0, |
|
1863
|
|
|
|
|
|
|
nodata => 1, |
|
1864
|
|
|
|
|
|
|
skipdata => 2, |
|
1865
|
|
|
|
|
|
|
}, |
|
1866
|
|
|
|
|
|
|
}, |
|
1867
|
|
|
|
|
|
|
aws_event_type => { |
|
1868
|
|
|
|
|
|
|
numeric => 0, |
|
1869
|
|
|
|
|
|
|
map => { |
|
1870
|
|
|
|
|
|
|
# CloudTrail eventType. AwsConsoleSignIn is the one you flag. |
|
1871
|
|
|
|
|
|
|
awsapicall => 0, |
|
1872
|
|
|
|
|
|
|
awsserviceevent => 1, |
|
1873
|
|
|
|
|
|
|
awsconsoleaction => 2, |
|
1874
|
|
|
|
|
|
|
awsconsolesignin => 3, |
|
1875
|
|
|
|
|
|
|
awscloudtrailinsight => 4, |
|
1876
|
|
|
|
|
|
|
}, |
|
1877
|
|
|
|
|
|
|
}, |
|
1878
|
|
|
|
|
|
|
conditional_access_result => { |
|
1879
|
|
|
|
|
|
|
numeric => 0, |
|
1880
|
|
|
|
|
|
|
map => { |
|
1881
|
|
|
|
|
|
|
# Azure AD sign-in conditionalAccessStatus. |
|
1882
|
|
|
|
|
|
|
success => 0, |
|
1883
|
|
|
|
|
|
|
notapplied => 1, |
|
1884
|
|
|
|
|
|
|
notenabled => 2, |
|
1885
|
|
|
|
|
|
|
reportonly => 3, |
|
1886
|
|
|
|
|
|
|
failure => 4, |
|
1887
|
|
|
|
|
|
|
}, |
|
1888
|
|
|
|
|
|
|
}, |
|
1889
|
|
|
|
|
|
|
); |
|
1890
|
|
|
|
|
|
|
for my $name ( keys %NAMED_ENUM ) { |
|
1891
|
|
|
|
|
|
|
my $e = $NAMED_ENUM{$name}; |
|
1892
|
|
|
|
|
|
|
$BUILDERS{"${name}_enum"} = sub { _named_enum_munger( $name, $e, @_ ) }; |
|
1893
|
|
|
|
|
|
|
} |
|
1894
|
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
# Shared closure for the named-map enums registered from %NAMED_ENUM. |
|
1896
|
|
|
|
|
|
|
sub _named_enum_munger { |
|
1897
|
48
|
|
|
48
|
|
154
|
my ( $name, $e, $spec, $where ) = @_; |
|
1898
|
|
|
|
|
|
|
|
|
1899
|
48
|
|
|
|
|
117
|
my $has_default = exists $spec->{default}; |
|
1900
|
48
|
|
|
|
|
103
|
my $default = $spec->{default}; |
|
1901
|
48
|
100
|
100
|
|
|
362
|
croak "${name}_enum munger$where: 'default' must be numeric" |
|
1902
|
|
|
|
|
|
|
if $has_default && !looks_like_number($default); |
|
1903
|
|
|
|
|
|
|
|
|
1904
|
47
|
|
|
|
|
89
|
my ( $map, $numeric ) = @{$e}{qw(map numeric)}; |
|
|
47
|
|
|
|
|
169
|
|
|
1905
|
|
|
|
|
|
|
return sub { |
|
1906
|
332
|
|
|
332
|
|
24622
|
my ($v) = @_; |
|
1907
|
332
|
100
|
|
|
|
1016
|
if ( defined $v ) { |
|
1908
|
331
|
100
|
100
|
|
|
1287
|
return $v + 0 if $numeric && looks_like_number($v); |
|
1909
|
325
|
|
|
|
|
742
|
my $k = lc $v; |
|
1910
|
325
|
100
|
|
|
|
2330
|
return $map->{$k} if exists $map->{$k}; |
|
1911
|
|
|
|
|
|
|
} |
|
1912
|
26
|
100
|
|
|
|
136
|
return $default if $has_default; |
|
1913
|
9
|
50
|
|
|
|
1532
|
croak "${name}_enum munger$where: no mapping for '" . ( defined $v ? $v : 'undef' ) . "'"; |
|
1914
|
47
|
|
|
|
|
447
|
}; ## end sub |
|
1915
|
|
|
|
|
|
|
} ## end sub _named_enum_munger |
|
1916
|
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
=head2 bool |
|
1918
|
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
{ munger => 'bool' } # Perl truthiness -> 1/0 |
|
1920
|
|
|
|
|
|
|
{ munger => 'bool', true => [ 'yes', 'Y', '1', 'true' ] } |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
Coerce to C<1> or C<0>. With a C list, only those (string-compared) values |
|
1923
|
|
|
|
|
|
|
are C<1>; otherwise ordinary Perl truthiness is used. |
|
1924
|
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
=cut |
|
1926
|
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
sub _build_bool { |
|
1928
|
2
|
|
|
2
|
|
3
|
my ( $spec, $where ) = @_; |
|
1929
|
|
|
|
|
|
|
|
|
1930
|
2
|
100
|
|
|
|
6
|
if ( exists $spec->{true} ) { |
|
1931
|
|
|
|
|
|
|
croak "bool munger$where: 'true' must be an arrayref" |
|
1932
|
1
|
50
|
|
|
|
4
|
unless ref $spec->{true} eq 'ARRAY'; |
|
1933
|
1
|
|
|
|
|
2
|
my %true = map { $_ => 1 } @{ $spec->{true} }; |
|
|
3
|
|
|
|
|
7
|
|
|
|
1
|
|
|
|
|
3
|
|
|
1934
|
|
|
|
|
|
|
return sub { |
|
1935
|
3
|
|
|
3
|
|
10
|
my ($v) = @_; |
|
1936
|
3
|
100
|
|
|
|
15
|
return exists $true{ defined $v ? $v : '' } ? 1 : 0; |
|
|
|
100
|
|
|
|
|
|
|
1937
|
1
|
|
|
|
|
7
|
}; |
|
1938
|
|
|
|
|
|
|
} |
|
1939
|
|
|
|
|
|
|
|
|
1940
|
1
|
100
|
|
2
|
|
4
|
return sub { $_[0] ? 1 : 0 }; |
|
|
2
|
|
|
|
|
12
|
|
|
1941
|
|
|
|
|
|
|
} ## end sub _build_bool |
|
1942
|
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
=head2 length |
|
1944
|
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
{ munger => 'length' } |
|
1946
|
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
The character length of the stringified input, C counting as C<0> (an |
|
1948
|
|
|
|
|
|
|
absent value is a zero-length one -- e.g. an SNI-absent TLS record). This is the |
|
1949
|
|
|
|
|
|
|
cheap shape feature behind every C<*_length> column (domain, URL, filename, SNI, |
|
1950
|
|
|
|
|
|
|
hostname, ...): tunneling and generated names run long, so raw length is a |
|
1951
|
|
|
|
|
|
|
surprisingly strong corroborator next to L. Length is counted in |
|
1952
|
|
|
|
|
|
|
B, not bytes, so a multi-byte name is measured as a human would read |
|
1953
|
|
|
|
|
|
|
it; use L (which is byte-oriented) when you want per-symbol randomness. |
|
1954
|
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
=cut |
|
1956
|
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
sub _build_length { |
|
1958
|
7
|
|
|
7
|
|
22
|
my ( $spec, $where ) = @_; |
|
1959
|
|
|
|
|
|
|
return sub { |
|
1960
|
13
|
|
|
13
|
|
37
|
my ($v) = @_; |
|
1961
|
13
|
100
|
|
|
|
74
|
return length( defined $v ? "$v" : '' ); |
|
1962
|
7
|
|
|
|
|
36
|
}; |
|
1963
|
|
|
|
|
|
|
} |
|
1964
|
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
=head2 entropy |
|
1966
|
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
{ munger => 'entropy' } |
|
1968
|
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
Shannon entropy of the input string, in B -- i.e. |
|
1970
|
|
|
|
|
|
|
C<-sum(p*log2(p))> over the frequencies of its bytes. This is the single most |
|
1971
|
|
|
|
|
|
|
common feature in the pipeline (DGA domains, randomized filenames, forged |
|
1972
|
|
|
|
|
|
|
User-Agents, generated SNIs / hostnames / principal names), because |
|
1973
|
|
|
|
|
|
|
machine-generated strings spread their characters far more evenly than |
|
1974
|
|
|
|
|
|
|
human-chosen ones and so score high, while a real word scores low. An empty |
|
1975
|
|
|
|
|
|
|
string is C<0>; the maximum is C<8> (every byte value equally likely). |
|
1976
|
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
Entropy is computed over the string's B (matching L), so the |
|
1978
|
|
|
|
|
|
|
value is well-defined regardless of the scalar's internal encoding flag. Like |
|
1979
|
|
|
|
|
|
|
C, this munger is XS-accelerated -- a per-byte histogram plus a C per |
|
1980
|
|
|
|
|
|
|
distinct byte -- with a pure-Perl fallback that produces identical values; |
|
1981
|
|
|
|
|
|
|
C<$Algorithm::ToNumberMunger::HAVE_XS> says which |
|
1982
|
|
|
|
|
|
|
is in use. |
|
1983
|
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
=cut |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
sub _build_entropy { |
|
1987
|
1
|
|
|
1
|
|
3
|
my ( $spec, $where ) = @_; |
|
1988
|
1
|
50
|
|
|
|
4
|
my $fn = $HAVE_XS ? \&_entropy_xs : \&_entropy_pp; |
|
1989
|
|
|
|
|
|
|
return sub { |
|
1990
|
12
|
|
|
12
|
|
1177
|
my ($v) = @_; |
|
1991
|
12
|
50
|
|
|
|
103
|
return $fn->( defined $v ? "$v" : '' ); |
|
1992
|
1
|
|
|
|
|
6
|
}; |
|
1993
|
|
|
|
|
|
|
} |
|
1994
|
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
# Pure-Perl Shannon entropy (bits), used only when the XS did not build. Byte |
|
1996
|
|
|
|
|
|
|
# view via an explicit encode so it matches the XS's SvPVutf8, and so the same |
|
1997
|
|
|
|
|
|
|
# string scores the same regardless of its internal flag. |
|
1998
|
|
|
|
|
|
|
sub _entropy_pp { |
|
1999
|
6
|
|
|
6
|
|
10
|
my ($str) = @_; |
|
2000
|
6
|
|
|
|
|
14
|
utf8::encode($str); |
|
2001
|
6
|
|
|
|
|
9
|
my $n = length $str; |
|
2002
|
6
|
100
|
|
|
|
18
|
return 0 unless $n; |
|
2003
|
5
|
|
|
|
|
6
|
my %count; |
|
2004
|
5
|
|
|
|
|
43
|
$count{$_}++ for unpack 'C*', $str; |
|
2005
|
5
|
|
|
|
|
9
|
my $ln2 = log(2); |
|
2006
|
5
|
|
|
|
|
6
|
my $h = 0; |
|
2007
|
|
|
|
|
|
|
|
|
2008
|
5
|
|
|
|
|
10
|
for my $c ( values %count ) { |
|
2009
|
28
|
|
|
|
|
29
|
my $p = $c / $n; |
|
2010
|
28
|
|
|
|
|
39
|
$h -= $p * ( log($p) / $ln2 ); |
|
2011
|
|
|
|
|
|
|
} |
|
2012
|
5
|
|
|
|
|
21
|
return $h; |
|
2013
|
|
|
|
|
|
|
} ## end sub _entropy_pp |
|
2014
|
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
=head2 ngram |
|
2016
|
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
{ munger => 'ngram', counts => { th => 152, he => 128, in => 94, ... } } |
|
2018
|
|
|
|
|
|
|
# defaults: smoothing => 1, fold_case => 1; n is inferred from the keys |
|
2019
|
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
Mean per-gram surprisal of the input string against a B |
|
2021
|
|
|
|
|
|
|
n-gram count table: C, each gram's probability |
|
2022
|
|
|
|
|
|
|
smoothed exactly as in L. This is C's sequential cousin |
|
2023
|
|
|
|
|
|
|
and the strongest single gibberish detector: L misses |
|
2024
|
|
|
|
|
|
|
I generated names and is unreliable on short strings, while an |
|
2025
|
|
|
|
|
|
|
n-gram score against (say) hostname bigram statistics catches both -- real |
|
2026
|
|
|
|
|
|
|
words ride the common bigrams and score low, generated names keep hitting rare |
|
2027
|
|
|
|
|
|
|
ones and score high. Dividing by the gram count keeps scores comparable across |
|
2028
|
|
|
|
|
|
|
lengths. |
|
2029
|
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
C maps each n-gram to how often it was observed when the table was |
|
2031
|
|
|
|
|
|
|
built; all keys must be the same length, and that length B C (bigrams |
|
2032
|
|
|
|
|
|
|
are the usual choice -- a 26x26 table stays tiny in C; past |
|
2033
|
|
|
|
|
|
|
C<$FROZEN_FREQ_MAP_WARN_KEYS> entries it warns like C). C defaults |
|
2034
|
|
|
|
|
|
|
to the sum of counts and may be given larger to prune the tail, exactly as in |
|
2035
|
|
|
|
|
|
|
C. A gram absent from the table gets the smoothed unseen-bucket |
|
2036
|
|
|
|
|
|
|
probability -- an unseen gram is the interesting case -- so C must |
|
2037
|
|
|
|
|
|
|
be > 0 (default C<1>). With C (default on) the input is lowercased |
|
2038
|
|
|
|
|
|
|
before scoring, matching the usual lowercased table. A string with no grams |
|
2039
|
|
|
|
|
|
|
(shorter than C) scores C<0>. Grams are taken over B, matching |
|
2040
|
|
|
|
|
|
|
L rather than the byte-oriented C. |
|
2041
|
|
|
|
|
|
|
|
|
2042
|
|
|
|
|
|
|
=cut |
|
2043
|
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
sub _build_ngram { |
|
2045
|
7
|
|
|
7
|
|
12
|
my ( $spec, $where ) = @_; |
|
2046
|
|
|
|
|
|
|
|
|
2047
|
7
|
|
|
|
|
13
|
my $counts = $spec->{counts}; |
|
2048
|
7
|
100
|
66
|
|
|
154
|
croak "ngram munger$where requires a non-empty 'counts' hashref" |
|
2049
|
|
|
|
|
|
|
unless ref $counts eq 'HASH' && %$counts; |
|
2050
|
|
|
|
|
|
|
|
|
2051
|
6
|
|
|
|
|
8
|
my $n; |
|
2052
|
6
|
|
|
|
|
8
|
my $sum = 0; |
|
2053
|
6
|
|
|
|
|
14
|
for my $g ( keys %$counts ) { |
|
2054
|
9
|
100
|
|
|
|
16
|
$n = length $g unless defined $n; |
|
2055
|
9
|
100
|
|
|
|
105
|
croak "ngram munger$where: all 'counts' keys must be the same length " |
|
2056
|
|
|
|
|
|
|
. "(that length is n); got '$g' alongside a $n-gram" |
|
2057
|
|
|
|
|
|
|
unless length($g) == $n; |
|
2058
|
8
|
|
|
|
|
11
|
my $c = $counts->{$g}; |
|
2059
|
8
|
50
|
66
|
|
|
129
|
croak "ngram munger$where: count for '$g' ('" |
|
|
|
100
|
|
|
|
|
|
|
2060
|
|
|
|
|
|
|
. ( defined $c ? $c : 'undef' ) |
|
2061
|
|
|
|
|
|
|
. "') is not a non-negative number" |
|
2062
|
|
|
|
|
|
|
unless looks_like_number($c) && $c >= 0; |
|
2063
|
7
|
|
|
|
|
25
|
$sum += $c; |
|
2064
|
|
|
|
|
|
|
} ## end for my $g ( keys %$counts ) |
|
2065
|
4
|
50
|
|
|
|
10
|
croak "ngram munger$where: 'counts' keys must be at least 1 character" |
|
2066
|
|
|
|
|
|
|
unless $n >= 1; |
|
2067
|
|
|
|
|
|
|
|
|
2068
|
4
|
|
|
|
|
6
|
my $V = keys %$counts; |
|
2069
|
4
|
50
|
|
|
|
13
|
carp "ngram munger$where: 'counts' has $V keys; a table this large bloats info.json" |
|
2070
|
|
|
|
|
|
|
if $V > $FROZEN_FREQ_MAP_WARN_KEYS; |
|
2071
|
|
|
|
|
|
|
|
|
2072
|
4
|
100
|
|
|
|
12
|
my $total = defined $spec->{total} ? $spec->{total} : $sum; |
|
2073
|
4
|
50
|
|
|
|
9
|
croak "ngram munger$where: 'total' must be numeric" |
|
2074
|
|
|
|
|
|
|
unless looks_like_number($total); |
|
2075
|
4
|
100
|
|
|
|
115
|
croak "ngram munger$where: 'total' ($total) must be >= sum of counts ($sum)" |
|
2076
|
|
|
|
|
|
|
if $total < $sum; |
|
2077
|
|
|
|
|
|
|
|
|
2078
|
3
|
100
|
|
|
|
9
|
my $s = defined $spec->{smoothing} ? $spec->{smoothing} : 1; |
|
2079
|
3
|
100
|
66
|
|
|
134
|
croak "ngram munger$where: 'smoothing' must be a number > 0 " |
|
2080
|
|
|
|
|
|
|
. '(an unseen gram would otherwise be infinitely surprising)' |
|
2081
|
|
|
|
|
|
|
unless looks_like_number($s) && $s > 0; |
|
2082
|
|
|
|
|
|
|
|
|
2083
|
2
|
50
|
|
|
|
6
|
my $fold = exists $spec->{fold_case} ? ( $spec->{fold_case} ? 1 : 0 ) : 1; |
|
|
|
100
|
|
|
|
|
|
|
2084
|
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
# Same smoothed-probability scheme as frozen_freq_map, "unseen" as one extra |
|
2086
|
|
|
|
|
|
|
# bucket; surprisal precomputed per listed gram. |
|
2087
|
2
|
|
|
|
|
3
|
my $denom = $total + $s * ( $V + 1 ); |
|
2088
|
2
|
|
|
|
|
5
|
my %si = map { $_ => -log( ( $counts->{$_} + $s ) / $denom ) } keys %$counts; |
|
|
4
|
|
|
|
|
50
|
|
|
2089
|
2
|
|
|
|
|
4
|
my $unseen = -log( $s / $denom ); |
|
2090
|
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
return sub { |
|
2092
|
12
|
|
|
12
|
|
39
|
my ($v) = @_; |
|
2093
|
12
|
100
|
|
|
|
35
|
my $str = defined $v ? "$v" : ''; |
|
2094
|
12
|
100
|
|
|
|
28
|
$str = lc $str if $fold; |
|
2095
|
12
|
|
|
|
|
20
|
my $grams = length($str) - $n + 1; |
|
2096
|
12
|
100
|
|
|
|
30
|
return 0 if $grams < 1; |
|
2097
|
9
|
|
|
|
|
13
|
my $tot = 0; |
|
2098
|
9
|
|
|
|
|
20
|
for my $i ( 0 .. $grams - 1 ) { |
|
2099
|
14
|
|
|
|
|
24
|
my $g = substr( $str, $i, $n ); |
|
2100
|
14
|
100
|
|
|
|
34
|
$tot += exists $si{$g} ? $si{$g} : $unseen; |
|
2101
|
|
|
|
|
|
|
} |
|
2102
|
9
|
|
|
|
|
38
|
return $tot / $grams; |
|
2103
|
2
|
|
|
|
|
21
|
}; ## end sub |
|
2104
|
|
|
|
|
|
|
} ## end sub _build_ngram |
|
2105
|
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
=head2 char |
|
2107
|
|
|
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
{ munger => 'char', class => 'non_alnum', mode => 'ratio' } |
|
2109
|
|
|
|
|
|
|
{ munger => 'char', class => 'non_ascii' } # mode defaults to count |
|
2110
|
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
Count the characters of the input that fall in a named C, either as a raw |
|
2112
|
|
|
|
|
|
|
C (default) or, with C<< mode => 'ratio' >>, as a fraction of the string's |
|
2113
|
|
|
|
|
|
|
length (C<0> for an empty string). This is the injection / obfuscation detector |
|
2114
|
|
|
|
|
|
|
behind columns like C (a I, so it stays independent of |
|
2115
|
|
|
|
|
|
|
length) and C (a I): payloads and homoglyph tricks |
|
2116
|
|
|
|
|
|
|
are dense with punctuation, percent-encoding, or non-ASCII where normal input is |
|
2117
|
|
|
|
|
|
|
not. Counting is over B, so C means codepoints above 127. |
|
2118
|
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
Recognised classes: C / C, C / C, C, |
|
2120
|
|
|
|
|
|
|
C, C, C, C, C, C, C, |
|
2121
|
|
|
|
|
|
|
C. C and C are the ASCII letters (C counting as a |
|
2122
|
|
|
|
|
|
|
consonant) -- a vowel/consonant I is a DGA corroborator that catches |
|
2123
|
|
|
|
|
|
|
consonant-heavy random strings C alone underrates; C is |
|
2124
|
|
|
|
|
|
|
C<0-9a-fA-F>, dense in encoded payloads. |
|
2125
|
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
=cut |
|
2127
|
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
# class name => a counting sub over an (already copied) string. The literal- |
|
2129
|
|
|
|
|
|
|
# range classes count with tr///, which runs at C speed -- an order of |
|
2130
|
|
|
|
|
|
|
# magnitude faster than tallying regex matches. tr/// needs its ranges spelled |
|
2131
|
|
|
|
|
|
|
# at compile time, hence one sub per class rather than a data table. The 'run' |
|
2132
|
|
|
|
|
|
|
# munger's %RUN_RE mirrors these class names; keep the two in sync. |
|
2133
|
|
|
|
|
|
|
my %CHAR_COUNT = ( |
|
2134
|
|
|
|
|
|
|
alnum => sub { $_[0] =~ tr/A-Za-z0-9// }, |
|
2135
|
|
|
|
|
|
|
non_alnum => sub { $_[0] =~ tr/A-Za-z0-9//c }, |
|
2136
|
|
|
|
|
|
|
ascii => sub { $_[0] =~ tr/\x00-\x7f// }, |
|
2137
|
|
|
|
|
|
|
non_ascii => sub { $_[0] =~ tr/\x00-\x7f//c }, |
|
2138
|
|
|
|
|
|
|
digit => sub { $_[0] =~ tr/0-9// }, |
|
2139
|
|
|
|
|
|
|
alpha => sub { $_[0] =~ tr/A-Za-z// }, |
|
2140
|
|
|
|
|
|
|
upper => sub { $_[0] =~ tr/A-Z// }, |
|
2141
|
|
|
|
|
|
|
lower => sub { $_[0] =~ tr/a-z// }, |
|
2142
|
|
|
|
|
|
|
vowel => sub { $_[0] =~ tr/aeiouAEIOU// }, |
|
2143
|
|
|
|
|
|
|
consonant => sub { $_[0] =~ tr/b-df-hj-np-tv-zB-DF-HJ-NP-TV-Z// }, |
|
2144
|
|
|
|
|
|
|
xdigit => sub { $_[0] =~ tr/0-9A-Fa-f// }, |
|
2145
|
|
|
|
|
|
|
# space and punct match richer classes (\s, [[:punct:]], including their |
|
2146
|
|
|
|
|
|
|
# Unicode behavior) that tr/// ranges cannot reproduce; they stay on the |
|
2147
|
|
|
|
|
|
|
# regex so their semantics do not change. |
|
2148
|
|
|
|
|
|
|
space => sub { my $n = () = $_[0] =~ /\s/g; $n }, |
|
2149
|
|
|
|
|
|
|
punct => sub { my $n = () = $_[0] =~ /[[:punct:]]/g; $n }, |
|
2150
|
|
|
|
|
|
|
); |
|
2151
|
|
|
|
|
|
|
|
|
2152
|
|
|
|
|
|
|
sub _build_char { |
|
2153
|
10
|
|
|
10
|
|
15
|
my ( $spec, $where ) = @_; |
|
2154
|
|
|
|
|
|
|
|
|
2155
|
10
|
|
|
|
|
16
|
my $class = $spec->{class}; |
|
2156
|
10
|
50
|
|
|
|
19
|
croak "char munger$where requires a 'class'" |
|
2157
|
|
|
|
|
|
|
unless defined $class; |
|
2158
|
10
|
100
|
|
|
|
149
|
my $count = $CHAR_COUNT{$class} |
|
2159
|
|
|
|
|
|
|
or croak "char munger$where: unknown class '$class' (known: " . join( ', ', sort keys %CHAR_COUNT ) . ')'; |
|
2160
|
|
|
|
|
|
|
|
|
2161
|
9
|
100
|
|
|
|
17
|
my $mode = defined $spec->{mode} ? $spec->{mode} : 'count'; |
|
2162
|
9
|
100
|
100
|
|
|
127
|
croak "char munger$where: 'mode' must be 'count' or 'ratio'" |
|
2163
|
|
|
|
|
|
|
unless $mode eq 'count' || $mode eq 'ratio'; |
|
2164
|
8
|
100
|
|
|
|
39
|
my $ratio = $mode eq 'ratio' ? 1 : 0; |
|
2165
|
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
return sub { |
|
2167
|
11
|
|
|
11
|
|
43
|
my ($v) = @_; |
|
2168
|
11
|
50
|
|
|
|
27
|
my $s = defined $v ? "$v" : ''; |
|
2169
|
11
|
|
|
|
|
26
|
my $n = $count->($s); |
|
2170
|
11
|
100
|
|
|
|
38
|
return $n unless $ratio; |
|
2171
|
3
|
|
|
|
|
7
|
my $len = length $s; |
|
2172
|
3
|
100
|
|
|
|
15
|
return $len ? $n / $len : 0; |
|
2173
|
8
|
|
|
|
|
52
|
}; |
|
2174
|
|
|
|
|
|
|
} ## end sub _build_char |
|
2175
|
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
=head2 run |
|
2177
|
|
|
|
|
|
|
|
|
2178
|
|
|
|
|
|
|
{ munger => 'run', class => 'consonant' } |
|
2179
|
|
|
|
|
|
|
{ munger => 'run', class => 'digit' } |
|
2180
|
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
The length of the longest unbroken run of characters in a named C -- |
|
2182
|
|
|
|
|
|
|
the same class names L recognises. Where C counts how many such |
|
2183
|
|
|
|
|
|
|
characters occur in total, C measures how tightly they clump: the |
|
2184
|
|
|
|
|
|
|
longest consonant run and longest digit run are staple generated-name (DGA) |
|
2185
|
|
|
|
|
|
|
features that neither total counts nor L capture, because a real |
|
2186
|
|
|
|
|
|
|
word breaks its consonants up with vowels while a random string will happily |
|
2187
|
|
|
|
|
|
|
emit six in a row. An empty or undef input is C<0>. |
|
2188
|
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
=cut |
|
2190
|
|
|
|
|
|
|
|
|
2191
|
|
|
|
|
|
|
# class name => a character-class pattern for the 'run' munger. Mirrors |
|
2192
|
|
|
|
|
|
|
# %CHAR_COUNT's class names (keep in sync); runs need a regex quantifier, so |
|
2193
|
|
|
|
|
|
|
# tr///'s speed trick does not apply here. |
|
2194
|
|
|
|
|
|
|
my %RUN_RE = ( |
|
2195
|
|
|
|
|
|
|
alnum => '[A-Za-z0-9]', |
|
2196
|
|
|
|
|
|
|
non_alnum => '[^A-Za-z0-9]', |
|
2197
|
|
|
|
|
|
|
ascii => '[\x00-\x7f]', |
|
2198
|
|
|
|
|
|
|
non_ascii => '[^\x00-\x7f]', |
|
2199
|
|
|
|
|
|
|
digit => '[0-9]', |
|
2200
|
|
|
|
|
|
|
alpha => '[A-Za-z]', |
|
2201
|
|
|
|
|
|
|
upper => '[A-Z]', |
|
2202
|
|
|
|
|
|
|
lower => '[a-z]', |
|
2203
|
|
|
|
|
|
|
vowel => '[aeiouAEIOU]', |
|
2204
|
|
|
|
|
|
|
consonant => '[b-df-hj-np-tv-zB-DF-HJ-NP-TV-Z]', |
|
2205
|
|
|
|
|
|
|
xdigit => '[0-9A-Fa-f]', |
|
2206
|
|
|
|
|
|
|
space => '\s', |
|
2207
|
|
|
|
|
|
|
punct => '[[:punct:]]', |
|
2208
|
|
|
|
|
|
|
); |
|
2209
|
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
sub _build_run { |
|
2211
|
4
|
|
|
4
|
|
7
|
my ( $spec, $where ) = @_; |
|
2212
|
|
|
|
|
|
|
|
|
2213
|
4
|
|
|
|
|
6
|
my $class = $spec->{class}; |
|
2214
|
4
|
100
|
|
|
|
126
|
croak "run munger$where requires a 'class'" |
|
2215
|
|
|
|
|
|
|
unless defined $class; |
|
2216
|
3
|
100
|
|
|
|
106
|
my $cc = $RUN_RE{$class} |
|
2217
|
|
|
|
|
|
|
or croak "run munger$where: unknown class '$class' (known: " . join( ', ', sort keys %RUN_RE ) . ')'; |
|
2218
|
2
|
|
|
|
|
54
|
my $re = qr/((?:$cc)+)/; |
|
2219
|
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
return sub { |
|
2221
|
6
|
|
|
6
|
|
27
|
my ($v) = @_; |
|
2222
|
6
|
100
|
|
|
|
16
|
my $s = defined $v ? "$v" : ''; |
|
2223
|
6
|
|
|
|
|
8
|
my $max = 0; |
|
2224
|
6
|
|
|
|
|
37
|
while ( $s =~ /$re/g ) { |
|
2225
|
6
|
100
|
|
|
|
25
|
$max = length $1 if length $1 > $max; |
|
2226
|
|
|
|
|
|
|
} |
|
2227
|
6
|
|
|
|
|
20
|
return $max; |
|
2228
|
2
|
|
|
|
|
13
|
}; |
|
2229
|
|
|
|
|
|
|
} ## end sub _build_run |
|
2230
|
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
=head2 count |
|
2232
|
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
{ munger => 'count', of => '/' } # url_path_depth, topic_depth |
|
2234
|
|
|
|
|
|
|
{ munger => 'count', of => '.', plus => 1 } # label_count (dots + 1) |
|
2235
|
|
|
|
|
|
|
|
|
2236
|
|
|
|
|
|
|
Count non-overlapping occurrences of a literal substring C in the input, |
|
2237
|
|
|
|
|
|
|
optionally adding a constant C. This is the segment/depth feature behind |
|
2238
|
|
|
|
|
|
|
C and C (count of C<`/`>) and C (dots |
|
2239
|
|
|
|
|
|
|
plus one). C is matched literally, not as a pattern, so C<.> means a literal |
|
2240
|
|
|
|
|
|
|
dot. |
|
2241
|
|
|
|
|
|
|
|
|
2242
|
|
|
|
|
|
|
=cut |
|
2243
|
|
|
|
|
|
|
|
|
2244
|
|
|
|
|
|
|
sub _build_count { |
|
2245
|
4
|
|
|
4
|
|
8
|
my ( $spec, $where ) = @_; |
|
2246
|
|
|
|
|
|
|
|
|
2247
|
4
|
|
|
|
|
6
|
my $of = $spec->{of}; |
|
2248
|
4
|
100
|
66
|
|
|
106
|
croak "count munger$where requires a non-empty 'of' string" |
|
2249
|
|
|
|
|
|
|
unless defined $of && length $of; |
|
2250
|
|
|
|
|
|
|
|
|
2251
|
3
|
100
|
|
|
|
7
|
my $plus = defined $spec->{plus} ? $spec->{plus} : 0; |
|
2252
|
3
|
50
|
|
|
|
9
|
croak "count munger$where: 'plus' must be numeric" |
|
2253
|
|
|
|
|
|
|
unless looks_like_number($plus); |
|
2254
|
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
# index() beats a global regex match here: no pattern engine, and no |
|
2256
|
|
|
|
|
|
|
# per-call list of matches just to count them. Advancing by length($of) |
|
2257
|
|
|
|
|
|
|
# keeps the non-overlapping semantics m//g had. |
|
2258
|
3
|
|
|
|
|
6
|
my $oflen = length $of; |
|
2259
|
|
|
|
|
|
|
return sub { |
|
2260
|
6
|
|
|
6
|
|
20
|
my ($v) = @_; |
|
2261
|
6
|
50
|
|
|
|
15
|
my $s = defined $v ? "$v" : ''; |
|
2262
|
6
|
|
|
|
|
7
|
my $n = 0; |
|
2263
|
6
|
|
|
|
|
9
|
my $p = 0; |
|
2264
|
6
|
|
|
|
|
16
|
while ( ( $p = index( $s, $of, $p ) ) >= 0 ) { |
|
2265
|
10
|
|
|
|
|
22
|
$n++; |
|
2266
|
10
|
|
|
|
|
17
|
$p += $oflen; |
|
2267
|
|
|
|
|
|
|
} |
|
2268
|
6
|
|
|
|
|
22
|
return $n + $plus; |
|
2269
|
3
|
|
|
|
|
16
|
}; ## end sub |
|
2270
|
|
|
|
|
|
|
} ## end sub _build_count |
|
2271
|
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
=head2 match |
|
2273
|
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
{ munger => 'match', pattern => '^xn--' } # punycode label |
|
2275
|
|
|
|
|
|
|
{ munger => 'match', pattern => '%[0-9A-Fa-f]{2}', mode => 'count' } |
|
2276
|
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
Match the input against a Perl regular expression C: C<1>/C<0> under |
|
2278
|
|
|
|
|
|
|
the default C<< mode => 'bool' >>, or the number of non-overlapping matches |
|
2279
|
|
|
|
|
|
|
with C<< mode => 'count' >>. A true C makes the match |
|
2280
|
|
|
|
|
|
|
case-insensitive. This is the catch-all shape test behind flags like "is this |
|
2281
|
|
|
|
|
|
|
label punycode" or "is the Host an IP literal", and counters like |
|
2282
|
|
|
|
|
|
|
percent-escapes in a URL -- anything L and L are not expressive |
|
2283
|
|
|
|
|
|
|
enough for. The pattern is compiled at build time, so a broken one fails at |
|
2284
|
|
|
|
|
|
|
C rather than per row. |
|
2285
|
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
B a pattern cannot execute code (Perl requires C |
|
2287
|
|
|
|
|
|
|
for that, which this module does not enable), but a pathological pattern can |
|
2288
|
|
|
|
|
|
|
still backtrack catastrophically and stall a writer. Treat munger specs -- |
|
2289
|
|
|
|
|
|
|
like the rest of C -- as configuration from a trusted operator, |
|
2290
|
|
|
|
|
|
|
not as untrusted input. |
|
2291
|
|
|
|
|
|
|
|
|
2292
|
|
|
|
|
|
|
=cut |
|
2293
|
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
sub _build_match { |
|
2295
|
6
|
|
|
6
|
|
13
|
my ( $spec, $where ) = @_; |
|
2296
|
|
|
|
|
|
|
|
|
2297
|
6
|
|
|
|
|
10
|
my $pat = $spec->{pattern}; |
|
2298
|
6
|
100
|
66
|
|
|
161
|
croak "match munger$where requires a non-empty 'pattern'" |
|
2299
|
|
|
|
|
|
|
unless defined $pat && length $pat; |
|
2300
|
|
|
|
|
|
|
|
|
2301
|
5
|
100
|
|
|
|
12
|
my $mode = defined $spec->{mode} ? $spec->{mode} : 'bool'; |
|
2302
|
5
|
100
|
100
|
|
|
156
|
croak "match munger$where: 'mode' must be 'bool' or 'count'" |
|
2303
|
|
|
|
|
|
|
unless $mode eq 'bool' || $mode eq 'count'; |
|
2304
|
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
# qr// on spec text cannot run code -- (?{...}) needs 'use re "eval"', |
|
2306
|
|
|
|
|
|
|
# which is not enabled here -- but it can be syntactically invalid, so |
|
2307
|
|
|
|
|
|
|
# compile eagerly and croak at build time. |
|
2308
|
4
|
100
|
|
|
|
6
|
my $re = eval { $spec->{ignore_case} ? qr/$pat/i : qr/$pat/ }; |
|
|
4
|
|
|
|
|
104
|
|
|
2309
|
4
|
100
|
|
|
|
167
|
croak "match munger$where: cannot compile pattern '$pat': $@" |
|
2310
|
|
|
|
|
|
|
unless defined $re; |
|
2311
|
|
|
|
|
|
|
|
|
2312
|
3
|
100
|
|
|
|
5
|
if ( $mode eq 'bool' ) { |
|
2313
|
|
|
|
|
|
|
return sub { |
|
2314
|
4
|
100
|
|
4
|
|
17
|
my $s = defined $_[0] ? "$_[0]" : ''; |
|
2315
|
4
|
100
|
|
|
|
26
|
return $s =~ $re ? 1 : 0; |
|
2316
|
2
|
|
|
|
|
10
|
}; |
|
2317
|
|
|
|
|
|
|
} |
|
2318
|
|
|
|
|
|
|
return sub { |
|
2319
|
2
|
50
|
|
2
|
|
10
|
my $s = defined $_[0] ? "$_[0]" : ''; |
|
2320
|
2
|
|
|
|
|
13
|
my $n = () = $s =~ /$re/g; |
|
2321
|
2
|
|
|
|
|
8
|
return $n; |
|
2322
|
1
|
|
|
|
|
6
|
}; |
|
2323
|
|
|
|
|
|
|
} ## end sub _build_match |
|
2324
|
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
=head2 bucket |
|
2326
|
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
{ munger => 'bucket', bounds => [ 1024, 49152 ] } # dest_port classes |
|
2328
|
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
Map a number to a bucket index by ascending C: the result is how many |
|
2330
|
|
|
|
|
|
|
bounds the value is greater than or equal to. With C<< bounds => [1024, 49152] >> |
|
2331
|
|
|
|
|
|
|
a value under C<1024> is C<0> (well-known), C<1024>-C<49151> is C<1> (registered), |
|
2332
|
|
|
|
|
|
|
and C<49152>+ is C<2> (ephemeral) -- the classic port classing, where the literal |
|
2333
|
|
|
|
|
|
|
port number is meaningless to a threshold split but the I is a real |
|
2334
|
|
|
|
|
|
|
signal. C must be strictly ascending; N bounds yield indices C<0>..C. |
|
2335
|
|
|
|
|
|
|
|
|
2336
|
|
|
|
|
|
|
This generalises the C<*_enum> status-class mungers, which are the special case |
|
2337
|
|
|
|
|
|
|
of bucketing a reply code by its leading digit. |
|
2338
|
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
=cut |
|
2340
|
|
|
|
|
|
|
|
|
2341
|
|
|
|
|
|
|
sub _build_bucket { |
|
2342
|
3
|
|
|
3
|
|
8
|
my ( $spec, $where ) = @_; |
|
2343
|
|
|
|
|
|
|
|
|
2344
|
3
|
|
|
|
|
6
|
my $bounds = $spec->{bounds}; |
|
2345
|
3
|
100
|
66
|
|
|
190
|
croak "bucket munger$where requires a non-empty 'bounds' arrayref" |
|
2346
|
|
|
|
|
|
|
unless ref $bounds eq 'ARRAY' && @$bounds; |
|
2347
|
|
|
|
|
|
|
|
|
2348
|
2
|
|
|
|
|
6
|
my @b = @$bounds; |
|
2349
|
2
|
|
|
|
|
8
|
for my $i ( 0 .. $#b ) { |
|
2350
|
4
|
0
|
|
|
|
16
|
croak "bucket munger$where: bound[$i] ('" . ( defined $b[$i] ? $b[$i] : 'undef' ) . "') is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
unless looks_like_number( $b[$i] ); |
|
2352
|
4
|
100
|
100
|
|
|
154
|
croak "bucket munger$where: 'bounds' must be strictly ascending" |
|
2353
|
|
|
|
|
|
|
if $i && $b[$i] <= $b[ $i - 1 ]; |
|
2354
|
|
|
|
|
|
|
} |
|
2355
|
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
return sub { |
|
2357
|
6
|
|
|
6
|
|
16
|
my ($v) = @_; |
|
2358
|
6
|
0
|
|
|
|
21
|
croak "bucket munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2360
|
6
|
|
|
|
|
10
|
my $idx = 0; |
|
2361
|
6
|
|
|
|
|
11
|
for my $bound (@b) { |
|
2362
|
10
|
100
|
|
|
|
24
|
last if $v < $bound; |
|
2363
|
6
|
|
|
|
|
8
|
$idx++; |
|
2364
|
|
|
|
|
|
|
} |
|
2365
|
6
|
|
|
|
|
20
|
return $idx; |
|
2366
|
1
|
|
|
|
|
7
|
}; ## end sub |
|
2367
|
|
|
|
|
|
|
} ## end sub _build_bucket |
|
2368
|
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
=head2 quantile |
|
2370
|
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
{ munger => 'quantile', bounds => [ 40, 180, 460, 2200, 64000 ] } |
|
2372
|
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
Piecewise-linear ECDF: map a number onto C<[0, 1]> by where it falls among |
|
2374
|
|
|
|
|
|
|
ascending C taken from the training data's quantiles (e.g. its |
|
2375
|
|
|
|
|
|
|
min / p25 / p50 / p75 / max). Values at or below the first bound map to C<0>, |
|
2376
|
|
|
|
|
|
|
at or above the last to C<1>, and anything between two adjacent bounds |
|
2377
|
|
|
|
|
|
|
interpolates linearly between their positions. This is L's continuous |
|
2378
|
|
|
|
|
|
|
sibling and the heavy-tail normaliser to reach for when L is not enough |
|
2379
|
|
|
|
|
|
|
and L would let one outlier stretch the whole scale: after the |
|
2380
|
|
|
|
|
|
|
transform the training distribution is roughly uniform, so a forest threshold |
|
2381
|
|
|
|
|
|
|
split lands anywhere in it with equal ease. C must be strictly |
|
2382
|
|
|
|
|
|
|
ascending with at least two values; like C, the parameters are |
|
2383
|
|
|
|
|
|
|
supplied rather than learned, so munging stays stateless. |
|
2384
|
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
=cut |
|
2386
|
|
|
|
|
|
|
|
|
2387
|
|
|
|
|
|
|
sub _build_quantile { |
|
2388
|
3
|
|
|
3
|
|
10
|
my ( $spec, $where ) = @_; |
|
2389
|
|
|
|
|
|
|
|
|
2390
|
3
|
|
|
|
|
7
|
my $bounds = $spec->{bounds}; |
|
2391
|
3
|
100
|
66
|
|
|
156
|
croak "quantile munger$where requires a 'bounds' arrayref with at least 2 values" |
|
2392
|
|
|
|
|
|
|
unless ref $bounds eq 'ARRAY' && @$bounds >= 2; |
|
2393
|
|
|
|
|
|
|
|
|
2394
|
2
|
|
|
|
|
7
|
my @b = @$bounds; |
|
2395
|
2
|
|
|
|
|
8
|
for my $i ( 0 .. $#b ) { |
|
2396
|
7
|
0
|
|
|
|
22
|
croak "quantile munger$where: bound[$i] ('" . ( defined $b[$i] ? $b[$i] : 'undef' ) . "') is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2397
|
|
|
|
|
|
|
unless looks_like_number( $b[$i] ); |
|
2398
|
7
|
100
|
100
|
|
|
226
|
croak "quantile munger$where: 'bounds' must be strictly ascending" |
|
2399
|
|
|
|
|
|
|
if $i && $b[$i] <= $b[ $i - 1 ]; |
|
2400
|
|
|
|
|
|
|
} |
|
2401
|
1
|
|
|
|
|
3
|
my $segs = $#b; |
|
2402
|
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
return sub { |
|
2404
|
9
|
|
|
9
|
|
33
|
my ($v) = @_; |
|
2405
|
9
|
50
|
|
|
|
172
|
croak "quantile munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
100
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2407
|
8
|
100
|
|
|
|
31
|
return 0 if $v <= $b[0]; |
|
2408
|
6
|
100
|
|
|
|
23
|
return 1 if $v >= $b[-1]; |
|
2409
|
4
|
|
|
|
|
7
|
my $i = 0; |
|
2410
|
4
|
|
|
|
|
20
|
$i++ while $v >= $b[ $i + 1 ]; |
|
2411
|
4
|
|
|
|
|
33
|
return ( $i + ( $v - $b[$i] ) / ( $b[ $i + 1 ] - $b[$i] ) ) / $segs; |
|
2412
|
1
|
|
|
|
|
9
|
}; ## end sub |
|
2413
|
|
|
|
|
|
|
} ## end sub _build_quantile |
|
2414
|
|
|
|
|
|
|
|
|
2415
|
|
|
|
|
|
|
=head2 scale |
|
2416
|
|
|
|
|
|
|
|
|
2417
|
|
|
|
|
|
|
{ munger => 'scale', min => 0, max => 1000, clamp => 1 } |
|
2418
|
|
|
|
|
|
|
|
|
2419
|
|
|
|
|
|
|
Min-max normalisation: C<(v - min) / (max - min)>, mapping C<[min, max]> onto |
|
2420
|
|
|
|
|
|
|
C<[0, 1]>. C and C must differ. With a true C, results are |
|
2421
|
|
|
|
|
|
|
pinned into C<[0, 1]> so out-of-range inputs cannot escape the unit interval. |
|
2422
|
|
|
|
|
|
|
|
|
2423
|
|
|
|
|
|
|
=cut |
|
2424
|
|
|
|
|
|
|
|
|
2425
|
|
|
|
|
|
|
sub _build_scale { |
|
2426
|
3
|
|
|
3
|
|
7
|
my ( $spec, $where ) = @_; |
|
2427
|
|
|
|
|
|
|
|
|
2428
|
3
|
|
|
|
|
4
|
my ( $min, $max ) = @{$spec}{qw(min max)}; |
|
|
3
|
|
|
|
|
7
|
|
|
2429
|
3
|
50
|
33
|
|
|
17
|
croak "scale munger$where requires numeric 'min' and 'max'" |
|
2430
|
|
|
|
|
|
|
unless looks_like_number($min) && looks_like_number($max); |
|
2431
|
|
|
|
|
|
|
|
|
2432
|
3
|
|
|
|
|
5
|
my $range = $max - $min; |
|
2433
|
3
|
100
|
|
|
|
100
|
croak "scale munger$where: 'min' and 'max' must differ" |
|
2434
|
|
|
|
|
|
|
if $range == 0; |
|
2435
|
|
|
|
|
|
|
|
|
2436
|
2
|
100
|
|
|
|
4
|
my $clamp = $spec->{clamp} ? 1 : 0; |
|
2437
|
|
|
|
|
|
|
return sub { |
|
2438
|
4
|
|
|
4
|
|
13
|
my ($v) = @_; |
|
2439
|
4
|
0
|
|
|
|
12
|
croak "scale munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2440
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2441
|
4
|
|
|
|
|
23
|
my $s = ( $v - $min ) / $range; |
|
2442
|
4
|
100
|
|
|
|
9
|
if ($clamp) { $s = 0 if $s < 0; $s = 1 if $s > 1; } |
|
|
2
|
100
|
|
|
|
7
|
|
|
|
2
|
100
|
|
|
|
5
|
|
|
2443
|
4
|
|
|
|
|
12
|
return $s; |
|
2444
|
2
|
|
|
|
|
12
|
}; |
|
2445
|
|
|
|
|
|
|
} ## end sub _build_scale |
|
2446
|
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
=head2 zscore |
|
2448
|
|
|
|
|
|
|
|
|
2449
|
|
|
|
|
|
|
{ munger => 'zscore', mean => 42.0, std => 7.5 } |
|
2450
|
|
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
Standardise: C<(v - mean) / std>. C must be non-zero. The C/C |
|
2452
|
|
|
|
|
|
|
are supplied (this module does not learn them) so munging stays stateless and a |
|
2453
|
|
|
|
|
|
|
row can be munged in isolation. |
|
2454
|
|
|
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
=cut |
|
2456
|
|
|
|
|
|
|
|
|
2457
|
|
|
|
|
|
|
sub _build_zscore { |
|
2458
|
2
|
|
|
2
|
|
4
|
my ( $spec, $where ) = @_; |
|
2459
|
|
|
|
|
|
|
|
|
2460
|
2
|
|
|
|
|
3
|
my ( $mean, $std ) = @{$spec}{qw(mean std)}; |
|
|
2
|
|
|
|
|
5
|
|
|
2461
|
2
|
50
|
33
|
|
|
12
|
croak "zscore munger$where requires numeric 'mean' and 'std'" |
|
2462
|
|
|
|
|
|
|
unless looks_like_number($mean) && looks_like_number($std); |
|
2463
|
2
|
100
|
|
|
|
99
|
croak "zscore munger$where: 'std' must be non-zero" |
|
2464
|
|
|
|
|
|
|
if $std == 0; |
|
2465
|
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
return sub { |
|
2467
|
2
|
|
|
2
|
|
7
|
my ($v) = @_; |
|
2468
|
2
|
0
|
|
|
|
7
|
croak "zscore munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2469
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2470
|
2
|
|
|
|
|
8
|
return ( $v - $mean ) / $std; |
|
2471
|
1
|
|
|
|
|
6
|
}; |
|
2472
|
|
|
|
|
|
|
} ## end sub _build_zscore |
|
2473
|
|
|
|
|
|
|
|
|
2474
|
|
|
|
|
|
|
=head2 log |
|
2475
|
|
|
|
|
|
|
|
|
2476
|
|
|
|
|
|
|
{ munger => 'log' } # natural log |
|
2477
|
|
|
|
|
|
|
{ munger => 'log', offset => 1 } # log1p-style, so 0 is allowed |
|
2478
|
|
|
|
|
|
|
{ munger => 'log', base => 10, offset => 1 } |
|
2479
|
|
|
|
|
|
|
|
|
2480
|
|
|
|
|
|
|
Logarithm of C. Heavy-tailed counts (bytes, durations) compress well |
|
2481
|
|
|
|
|
|
|
under a log, which keeps a few huge values from dominating the forest. C |
|
2482
|
|
|
|
|
|
|
(default C<0>) shifts the input so zeros/small values are representable; the |
|
2483
|
|
|
|
|
|
|
shifted value must be strictly positive or the input croaks. C defaults to |
|
2484
|
|
|
|
|
|
|
natural log. |
|
2485
|
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
=cut |
|
2487
|
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
sub _build_log { |
|
2489
|
8
|
|
|
8
|
|
19
|
my ( $spec, $where ) = @_; |
|
2490
|
|
|
|
|
|
|
|
|
2491
|
8
|
100
|
|
|
|
39
|
my $offset = exists $spec->{offset} ? $spec->{offset} : 0; |
|
2492
|
8
|
50
|
|
|
|
33
|
croak "log munger$where: 'offset' must be numeric" |
|
2493
|
|
|
|
|
|
|
unless looks_like_number($offset); |
|
2494
|
|
|
|
|
|
|
|
|
2495
|
8
|
|
|
|
|
14
|
my $ln_base; |
|
2496
|
8
|
100
|
|
|
|
20
|
if ( defined $spec->{base} ) { |
|
2497
|
|
|
|
|
|
|
croak "log munger$where: 'base' must be numeric and > 0 and != 1" |
|
2498
|
|
|
|
|
|
|
unless looks_like_number( $spec->{base} ) |
|
2499
|
|
|
|
|
|
|
&& $spec->{base} > 0 |
|
2500
|
2
|
50
|
66
|
|
|
170
|
&& $spec->{base} != 1; |
|
|
|
|
66
|
|
|
|
|
|
2501
|
1
|
|
|
|
|
4
|
$ln_base = log( $spec->{base} ); |
|
2502
|
|
|
|
|
|
|
} |
|
2503
|
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
return sub { |
|
2505
|
9
|
|
|
9
|
|
39
|
my ($v) = @_; |
|
2506
|
9
|
0
|
|
|
|
30
|
croak "log munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2507
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2508
|
9
|
|
|
|
|
15
|
my $x = $v + $offset; |
|
2509
|
9
|
100
|
|
|
|
101
|
croak "log munger$where: value+offset must be > 0 (got $x)" |
|
2510
|
|
|
|
|
|
|
unless $x > 0; |
|
2511
|
8
|
|
|
|
|
24
|
my $r = log($x); |
|
2512
|
8
|
100
|
|
|
|
20
|
$r /= $ln_base if defined $ln_base; |
|
2513
|
8
|
|
|
|
|
26
|
return $r; |
|
2514
|
7
|
|
|
|
|
54
|
}; ## end sub |
|
2515
|
|
|
|
|
|
|
} ## end sub _build_log |
|
2516
|
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
=head2 clamp |
|
2518
|
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
{ munger => 'clamp', min => 0 } |
|
2520
|
|
|
|
|
|
|
{ munger => 'clamp', min => 0, max => 65535 } |
|
2521
|
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
Pass the number through, pinned into C<[min, max]>. Either bound may be omitted |
|
2523
|
|
|
|
|
|
|
to clamp on one side only. Unlike C this does not rescale; it only caps |
|
2524
|
|
|
|
|
|
|
outliers before they reach the model. |
|
2525
|
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
=cut |
|
2527
|
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
sub _build_clamp { |
|
2529
|
3
|
|
|
3
|
|
6
|
my ( $spec, $where ) = @_; |
|
2530
|
|
|
|
|
|
|
|
|
2531
|
3
|
|
|
|
|
5
|
my ( $min, $max ) = @{$spec}{qw(min max)}; |
|
|
3
|
|
|
|
|
7
|
|
|
2532
|
3
|
|
|
|
|
5
|
my $have_min = defined $min; |
|
2533
|
3
|
|
|
|
|
5
|
my $have_max = defined $max; |
|
2534
|
3
|
100
|
66
|
|
|
106
|
croak "clamp munger$where needs at least one of 'min' or 'max'" |
|
2535
|
|
|
|
|
|
|
unless $have_min || $have_max; |
|
2536
|
2
|
50
|
33
|
|
|
11
|
croak "clamp munger$where: 'min' must be numeric" |
|
2537
|
|
|
|
|
|
|
if $have_min && !looks_like_number($min); |
|
2538
|
2
|
50
|
66
|
|
|
8
|
croak "clamp munger$where: 'max' must be numeric" |
|
2539
|
|
|
|
|
|
|
if $have_max && !looks_like_number($max); |
|
2540
|
2
|
50
|
66
|
|
|
9
|
croak "clamp munger$where: 'min' must be <= 'max'" |
|
|
|
|
66
|
|
|
|
|
|
2541
|
|
|
|
|
|
|
if $have_min && $have_max && $min > $max; |
|
2542
|
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
return sub { |
|
2544
|
5
|
|
|
5
|
|
15
|
my ($v) = @_; |
|
2545
|
5
|
0
|
|
|
|
14
|
croak "clamp munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2547
|
5
|
100
|
66
|
|
|
16
|
$v = $min if $have_min && $v < $min; |
|
2548
|
5
|
100
|
100
|
|
|
12
|
$v = $max if $have_max && $v > $max; |
|
2549
|
5
|
|
|
|
|
16
|
return $v; |
|
2550
|
2
|
|
|
|
|
12
|
}; |
|
2551
|
|
|
|
|
|
|
} ## end sub _build_clamp |
|
2552
|
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
=head2 num |
|
2554
|
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
{ munger => 'num', base => 16 } # '0x1a' or '1a' -> 26 |
|
2556
|
|
|
|
|
|
|
{ munger => 'num' } # plain numeric coercion |
|
2557
|
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
Parse a string as a number in C (2-36, default 10). Base 10 simply |
|
2559
|
|
|
|
|
|
|
validates and numifies. Other bases accept the digits C<0-9a-z> below the |
|
2560
|
|
|
|
|
|
|
base, case-insensitively, an optional leading C<->, and the conventional |
|
2561
|
|
|
|
|
|
|
prefix for that base (C<0x> for 16, C<0b> for 2, C<0o> for 8). Plenty of |
|
2562
|
|
|
|
|
|
|
tooling logs flag words and IDs in hex (C<0x2f>), which the Writer would |
|
2563
|
|
|
|
|
|
|
reject as non-numeric; this munger is the bridge. Croaks on anything that is |
|
2564
|
|
|
|
|
|
|
not a clean number in the chosen base. |
|
2565
|
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
=cut |
|
2567
|
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
sub _build_num { |
|
2569
|
7
|
|
|
7
|
|
13
|
my ( $spec, $where ) = @_; |
|
2570
|
|
|
|
|
|
|
|
|
2571
|
7
|
100
|
|
|
|
24
|
my $base = defined $spec->{base} ? $spec->{base} : 10; |
|
2572
|
7
|
100
|
66
|
|
|
243
|
croak "num munger$where: 'base' must be an integer from 2 to 36" |
|
|
|
|
100
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
unless $base =~ /\A[0-9]+\z/ && $base >= 2 && $base <= 36; |
|
2574
|
|
|
|
|
|
|
|
|
2575
|
5
|
100
|
|
|
|
14
|
if ( $base == 10 ) { |
|
2576
|
|
|
|
|
|
|
return sub { |
|
2577
|
3
|
|
|
3
|
|
9
|
my ($v) = @_; |
|
2578
|
3
|
50
|
|
|
|
99
|
croak "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
100
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2580
|
2
|
|
|
|
|
13
|
return $v + 0; |
|
2581
|
1
|
|
|
|
|
6
|
}; |
|
2582
|
|
|
|
|
|
|
} |
|
2583
|
|
|
|
|
|
|
|
|
2584
|
4
|
|
|
|
|
7
|
my %digit; |
|
2585
|
4
|
|
|
|
|
7
|
my $i = 0; |
|
2586
|
4
|
|
|
|
|
119
|
$digit{$_} = $i++ for ( '0' .. '9', 'a' .. 'z' ); |
|
2587
|
|
|
|
|
|
|
# Strip only the base's own conventional prefix; for other bases a letter |
|
2588
|
|
|
|
|
|
|
# like 'b' is just a digit, so there is nothing to disambiguate. |
|
2589
|
4
|
50
|
|
|
|
19
|
my $prefix |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
= $base == 16 ? qr/\A0x/ |
|
2591
|
|
|
|
|
|
|
: $base == 8 ? qr/\A0o/ |
|
2592
|
|
|
|
|
|
|
: $base == 2 ? qr/\A0b/ |
|
2593
|
|
|
|
|
|
|
: undef; |
|
2594
|
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
return sub { |
|
2596
|
11
|
|
|
11
|
|
504
|
my ($v) = @_; |
|
2597
|
11
|
50
|
|
|
|
30
|
my $s = defined $v ? lc "$v" : ''; |
|
2598
|
11
|
50
|
|
|
|
38
|
my $err = "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a base-$base number"; |
|
2599
|
11
|
|
|
|
|
24
|
my $neg = $s =~ s/\A-//; |
|
2600
|
11
|
50
|
|
|
|
57
|
$s =~ s/$prefix// if defined $prefix; |
|
2601
|
11
|
100
|
|
|
|
106
|
croak $err unless length $s; |
|
2602
|
10
|
|
|
|
|
10
|
my $n = 0; |
|
2603
|
10
|
|
|
|
|
28
|
for my $c ( split //, $s ) { |
|
2604
|
25
|
|
|
|
|
29
|
my $d = $digit{$c}; |
|
2605
|
25
|
100
|
66
|
|
|
137
|
croak $err unless defined $d && $d < $base; |
|
2606
|
24
|
|
|
|
|
32
|
$n = $n * $base + $d; |
|
2607
|
|
|
|
|
|
|
} |
|
2608
|
9
|
100
|
|
|
|
39
|
return $neg ? -$n : $n; |
|
2609
|
4
|
|
|
|
|
39
|
}; ## end sub |
|
2610
|
|
|
|
|
|
|
} ## end sub _build_num |
|
2611
|
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
=head2 ratio |
|
2613
|
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
# 'io_ratio' is a tag; bytes_out and bytes_in are input fields |
|
2615
|
|
|
|
|
|
|
"io_ratio": { "munger": "ratio", "from": ["bytes_out", "bytes_in"] } |
|
2616
|
|
|
|
|
|
|
{ munger => 'ratio', from => [qw(bytes_out bytes_in)], zero => -1 } |
|
2617
|
|
|
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
First source divided by the second: with C<< from => [a, b] >> the column gets |
|
2619
|
|
|
|
|
|
|
C. Asymmetry between two counters is a classic feature the counters |
|
2620
|
|
|
|
|
|
|
alone cannot express -- bytes out over bytes in flags exfiltration, requests |
|
2621
|
|
|
|
|
|
|
over responses flags scanning -- and the division has to happen at munge time |
|
2622
|
|
|
|
|
|
|
because a forest split only ever sees one column. A zero denominator yields |
|
2623
|
|
|
|
|
|
|
C (default C<0>) instead of dying, since "nothing came back" is a |
|
2624
|
|
|
|
|
|
|
legitimate row, not bad input; pick a C outside the ratio's normal range |
|
2625
|
|
|
|
|
|
|
if you want those rows to stand out. Both inputs must be numeric. |
|
2626
|
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
This is a B munger: it only makes sense with several sources, so |
|
2628
|
|
|
|
|
|
|
it is only usable through L with C as an arrayref of exactly |
|
2629
|
|
|
|
|
|
|
two field names (and thus C / C). The sources are |
|
2630
|
|
|
|
|
|
|
raw input fields, not other columns. |
|
2631
|
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
=head2 combine |
|
2633
|
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
{ munger => 'combine', op => 'sum', from => [qw(bytes_in bytes_out)] } |
|
2635
|
|
|
|
|
|
|
{ munger => 'combine', op => 'max', from => [qw(req_time resp_time)] } |
|
2636
|
|
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
|
Fold two or more numeric source fields into one column with C: C, |
|
2638
|
|
|
|
|
|
|
C (first minus second; exactly two sources), C, C, C, |
|
2639
|
|
|
|
|
|
|
or C. The general-purpose sibling of L for when the interesting |
|
2640
|
|
|
|
|
|
|
feature is a total, a gap, or an extreme across fields rather than any one |
|
2641
|
|
|
|
|
|
|
field. Every input must be numeric. |
|
2642
|
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
Like C, this is a B munger: only usable through |
|
2644
|
|
|
|
|
|
|
L with C as an arrayref of source field names. |
|
2645
|
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
=cut |
|
2647
|
|
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
|
sub _build_ratio { |
|
2649
|
3
|
|
|
3
|
|
8
|
my ( $spec, $where, $nsrc ) = @_; |
|
2650
|
|
|
|
|
|
|
|
|
2651
|
3
|
100
|
|
|
|
210
|
croak "ratio munger$where takes exactly 2 source fields (numerator, denominator), not $nsrc" |
|
2652
|
|
|
|
|
|
|
unless $nsrc == 2; |
|
2653
|
|
|
|
|
|
|
|
|
2654
|
2
|
100
|
|
|
|
7
|
my $zero = defined $spec->{zero} ? $spec->{zero} : 0; |
|
2655
|
2
|
50
|
|
|
|
7
|
croak "ratio munger$where: 'zero' must be numeric" |
|
2656
|
|
|
|
|
|
|
unless looks_like_number($zero); |
|
2657
|
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
return sub { |
|
2659
|
5
|
|
|
5
|
|
9
|
for my $v (@_) { |
|
2660
|
10
|
50
|
|
|
|
172
|
croak "ratio munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
100
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2662
|
|
|
|
|
|
|
} |
|
2663
|
4
|
100
|
|
|
|
13
|
return $zero if $_[1] == 0; |
|
2664
|
2
|
|
|
|
|
10
|
return $_[0] / $_[1]; |
|
2665
|
2
|
|
|
|
|
11
|
}; |
|
2666
|
|
|
|
|
|
|
} ## end sub _build_ratio |
|
2667
|
|
|
|
|
|
|
|
|
2668
|
|
|
|
|
|
|
# op => fold over the already numeric-checked source values. A table so the |
|
2669
|
|
|
|
|
|
|
# error message can enumerate them and a new op is one line. |
|
2670
|
|
|
|
|
|
|
my %COMBINE_OPS = ( |
|
2671
|
|
|
|
|
|
|
sum => sub { my $t = 0; $t += $_ for @_; return $t }, |
|
2672
|
|
|
|
|
|
|
diff => sub { return $_[0] - $_[1] }, |
|
2673
|
|
|
|
|
|
|
product => sub { my $t = 1; $t *= $_ for @_; return $t }, |
|
2674
|
|
|
|
|
|
|
min => sub { |
|
2675
|
|
|
|
|
|
|
my $t = shift; |
|
2676
|
|
|
|
|
|
|
for (@_) { $t = $_ if $_ < $t } |
|
2677
|
|
|
|
|
|
|
return $t; |
|
2678
|
|
|
|
|
|
|
}, |
|
2679
|
|
|
|
|
|
|
max => sub { |
|
2680
|
|
|
|
|
|
|
my $t = shift; |
|
2681
|
|
|
|
|
|
|
for (@_) { $t = $_ if $_ > $t } |
|
2682
|
|
|
|
|
|
|
return $t; |
|
2683
|
|
|
|
|
|
|
}, |
|
2684
|
|
|
|
|
|
|
mean => sub { my $t = 0; $t += $_ for @_; return $t / @_ }, |
|
2685
|
|
|
|
|
|
|
); |
|
2686
|
|
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
sub _build_combine_op { |
|
2688
|
10
|
|
|
10
|
|
20
|
my ( $spec, $where, $nsrc ) = @_; |
|
2689
|
|
|
|
|
|
|
|
|
2690
|
10
|
|
|
|
|
15
|
my $op = $spec->{op}; |
|
2691
|
10
|
100
|
66
|
|
|
200
|
croak "combine munger$where requires an 'op' (one of: " . join( ', ', sort keys %COMBINE_OPS ) . ')' |
|
2692
|
|
|
|
|
|
|
unless defined $op && length $op; |
|
2693
|
9
|
100
|
|
|
|
215
|
my $fold = $COMBINE_OPS{$op} |
|
2694
|
|
|
|
|
|
|
or croak "combine munger$where: unknown op '$op' (known: " . join( ', ', sort keys %COMBINE_OPS ) . ')'; |
|
2695
|
8
|
100
|
100
|
|
|
188
|
croak "combine munger$where: op 'diff' takes exactly 2 source fields, not $nsrc" |
|
2696
|
|
|
|
|
|
|
if $op eq 'diff' && $nsrc != 2; |
|
2697
|
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
return sub { |
|
2699
|
8
|
|
|
8
|
|
9
|
for my $v (@_) { |
|
2700
|
18
|
0
|
|
|
|
28
|
croak "combine munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric" |
|
|
|
50
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
unless looks_like_number($v); |
|
2702
|
|
|
|
|
|
|
} |
|
2703
|
8
|
|
|
|
|
15
|
return $fold->(@_); |
|
2704
|
7
|
|
|
|
|
60
|
}; |
|
2705
|
|
|
|
|
|
|
} ## end sub _build_combine_op |
|
2706
|
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
=head2 bit |
|
2708
|
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
{ munger => 'bit', mask => '0x12' } # SYN or ACK set? |
|
2710
|
|
|
|
|
|
|
{ munger => 'bit', mask => '0x02', mode => 'all' } # the SYN bit itself |
|
2711
|
|
|
|
|
|
|
{ munger => 'bit', mode => 'popcount' } # how many flags at all |
|
2712
|
|
|
|
|
|
|
{ munger => 'bit', mask => '0x0f', mode => 'value' } # low nibble, 0-15 |
|
2713
|
|
|
|
|
|
|
{ munger => 'bit', mask => '0x02', base => 16 } # Suricata tcp_flags "1b" |
|
2714
|
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
Bit-level features from an integer flags word (TCP flags, DNS header flags, |
|
2716
|
|
|
|
|
|
|
protocol option words): the raw word is meaningless to a threshold split, but |
|
2717
|
|
|
|
|
|
|
individual bits and bit I are real signals. The input must be a |
|
2718
|
|
|
|
|
|
|
non-negative integer, in decimal or C<0x> hex (so a logged C<0x12> works |
|
2719
|
|
|
|
|
|
|
as-is); C may be written either way too. |
|
2720
|
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
Set C<< base => 16 >> to read the B as bare hexadecimal with no C<0x> |
|
2722
|
|
|
|
|
|
|
prefix -- Suricata logs C (and C/C) |
|
2723
|
|
|
|
|
|
|
as e.g. C<"1b">, which is otherwise ambiguous with decimal. A C<0x> prefix on |
|
2724
|
|
|
|
|
|
|
the input is still accepted under C<< base => 16 >>. C is always written |
|
2725
|
|
|
|
|
|
|
in decimal or C<0x> hex regardless of C. Modes: |
|
2726
|
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
=over 4 |
|
2728
|
|
|
|
|
|
|
|
|
2729
|
|
|
|
|
|
|
=item * C (default) - C<1> if any bit of C is set in the value. |
|
2730
|
|
|
|
|
|
|
|
|
2731
|
|
|
|
|
|
|
=item * C - C<1> only if every bit of C is set. |
|
2732
|
|
|
|
|
|
|
|
|
2733
|
|
|
|
|
|
|
=item * C - the masked bits, shifted down to the mask's lowest set |
|
2734
|
|
|
|
|
|
|
bit: C<< mask => '0x0f' >> extracts the low nibble as C<0>-C<15>. |
|
2735
|
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
=item * C - the number of set bits in C; C is |
|
2737
|
|
|
|
|
|
|
optional here and defaults to all bits. An abnormal flag I (a |
|
2738
|
|
|
|
|
|
|
Christmas-tree packet) is anomalous even when each individual bit is common. |
|
2739
|
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
=back |
|
2741
|
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
C is required (and must be non-zero) for every mode except C. |
|
2743
|
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
=cut |
|
2745
|
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
my %BIT_MODE = map { $_ => 1 } qw(any all value popcount); |
|
2747
|
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
# Accept an integer in decimal or 0x-hex form; returns the number, or undef |
|
2749
|
|
|
|
|
|
|
# if it is neither. Shared by bit's mask (spec) and value (input) parsing. |
|
2750
|
|
|
|
|
|
|
sub _bit_int { |
|
2751
|
23
|
|
|
23
|
|
54
|
my ($v) = @_; |
|
2752
|
23
|
50
|
|
|
|
43
|
return undef unless defined $v; |
|
2753
|
23
|
100
|
|
|
|
75
|
return hex($v) if $v =~ /\A0x[0-9a-f]+\z/i; |
|
2754
|
13
|
100
|
|
|
|
86
|
return $v + 0 if $v =~ /\A[0-9]+\z/; |
|
2755
|
3
|
|
|
|
|
7
|
return undef; |
|
2756
|
|
|
|
|
|
|
} |
|
2757
|
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
# Parse an input value as bare hex (a '0x' prefix is tolerated), for bit's |
|
2759
|
|
|
|
|
|
|
# 'base => 16' mode. Suricata logs tcp_flags as "1b" with no prefix, which |
|
2760
|
|
|
|
|
|
|
# _bit_int would read as decimal (or reject), hence a separate parser opted |
|
2761
|
|
|
|
|
|
|
# into per munger rather than a change to the ambiguous default. |
|
2762
|
|
|
|
|
|
|
sub _bit_hex { |
|
2763
|
5
|
|
|
5
|
|
14
|
my ($v) = @_; |
|
2764
|
5
|
50
|
|
|
|
17
|
return undef unless defined $v; |
|
2765
|
5
|
100
|
|
|
|
47
|
return hex($1) if $v =~ /\A(?:0x)?([0-9a-f]+)\z/i; |
|
2766
|
1
|
|
|
|
|
3
|
return undef; |
|
2767
|
|
|
|
|
|
|
} |
|
2768
|
|
|
|
|
|
|
|
|
2769
|
|
|
|
|
|
|
sub _build_bit { |
|
2770
|
13
|
|
|
13
|
|
30
|
my ( $spec, $where ) = @_; |
|
2771
|
|
|
|
|
|
|
|
|
2772
|
13
|
100
|
|
|
|
36
|
my $mode = defined $spec->{mode} ? $spec->{mode} : 'any'; |
|
2773
|
|
|
|
|
|
|
croak "bit munger$where: unknown mode '$mode' (known: " . join( ', ', sort keys %BIT_MODE ) . ')' |
|
2774
|
13
|
100
|
|
|
|
187
|
unless $BIT_MODE{$mode}; |
|
2775
|
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
# Input base: 10 (default, decimal or 0x hex) or 16 (bare hex, for feeds |
|
2777
|
|
|
|
|
|
|
# like Suricata's tcp_flags). Only the per-row input parser changes; the |
|
2778
|
|
|
|
|
|
|
# mask below is always read with _bit_int. |
|
2779
|
12
|
100
|
|
|
|
29
|
my $base = defined $spec->{base} ? $spec->{base} : 10; |
|
2780
|
12
|
100
|
100
|
|
|
217
|
croak "bit munger$where: 'base' must be 10 or 16" |
|
2781
|
|
|
|
|
|
|
unless $base eq '10' || $base eq '16'; |
|
2782
|
11
|
100
|
|
|
|
31
|
my $parse_in = $base eq '16' ? \&_bit_hex : \&_bit_int; |
|
2783
|
11
|
100
|
|
|
|
26
|
my $in_form = $base eq '16' ? 'hex' : 'decimal or 0x hex'; |
|
2784
|
|
|
|
|
|
|
|
|
2785
|
11
|
|
|
|
|
14
|
my $mask; |
|
2786
|
11
|
100
|
|
|
|
42
|
if ( defined $spec->{mask} ) { |
|
|
|
100
|
|
|
|
|
|
|
2787
|
8
|
|
|
|
|
18
|
$mask = _bit_int( $spec->{mask} ); |
|
2788
|
8
|
100
|
|
|
|
166
|
croak "bit munger$where: 'mask' must be a non-negative integer " . '(decimal or 0x hex)' |
|
2789
|
|
|
|
|
|
|
unless defined $mask; |
|
2790
|
7
|
100
|
66
|
|
|
161
|
croak "bit munger$where: 'mask' must be non-zero" |
|
2791
|
|
|
|
|
|
|
if $mask == 0 && $mode ne 'popcount'; |
|
2792
|
|
|
|
|
|
|
} elsif ( $mode ne 'popcount' ) { |
|
2793
|
1
|
|
|
|
|
150
|
croak "bit munger$where: mode '$mode' requires a 'mask'"; |
|
2794
|
|
|
|
|
|
|
} |
|
2795
|
|
|
|
|
|
|
|
|
2796
|
|
|
|
|
|
|
# For 'value', bake in the shift down to the mask's lowest set bit. |
|
2797
|
8
|
|
|
|
|
10
|
my $shift = 0; |
|
2798
|
8
|
100
|
|
|
|
16
|
if ( $mode eq 'value' ) { |
|
2799
|
1
|
|
|
|
|
2
|
my $m = $mask; |
|
2800
|
1
|
|
|
|
|
3
|
until ( $m & 1 ) { $m >>= 1; $shift++; } |
|
|
4
|
|
|
|
|
3
|
|
|
|
4
|
|
|
|
|
8
|
|
|
2801
|
|
|
|
|
|
|
} |
|
2802
|
|
|
|
|
|
|
|
|
2803
|
|
|
|
|
|
|
return sub { |
|
2804
|
20
|
|
|
20
|
|
907
|
my ($v) = @_; |
|
2805
|
20
|
50
|
|
|
|
68
|
my $n = $parse_in->( defined $v ? "$v" : undef ); |
|
2806
|
20
|
50
|
|
|
|
458
|
croak "bit munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a non-negative integer ($in_form)" |
|
|
|
100
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
unless defined $n; |
|
2808
|
17
|
100
|
|
|
|
36
|
$n &= $mask if defined $mask; |
|
2809
|
17
|
100
|
|
|
|
57
|
return sprintf( '%b', $n ) =~ tr/1// if $mode eq 'popcount'; |
|
2810
|
12
|
100
|
|
|
|
41
|
return $n ? 1 : 0 if $mode eq 'any'; |
|
|
|
100
|
|
|
|
|
|
|
2811
|
6
|
100
|
|
|
|
21
|
return $n == $mask ? 1 : 0 if $mode eq 'all'; |
|
|
|
100
|
|
|
|
|
|
|
2812
|
2
|
|
|
|
|
8
|
return $n >> $shift; # value |
|
2813
|
8
|
|
|
|
|
53
|
}; ## end sub |
|
2814
|
|
|
|
|
|
|
} ## end sub _build_bit |
|
2815
|
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
=head2 ip_class |
|
2817
|
|
|
|
|
|
|
|
|
2818
|
|
|
|
|
|
|
{ munger => 'ip_class' } |
|
2819
|
|
|
|
|
|
|
{ munger => 'ip_class', default => -1 } |
|
2820
|
|
|
|
|
|
|
|
|
2821
|
|
|
|
|
|
|
Collapse an IPv4 or IPv6 address to its address-space class -- to addresses |
|
2822
|
|
|
|
|
|
|
what the status-class enums are to reply codes: the literal address is |
|
2823
|
|
|
|
|
|
|
high-cardinality noise, but "an internal host suddenly talking multicast" is |
|
2824
|
|
|
|
|
|
|
a class-level signal. Classes and their emitted numbers: |
|
2825
|
|
|
|
|
|
|
|
|
2826
|
|
|
|
|
|
|
0 global anything not covered below |
|
2827
|
|
|
|
|
|
|
1 private 10/8, 172.16/12, 192.168/16, 100.64/10 (CGNAT), fc00::/7 (ULA) |
|
2828
|
|
|
|
|
|
|
2 loopback 127/8, ::1 |
|
2829
|
|
|
|
|
|
|
3 link_local 169.254/16, fe80::/10 |
|
2830
|
|
|
|
|
|
|
4 multicast 224/4, ff00::/8 |
|
2831
|
|
|
|
|
|
|
5 broadcast 255.255.255.255 |
|
2832
|
|
|
|
|
|
|
6 unspecified 0.0.0.0, :: |
|
2833
|
|
|
|
|
|
|
7 reserved 0/8, 192.0.0/24, the documentation nets (192.0.2/24, |
|
2834
|
|
|
|
|
|
|
198.51.100/24, 203.0.113/24, 2001:db8::/32), benchmarking |
|
2835
|
|
|
|
|
|
|
(198.18/15), 240/4, and the 100::/64 discard prefix |
|
2836
|
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
An IPv4-mapped IPv6 address (C<::ffff:a.b.c.d>) is classified as its embedded |
|
2838
|
|
|
|
|
|
|
IPv4 address. An unparseable input croaks, or yields the numeric C |
|
2839
|
|
|
|
|
|
|
when one is given. IPv6 parsing uses L's C, loaded lazily |
|
2840
|
|
|
|
|
|
|
the way L loads Time::Piece. For B zones (DMZ, |
|
2841
|
|
|
|
|
|
|
server VLAN, guest Wi-Fi) use L, which knows your networks instead of |
|
2842
|
|
|
|
|
|
|
the RFCs'. |
|
2843
|
|
|
|
|
|
|
|
|
2844
|
|
|
|
|
|
|
=head2 cidr |
|
2845
|
|
|
|
|
|
|
|
|
2846
|
|
|
|
|
|
|
{ munger => 'cidr', |
|
2847
|
|
|
|
|
|
|
nets => [ '10.10.0.0/16', '10.20.0.0/16', '2001:db8:5::/48' ], |
|
2848
|
|
|
|
|
|
|
default => -1 } |
|
2849
|
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
Membership in a list of CIDR networks: the result is the (0-based) index of |
|
2851
|
|
|
|
|
|
|
the B net in C containing the address -- L for address |
|
2852
|
|
|
|
|
|
|
space, and the way a site encodes its own zones (DMZ vs. server VLAN vs. |
|
2853
|
|
|
|
|
|
|
guest Wi-Fi) that L's generic RFC classes cannot know about. |
|
2854
|
|
|
|
|
|
|
C may mix IPv4 and IPv6; an address is only tested against nets of its |
|
2855
|
|
|
|
|
|
|
own family. Overlapping nets are fine -- list the most specific first, since |
|
2856
|
|
|
|
|
|
|
the first match wins. An input that is unparseable or in none of the listed |
|
2857
|
|
|
|
|
|
|
nets croaks, or yields the numeric C when one is given (a catch-all |
|
2858
|
|
|
|
|
|
|
C is the usual configuration). |
|
2859
|
|
|
|
|
|
|
|
|
2860
|
|
|
|
|
|
|
=cut |
|
2861
|
|
|
|
|
|
|
|
|
2862
|
|
|
|
|
|
|
# Parse an IP address string: (4, $int) for IPv4, (6, $bytes16) for IPv6, or |
|
2863
|
|
|
|
|
|
|
# an empty list for neither. v4 goes through a regex (also pinning the |
|
2864
|
|
|
|
|
|
|
# dotted-quad form, so inet_pton's odd shorthands never sneak in); v6 leans |
|
2865
|
|
|
|
|
|
|
# on Socket's inet_pton, loaded lazily so no munger that skips IPs pays for |
|
2866
|
|
|
|
|
|
|
# it. |
|
2867
|
|
|
|
|
|
|
sub _parse_ip { |
|
2868
|
51
|
|
|
51
|
|
125
|
my ($s) = @_; |
|
2869
|
51
|
100
|
|
|
|
343
|
if ( $s =~ /\A([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\z/ ) { |
|
2870
|
31
|
100
|
33
|
|
|
425
|
return unless $1 <= 255 && $2 <= 255 && $3 <= 255 && $4 <= 255; |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
2871
|
30
|
|
|
|
|
186
|
return ( 4, ( $1 << 24 ) | ( $2 << 16 ) | ( $3 << 8 ) | $4 ); |
|
2872
|
|
|
|
|
|
|
} |
|
2873
|
20
|
100
|
|
|
|
69
|
if ( index( $s, ':' ) >= 0 ) { |
|
2874
|
14
|
|
|
|
|
812
|
require Socket; |
|
2875
|
14
|
|
|
|
|
3321
|
my $b = eval { Socket::inet_pton( Socket::AF_INET6(), $s ) }; |
|
|
14
|
|
|
|
|
79
|
|
|
2876
|
14
|
50
|
33
|
|
|
126
|
return ( 6, $b ) if defined $b && length $b == 16; |
|
2877
|
|
|
|
|
|
|
} |
|
2878
|
6
|
|
|
|
|
19
|
return; |
|
2879
|
|
|
|
|
|
|
} ## end sub _parse_ip |
|
2880
|
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
# The ip_class class names, pinned to their emitted numbers. |
|
2882
|
|
|
|
|
|
|
my %IP_CLASS = ( |
|
2883
|
|
|
|
|
|
|
global => 0, |
|
2884
|
|
|
|
|
|
|
private => 1, |
|
2885
|
|
|
|
|
|
|
loopback => 2, |
|
2886
|
|
|
|
|
|
|
link_local => 3, |
|
2887
|
|
|
|
|
|
|
multicast => 4, |
|
2888
|
|
|
|
|
|
|
broadcast => 5, |
|
2889
|
|
|
|
|
|
|
unspecified => 6, |
|
2890
|
|
|
|
|
|
|
reserved => 7, |
|
2891
|
|
|
|
|
|
|
); |
|
2892
|
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
sub _ip4_class { |
|
2894
|
21
|
|
|
21
|
|
51
|
my ($n) = @_; |
|
2895
|
21
|
100
|
|
|
|
67
|
return 'unspecified' if $n == 0; |
|
2896
|
20
|
100
|
|
|
|
77
|
return 'broadcast' if $n == 0xffffffff; |
|
2897
|
19
|
|
|
|
|
38
|
my $a = $n >> 24; |
|
2898
|
19
|
|
|
|
|
72
|
my $b = ( $n >> 16 ) & 0xff; |
|
2899
|
19
|
|
|
|
|
35
|
my $c = ( $n >> 8 ) & 0xff; |
|
2900
|
19
|
100
|
|
|
|
53
|
return 'reserved' if $a == 0; # 0/8 "this network" |
|
2901
|
18
|
100
|
|
|
|
56
|
return 'private' if $a == 10; |
|
2902
|
16
|
100
|
66
|
|
|
56
|
return 'private' if $a == 100 && $b >= 64 && $b <= 127; # CGNAT 100.64/10 |
|
|
|
|
100
|
|
|
|
|
|
2903
|
15
|
100
|
|
|
|
41
|
return 'loopback' if $a == 127; |
|
2904
|
14
|
100
|
66
|
|
|
48
|
return 'link_local' if $a == 169 && $b == 254; |
|
2905
|
13
|
100
|
66
|
|
|
47
|
return 'private' if $a == 172 && $b >= 16 && $b <= 31; |
|
|
|
|
100
|
|
|
|
|
|
2906
|
12
|
50
|
100
|
|
|
51
|
return 'reserved' if $a == 192 && $b == 0 && ( $c == 0 || $c == 2 ); |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
2907
|
11
|
100
|
66
|
|
|
42
|
return 'private' if $a == 192 && $b == 168; |
|
2908
|
10
|
100
|
66
|
|
|
40
|
return 'reserved' if $a == 198 && ( $b == 18 || $b == 19 ); # benchmarking |
|
|
|
|
66
|
|
|
|
|
|
2909
|
9
|
50
|
66
|
|
|
35
|
return 'reserved' if $a == 198 && $b == 51 && $c == 100; # TEST-NET-2 |
|
|
|
|
66
|
|
|
|
|
|
2910
|
8
|
50
|
66
|
|
|
63
|
return 'reserved' if $a == 203 && $b == 0 && $c == 113; # TEST-NET-3 |
|
|
|
|
66
|
|
|
|
|
|
2911
|
7
|
100
|
100
|
|
|
39
|
return 'multicast' if $a >= 224 && $a <= 239; |
|
2912
|
5
|
100
|
|
|
|
20
|
return 'reserved' if $a >= 240; # 240/4 future use |
|
2913
|
4
|
|
|
|
|
35
|
return 'global'; |
|
2914
|
|
|
|
|
|
|
} ## end sub _ip4_class |
|
2915
|
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
sub _ip6_class { |
|
2917
|
10
|
|
|
10
|
|
23
|
my ($bytes) = @_; |
|
2918
|
10
|
|
|
|
|
49
|
my @o = unpack 'C16', $bytes; |
|
2919
|
10
|
|
|
|
|
19
|
my $lead0 = 1; |
|
2920
|
10
|
|
100
|
|
|
31
|
for my $i ( 0 .. 14 ) { $lead0 &&= $o[$i] == 0 } |
|
|
150
|
|
|
|
|
400
|
|
|
2921
|
10
|
100
|
|
|
|
25
|
if ($lead0) { |
|
2922
|
2
|
100
|
|
|
|
15
|
return 'unspecified' if $o[15] == 0; |
|
2923
|
1
|
50
|
|
|
|
11
|
return 'loopback' if $o[15] == 1; |
|
2924
|
|
|
|
|
|
|
} |
|
2925
|
|
|
|
|
|
|
# v4-mapped ::ffff:a.b.c.d -- classify as the embedded v4 address. |
|
2926
|
8
|
|
|
|
|
17
|
my $map = 1; |
|
2927
|
8
|
|
100
|
|
|
16
|
for my $i ( 0 .. 9 ) { $map &&= $o[$i] == 0 } |
|
|
80
|
|
|
|
|
193
|
|
|
2928
|
8
|
50
|
66
|
|
|
41
|
return _ip4_class( ( $o[12] << 24 ) | ( $o[13] << 16 ) | ( $o[14] << 8 ) | $o[15] ) |
|
|
|
|
66
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
if $map && $o[10] == 0xff && $o[11] == 0xff; |
|
2930
|
6
|
100
|
|
|
|
24
|
return 'multicast' if $o[0] == 0xff; |
|
2931
|
5
|
100
|
|
|
|
20
|
return 'private' if ( $o[0] & 0xfe ) == 0xfc; # ULA fc00::/7 |
|
2932
|
4
|
100
|
66
|
|
|
24
|
return 'link_local' if $o[0] == 0xfe && ( $o[1] & 0xc0 ) == 0x80; # fe80::/10 |
|
2933
|
3
|
50
|
66
|
|
|
27
|
return 'reserved' if $o[0] == 0x20 && $o[1] == 0x01 && $o[2] == 0x0d && $o[3] == 0xb8; # 2001:db8::/32 |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
2934
|
2
|
|
|
|
|
3
|
my $discard = $o[0] == 0x01; # 100::/64 |
|
2935
|
2
|
|
66
|
|
|
5
|
for my $i ( 1 .. 7 ) { $discard &&= $o[$i] == 0 } |
|
|
14
|
|
|
|
|
34
|
|
|
2936
|
2
|
100
|
|
|
|
12
|
return 'reserved' if $discard; |
|
2937
|
1
|
|
|
|
|
7
|
return 'global'; |
|
2938
|
|
|
|
|
|
|
} ## end sub _ip6_class |
|
2939
|
|
|
|
|
|
|
|
|
2940
|
|
|
|
|
|
|
sub _build_ip_class { |
|
2941
|
3
|
|
|
3
|
|
10
|
my ( $spec, $where ) = @_; |
|
2942
|
|
|
|
|
|
|
|
|
2943
|
3
|
|
|
|
|
9
|
my $has_default = exists $spec->{default}; |
|
2944
|
3
|
|
|
|
|
12
|
my $default = $spec->{default}; |
|
2945
|
3
|
100
|
100
|
|
|
170
|
croak "ip_class munger$where: 'default' must be numeric" |
|
2946
|
|
|
|
|
|
|
if $has_default && !looks_like_number($default); |
|
2947
|
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
return sub { |
|
2949
|
33
|
|
|
33
|
|
990
|
my ($v) = @_; |
|
2950
|
33
|
100
|
|
|
|
183
|
my ( $fam, $p ) = _parse_ip( defined $v ? "$v" : '' ); |
|
2951
|
33
|
100
|
|
|
|
115
|
if ($fam) { |
|
2952
|
29
|
100
|
|
|
|
106
|
return $IP_CLASS{ $fam == 4 ? _ip4_class($p) : _ip6_class($p) }; |
|
2953
|
|
|
|
|
|
|
} |
|
2954
|
4
|
100
|
|
|
|
20
|
return $default if $has_default; |
|
2955
|
2
|
50
|
|
|
|
327
|
croak "ip_class munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a parseable IP address"; |
|
2956
|
2
|
|
|
|
|
20
|
}; |
|
2957
|
|
|
|
|
|
|
} ## end sub _build_ip_class |
|
2958
|
|
|
|
|
|
|
|
|
2959
|
|
|
|
|
|
|
# Build a 16-byte netmask string for an IPv6 prefix length. |
|
2960
|
|
|
|
|
|
|
sub _v6_mask { |
|
2961
|
2
|
|
|
2
|
|
7
|
my ($len) = @_; |
|
2962
|
2
|
|
|
|
|
11
|
my $mask = "\xff" x int( $len / 8 ); |
|
2963
|
2
|
50
|
|
|
|
7
|
$mask .= chr( ( 0xff << ( 8 - $len % 8 ) ) & 0xff ) if $len % 8; |
|
2964
|
2
|
|
|
|
|
9
|
return $mask . ( "\0" x ( 16 - length $mask ) ); |
|
2965
|
|
|
|
|
|
|
} |
|
2966
|
|
|
|
|
|
|
|
|
2967
|
|
|
|
|
|
|
sub _build_cidr { |
|
2968
|
8
|
|
|
8
|
|
25
|
my ( $spec, $where ) = @_; |
|
2969
|
|
|
|
|
|
|
|
|
2970
|
8
|
|
|
|
|
19
|
my $nets = $spec->{nets}; |
|
2971
|
8
|
100
|
66
|
|
|
189
|
croak "cidr munger$where requires a non-empty 'nets' arrayref" |
|
2972
|
|
|
|
|
|
|
unless ref $nets eq 'ARRAY' && @$nets; |
|
2973
|
|
|
|
|
|
|
|
|
2974
|
|
|
|
|
|
|
# [family, masked network, mask] per net; & on the 16-byte v6 strings is |
|
2975
|
|
|
|
|
|
|
# Perl's bitwise string AND, so both families match the same way. |
|
2976
|
7
|
|
|
|
|
13
|
my @match; |
|
2977
|
7
|
|
|
|
|
27
|
for my $i ( 0 .. $#$nets ) { |
|
2978
|
9
|
|
|
|
|
18
|
my $net = $nets->[$i]; |
|
2979
|
9
|
50
|
66
|
|
|
242
|
croak "cidr munger$where: nets[$i] ('" |
|
|
|
100
|
|
|
|
|
|
|
2980
|
|
|
|
|
|
|
. ( defined $net ? $net : 'undef' ) |
|
2981
|
|
|
|
|
|
|
. "') is not in 'address/prefix' form" |
|
2982
|
|
|
|
|
|
|
unless defined $net && $net =~ m{\A(.+)/([0-9]{1,3})\z}; |
|
2983
|
8
|
|
|
|
|
36
|
my ( $addr, $len ) = ( $1, $2 ); |
|
2984
|
8
|
|
|
|
|
22
|
my ( $fam, $p ) = _parse_ip($addr); |
|
2985
|
8
|
100
|
|
|
|
198
|
croak "cidr munger$where: nets[$i] ('$net') has an unparseable address" |
|
2986
|
|
|
|
|
|
|
unless $fam; |
|
2987
|
7
|
100
|
|
|
|
22
|
my $max = $fam == 4 ? 32 : 128; |
|
2988
|
7
|
100
|
|
|
|
167
|
croak "cidr munger$where: nets[$i] ('$net') prefix length must be 0-$max" |
|
2989
|
|
|
|
|
|
|
if $len > $max; |
|
2990
|
6
|
100
|
|
|
|
24
|
my $mask |
|
|
|
100
|
|
|
|
|
|
|
2991
|
|
|
|
|
|
|
= $fam == 4 |
|
2992
|
|
|
|
|
|
|
? ( $len == 0 ? 0 : ( 0xffffffff << ( 32 - $len ) ) & 0xffffffff ) |
|
2993
|
|
|
|
|
|
|
: _v6_mask($len); |
|
2994
|
6
|
|
|
|
|
31
|
push @match, [ $fam, $p & $mask, $mask ]; |
|
2995
|
|
|
|
|
|
|
} ## end for my $i ( 0 .. $#$nets ) |
|
2996
|
|
|
|
|
|
|
|
|
2997
|
4
|
|
|
|
|
12
|
my $has_default = exists $spec->{default}; |
|
2998
|
4
|
|
|
|
|
9
|
my $default = $spec->{default}; |
|
2999
|
4
|
50
|
66
|
|
|
29
|
croak "cidr munger$where: 'default' must be numeric" |
|
3000
|
|
|
|
|
|
|
if $has_default && !looks_like_number($default); |
|
3001
|
|
|
|
|
|
|
|
|
3002
|
|
|
|
|
|
|
return sub { |
|
3003
|
10
|
|
|
10
|
|
664
|
my ($v) = @_; |
|
3004
|
10
|
50
|
|
|
|
66
|
my ( $fam, $p ) = _parse_ip( defined $v ? "$v" : '' ); |
|
3005
|
10
|
100
|
|
|
|
27
|
if ($fam) { |
|
3006
|
8
|
|
|
|
|
27
|
for my $i ( 0 .. $#match ) { |
|
3007
|
15
|
|
|
|
|
28
|
my ( $f, $network, $mask ) = @{ $match[$i] }; |
|
|
15
|
|
|
|
|
37
|
|
|
3008
|
15
|
100
|
|
|
|
42
|
next unless $f == $fam; |
|
3009
|
9
|
100
|
|
|
|
52
|
return $i |
|
|
|
100
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
if $fam == 4 |
|
3011
|
|
|
|
|
|
|
? ( ( $p & $mask ) == $network ) |
|
3012
|
|
|
|
|
|
|
: ( ( $p & $mask ) eq $network ); |
|
3013
|
|
|
|
|
|
|
} |
|
3014
|
4
|
100
|
|
|
|
25
|
return $default if $has_default; |
|
3015
|
1
|
|
|
|
|
134
|
croak "cidr munger$where: '$v' is in none of the listed networks (and no 'default')"; |
|
3016
|
|
|
|
|
|
|
} ## end if ($fam) |
|
3017
|
2
|
100
|
|
|
|
12
|
return $default if $has_default; |
|
3018
|
1
|
50
|
|
|
|
174
|
croak "cidr munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a parseable IP address"; |
|
3019
|
4
|
|
|
|
|
41
|
}; ## end sub |
|
3020
|
|
|
|
|
|
|
} ## end sub _build_cidr |
|
3021
|
|
|
|
|
|
|
|
|
3022
|
|
|
|
|
|
|
=head2 datetime |
|
3023
|
|
|
|
|
|
|
|
|
3024
|
|
|
|
|
|
|
{ munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'epoch' } |
|
3025
|
|
|
|
|
|
|
{ munger => 'datetime', format => '%Y-%m-%d %H:%M:%S', part => 'hour' } |
|
3026
|
|
|
|
|
|
|
|
|
3027
|
|
|
|
|
|
|
Parse a formatted timestamp with L (C, so C is a |
|
3028
|
|
|
|
|
|
|
standard strptime pattern) and extract one numeric C: |
|
3029
|
|
|
|
|
|
|
|
|
3030
|
|
|
|
|
|
|
=over 4 |
|
3031
|
|
|
|
|
|
|
|
|
3032
|
|
|
|
|
|
|
=item * C (default) - seconds since the epoch. |
|
3033
|
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
=item * C, C (1-12), C (1-31), C, C, C. |
|
3035
|
|
|
|
|
|
|
|
|
3036
|
|
|
|
|
|
|
=item * C - day of week, C<0>=Sunday .. C<6>=Saturday. |
|
3037
|
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
=item * C - day of year, C<0>-based. |
|
3039
|
|
|
|
|
|
|
|
|
3040
|
|
|
|
|
|
|
=item * C - time of day as a fraction in C<[0, 1)>, i.e. |
|
3041
|
|
|
|
|
|
|
C<(hour*3600 + min*60 + sec) / 86400>. Handy as a cyclic-ish time-of-day feature. |
|
3042
|
|
|
|
|
|
|
|
|
3043
|
|
|
|
|
|
|
=item * C - position within the week as a fraction in C<[0, 1)>, the |
|
3044
|
|
|
|
|
|
|
week starting Sunday to match C: C<(wday*86400 + hour*3600 + min*60 + sec) |
|
3045
|
|
|
|
|
|
|
/ 604800>. Like C but cycling over a week, so a weekly rhythm (weekend |
|
3046
|
|
|
|
|
|
|
vs. weekday, or a Monday-morning batch) shows up as a feature. |
|
3047
|
|
|
|
|
|
|
|
|
3048
|
|
|
|
|
|
|
=item * C / C, C / C - the C value |
|
3049
|
|
|
|
|
|
|
mapped onto a circle, C and C. Prefer these over |
|
3050
|
|
|
|
|
|
|
the raw C when feeding the forest: a plain fraction has a false seam at |
|
3051
|
|
|
|
|
|
|
the wrap (23:59 and 00:00 sit at opposite ends, 1 vs 0, though they are a minute |
|
3052
|
|
|
|
|
|
|
apart), whereas the sin/cos pair is continuous across midnight/Sunday. Store |
|
3053
|
|
|
|
|
|
|
I of a pair in two columns so the position is unambiguous. |
|
3054
|
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
=back |
|
3056
|
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
Time features often carry the anomaly (a job that normally runs at 03:00 |
|
3058
|
|
|
|
|
|
|
suddenly firing at noon, or a weekday task firing on a Sunday), which is why this |
|
3059
|
|
|
|
|
|
|
is a first-class munger. |
|
3060
|
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
B A cyclic pair belongs together -- C alone collides |
|
3062
|
|
|
|
|
|
|
(C is symmetric about its peak, so two different times map to one value) and |
|
3063
|
|
|
|
|
|
|
the forest then treats distinct times as identical. To emit a pair atomically, |
|
3064
|
|
|
|
|
|
|
give C (plural) and route them to two columns with C (see |
|
3065
|
|
|
|
|
|
|
L): |
|
3066
|
|
|
|
|
|
|
|
|
3067
|
|
|
|
|
|
|
"time_of_week": { |
|
3068
|
|
|
|
|
|
|
"munger": "datetime", "from": "timestamp", |
|
3069
|
|
|
|
|
|
|
"format": "%Y-%m-%dT%H:%M:%S", |
|
3070
|
|
|
|
|
|
|
"parts": [ "sin_week", "cos_week" ], |
|
3071
|
|
|
|
|
|
|
"into": [ "time_sin", "time_cos" ] |
|
3072
|
|
|
|
|
|
|
} |
|
3073
|
|
|
|
|
|
|
|
|
3074
|
|
|
|
|
|
|
The timestamp is parsed once and both columns are filled together, so they can |
|
3075
|
|
|
|
|
|
|
never drift apart or be half-configured. C and C must be the same |
|
3076
|
|
|
|
|
|
|
length. (Using C without C, or C with C, is an error.) |
|
3077
|
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
B Two transparent accelerations, both value-identical to the plain |
|
3079
|
|
|
|
|
|
|
path: a one-slot memo returns the previous result when the same stamp string |
|
3080
|
|
|
|
|
|
|
repeats (the common case in bursty event streams); and when the format is built |
|
3081
|
|
|
|
|
|
|
from only the six numeric codes C<%Y %m %d %H %M %S> (once each, e.g. |
|
3082
|
|
|
|
|
|
|
C<%Y-%m-%dT%H:%M:%S>), parsing skips C for a compiled regex plus |
|
3083
|
|
|
|
|
|
|
integer date math, falling back to C for any value the regex does not |
|
3084
|
|
|
|
|
|
|
match B (a month C<13>, an hour C<24>, a |
|
3085
|
|
|
|
|
|
|
C) -- so an invalid stamp croaks or normalizes exactly as C |
|
3086
|
|
|
|
|
|
|
would, never silently feeding nonsense to the date math. Like C |
|
3087
|
|
|
|
|
|
|
without a zone code, stamps are treated as UTC. |
|
3088
|
|
|
|
|
|
|
|
|
3089
|
|
|
|
|
|
|
=cut |
|
3090
|
|
|
|
|
|
|
|
|
3091
|
|
|
|
|
|
|
# Fraction (in [0,1)) of the way through the day / week, shared by the frac_* |
|
3092
|
|
|
|
|
|
|
# parts and their sin/cos cyclic encodings. |
|
3093
|
|
|
|
|
|
|
sub _frac_day { |
|
3094
|
1
|
|
|
1
|
|
4
|
my $t = shift; |
|
3095
|
1
|
|
|
|
|
4
|
return ( $t->hour * 3600 + $t->min * 60 + $t->sec ) / 86400; |
|
3096
|
|
|
|
|
|
|
} |
|
3097
|
|
|
|
|
|
|
|
|
3098
|
|
|
|
|
|
|
sub _frac_week { |
|
3099
|
2
|
|
|
2
|
|
3
|
my $t = shift; |
|
3100
|
2
|
|
|
|
|
5
|
return ( $t->day_of_week * 86400 + $t->hour * 3600 + $t->min * 60 + $t->sec ) / 604800; |
|
3101
|
|
|
|
|
|
|
} |
|
3102
|
|
|
|
|
|
|
|
|
3103
|
|
|
|
|
|
|
my $TWO_PI = 2 * atan2( 0, -1 ); # atan2(0,-1) == pi, core-only, no POSIX |
|
3104
|
|
|
|
|
|
|
|
|
3105
|
|
|
|
|
|
|
# part name => how to pull it off a Time::Piece object. |
|
3106
|
|
|
|
|
|
|
my %DATETIME_PART = ( |
|
3107
|
|
|
|
|
|
|
epoch => sub { $_[0]->epoch }, |
|
3108
|
|
|
|
|
|
|
year => sub { $_[0]->year }, |
|
3109
|
|
|
|
|
|
|
mon => sub { $_[0]->mon }, |
|
3110
|
|
|
|
|
|
|
mday => sub { $_[0]->mday }, |
|
3111
|
|
|
|
|
|
|
hour => sub { $_[0]->hour }, |
|
3112
|
|
|
|
|
|
|
min => sub { $_[0]->min }, |
|
3113
|
|
|
|
|
|
|
sec => sub { $_[0]->sec }, |
|
3114
|
|
|
|
|
|
|
wday => sub { $_[0]->day_of_week }, |
|
3115
|
|
|
|
|
|
|
yday => sub { $_[0]->yday }, |
|
3116
|
|
|
|
|
|
|
frac_day => \&_frac_day, |
|
3117
|
|
|
|
|
|
|
frac_week => \&_frac_week, |
|
3118
|
|
|
|
|
|
|
sin_day => sub { sin( $TWO_PI * _frac_day( $_[0] ) ) }, |
|
3119
|
|
|
|
|
|
|
cos_day => sub { cos( $TWO_PI * _frac_day( $_[0] ) ) }, |
|
3120
|
|
|
|
|
|
|
sin_week => sub { sin( $TWO_PI * _frac_week( $_[0] ) ) }, |
|
3121
|
|
|
|
|
|
|
cos_week => sub { cos( $TWO_PI * _frac_week( $_[0] ) ) }, |
|
3122
|
|
|
|
|
|
|
); |
|
3123
|
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
# ---- fast fixed-format engine ---------------------------------------------- |
|
3125
|
|
|
|
|
|
|
# |
|
3126
|
|
|
|
|
|
|
# Time::Piece->strptime costs microseconds per call. When the format is built |
|
3127
|
|
|
|
|
|
|
# from only the six all-numeric codes below (once each, e.g. the ubiquitous |
|
3128
|
|
|
|
|
|
|
# '%Y-%m-%dT%H:%M:%S'), we can compile it to a capture regex and derive every |
|
3129
|
|
|
|
|
|
|
# part with integer math instead -- several times faster, and bit-identical: |
|
3130
|
|
|
|
|
|
|
# both paths treat the stamp as UTC (strptime with no zone does the same). |
|
3131
|
|
|
|
|
|
|
# Anything fancier (%b, %z, %j, ...) stays on strptime. |
|
3132
|
|
|
|
|
|
|
|
|
3133
|
|
|
|
|
|
|
# strptime code => [ field name, capture pattern ]. |
|
3134
|
|
|
|
|
|
|
my %FAST_CODE = ( |
|
3135
|
|
|
|
|
|
|
Y => [ 'year', '[0-9]{4}' ], |
|
3136
|
|
|
|
|
|
|
m => [ 'mon', '[0-9]{2}' ], |
|
3137
|
|
|
|
|
|
|
d => [ 'mday', '[0-9]{2}' ], |
|
3138
|
|
|
|
|
|
|
H => [ 'hour', '[0-9]{2}' ], |
|
3139
|
|
|
|
|
|
|
M => [ 'min', '[0-9]{2}' ], |
|
3140
|
|
|
|
|
|
|
S => [ 'sec', '[0-9]{2}' ], |
|
3141
|
|
|
|
|
|
|
); |
|
3142
|
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
# Compile a strptime format into { re, idx } for the arithmetic fast path -- |
|
3144
|
|
|
|
|
|
|
# idx maps field name (year/mon/...) to its capture position -- or return undef |
|
3145
|
|
|
|
|
|
|
# when the format is not fast-eligible. All six codes must appear exactly once |
|
3146
|
|
|
|
|
|
|
# so every part can be derived. |
|
3147
|
|
|
|
|
|
|
sub _compile_fast_format { |
|
3148
|
104
|
|
|
104
|
|
148414
|
my ($format) = @_; |
|
3149
|
104
|
|
|
|
|
169
|
my $re = ''; |
|
3150
|
104
|
|
|
|
|
199
|
my %idx = (); |
|
3151
|
104
|
|
|
|
|
169
|
my $n = 0; |
|
3152
|
104
|
|
|
|
|
184
|
my $rest = $format; |
|
3153
|
104
|
|
|
|
|
252
|
while ( length $rest ) { |
|
3154
|
624
|
100
|
|
|
|
2038
|
if ( $rest =~ s/\A%(.)//s ) { |
|
|
|
50
|
|
|
|
|
|
|
3155
|
369
|
100
|
|
|
|
1110
|
my $f = $FAST_CODE{$1} or return undef; |
|
3156
|
314
|
50
|
|
|
|
631
|
return undef if exists $idx{ $f->[0] }; |
|
3157
|
314
|
|
|
|
|
581
|
$idx{ $f->[0] } = $n++; |
|
3158
|
314
|
|
|
|
|
683
|
$re .= '(' . $f->[1] . ')'; |
|
3159
|
|
|
|
|
|
|
} elsif ( $rest =~ s/\A([^%]+)//s ) { |
|
3160
|
255
|
|
|
|
|
590
|
$re .= quotemeta($1); |
|
3161
|
|
|
|
|
|
|
} else { |
|
3162
|
0
|
|
|
|
|
0
|
return undef; # lone trailing '%' -- not fast-eligible |
|
3163
|
|
|
|
|
|
|
} |
|
3164
|
|
|
|
|
|
|
} ## end while ( length $rest ) |
|
3165
|
49
|
100
|
|
|
|
167
|
return undef unless keys %idx == 6; |
|
3166
|
36
|
|
|
|
|
476
|
return { re => qr/\A$re\z/, idx => \%idx }; |
|
3167
|
|
|
|
|
|
|
} ## end sub _compile_fast_format |
|
3168
|
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
# A regex match only proves each fast-path field is digits of the right width, |
|
3170
|
|
|
|
|
|
|
# not that the six of them form a real timestamp: '2026-13-01T25:00:00' matches |
|
3171
|
|
|
|
|
|
|
# the shape. Fields out of range (month 13, hour 24, Feb 30) must not reach the |
|
3172
|
|
|
|
|
|
|
# blind integer date math -- they are routed to strptime instead, which stays |
|
3173
|
|
|
|
|
|
|
# the judge of whether such a stamp croaks or normalizes (Time::Piece rolls |
|
3174
|
|
|
|
|
|
|
# Feb 30 over into March), keeping the two paths value-identical. Seconds stop |
|
3175
|
|
|
|
|
|
|
# at 59: a :60 leap second is not representable in epoch math, so strptime |
|
3176
|
|
|
|
|
|
|
# arbitrates it too. |
|
3177
|
|
|
|
|
|
|
my @DAYS_IN_MONTH = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); |
|
3178
|
|
|
|
|
|
|
|
|
3179
|
|
|
|
|
|
|
sub _fast_fields_in_range { |
|
3180
|
156
|
|
|
156
|
|
236
|
my ( $c, $idx ) = @_; |
|
3181
|
156
|
|
|
|
|
201
|
my ( $y, $m, $d, $H, $M, $S ) = @{$c}[ @{$idx}{qw(year mon mday hour min sec)} ]; |
|
|
156
|
|
|
|
|
338
|
|
|
|
156
|
|
|
|
|
283
|
|
|
3182
|
156
|
100
|
100
|
|
|
498
|
return 0 if $m < 1 || $m > 12; |
|
3183
|
145
|
|
|
|
|
227
|
my $dim = $DAYS_IN_MONTH[ $m - 1 ]; |
|
3184
|
145
|
100
|
100
|
|
|
411
|
$dim = 29 if $m == 2 && ( ( !( $y % 4 ) && $y % 100 ) || !( $y % 400 ) ); |
|
|
|
|
100
|
|
|
|
|
|
3185
|
145
|
100
|
100
|
|
|
381
|
return 0 if $d < 1 || $d > $dim; |
|
3186
|
125
|
100
|
100
|
|
|
438
|
return 0 if $H > 23 || $M > 59 || $S > 59; |
|
|
|
|
66
|
|
|
|
|
|
3187
|
115
|
|
|
|
|
364
|
return 1; |
|
3188
|
|
|
|
|
|
|
} ## end sub _fast_fields_in_range |
|
3189
|
|
|
|
|
|
|
|
|
3190
|
|
|
|
|
|
|
# Days since 1970-01-01 for a proleptic-Gregorian date (Howard Hinnant's |
|
3191
|
|
|
|
|
|
|
# days-from-civil). Pure integer math; Perl's % already yields a non-negative |
|
3192
|
|
|
|
|
|
|
# result for the wday derivation even on pre-1970 dates. |
|
3193
|
|
|
|
|
|
|
sub _days_from_civil { |
|
3194
|
62
|
|
|
62
|
|
118
|
my ( $y, $m, $d ) = @_; |
|
3195
|
62
|
|
|
|
|
91
|
$y -= $m <= 2; |
|
3196
|
62
|
50
|
|
|
|
152
|
my $era = int( ( $y >= 0 ? $y : $y - 399 ) / 400 ); |
|
3197
|
62
|
|
|
|
|
82
|
my $yoe = $y - $era * 400; |
|
3198
|
62
|
100
|
|
|
|
133
|
my $doy = int( ( 153 * ( $m + ( $m > 2 ? -3 : 9 ) ) + 2 ) / 5 ) + $d - 1; |
|
3199
|
62
|
|
|
|
|
116
|
my $doe = $yoe * 365 + int( $yoe / 4 ) - int( $yoe / 100 ) + $doy; |
|
3200
|
62
|
|
|
|
|
216
|
return $era * 146097 + $doe - 719468; |
|
3201
|
|
|
|
|
|
|
} |
|
3202
|
|
|
|
|
|
|
|
|
3203
|
|
|
|
|
|
|
# part name => factory(\%idx) => getter(\@captures). Mirrors %DATETIME_PART; |
|
3204
|
|
|
|
|
|
|
# t/mungers-datetime-fast.t asserts the two stay value-identical. The factories |
|
3205
|
|
|
|
|
|
|
# bake the capture positions in at build time so a per-row getter indexes the |
|
3206
|
|
|
|
|
|
|
# raw capture array directly -- no intermediate hash per row, which is where |
|
3207
|
|
|
|
|
|
|
# the fast path's time would otherwise go. Slot 6 of the capture array caches |
|
3208
|
|
|
|
|
|
|
# days-from-civil so a multi-part (sin/cos) extraction computes it once. |
|
3209
|
|
|
|
|
|
|
my %DATETIME_PART_FAST; |
|
3210
|
|
|
|
|
|
|
{ |
|
3211
|
|
|
|
|
|
|
my $days_of = sub { |
|
3212
|
|
|
|
|
|
|
my ( $iy, $im, $id ) = @{ $_[0] }{qw(year mon mday)}; |
|
3213
|
|
|
|
|
|
|
return sub { |
|
3214
|
|
|
|
|
|
|
my $c = shift; |
|
3215
|
|
|
|
|
|
|
return defined $c->[6] |
|
3216
|
|
|
|
|
|
|
? $c->[6] |
|
3217
|
|
|
|
|
|
|
: ( $c->[6] = _days_from_civil( $c->[$iy], $c->[$im], $c->[$id] ) ); |
|
3218
|
|
|
|
|
|
|
}; |
|
3219
|
|
|
|
|
|
|
}; |
|
3220
|
|
|
|
|
|
|
my $sod_of = sub { |
|
3221
|
|
|
|
|
|
|
my ( $ih, $in, $is ) = @{ $_[0] }{qw(hour min sec)}; |
|
3222
|
|
|
|
|
|
|
return sub { $_[0][$ih] * 3600 + $_[0][$in] * 60 + $_[0][$is] }; |
|
3223
|
|
|
|
|
|
|
}; |
|
3224
|
|
|
|
|
|
|
my $frac_day_of = sub { |
|
3225
|
|
|
|
|
|
|
my $sod = $sod_of->( $_[0] ); |
|
3226
|
|
|
|
|
|
|
return sub { $sod->( $_[0] ) / 86400 }; |
|
3227
|
|
|
|
|
|
|
}; |
|
3228
|
|
|
|
|
|
|
my $frac_week_of = sub { |
|
3229
|
|
|
|
|
|
|
my ( $days, $sod ) = ( $days_of->( $_[0] ), $sod_of->( $_[0] ) ); |
|
3230
|
|
|
|
|
|
|
return sub { |
|
3231
|
|
|
|
|
|
|
my $c = shift; |
|
3232
|
|
|
|
|
|
|
return ( ( ( $days->($c) + 4 ) % 7 ) * 86400 + $sod->($c) ) / 604800; |
|
3233
|
|
|
|
|
|
|
}; |
|
3234
|
|
|
|
|
|
|
}; |
|
3235
|
|
|
|
|
|
|
my $field_of = sub { |
|
3236
|
|
|
|
|
|
|
my ($name) = @_; |
|
3237
|
|
|
|
|
|
|
return sub { |
|
3238
|
|
|
|
|
|
|
my $i = $_[0]{$name}; |
|
3239
|
|
|
|
|
|
|
return sub { $_[0][$i] + 0 } |
|
3240
|
|
|
|
|
|
|
}; |
|
3241
|
|
|
|
|
|
|
}; |
|
3242
|
|
|
|
|
|
|
|
|
3243
|
|
|
|
|
|
|
%DATETIME_PART_FAST = ( |
|
3244
|
|
|
|
|
|
|
year => $field_of->('year'), |
|
3245
|
|
|
|
|
|
|
mon => $field_of->('mon'), |
|
3246
|
|
|
|
|
|
|
mday => $field_of->('mday'), |
|
3247
|
|
|
|
|
|
|
hour => $field_of->('hour'), |
|
3248
|
|
|
|
|
|
|
min => $field_of->('min'), |
|
3249
|
|
|
|
|
|
|
sec => $field_of->('sec'), |
|
3250
|
|
|
|
|
|
|
epoch => sub { |
|
3251
|
|
|
|
|
|
|
my ( $days, $sod ) = ( $days_of->( $_[0] ), $sod_of->( $_[0] ) ); |
|
3252
|
|
|
|
|
|
|
return sub { $days->( $_[0] ) * 86400 + $sod->( $_[0] ) }; |
|
3253
|
|
|
|
|
|
|
}, |
|
3254
|
|
|
|
|
|
|
wday => sub { # epoch day 0 = Thursday = 4 |
|
3255
|
|
|
|
|
|
|
my $days = $days_of->( $_[0] ); |
|
3256
|
|
|
|
|
|
|
return sub { ( $days->( $_[0] ) + 4 ) % 7 }; |
|
3257
|
|
|
|
|
|
|
}, |
|
3258
|
|
|
|
|
|
|
yday => sub { |
|
3259
|
|
|
|
|
|
|
my ($idx) = @_; |
|
3260
|
|
|
|
|
|
|
my $days = $days_of->($idx); |
|
3261
|
|
|
|
|
|
|
my $iy = $idx->{year}; |
|
3262
|
|
|
|
|
|
|
return sub { |
|
3263
|
|
|
|
|
|
|
my $c = shift; |
|
3264
|
|
|
|
|
|
|
return $days->($c) - _days_from_civil( $c->[$iy], 1, 1 ); |
|
3265
|
|
|
|
|
|
|
}; |
|
3266
|
|
|
|
|
|
|
}, |
|
3267
|
|
|
|
|
|
|
frac_day => $frac_day_of, |
|
3268
|
|
|
|
|
|
|
frac_week => $frac_week_of, |
|
3269
|
|
|
|
|
|
|
sin_day => sub { |
|
3270
|
|
|
|
|
|
|
my $f = $frac_day_of->( $_[0] ); |
|
3271
|
|
|
|
|
|
|
return sub { sin( $TWO_PI * $f->( $_[0] ) ) }; |
|
3272
|
|
|
|
|
|
|
}, |
|
3273
|
|
|
|
|
|
|
cos_day => sub { |
|
3274
|
|
|
|
|
|
|
my $f = $frac_day_of->( $_[0] ); |
|
3275
|
|
|
|
|
|
|
return sub { cos( $TWO_PI * $f->( $_[0] ) ) }; |
|
3276
|
|
|
|
|
|
|
}, |
|
3277
|
|
|
|
|
|
|
sin_week => sub { |
|
3278
|
|
|
|
|
|
|
my $f = $frac_week_of->( $_[0] ); |
|
3279
|
|
|
|
|
|
|
return sub { sin( $TWO_PI * $f->( $_[0] ) ) }; |
|
3280
|
|
|
|
|
|
|
}, |
|
3281
|
|
|
|
|
|
|
cos_week => sub { |
|
3282
|
|
|
|
|
|
|
my $f = $frac_week_of->( $_[0] ); |
|
3283
|
|
|
|
|
|
|
return sub { cos( $TWO_PI * $f->( $_[0] ) ) }; |
|
3284
|
|
|
|
|
|
|
}, |
|
3285
|
|
|
|
|
|
|
); |
|
3286
|
|
|
|
|
|
|
} |
|
3287
|
|
|
|
|
|
|
|
|
3288
|
|
|
|
|
|
|
# Build the parse/getter machinery for a datetime spec: ($parse, $getter_for), |
|
3289
|
|
|
|
|
|
|
# where $parse->($v) yields whatever the getters consume (a capture array on |
|
3290
|
|
|
|
|
|
|
# the fast path, a Time::Piece object otherwise) and $getter_for->($part) |
|
3291
|
|
|
|
|
|
|
# resolves a part name to a getter closure, croaking on an unknown part. |
|
3292
|
|
|
|
|
|
|
# Shared by the scalar and multi-output builders so the choice is made in |
|
3293
|
|
|
|
|
|
|
# exactly one place. |
|
3294
|
|
|
|
|
|
|
sub _datetime_engine { |
|
3295
|
91
|
|
|
91
|
|
177
|
my ( $format, $where ) = @_; |
|
3296
|
91
|
50
|
33
|
|
|
298
|
croak "datetime munger$where requires a strptime 'format'" |
|
3297
|
|
|
|
|
|
|
unless defined $format && length $format; |
|
3298
|
|
|
|
|
|
|
|
|
3299
|
|
|
|
|
|
|
# Time::Piece is not core on the ancient perls Makefile.PL still nominally |
|
3300
|
|
|
|
|
|
|
# supports, so only pull it in for the one munger that needs it. The fast |
|
3301
|
|
|
|
|
|
|
# path keeps it loaded too: a regex mismatch falls back to strptime so the |
|
3302
|
|
|
|
|
|
|
# fast path can never reject a value the slow path would have accepted. |
|
3303
|
91
|
|
|
|
|
1095
|
require Time::Piece; |
|
3304
|
|
|
|
|
|
|
|
|
3305
|
|
|
|
|
|
|
my $strptime = sub { |
|
3306
|
98
|
|
|
98
|
|
160
|
my ($v) = @_; |
|
3307
|
98
|
|
|
|
|
143
|
my $t = eval { Time::Piece->strptime( $v, $format ) }; |
|
|
98
|
|
|
|
|
301
|
|
|
3308
|
98
|
100
|
|
|
|
5541
|
croak "datetime munger$where: cannot parse '$v' with '$format'" |
|
3309
|
|
|
|
|
|
|
unless $t; |
|
3310
|
75
|
|
|
|
|
4862
|
return $t; |
|
3311
|
91
|
|
|
|
|
9912
|
}; |
|
3312
|
|
|
|
|
|
|
|
|
3313
|
91
|
100
|
|
|
|
247
|
if ( my $fast = _compile_fast_format($format) ) { |
|
3314
|
36
|
|
|
|
|
57
|
my ( $re, $idx ) = @{$fast}{qw(re idx)}; |
|
|
36
|
|
|
|
|
83
|
|
|
3315
|
|
|
|
|
|
|
my $parse = sub { |
|
3316
|
158
|
|
|
158
|
|
204
|
my ($v) = @_; |
|
3317
|
158
|
50
|
|
|
|
243
|
croak "datetime munger$where: undefined value" unless defined $v; |
|
3318
|
158
|
100
|
|
|
|
1539
|
if ( my @c = $v =~ $re ) { |
|
3319
|
156
|
100
|
|
|
|
346
|
return \@c if _fast_fields_in_range( \@c, $idx ); |
|
3320
|
|
|
|
|
|
|
} |
|
3321
|
|
|
|
|
|
|
# Regex mismatch or out-of-range fields: let strptime be the judge, |
|
3322
|
|
|
|
|
|
|
# rebuilding the capture array (normalized, when strptime chooses |
|
3323
|
|
|
|
|
|
|
# to normalize rather than reject) in this format's capture order. |
|
3324
|
43
|
|
|
|
|
75
|
my $t = $strptime->($v); |
|
3325
|
21
|
|
|
|
|
65
|
my @c; |
|
3326
|
21
|
|
|
|
|
41
|
@c[ @{$idx}{qw(year mon mday hour min sec)} ] |
|
|
21
|
|
|
|
|
294
|
|
|
3327
|
|
|
|
|
|
|
= ( $t->year, $t->mon, $t->mday, $t->hour, $t->min, $t->sec ); |
|
3328
|
21
|
|
|
|
|
65
|
return \@c; |
|
3329
|
36
|
|
|
|
|
171
|
}; ## end $parse = sub |
|
3330
|
|
|
|
|
|
|
my $getter_for = sub { |
|
3331
|
40
|
|
|
40
|
|
58
|
my ($part) = @_; |
|
3332
|
40
|
50
|
|
|
|
142
|
my $factory = $DATETIME_PART_FAST{$part} |
|
3333
|
|
|
|
|
|
|
or croak "datetime munger$where: unknown part '$part' (known: " |
|
3334
|
|
|
|
|
|
|
. join( ', ', sort keys %DATETIME_PART ) . ')'; |
|
3335
|
40
|
|
|
|
|
85
|
return $factory->($idx); |
|
3336
|
36
|
|
|
|
|
89
|
}; |
|
3337
|
36
|
|
|
|
|
127
|
return ( $parse, $getter_for ); |
|
3338
|
|
|
|
|
|
|
} ## end if ( my $fast = _compile_fast_format($format...)) |
|
3339
|
|
|
|
|
|
|
|
|
3340
|
|
|
|
|
|
|
my $parse = sub { |
|
3341
|
56
|
|
|
56
|
|
95
|
my ($v) = @_; |
|
3342
|
56
|
100
|
|
|
|
236
|
croak "datetime munger$where: undefined value" unless defined $v; |
|
3343
|
55
|
|
|
|
|
113
|
return $strptime->($v); |
|
3344
|
55
|
|
|
|
|
229
|
}; |
|
3345
|
|
|
|
|
|
|
my $getter_for = sub { |
|
3346
|
56
|
|
|
56
|
|
113
|
my ($part) = @_; |
|
3347
|
56
|
50
|
|
|
|
152
|
my $get = $DATETIME_PART{$part} |
|
3348
|
|
|
|
|
|
|
or croak "datetime munger$where: unknown part '$part' (known: " |
|
3349
|
|
|
|
|
|
|
. join( ', ', sort keys %DATETIME_PART ) . ')'; |
|
3350
|
56
|
|
|
|
|
104
|
return $get; |
|
3351
|
55
|
|
|
|
|
173
|
}; |
|
3352
|
55
|
|
|
|
|
179
|
return ( $parse, $getter_for ); |
|
3353
|
|
|
|
|
|
|
} ## end sub _datetime_engine |
|
3354
|
|
|
|
|
|
|
|
|
3355
|
|
|
|
|
|
|
sub _build_datetime { |
|
3356
|
85
|
|
|
85
|
|
220
|
my ( $spec, $where ) = @_; |
|
3357
|
|
|
|
|
|
|
|
|
3358
|
|
|
|
|
|
|
croak "datetime munger$where: 'parts' is for the multi-output form (needs " |
|
3359
|
|
|
|
|
|
|
. "'into'); use 'part' for a single column" |
|
3360
|
85
|
100
|
|
|
|
396
|
if defined $spec->{parts}; |
|
3361
|
|
|
|
|
|
|
|
|
3362
|
84
|
|
|
|
|
190
|
my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where ); |
|
3363
|
84
|
50
|
|
|
|
274
|
my $get = $getter_for->( defined $spec->{part} ? $spec->{part} : 'epoch' ); |
|
3364
|
|
|
|
|
|
|
|
|
3365
|
|
|
|
|
|
|
# One-slot memo: event streams repeat the same stamp within a second |
|
3366
|
|
|
|
|
|
|
# constantly, so the previous input usually answers the next call with a |
|
3367
|
|
|
|
|
|
|
# string compare. A parse failure leaves the memo untouched. |
|
3368
|
84
|
|
|
|
|
138
|
my ( $memo_in, $memo_out ); |
|
3369
|
|
|
|
|
|
|
return sub { |
|
3370
|
251
|
|
|
251
|
|
77911
|
my ($v) = @_; |
|
3371
|
251
|
100
|
100
|
|
|
1329
|
return $memo_out |
|
|
|
|
100
|
|
|
|
|
|
3372
|
|
|
|
|
|
|
if defined $v && defined $memo_in && $v eq $memo_in; |
|
3373
|
209
|
|
|
|
|
375
|
my $out = $get->( $parse->($v) ); |
|
3374
|
185
|
|
|
|
|
613
|
( $memo_in, $memo_out ) = ( $v, $out ); |
|
3375
|
185
|
|
|
|
|
459
|
return $out; |
|
3376
|
84
|
|
|
|
|
671
|
}; |
|
3377
|
|
|
|
|
|
|
} ## end sub _build_datetime |
|
3378
|
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
# Multi-output datetime: parse once, emit one number per part, in 'parts' order |
|
3380
|
|
|
|
|
|
|
# (which lines up with the caller's 'into'). Returns ($list_returning_code, |
|
3381
|
|
|
|
|
|
|
# $arity) so compile() can check the arity against 'into'. Memoized like the |
|
3382
|
|
|
|
|
|
|
# scalar form, caching the whole output list per input stamp. |
|
3383
|
|
|
|
|
|
|
sub _build_datetime_multi { |
|
3384
|
7
|
|
|
7
|
|
18
|
my ( $spec, $where ) = @_; |
|
3385
|
|
|
|
|
|
|
|
|
3386
|
7
|
|
|
|
|
41
|
my $parts = $spec->{parts}; |
|
3387
|
7
|
50
|
33
|
|
|
33
|
croak "datetime munger$where: 'parts' must be a non-empty arrayref" |
|
3388
|
|
|
|
|
|
|
unless ref $parts eq 'ARRAY' && @$parts; |
|
3389
|
|
|
|
|
|
|
|
|
3390
|
7
|
|
|
|
|
24
|
my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where ); |
|
3391
|
7
|
|
|
|
|
15
|
my @get = map { $getter_for->($_) } @$parts; |
|
|
12
|
|
|
|
|
22
|
|
|
3392
|
|
|
|
|
|
|
|
|
3393
|
7
|
|
|
|
|
26
|
my ( $memo_in, @memo_out ); |
|
3394
|
|
|
|
|
|
|
my $code = sub { |
|
3395
|
7
|
|
|
7
|
|
10
|
my ($v) = @_; |
|
3396
|
|
|
|
|
|
|
return @memo_out |
|
3397
|
7
|
100
|
66
|
|
|
43
|
if defined $v && defined $memo_in && $v eq $memo_in; |
|
|
|
|
100
|
|
|
|
|
|
3398
|
5
|
|
|
|
|
8
|
my $t = $parse->($v); |
|
3399
|
5
|
|
|
|
|
11
|
my @out = map { $_->($t) } @get; |
|
|
10
|
|
|
|
|
36
|
|
|
3400
|
5
|
|
|
|
|
19
|
( $memo_in, @memo_out ) = ( $v, @out ); |
|
3401
|
5
|
|
|
|
|
24
|
return @out; |
|
3402
|
7
|
|
|
|
|
34
|
}; |
|
3403
|
7
|
|
|
|
|
50
|
return ( $code, scalar @$parts ); |
|
3404
|
|
|
|
|
|
|
} ## end sub _build_datetime_multi |
|
3405
|
|
|
|
|
|
|
|
|
3406
|
|
|
|
|
|
|
=head2 hash |
|
3407
|
|
|
|
|
|
|
|
|
3408
|
|
|
|
|
|
|
{ munger => 'hash', buckets => 1024 } |
|
3409
|
|
|
|
|
|
|
{ munger => 'hash', buckets => 1024, seed => 7 } |
|
3410
|
|
|
|
|
|
|
{ munger => 'hash' } # raw 32-bit FNV-1a value |
|
3411
|
|
|
|
|
|
|
|
|
3412
|
|
|
|
|
|
|
Feature hashing for high-cardinality categoricals you do not want to (or cannot) |
|
3413
|
|
|
|
|
|
|
enumerate with C. The input is stringified and run through 32-bit FNV-1a; |
|
3414
|
|
|
|
|
|
|
with C the result is reduced modulo that many buckets (C<[0, buckets)>), |
|
3415
|
|
|
|
|
|
|
otherwise the full 32-bit hash is returned. An optional C lets you decorrelate |
|
3416
|
|
|
|
|
|
|
two hashed columns. |
|
3417
|
|
|
|
|
|
|
|
|
3418
|
|
|
|
|
|
|
This is the one munger that is XS-accelerated: FNV-1a is a per-byte loop with a |
|
3419
|
|
|
|
|
|
|
32-bit modular multiply, which is slow in pure Perl and (on a 32-bit perl) fussy |
|
3420
|
|
|
|
|
|
|
to get exactly right. C<$Algorithm::ToNumberMunger::HAVE_XS> |
|
3421
|
|
|
|
|
|
|
reports whether the compiled path is in use; a pure-Perl fallback (exact on a |
|
3422
|
|
|
|
|
|
|
64-bit perl) is used otherwise, and both produce identical values. |
|
3423
|
|
|
|
|
|
|
|
|
3424
|
|
|
|
|
|
|
=cut |
|
3425
|
|
|
|
|
|
|
|
|
3426
|
|
|
|
|
|
|
sub _build_hash { |
|
3427
|
5
|
|
|
5
|
|
13
|
my ( $spec, $where ) = @_; |
|
3428
|
|
|
|
|
|
|
|
|
3429
|
5
|
|
|
|
|
13
|
my $buckets = $spec->{buckets}; |
|
3430
|
5
|
100
|
100
|
|
|
283
|
croak "hash munger$where: 'buckets' must be a positive integer" |
|
3431
|
|
|
|
|
|
|
if defined $buckets && $buckets !~ /\A[1-9][0-9]*\z/; |
|
3432
|
|
|
|
|
|
|
|
|
3433
|
4
|
100
|
|
|
|
12
|
my $seed = defined $spec->{seed} ? $spec->{seed} : 0; |
|
3434
|
4
|
50
|
|
|
|
23
|
croak "hash munger$where: 'seed' must be a non-negative integer" |
|
3435
|
|
|
|
|
|
|
if $seed !~ /\A[0-9]+\z/; |
|
3436
|
|
|
|
|
|
|
|
|
3437
|
4
|
50
|
|
|
|
14
|
my $fn = $HAVE_XS ? \&_fnv1a_xs : \&_fnv1a_pp; |
|
3438
|
|
|
|
|
|
|
return sub { |
|
3439
|
7
|
|
|
7
|
|
31
|
my ($v) = @_; |
|
3440
|
7
|
50
|
|
|
|
78
|
my $h = $fn->( defined $v ? "$v" : '', $seed ); |
|
3441
|
7
|
100
|
|
|
|
46
|
return defined $buckets ? $h % $buckets : $h; |
|
3442
|
4
|
|
|
|
|
30
|
}; |
|
3443
|
|
|
|
|
|
|
} ## end sub _build_hash |
|
3444
|
|
|
|
|
|
|
|
|
3445
|
|
|
|
|
|
|
# Pure-Perl 32-bit FNV-1a, used only when the XS did not build. On a 64-bit |
|
3446
|
|
|
|
|
|
|
# perl the intermediate h*16777619 (< 2**57) stays an exact integer, so the |
|
3447
|
|
|
|
|
|
|
# masked result matches the C version bit for bit. The string is always |
|
3448
|
|
|
|
|
|
|
# utf8-encoded first so a value hashes as its UTF-8 bytes no matter the internal |
|
3449
|
|
|
|
|
|
|
# flag -- the same well-defined bytes SvPVutf8 hands the XS. |
|
3450
|
|
|
|
|
|
|
sub _fnv1a_pp { |
|
3451
|
0
|
|
|
0
|
|
0
|
my ( $str, $seed ) = @_; |
|
3452
|
0
|
|
|
|
|
0
|
utf8::encode($str); |
|
3453
|
0
|
|
|
|
|
0
|
my $h = ( 2166136261 ^ ( $seed & 0xFFFFFFFF ) ) & 0xFFFFFFFF; |
|
3454
|
0
|
|
|
|
|
0
|
for my $c ( unpack 'C*', $str ) { |
|
3455
|
0
|
|
|
|
|
0
|
$h ^= $c; |
|
3456
|
0
|
|
|
|
|
0
|
$h = ( $h * 16777619 ) & 0xFFFFFFFF; |
|
3457
|
|
|
|
|
|
|
} |
|
3458
|
0
|
|
|
|
|
0
|
return $h; |
|
3459
|
|
|
|
|
|
|
} ## end sub _fnv1a_pp |
|
3460
|
|
|
|
|
|
|
|
|
3461
|
|
|
|
|
|
|
=head2 chain |
|
3462
|
|
|
|
|
|
|
|
|
3463
|
|
|
|
|
|
|
# Shannon entropy of just the TLD: lowercase, keep the last dot-label |
|
3464
|
|
|
|
|
|
|
{ munger => 'chain', |
|
3465
|
|
|
|
|
|
|
steps => [ { op => 'lc' }, { op => 'split', on => '.', index => -1 } ], |
|
3466
|
|
|
|
|
|
|
then => { munger => 'entropy' } } |
|
3467
|
|
|
|
|
|
|
|
|
3468
|
|
|
|
|
|
|
# a hex request id buried in a token like 'req-0x2F' |
|
3469
|
|
|
|
|
|
|
{ munger => 'chain', |
|
3470
|
|
|
|
|
|
|
steps => [ { op => 'capture', pattern => 'req-(0x[0-9a-fA-F]+)' } ], |
|
3471
|
|
|
|
|
|
|
then => { munger => 'num', base => 16 } } |
|
3472
|
|
|
|
|
|
|
|
|
3473
|
|
|
|
|
|
|
Run the input through a list of string pre-transforms (C, applied in |
|
3474
|
|
|
|
|
|
|
order), then hand the result to a terminal munger (C) for the actual |
|
3475
|
|
|
|
|
|
|
number. Every string munger above scores the I value; C is how a |
|
3476
|
|
|
|
|
|
|
feature targets a I of it -- the entropy of the TLD alone, the length |
|
3477
|
|
|
|
|
|
|
of the first path segment, an enum over a normalized token -- without asking |
|
3478
|
|
|
|
|
|
|
the writer's caller to pre-slice its input. Each step is a hashref with an |
|
3479
|
|
|
|
|
|
|
C: |
|
3480
|
|
|
|
|
|
|
|
|
3481
|
|
|
|
|
|
|
=over 4 |
|
3482
|
|
|
|
|
|
|
|
|
3483
|
|
|
|
|
|
|
=item * C / C - case-fold the value. |
|
3484
|
|
|
|
|
|
|
|
|
3485
|
|
|
|
|
|
|
=item * C - strip leading and trailing whitespace. |
|
3486
|
|
|
|
|
|
|
|
|
3487
|
|
|
|
|
|
|
=item * C - split on the literal separator C and keep piece |
|
3488
|
|
|
|
|
|
|
C (0-based; negative counts from the end, so C<-1> is a hostname's last |
|
3489
|
|
|
|
|
|
|
label). An index past either end yields the empty string. |
|
3490
|
|
|
|
|
|
|
|
|
3491
|
|
|
|
|
|
|
=item * C - match the regex C and keep capture group |
|
3492
|
|
|
|
|
|
|
C (default C<1>). No match, or a group that did not participate, yields |
|
3493
|
|
|
|
|
|
|
the empty string. A true C matches case-insensitively; the |
|
3494
|
|
|
|
|
|
|
L trust note applies here too. |
|
3495
|
|
|
|
|
|
|
|
|
3496
|
|
|
|
|
|
|
=item * C - replace every match of the regex C with the |
|
3497
|
|
|
|
|
|
|
literal string C (default: delete the matches). C as above. |
|
3498
|
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
=back |
|
3500
|
|
|
|
|
|
|
|
|
3501
|
|
|
|
|
|
|
C is a full munger spec and may be any built-in that takes one value -- |
|
3502
|
|
|
|
|
|
|
including another C. All step parameters and the terminal spec are |
|
3503
|
|
|
|
|
|
|
validated at build time. An undef input enters the chain as the empty string; |
|
3504
|
|
|
|
|
|
|
whether an empty result is acceptable is the terminal's call (C and |
|
3505
|
|
|
|
|
|
|
C score it C<0>, C croaks). |
|
3506
|
|
|
|
|
|
|
|
|
3507
|
|
|
|
|
|
|
The multi-output form works too: put C on the B and the C |
|
3508
|
|
|
|
|
|
|
on the terminal, e.g. C a sloppy timestamp before a L |
|
3509
|
|
|
|
|
|
|
C/C expansion. |
|
3510
|
|
|
|
|
|
|
|
|
3511
|
|
|
|
|
|
|
=cut |
|
3512
|
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
# op => step builder; each validates its slice of the step spec at build time |
|
3514
|
|
|
|
|
|
|
# and returns a string-to-string closure. Steps only ever see a defined string |
|
3515
|
|
|
|
|
|
|
# (the chain entry point turns undef into ''). |
|
3516
|
|
|
|
|
|
|
my %CHAIN_OPS = ( |
|
3517
|
|
|
|
|
|
|
lc => sub { |
|
3518
|
|
|
|
|
|
|
return sub { return lc $_[0] } |
|
3519
|
|
|
|
|
|
|
}, |
|
3520
|
|
|
|
|
|
|
uc => sub { |
|
3521
|
|
|
|
|
|
|
return sub { return uc $_[0] } |
|
3522
|
|
|
|
|
|
|
}, |
|
3523
|
|
|
|
|
|
|
trim => sub { |
|
3524
|
|
|
|
|
|
|
return sub { my ($s) = @_; $s =~ s/\A\s+//; $s =~ s/\s+\z//; return $s }; |
|
3525
|
|
|
|
|
|
|
}, |
|
3526
|
|
|
|
|
|
|
split => sub { |
|
3527
|
|
|
|
|
|
|
my ( $step, $where ) = @_; |
|
3528
|
|
|
|
|
|
|
my $on = $step->{on}; |
|
3529
|
|
|
|
|
|
|
croak "chain munger$where: split step requires a non-empty 'on' string" |
|
3530
|
|
|
|
|
|
|
unless defined $on && length $on; |
|
3531
|
|
|
|
|
|
|
my $idx = defined $step->{index} ? $step->{index} : 0; |
|
3532
|
|
|
|
|
|
|
croak "chain munger$where: split 'index' must be an integer" |
|
3533
|
|
|
|
|
|
|
unless $idx =~ /\A-?[0-9]+\z/; |
|
3534
|
|
|
|
|
|
|
# limit -1 keeps trailing empty pieces, so 'a.' really has two labels |
|
3535
|
|
|
|
|
|
|
# and index -1 is the empty last one, not 'a'. |
|
3536
|
|
|
|
|
|
|
return sub { |
|
3537
|
|
|
|
|
|
|
my @p = split /\Q$on\E/, $_[0], -1; |
|
3538
|
|
|
|
|
|
|
return ( $idx > $#p || $idx < -@p ) ? '' : $p[$idx]; |
|
3539
|
|
|
|
|
|
|
}; |
|
3540
|
|
|
|
|
|
|
}, |
|
3541
|
|
|
|
|
|
|
capture => sub { |
|
3542
|
|
|
|
|
|
|
my ( $step, $where ) = @_; |
|
3543
|
|
|
|
|
|
|
my $pat = $step->{pattern}; |
|
3544
|
|
|
|
|
|
|
croak "chain munger$where: capture step requires a non-empty 'pattern'" |
|
3545
|
|
|
|
|
|
|
unless defined $pat && length $pat; |
|
3546
|
|
|
|
|
|
|
my $re = eval { $step->{ignore_case} ? qr/$pat/i : qr/$pat/ }; |
|
3547
|
|
|
|
|
|
|
croak "chain munger$where: cannot compile pattern '$pat': $@" |
|
3548
|
|
|
|
|
|
|
unless defined $re; |
|
3549
|
|
|
|
|
|
|
my $group = defined $step->{group} ? $step->{group} : 1; |
|
3550
|
|
|
|
|
|
|
croak "chain munger$where: capture 'group' must be a positive integer" |
|
3551
|
|
|
|
|
|
|
unless $group =~ /\A[1-9][0-9]*\z/; |
|
3552
|
|
|
|
|
|
|
# @-/@+ rather than a list-context match: a pattern with no capture |
|
3553
|
|
|
|
|
|
|
# groups returns (1) in list context, which would masquerade as a |
|
3554
|
|
|
|
|
|
|
# captured '1'; $#+ says how many groups the pattern really has. |
|
3555
|
|
|
|
|
|
|
return sub { |
|
3556
|
|
|
|
|
|
|
my ($s) = @_; |
|
3557
|
|
|
|
|
|
|
return '' unless $s =~ $re; |
|
3558
|
|
|
|
|
|
|
return '' unless $group <= $#+ && defined $-[$group]; |
|
3559
|
|
|
|
|
|
|
return substr( $s, $-[$group], $+[$group] - $-[$group] ); |
|
3560
|
|
|
|
|
|
|
}; |
|
3561
|
|
|
|
|
|
|
}, |
|
3562
|
|
|
|
|
|
|
replace => sub { |
|
3563
|
|
|
|
|
|
|
my ( $step, $where ) = @_; |
|
3564
|
|
|
|
|
|
|
my $pat = $step->{pattern}; |
|
3565
|
|
|
|
|
|
|
croak "chain munger$where: replace step requires a non-empty 'pattern'" |
|
3566
|
|
|
|
|
|
|
unless defined $pat && length $pat; |
|
3567
|
|
|
|
|
|
|
my $re = eval { $step->{ignore_case} ? qr/$pat/i : qr/$pat/ }; |
|
3568
|
|
|
|
|
|
|
croak "chain munger$where: cannot compile pattern '$pat': $@" |
|
3569
|
|
|
|
|
|
|
unless defined $re; |
|
3570
|
|
|
|
|
|
|
my $with = defined $step->{with} ? $step->{with} : ''; |
|
3571
|
|
|
|
|
|
|
return sub { my ($s) = @_; $s =~ s/$re/$with/g; return $s }; |
|
3572
|
|
|
|
|
|
|
}, |
|
3573
|
|
|
|
|
|
|
); |
|
3574
|
|
|
|
|
|
|
|
|
3575
|
|
|
|
|
|
|
# Compile the 'steps' list into string-to-string closures; shared by the |
|
3576
|
|
|
|
|
|
|
# scalar and multi-output chain builders. |
|
3577
|
|
|
|
|
|
|
sub _chain_steps { |
|
3578
|
18
|
|
|
18
|
|
38
|
my ( $spec, $where ) = @_; |
|
3579
|
|
|
|
|
|
|
|
|
3580
|
18
|
|
|
|
|
39
|
my $steps = $spec->{steps}; |
|
3581
|
18
|
100
|
66
|
|
|
308
|
croak "chain munger$where requires a non-empty 'steps' arrayref" |
|
3582
|
|
|
|
|
|
|
unless ref $steps eq 'ARRAY' && @$steps; |
|
3583
|
|
|
|
|
|
|
|
|
3584
|
17
|
|
|
|
|
60
|
my @ops; |
|
3585
|
17
|
|
|
|
|
62
|
for my $i ( 0 .. $#$steps ) { |
|
3586
|
20
|
|
|
|
|
43
|
my $step = $steps->[$i]; |
|
3587
|
20
|
50
|
|
|
|
57
|
croak "chain munger$where: step[$i] must be a hashref" |
|
3588
|
|
|
|
|
|
|
unless ref $step eq 'HASH'; |
|
3589
|
20
|
|
|
|
|
41
|
my $op = $step->{op}; |
|
3590
|
20
|
50
|
33
|
|
|
86
|
croak "chain munger$where: step[$i] has no 'op'" |
|
3591
|
|
|
|
|
|
|
unless defined $op && length $op; |
|
3592
|
20
|
100
|
|
|
|
230
|
my $mk = $CHAIN_OPS{$op} |
|
3593
|
|
|
|
|
|
|
or croak "chain munger$where: step[$i] has unknown op '$op' (known: " |
|
3594
|
|
|
|
|
|
|
. join( ', ', sort keys %CHAIN_OPS ) . ')'; |
|
3595
|
19
|
|
|
|
|
48
|
push @ops, $mk->( $step, $where ); |
|
3596
|
|
|
|
|
|
|
} ## end for my $i ( 0 .. $#$steps ) |
|
3597
|
14
|
|
|
|
|
40
|
return \@ops; |
|
3598
|
|
|
|
|
|
|
} ## end sub _chain_steps |
|
3599
|
|
|
|
|
|
|
|
|
3600
|
|
|
|
|
|
|
# Validate and unpack the terminal spec; shared like _chain_steps. |
|
3601
|
|
|
|
|
|
|
sub _chain_terminal_spec { |
|
3602
|
14
|
|
|
14
|
|
31
|
my ( $spec, $where ) = @_; |
|
3603
|
14
|
|
|
|
|
31
|
my $then = $spec->{then}; |
|
3604
|
14
|
100
|
|
|
|
200
|
croak "chain munger$where requires a 'then' hashref -- the terminal munger that produces the number" |
|
3605
|
|
|
|
|
|
|
unless ref $then eq 'HASH'; |
|
3606
|
13
|
|
|
|
|
28
|
my $name = $then->{munger}; |
|
3607
|
13
|
50
|
33
|
|
|
76
|
croak "chain munger$where: 'then' has no 'munger' name" |
|
3608
|
|
|
|
|
|
|
unless defined $name && length $name; |
|
3609
|
13
|
|
|
|
|
41
|
return ( $then, $name ); |
|
3610
|
|
|
|
|
|
|
} ## end sub _chain_terminal_spec |
|
3611
|
|
|
|
|
|
|
|
|
3612
|
|
|
|
|
|
|
sub _build_chain { |
|
3613
|
16
|
|
|
16
|
|
42
|
my ( $spec, $where ) = @_; |
|
3614
|
|
|
|
|
|
|
|
|
3615
|
16
|
|
|
|
|
43
|
my $ops = _chain_steps( $spec, $where ); |
|
3616
|
12
|
|
|
|
|
35
|
my ( $then, $name ) = _chain_terminal_spec( $spec, $where ); |
|
3617
|
11
|
100
|
|
|
|
288
|
my $builder = $BUILDERS{$name} |
|
3618
|
|
|
|
|
|
|
or croak "chain munger$where: unknown terminal munger '$name' (known: " |
|
3619
|
|
|
|
|
|
|
. join( ', ', sort keys %BUILDERS ) . ')'; |
|
3620
|
10
|
|
|
|
|
46
|
my $term = $builder->( $then, "$where (chain terminal)" ); |
|
3621
|
|
|
|
|
|
|
|
|
3622
|
|
|
|
|
|
|
return sub { |
|
3623
|
11
|
100
|
|
11
|
|
85
|
my $s = defined $_[0] ? "$_[0]" : ''; |
|
3624
|
11
|
|
|
|
|
37
|
$s = $_->($s) for @$ops; |
|
3625
|
11
|
|
|
|
|
24
|
return $term->($s); |
|
3626
|
9
|
|
|
|
|
57
|
}; |
|
3627
|
|
|
|
|
|
|
} ## end sub _build_chain |
|
3628
|
|
|
|
|
|
|
|
|
3629
|
|
|
|
|
|
|
# Multi-output chain: the same pre-transforms, but the terminal is one of the |
|
3630
|
|
|
|
|
|
|
# multi-output ('into') mungers. Returns ($list_returning_code, $arity) like |
|
3631
|
|
|
|
|
|
|
# every multi builder; the arity is the terminal's. |
|
3632
|
|
|
|
|
|
|
sub _build_chain_multi { |
|
3633
|
2
|
|
|
2
|
|
6
|
my ( $spec, $where ) = @_; |
|
3634
|
|
|
|
|
|
|
|
|
3635
|
2
|
|
|
|
|
8
|
my $ops = _chain_steps( $spec, $where ); |
|
3636
|
2
|
|
|
|
|
8
|
my ( $then, $name ) = _chain_terminal_spec( $spec, $where ); |
|
3637
|
2
|
100
|
|
|
|
204
|
my $builder = $MULTI_BUILDERS{$name} |
|
3638
|
|
|
|
|
|
|
or croak "chain munger$where: terminal munger '$name' does not support " |
|
3639
|
|
|
|
|
|
|
. "multiple outputs ('into'); only these do: " |
|
3640
|
|
|
|
|
|
|
. join( ', ', sort keys %MULTI_BUILDERS ); |
|
3641
|
1
|
|
|
|
|
5
|
my ( $term, $arity ) = $builder->( $then, "$where (chain terminal)" ); |
|
3642
|
|
|
|
|
|
|
|
|
3643
|
|
|
|
|
|
|
my $code = sub { |
|
3644
|
1
|
50
|
|
1
|
|
17
|
my $s = defined $_[0] ? "$_[0]" : ''; |
|
3645
|
1
|
|
|
|
|
3
|
$s = $_->($s) for @$ops; |
|
3646
|
1
|
|
|
|
|
3
|
return $term->($s); |
|
3647
|
1
|
|
|
|
|
4
|
}; |
|
3648
|
1
|
|
|
|
|
4
|
return ( $code, $arity ); |
|
3649
|
|
|
|
|
|
|
} ## end sub _build_chain_multi |
|
3650
|
|
|
|
|
|
|
|
|
3651
|
|
|
|
|
|
|
=head2 eps |
|
3652
|
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip' } |
|
3654
|
|
|
|
|
|
|
{ munger => 'eps', prefix => 'dns-nxd:', from => 'src_ip', |
|
3655
|
|
|
|
|
|
|
read => 'rate', mark => 0 } |
|
3656
|
|
|
|
|
|
|
# multi-output: one daemon round trip fills several columns |
|
3657
|
|
|
|
|
|
|
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip', |
|
3658
|
|
|
|
|
|
|
parts => [ 'rate', 'count' ], into => [ 'req_rate', 'req_count' ] } |
|
3659
|
|
|
|
|
|
|
|
|
3660
|
|
|
|
|
|
|
Per-entity sliding-window event rates via the C daemon shipped with |
|
3661
|
|
|
|
|
|
|
L (see |
|
3662
|
|
|
|
|
|
|
L). The input value becomes a meter B |
|
3663
|
|
|
|
|
|
|
(after C is prepended); by default the munger B one event against |
|
3664
|
|
|
|
|
|
|
that key and returns the key's current events-per-second, using the daemon's |
|
3665
|
|
|
|
|
|
|
C command -- mark and query in a single command with a single reply. |
|
3666
|
|
|
|
|
|
|
This is the munger behind rate columns like a per-source request rate: every |
|
3667
|
|
|
|
|
|
|
event marks its source's meter and stores the rate the meter now reads. |
|
3668
|
|
|
|
|
|
|
|
|
3669
|
|
|
|
|
|
|
Unlike every other munger this one consults external state -- but the state |
|
3670
|
|
|
|
|
|
|
lives in the daemon, not here, so the munger itself remains a stateless client |
|
3671
|
|
|
|
|
|
|
and rows stay reproducible I the daemon. Because the daemon is shared, |
|
3672
|
|
|
|
|
|
|
multiple writer processes marking the same keys see one B rate, which an |
|
3673
|
|
|
|
|
|
|
in-process meter could never give. |
|
3674
|
|
|
|
|
|
|
|
|
3675
|
|
|
|
|
|
|
Spec keys: |
|
3676
|
|
|
|
|
|
|
|
|
3677
|
|
|
|
|
|
|
=over 4 |
|
3678
|
|
|
|
|
|
|
|
|
3679
|
|
|
|
|
|
|
=item * C - unix socket path of the daemon. Defaults to |
|
3680
|
|
|
|
|
|
|
C<$Algorithm::ToNumberMunger::EPS_SOCKET> |
|
3681
|
|
|
|
|
|
|
(C). |
|
3682
|
|
|
|
|
|
|
|
|
3683
|
|
|
|
|
|
|
=item * C - string prepended to the input to form the key, namespacing |
|
3684
|
|
|
|
|
|
|
this column's meters (two columns keyed on the same field need different |
|
3685
|
|
|
|
|
|
|
prefixes or they share meters). No whitespace/control characters. Default C<''>. |
|
3686
|
|
|
|
|
|
|
|
|
3687
|
|
|
|
|
|
|
=item * C - whether to mark the key (default C<1>). Marking rides |
|
3688
|
|
|
|
|
|
|
C: with C<< read => 'rate' >> that one command is the whole exchange; |
|
3689
|
|
|
|
|
|
|
with C/C the read is pipelined after it (the C rate |
|
3690
|
|
|
|
|
|
|
reply is discarded), so a marking failure still comes back as an ordinary |
|
3691
|
|
|
|
|
|
|
first reply. With C<< mark => 0 >> the munger only reads, for columns whose |
|
3692
|
|
|
|
|
|
|
marking is done elsewhere -- e.g. an NXDOMAIN rate is I by the pipeline |
|
3693
|
|
|
|
|
|
|
only on NXDOMAIN responses but I on every row. |
|
3694
|
|
|
|
|
|
|
|
|
3695
|
|
|
|
|
|
|
=item * C - what to read: C (events/sec over the daemon's window, |
|
3696
|
|
|
|
|
|
|
default), C (events inside the window), or C (lifetime). |
|
3697
|
|
|
|
|
|
|
|
|
3698
|
|
|
|
|
|
|
=item * C + C - multi-output form (see L): read several |
|
3699
|
|
|
|
|
|
|
of C/C/C for the one key in a single round trip, filling one |
|
3700
|
|
|
|
|
|
|
column each. When marking, the C reply itself serves the first C |
|
3701
|
|
|
|
|
|
|
part, so C<< parts => ['rate', 'count'] >> costs exactly two commands. |
|
3702
|
|
|
|
|
|
|
|
|
3703
|
|
|
|
|
|
|
=item * C - C<'die'> (default) croaks the write when the daemon is |
|
3704
|
|
|
|
|
|
|
unreachable or replies C; a number is returned instead as a quiet fallback. |
|
3705
|
|
|
|
|
|
|
Note C<0> is indistinguishable from a genuinely idle key, so quiet fallback |
|
3706
|
|
|
|
|
|
|
biases the column -- loud is the default on purpose. |
|
3707
|
|
|
|
|
|
|
|
|
3708
|
|
|
|
|
|
|
=item * C - per-operation socket timeout in seconds (default 5, |
|
3709
|
|
|
|
|
|
|
best-effort via C/C), so a wedged daemon cannot hang a |
|
3710
|
|
|
|
|
|
|
writer forever. |
|
3711
|
|
|
|
|
|
|
|
|
3712
|
|
|
|
|
|
|
=back |
|
3713
|
|
|
|
|
|
|
|
|
3714
|
|
|
|
|
|
|
Semantics worth knowing: a marked read B; keys |
|
3715
|
|
|
|
|
|
|
have whitespace/control bytes replaced with C<_> to satisfy the daemon's key |
|
3716
|
|
|
|
|
|
|
rules; connections are made lazily on first use and kept open (reconnecting |
|
3717
|
|
|
|
|
|
|
transparently after a fork or an error), so compiling a plan -- including the |
|
3718
|
|
|
|
|
|
|
eager validation in C -- needs no running daemon. Each eps column |
|
3719
|
|
|
|
|
|
|
costs one unix-socket round trip per row; the multi-output form exists so |
|
3720
|
|
|
|
|
|
|
rate+count of the same key costs one round trip, not two. |
|
3721
|
|
|
|
|
|
|
|
|
3722
|
|
|
|
|
|
|
=cut |
|
3723
|
|
|
|
|
|
|
|
|
3724
|
|
|
|
|
|
|
# Default socket path of the iqbi-damiq daemon. |
|
3725
|
|
|
|
|
|
|
our $EPS_SOCKET = '/var/run/iqbi-damiq.sock'; |
|
3726
|
|
|
|
|
|
|
|
|
3727
|
|
|
|
|
|
|
# Persistent daemon connections, keyed by socket path, shared by every eps |
|
3728
|
|
|
|
|
|
|
# munger in the process. Entries record the pid that opened them so a forked |
|
3729
|
|
|
|
|
|
|
# writer transparently reopens instead of sharing a socket with its parent. |
|
3730
|
|
|
|
|
|
|
# Connections are made lazily on first use -- never at munger build time, so a |
|
3731
|
|
|
|
|
|
|
# plan can compile (eager validation) with no daemon running. |
|
3732
|
|
|
|
|
|
|
my %EPS_CONN; |
|
3733
|
|
|
|
|
|
|
|
|
3734
|
|
|
|
|
|
|
sub _eps_conn { |
|
3735
|
0
|
|
|
0
|
|
0
|
my ( $path, $timeout ) = @_; |
|
3736
|
0
|
|
|
|
|
0
|
my $c = $EPS_CONN{$path}; |
|
3737
|
0
|
0
|
0
|
|
|
0
|
return $c->{fh} if $c && $c->{pid} == $$; |
|
3738
|
|
|
|
|
|
|
|
|
3739
|
0
|
|
|
|
|
0
|
require Socket; |
|
3740
|
0
|
|
|
|
|
0
|
require IO::Socket::UNIX; |
|
3741
|
0
|
0
|
|
|
|
0
|
my $fh = IO::Socket::UNIX->new( |
|
3742
|
|
|
|
|
|
|
Type => Socket::SOCK_STREAM(), |
|
3743
|
|
|
|
|
|
|
Peer => $path, |
|
3744
|
|
|
|
|
|
|
) or die "cannot connect to iqbi-damiq at $path: $!\n"; |
|
3745
|
|
|
|
|
|
|
|
|
3746
|
|
|
|
|
|
|
# Best-effort read/write timeouts so a wedged daemon cannot hang a writer. |
|
3747
|
0
|
|
|
|
|
0
|
eval { |
|
3748
|
0
|
|
|
|
|
0
|
my $tv = pack( 'l!l!', $timeout, 0 ); |
|
3749
|
0
|
|
|
|
|
0
|
setsockopt( $fh, Socket::SOL_SOCKET(), Socket::SO_RCVTIMEO(), $tv ); |
|
3750
|
0
|
|
|
|
|
0
|
setsockopt( $fh, Socket::SOL_SOCKET(), Socket::SO_SNDTIMEO(), $tv ); |
|
3751
|
|
|
|
|
|
|
}; |
|
3752
|
|
|
|
|
|
|
|
|
3753
|
0
|
|
|
|
|
0
|
$EPS_CONN{$path} = { fh => $fh, pid => $$ }; |
|
3754
|
0
|
|
|
|
|
0
|
return $fh; |
|
3755
|
|
|
|
|
|
|
} ## end sub _eps_conn |
|
3756
|
|
|
|
|
|
|
|
|
3757
|
|
|
|
|
|
|
# One pipelined transaction: send $cmd (possibly several lines) and read |
|
3758
|
|
|
|
|
|
|
# $nreplies "OK n" lines, one per command sent. The munger only ever sends |
|
3759
|
|
|
|
|
|
|
# commands that reply exactly once -- MARKRATE (which marks AND returns the |
|
3760
|
|
|
|
|
|
|
# rate in one go), RATE, COUNT, TOTAL; never a bare MARK, whose reply-only-on- |
|
3761
|
|
|
|
|
|
|
# error behavior would let a failure desynchronize the reply stream. Dies on |
|
3762
|
|
|
|
|
|
|
# ERR, EOF, or timeout; the caller still drops the cached connection on error |
|
3763
|
|
|
|
|
|
|
# as belt and braces. |
|
3764
|
|
|
|
|
|
|
sub _eps_txn { |
|
3765
|
0
|
|
|
0
|
|
0
|
my ( $path, $timeout, $cmd, $nreplies ) = @_; |
|
3766
|
0
|
|
|
|
|
0
|
my $fh = _eps_conn( $path, $timeout ); |
|
3767
|
0
|
0
|
|
|
|
0
|
print {$fh} $cmd or die "write to iqbi-damiq failed: $!\n"; |
|
|
0
|
|
|
|
|
0
|
|
|
3768
|
0
|
|
|
|
|
0
|
my @out; |
|
3769
|
0
|
|
|
|
|
0
|
for ( 1 .. $nreplies ) { |
|
3770
|
0
|
|
|
|
|
0
|
my $reply = <$fh>; |
|
3771
|
0
|
0
|
|
|
|
0
|
die "iqbi-damiq closed the connection (or timed out)\n" |
|
3772
|
|
|
|
|
|
|
unless defined $reply; |
|
3773
|
0
|
0
|
|
|
|
0
|
$reply =~ /\AOK (\S+)/ |
|
3774
|
|
|
|
|
|
|
or die "iqbi-damiq replied: $reply"; |
|
3775
|
0
|
|
|
|
|
0
|
push @out, $1 + 0; |
|
3776
|
|
|
|
|
|
|
} |
|
3777
|
0
|
|
|
|
|
0
|
return @out; |
|
3778
|
|
|
|
|
|
|
} ## end sub _eps_txn |
|
3779
|
|
|
|
|
|
|
|
|
3780
|
|
|
|
|
|
|
# Validate the spec keys shared by the scalar and multi-output eps builders. |
|
3781
|
|
|
|
|
|
|
sub _eps_spec { |
|
3782
|
0
|
|
|
0
|
|
0
|
my ( $spec, $where ) = @_; |
|
3783
|
|
|
|
|
|
|
|
|
3784
|
0
|
0
|
|
|
|
0
|
my $socket = defined $spec->{socket} ? $spec->{socket} : $EPS_SOCKET; |
|
3785
|
0
|
0
|
|
|
|
0
|
croak "eps munger$where: 'socket' must be a non-empty path" |
|
3786
|
|
|
|
|
|
|
unless length $socket; |
|
3787
|
|
|
|
|
|
|
|
|
3788
|
0
|
0
|
|
|
|
0
|
my $prefix = defined $spec->{prefix} ? $spec->{prefix} : ''; |
|
3789
|
0
|
0
|
|
|
|
0
|
croak "eps munger$where: 'prefix' may not contain whitespace or control " . 'characters' |
|
3790
|
|
|
|
|
|
|
if $prefix =~ /[\s[:cntrl:]]/; |
|
3791
|
|
|
|
|
|
|
|
|
3792
|
0
|
0
|
|
|
|
0
|
my $mark = exists $spec->{mark} ? ( $spec->{mark} ? 1 : 0 ) : 1; |
|
|
|
0
|
|
|
|
|
|
|
3793
|
|
|
|
|
|
|
|
|
3794
|
0
|
0
|
|
|
|
0
|
my $timeout = defined $spec->{timeout} ? $spec->{timeout} : 5; |
|
3795
|
0
|
0
|
0
|
|
|
0
|
croak "eps munger$where: 'timeout' must be a positive number" |
|
3796
|
|
|
|
|
|
|
unless looks_like_number($timeout) && $timeout > 0; |
|
3797
|
|
|
|
|
|
|
|
|
3798
|
0
|
0
|
|
|
|
0
|
my $on_error = defined $spec->{on_error} ? $spec->{on_error} : 'die'; |
|
3799
|
0
|
0
|
0
|
|
|
0
|
croak "eps munger$where: 'on_error' must be 'die' or a number" |
|
3800
|
|
|
|
|
|
|
unless $on_error eq 'die' || looks_like_number($on_error); |
|
3801
|
|
|
|
|
|
|
|
|
3802
|
0
|
|
|
|
|
0
|
return ( $socket, $prefix, $mark, $timeout, $on_error ); |
|
3803
|
|
|
|
|
|
|
} ## end sub _eps_spec |
|
3804
|
|
|
|
|
|
|
|
|
3805
|
|
|
|
|
|
|
my %EPS_READ = map { $_ => 1 } qw(rate count total); |
|
3806
|
|
|
|
|
|
|
|
|
3807
|
|
|
|
|
|
|
sub _build_eps { |
|
3808
|
0
|
|
|
0
|
|
0
|
my ( $spec, $where ) = @_; |
|
3809
|
|
|
|
|
|
|
|
|
3810
|
|
|
|
|
|
|
croak "eps munger$where: 'parts' is for the multi-output form (needs " . "'into'); use 'read' for a single column" |
|
3811
|
0
|
0
|
|
|
|
0
|
if defined $spec->{parts}; |
|
3812
|
|
|
|
|
|
|
|
|
3813
|
0
|
|
|
|
|
0
|
my ( $socket, $prefix, $mark, $timeout, $on_error ) = _eps_spec( $spec, $where ); |
|
3814
|
|
|
|
|
|
|
|
|
3815
|
0
|
0
|
|
|
|
0
|
my $read = defined $spec->{read} ? $spec->{read} : 'rate'; |
|
3816
|
|
|
|
|
|
|
croak "eps munger$where: unknown read '$read' (known: " . join( ', ', sort keys %EPS_READ ) . ')' |
|
3817
|
0
|
0
|
|
|
|
0
|
unless $EPS_READ{$read}; |
|
3818
|
|
|
|
|
|
|
|
|
3819
|
|
|
|
|
|
|
# Command plan, fixed at build time. The common case -- mark and read the |
|
3820
|
|
|
|
|
|
|
# rate -- is the daemon's single MARKRATE command. mark+count/total rides |
|
3821
|
|
|
|
|
|
|
# MARKRATE too (its rate reply is discarded) so marking failures come back |
|
3822
|
|
|
|
|
|
|
# as an ordinary first reply instead of a bare MARK's error-only surprise. |
|
3823
|
|
|
|
|
|
|
my @cmds |
|
3824
|
0
|
0
|
|
|
|
0
|
= !$mark ? ( uc $read ) |
|
|
|
0
|
|
|
|
|
|
|
3825
|
|
|
|
|
|
|
: $read eq 'rate' ? ('MARKRATE') |
|
3826
|
|
|
|
|
|
|
: ( 'MARKRATE', uc $read ); |
|
3827
|
|
|
|
|
|
|
|
|
3828
|
|
|
|
|
|
|
return sub { |
|
3829
|
0
|
|
|
0
|
|
0
|
my ($v) = @_; |
|
3830
|
0
|
0
|
|
|
|
0
|
my $key = $prefix . ( defined $v ? "$v" : '' ); |
|
3831
|
0
|
|
|
|
|
0
|
$key =~ s/[\s[:cntrl:]]/_/g; |
|
3832
|
0
|
|
|
|
|
0
|
my @replies = eval { |
|
3833
|
0
|
0
|
|
|
|
0
|
die "empty key\n" unless length $key; |
|
3834
|
0
|
|
|
|
|
0
|
_eps_txn( $socket, $timeout, join( '', map { "$_ $key\n" } @cmds ), scalar @cmds ); |
|
|
0
|
|
|
|
|
0
|
|
|
3835
|
|
|
|
|
|
|
}; |
|
3836
|
0
|
0
|
|
|
|
0
|
if ($@) { |
|
3837
|
0
|
|
|
|
|
0
|
my $err = $@; |
|
3838
|
0
|
|
|
|
|
0
|
delete $EPS_CONN{$socket}; # reconnect fresh next call |
|
3839
|
0
|
0
|
|
|
|
0
|
croak "eps munger$where: $err" if $on_error eq 'die'; |
|
3840
|
0
|
|
|
|
|
0
|
return $on_error + 0; |
|
3841
|
|
|
|
|
|
|
} |
|
3842
|
0
|
|
|
|
|
0
|
return $replies[-1]; # the requested read is always the last reply |
|
3843
|
0
|
|
|
|
|
0
|
}; ## end sub |
|
3844
|
|
|
|
|
|
|
} ## end sub _build_eps |
|
3845
|
|
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
|
# Multi-output eps: one key, several reads (rate/count/total), one round trip. |
|
3847
|
|
|
|
|
|
|
# Returns ($list_returning_code, $arity) for compile()'s 'into' check. |
|
3848
|
|
|
|
|
|
|
sub _build_eps_multi { |
|
3849
|
0
|
|
|
0
|
|
0
|
my ( $spec, $where ) = @_; |
|
3850
|
|
|
|
|
|
|
|
|
3851
|
0
|
|
|
|
|
0
|
my $parts = $spec->{parts}; |
|
3852
|
0
|
0
|
0
|
|
|
0
|
croak "eps munger$where: 'parts' must be a non-empty arrayref" |
|
3853
|
|
|
|
|
|
|
unless ref $parts eq 'ARRAY' && @$parts; |
|
3854
|
0
|
|
|
|
|
0
|
for my $p (@$parts) { |
|
3855
|
|
|
|
|
|
|
croak "eps munger$where: unknown part '" |
|
3856
|
|
|
|
|
|
|
. ( defined $p ? $p : 'undef' ) |
|
3857
|
|
|
|
|
|
|
. "' (known: " |
|
3858
|
|
|
|
|
|
|
. join( ', ', sort keys %EPS_READ ) . ')' |
|
3859
|
0
|
0
|
0
|
|
|
0
|
unless defined $p && $EPS_READ{$p}; |
|
|
|
0
|
|
|
|
|
|
|
3860
|
|
|
|
|
|
|
} |
|
3861
|
|
|
|
|
|
|
|
|
3862
|
0
|
|
|
|
|
0
|
my ( $socket, $prefix, $mark, $timeout, $on_error ) = _eps_spec( $spec, $where ); |
|
3863
|
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
# Command plan, fixed at build time. When marking, the mark is a MARKRATE |
|
3865
|
|
|
|
|
|
|
# whose own reply serves the first 'rate' part for free; the remaining |
|
3866
|
|
|
|
|
|
|
# parts become one read command each. @take maps each part to the reply |
|
3867
|
|
|
|
|
|
|
# index that answers it, so the output stays in 'parts' order. |
|
3868
|
0
|
|
|
|
|
0
|
my ( @cmds, @take ); |
|
3869
|
0
|
|
|
|
|
0
|
my $rate_served = 0; |
|
3870
|
0
|
0
|
|
|
|
0
|
push @cmds, 'MARKRATE' if $mark; |
|
3871
|
0
|
|
|
|
|
0
|
for my $i ( 0 .. $#$parts ) { |
|
3872
|
0
|
0
|
0
|
|
|
0
|
if ( $mark && !$rate_served && $parts->[$i] eq 'rate' ) { |
|
|
|
|
0
|
|
|
|
|
|
3873
|
0
|
|
|
|
|
0
|
$take[$i] = 0; # MARKRATE's reply is the rate |
|
3874
|
0
|
|
|
|
|
0
|
$rate_served = 1; |
|
3875
|
0
|
|
|
|
|
0
|
next; |
|
3876
|
|
|
|
|
|
|
} |
|
3877
|
0
|
|
|
|
|
0
|
push @cmds, uc $parts->[$i]; |
|
3878
|
0
|
|
|
|
|
0
|
$take[$i] = $#cmds; |
|
3879
|
|
|
|
|
|
|
} |
|
3880
|
0
|
|
|
|
|
0
|
my $n = @$parts; |
|
3881
|
0
|
|
|
|
|
0
|
my $nreplies = @cmds; |
|
3882
|
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
my $code = sub { |
|
3884
|
0
|
|
|
0
|
|
0
|
my ($v) = @_; |
|
3885
|
0
|
0
|
|
|
|
0
|
my $key = $prefix . ( defined $v ? "$v" : '' ); |
|
3886
|
0
|
|
|
|
|
0
|
$key =~ s/[\s[:cntrl:]]/_/g; |
|
3887
|
0
|
|
|
|
|
0
|
my @replies = eval { |
|
3888
|
0
|
0
|
|
|
|
0
|
die "empty key\n" unless length $key; |
|
3889
|
0
|
|
|
|
|
0
|
_eps_txn( $socket, $timeout, join( '', map { "$_ $key\n" } @cmds ), $nreplies ); |
|
|
0
|
|
|
|
|
0
|
|
|
3890
|
|
|
|
|
|
|
}; |
|
3891
|
0
|
0
|
|
|
|
0
|
if ($@) { |
|
3892
|
0
|
|
|
|
|
0
|
my $err = $@; |
|
3893
|
0
|
|
|
|
|
0
|
delete $EPS_CONN{$socket}; |
|
3894
|
0
|
0
|
|
|
|
0
|
croak "eps munger$where: $err" if $on_error eq 'die'; |
|
3895
|
0
|
|
|
|
|
0
|
return ( $on_error + 0 ) x $n; |
|
3896
|
|
|
|
|
|
|
} |
|
3897
|
0
|
|
|
|
|
0
|
return @replies[@take]; |
|
3898
|
0
|
|
|
|
|
0
|
}; ## end $code = sub |
|
3899
|
0
|
|
|
|
|
0
|
return ( $code, $n ); |
|
3900
|
|
|
|
|
|
|
} ## end sub _build_eps_multi |
|
3901
|
|
|
|
|
|
|
|
|
3902
|
|
|
|
|
|
|
# A compiled munging plan for one set, produced by Mungers->compile. It turns an |
|
3903
|
|
|
|
|
|
|
# input record into a fully-numeric row in tags order; the Writer then only has |
|
3904
|
|
|
|
|
|
|
# to validate and append. Kept in its own package so the assembly logic is |
|
3905
|
|
|
|
|
|
|
# testable without a Writer or the filesystem. |
|
3906
|
|
|
|
|
|
|
package Algorithm::ToNumberMunger::Plan; |
|
3907
|
|
|
|
|
|
|
|
|
3908
|
5
|
|
|
5
|
|
56
|
use strict; |
|
|
5
|
|
|
|
|
9
|
|
|
|
5
|
|
|
|
|
108
|
|
|
3909
|
5
|
|
|
5
|
|
17
|
use warnings; |
|
|
5
|
|
|
|
|
16
|
|
|
|
5
|
|
|
|
|
303
|
|
|
3910
|
5
|
|
|
5
|
|
21
|
use Carp qw(croak); |
|
|
5
|
|
|
|
|
15
|
|
|
|
5
|
|
|
|
|
7982
|
|
|
3911
|
|
|
|
|
|
|
|
|
3912
|
0
|
|
|
0
|
|
0
|
sub tags { return $_[0]->{tags} } |
|
3913
|
|
|
|
|
|
|
|
|
3914
|
|
|
|
|
|
|
# Assemble a row from a name-keyed record. Scalar/raw columns read their own tag |
|
3915
|
|
|
|
|
|
|
# (or the munger's 'from'); expanding mungers read one source and fill several |
|
3916
|
|
|
|
|
|
|
# columns; combining mungers read several sources and fill one. This is the only |
|
3917
|
|
|
|
|
|
|
# form that supports expanders and combiners. |
|
3918
|
|
|
|
|
|
|
sub apply_named { |
|
3919
|
17
|
|
|
17
|
|
2954
|
my ( $self, $hash ) = @_; |
|
3920
|
17
|
50
|
|
|
|
46
|
croak 'apply_named requires a hashref' unless ref $hash eq 'HASH'; |
|
3921
|
|
|
|
|
|
|
|
|
3922
|
17
|
|
|
|
|
30
|
my @row; |
|
3923
|
17
|
|
|
|
|
22
|
for my $s ( @{ $self->{scalar} } ) { |
|
|
17
|
|
|
|
|
45
|
|
|
3924
|
|
|
|
|
|
|
croak "missing value for '$s->{from}'" |
|
3925
|
8
|
100
|
|
|
|
107
|
unless exists $hash->{ $s->{from} }; |
|
3926
|
7
|
|
|
|
|
13
|
my $v = $hash->{ $s->{from} }; |
|
3927
|
7
|
100
|
|
|
|
27
|
$row[ $self->{pos}{ $s->{tag} } ] = $s->{code} ? $s->{code}->($v) : $v; |
|
3928
|
|
|
|
|
|
|
} |
|
3929
|
|
|
|
|
|
|
|
|
3930
|
16
|
|
|
|
|
21
|
for my $e ( @{ $self->{expand} } ) { |
|
|
16
|
|
|
|
|
28
|
|
|
3931
|
|
|
|
|
|
|
croak "missing value for '$e->{from}'" |
|
3932
|
8
|
100
|
|
|
|
186
|
unless exists $hash->{ $e->{from} }; |
|
3933
|
7
|
|
|
|
|
17
|
my @vals = $e->{code}->( $hash->{ $e->{from} } ); |
|
3934
|
0
|
|
|
|
|
0
|
croak "expanding munger for [@{ $e->{into} }] returned " |
|
3935
|
|
|
|
|
|
|
. scalar(@vals) |
|
3936
|
|
|
|
|
|
|
. ' value(s), expected ' |
|
3937
|
0
|
|
|
|
|
0
|
. scalar( @{ $e->{into} } ) |
|
3938
|
7
|
50
|
|
|
|
11
|
unless @vals == @{ $e->{into} }; |
|
|
7
|
|
|
|
|
23
|
|
|
3939
|
7
|
|
|
|
|
21
|
for my $i ( 0 .. $#{ $e->{into} } ) { |
|
|
7
|
|
|
|
|
15
|
|
|
3940
|
14
|
|
|
|
|
40
|
$row[ $self->{pos}{ $e->{into}[$i] } ] = $vals[$i]; |
|
3941
|
|
|
|
|
|
|
} |
|
3942
|
|
|
|
|
|
|
} ## end for my $e ( @{ $self->{expand} } ) |
|
3943
|
|
|
|
|
|
|
|
|
3944
|
15
|
|
|
|
|
41
|
for my $c ( @{ $self->{combine} } ) { |
|
|
15
|
|
|
|
|
28
|
|
|
3945
|
14
|
|
|
|
|
16
|
my @vals; |
|
3946
|
14
|
|
|
|
|
17
|
for my $f ( @{ $c->{from} } ) { |
|
|
14
|
|
|
|
|
20
|
|
|
3947
|
|
|
|
|
|
|
croak "missing value for '$f'" |
|
3948
|
31
|
100
|
|
|
|
182
|
unless exists $hash->{$f}; |
|
3949
|
30
|
|
|
|
|
45
|
push @vals, $hash->{$f}; |
|
3950
|
|
|
|
|
|
|
} |
|
3951
|
13
|
|
|
|
|
38
|
$row[ $self->{pos}{ $c->{tag} } ] = $c->{code}->(@vals); |
|
3952
|
|
|
|
|
|
|
} |
|
3953
|
|
|
|
|
|
|
|
|
3954
|
13
|
|
|
|
|
62
|
return \@row; |
|
3955
|
|
|
|
|
|
|
} ## end sub apply_named |
|
3956
|
|
|
|
|
|
|
|
|
3957
|
|
|
|
|
|
|
# Assemble a row from an already-ordered positional row, applying scalar mungers |
|
3958
|
|
|
|
|
|
|
# in place. Expanding and combining mungers cannot be expressed positionally |
|
3959
|
|
|
|
|
|
|
# (there is no named source), so a set that has any is a hard error here -- use |
|
3960
|
|
|
|
|
|
|
# apply_named. |
|
3961
|
|
|
|
|
|
|
sub apply_positional { |
|
3962
|
5
|
|
|
5
|
|
2365
|
my ( $self, $row ) = @_; |
|
3963
|
5
|
50
|
|
|
|
19
|
croak 'apply_positional requires an arrayref row' unless ref $row eq 'ARRAY'; |
|
3964
|
|
|
|
|
|
|
croak 'positional write is unsupported for a set with expanding mungers; ' . 'use write_named' |
|
3965
|
5
|
100
|
|
|
|
7
|
if @{ $self->{expand} }; |
|
|
5
|
|
|
|
|
150
|
|
|
3966
|
|
|
|
|
|
|
croak 'positional write is unsupported for a set with multi-input mungers; ' . 'use write_named' |
|
3967
|
4
|
100
|
|
|
|
6
|
if @{ $self->{combine} }; |
|
|
4
|
|
|
|
|
139
|
|
|
3968
|
1
|
|
|
|
|
167
|
croak 'row has ' . scalar(@$row) . ' fields but info.json declares ' . scalar( @{ $self->{tags} } ) |
|
3969
|
3
|
100
|
|
|
|
6
|
unless @$row == @{ $self->{tags} }; |
|
|
3
|
|
|
|
|
9
|
|
|
3970
|
|
|
|
|
|
|
|
|
3971
|
2
|
|
|
|
|
6
|
my @out = @$row; |
|
3972
|
2
|
|
|
|
|
4
|
for my $s ( @{ $self->{scalar} } ) { |
|
|
2
|
|
|
|
|
7
|
|
|
3973
|
4
|
100
|
|
|
|
12
|
next unless $s->{code}; |
|
3974
|
1
|
|
|
|
|
3
|
my $i = $self->{pos}{ $s->{tag} }; |
|
3975
|
1
|
|
|
|
|
3
|
$out[$i] = $s->{code}->( $out[$i] ); |
|
3976
|
|
|
|
|
|
|
} |
|
3977
|
2
|
|
|
|
|
10
|
return \@out; |
|
3978
|
|
|
|
|
|
|
} ## end sub apply_positional |
|
3979
|
|
|
|
|
|
|
|
|
3980
|
|
|
|
|
|
|
=head1 AUTHOR |
|
3981
|
|
|
|
|
|
|
|
|
3982
|
|
|
|
|
|
|
Zane C. Bowers-Hadley, C<< >> |
|
3983
|
|
|
|
|
|
|
|
|
3984
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
3985
|
|
|
|
|
|
|
|
|
3986
|
|
|
|
|
|
|
This software is Copyright (c) 2026 by Zane C. Bowers-Hadley. |
|
3987
|
|
|
|
|
|
|
|
|
3988
|
|
|
|
|
|
|
This is free software, licensed under: |
|
3989
|
|
|
|
|
|
|
|
|
3990
|
|
|
|
|
|
|
The GNU Lesser General Public License, Version 2.1, February 1999 |
|
3991
|
|
|
|
|
|
|
|
|
3992
|
|
|
|
|
|
|
=cut |
|
3993
|
|
|
|
|
|
|
|
|
3994
|
|
|
|
|
|
|
1; # End of Algorithm::ToNumberMunger |