-
Notifications
You must be signed in to change notification settings - Fork 33
/
Copy pathHariSekhonUtils.pm
4307 lines (3845 loc) · 142 KB
/
HariSekhonUtils.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#
# Author: Hari Sekhon
# Date: 2011-09-15 11:30:24 +0100 (Thu, 15 Sep 2011)
#
# https://github.com/HariSekhon/lib
#
# License: see accompanying LICENSE file
#
# ============================================================================ #
# Unit Tests
#
# make test
#
# This will call a bunch of Test::More unit tests from t/
#
# ============================================================================ #
# Functional Tests
#
# If you import this library then at the very minimum I recommend that you add
# one or more functional tests to cover all usage scenarios for your code to
# validate when this library is updated.
#
# ./testcmd.exp path_to_tests/*.exptest
#
# One of the original purposes of this library was to be able to rapidly develop Nagios plugins.
# If you use this to ease your development of Nagios plugins I strongly recommend that you add
# functional tests and run them whenever either this library or your plugin changes
#
# Running make test under nagios-plugins will run all unit and functional tests
# to make sure everything still works as expected before releasing to production. It will
# also check for plugins that are importing this library but don't have any test files
#
# You don't want your Nagios screen to suddenly go all red because you haven't done your QA!
#
# If you've added some code and don't have a corresponding suite of test files
# in the ./tests directory then they may well break when I update this library.
package HariSekhonUtils;
use warnings;
use strict;
# fixes 'Can't locate object method "tid" via package "threads" at /usr/lib64/perl5/XSLoader.pm line 94.' caused by http_proxy/https_proxy environment variables (LWP module)
# eval'ing it for perls built without thread support (like Travis CI)
use Config;
if($Config{usethreads}){
require threads;
import threads;
}
# breaks Perl Taint mode programs - for untainted programs, better to let user set $PERL5LIB
#BEGIN {
# if($ENV{"HOME"} =~ /^(\/[\w-]+)$/){
# $ENV{"HOME"} = $1;
# # use happens too early before $1 is populated or $HOME is changed, even when not in a BEGIN block
# # breaks taint mode programs
# use lib "$ENV{HOME}/perl5/lib";
# }
#}
use 5.006_001;
use Carp;
use Cwd 'abs_path';
use Fcntl ':flock';
use File::Basename;
use Getopt::Long qw(:config bundling);
# fixes 'Can't locate object method "flush" via package "IO::Handle" at /usr/local/share/perl5/LWP/UserAgent.pm line 536.' in -D/--debug mode
use IO::Handle;
use POSIX;
use JSON 'decode_json';
use Scalar::Util 'blessed';
#use Sys::Hostname;
#use Term::ANSIColor 2.01 qw(colorstrip);
use Term::ReadKey;
use Time::Local;
# Workaround for IO::Socket::SSL bug not respecting disabling verifying self-signed certs
if( -f dirname(__FILE__) . "/.use_net_ssl" ){
require Net::SSL;
import Net::SSL;
}
our $VERSION = "1.19.8";
#BEGIN {
# May want to refactor this so reserving ISA, update: 5.8.3 onwards
#use Exporter "import";
#require Exporter;
use Exporter;
our @ISA = qw(Exporter);
# consider replacing the above with these two lines for compatibility with Perl 5.6 and then removing our from @EXPORT* below
#use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
#@ISA = qw(Exporter);
our %EXPORT_TAGS = (
'array' => [ qw(
assert_array
assert_hash
assert_int
assert_float
compact_array
flattenStats
get_field
get_field_array
get_field_float
get_field_hash
get_field_int
get_field2
get_field2_array
get_field2_float
get_field2_hash
get_field2_int
inArray
sort_insensitive
uniq_array
uniq_array2
uniq_array_ordered
) ],
'cmd' => [ qw(
cmd
pkill
prompt
isYes
set_sudo
which
) ],
'file' => [ qw(
open_file
get_path_owner
) ],
'io' => [ qw(
autoflush
) ],
'is' => [ qw(
isArray
isAlNum
isAwsAccessKey
isAwsHostname
isAwsFqdn
isAwsSecretKey
isChars
isCollection
isDatabaseName
isDatabaseColumnName
isDatabaseFieldName
isDatabaseTableName
isDatabaseViewName
isDigit
isDomain
isDomain2
isDomainStrict
isDnsShortname
isEmail
isFilename
isDirname
isFloat
isFqdn
isHash
isHex
isHost
isHostname
isIP
isInt
isInterface
isKrb5Princ
isJavaBean
isJavaException
isJson
isLabel
isLdapDn
isLinux
isLinuxOrMac
isMac
isMinVersion
isNagiosUnit
isNoSqlKey
isObject
isOS
isPathQualified
isPort
isProcessName
isPythonTraceback
isRef
isRegex
isScalar
isScientific
isThreshold
isUrl
isUrlPathSuffix
isUser
isVersion
isVersionLax
isXml
user_exists
) ],
'lock' => [ qw(
go_flock_yourself
flock_off
) ],
'log' => [ qw(
log
loginit
logdie
) ],
'net' => [ qw(
resolve_ip
) ],
'options' => [ qw(
add_options
add_host_options
add_user_options
get_options
check_regex
check_string
check_threshold
check_thresholds
env_cred
env_creds
env_var
env_vars
expand_units
human_units
isYes
msg_perf_thresholds
minimum_value
month2int
parse_file_option
prompt
plural
remove_timeout
set_host_default
set_port_default
set_threshold_defaults
timecomponents2days
usage
validate_ssl
validate_tls
validate_thresholds
version
) ],
'os' => [ qw(
isLinux
isMac
isOS
linux_mac_only
linux_only
mac_only
) ],
'regex' => [ qw(
escape_regex
$aws_access_key_regex
$aws_host_ip_regex
$aws_hostname_regex
$aws_fqdn_regex
$aws_secret_key_regex
$column_regex
$dirname_regex
$domain_regex
$domain_regex2
$domain_regex_strict
$email_regex
$filename_regex
$fqdn_regex
$host_regex
$hostname_regex
$ip_prefix_regex
$ip_regex
$krb5_principal_regex
$label_regex
$ldap_dn_regex
$mac_regex
$process_name_regex
$rwxt_regex
$subnet_mask_regex
$tld_regex
$url_path_suffix_regex
$url_regex
$user_regex
$version_regex
$version_regex_lax
) ],
'status' => [ qw(
$status
status
status2
status3
critical
warning
unknown
is_critical
is_warning
is_unknown
is_ok
isYes
get_status_code
get_upper_threshold
get_upper_thresholds
msg_thresholds
try
catch
catch_quit
quit
) ],
'string' => [ qw(
lstrip
ltrim
perf_suffix
random_alnum
rstrip
rtrim
strBool
strip
strip_ansi_escape_codes
trim
trim_float
) ],
'time' => [ qw(
sec2min
sec2human
tprint
tstamp
) ],
'timeout' => [ qw(
$timeout_current_action
set_http_timeout
set_timeout
set_timeout_default
set_timeout_max
set_timeout_range
) ],
'validate' => [ qw(
skip_java_output
validate_alnum
validate_aws_access_key
validate_aws_bucket
validate_aws_secret_key
validate_chars
validate_collection
validate_database
validate_database_columnname
validate_database_fieldname
validate_database_query_select_show
validate_database_tablename
validate_database_viewname
validate_dir
validate_directory
validate_dirname
validate_domain
validate_domainname
validate_email
validate_file
validate_filename
validate_float
validate_fqdn
validate_host_port_user_password
validate_host
validate_hosts
validate_hostname
validate_hostport
validate_int
validate_integer
validate_interface
validate_ip
validate_java_bean
validate_krb5_princ
validate_krb5_realm
validate_label
validate_ldap_dn
validate_metrics
validate_node_list
validate_nodeport_list
validate_nosql_key
validate_password
validate_port
validate_process_name
validate_program_path
validate_regex
validate_resolvable
validate_ssl
validate_tls
validate_thresholds
validate_units
validate_url
validate_url_path_suffix
validate_user
validate_user_exists
validate_username
) ],
'vars' => [ qw(
$critical
$debug
$default_warning
$default_critical
$email
$expected_version
$host
$github_repo
$json
$msg
$msg_err
$msg_threshold
$multiline
$nagios_plugins_support_msg
$nagios_plugins_support_msg_api
$nodes
$password
$plural
$port
$progname
$status
$status_prefix
$sudo
$ssl
$ssl_ca_path
$tls
$ssl_noverify
$timeout
$timeout_current_action
$timeout_default
$timeout_max
$timeout_min
$usage_line
$user
$verbose
$version
$warning
%ERRORS
%emailoptions
%expected_version_option
%hostoptions
%multilineoption
%nodeoptions
%options
%ssloptions
%thresholdoptions
%thresholds
%tlsoptions
%useroption
%useroptions
@usage_order
) ],
'verbose' => [ qw(
code_error
debug
hr
tprint
tstamp
verbose_mode
vlog
vlog2
vlog3
vlogt
vlog2t
vlog3t
vlog_option
vlog_option_bool
) ],
'web' => [ qw(
curl
curl_json
wget
) ],
);
# same as below
#Exporter::export_tags('foo');
#Exporter::export_ok_tags('bar');
# TODO: move all of this from EXPORT to EXPORT_OK while validating all dependent code still works
our @EXPORT = (
@{$EXPORT_TAGS{'array'}},
@{$EXPORT_TAGS{'cmd'}},
@{$EXPORT_TAGS{'io'}},
@{$EXPORT_TAGS{'is'}},
@{$EXPORT_TAGS{'file'}},
@{$EXPORT_TAGS{'lock'}},
@{$EXPORT_TAGS{'net'}},
@{$EXPORT_TAGS{'options'}},
@{$EXPORT_TAGS{'os'}},
@{$EXPORT_TAGS{'status'}},
@{$EXPORT_TAGS{'string'}},
@{$EXPORT_TAGS{'timeout'}},
@{$EXPORT_TAGS{'validate'}},
@{$EXPORT_TAGS{'vars'}},
@{$EXPORT_TAGS{'verbose'}},
@{$EXPORT_TAGS{'web'}},
);
our @EXPORT_OK = ( @EXPORT,
@{$EXPORT_TAGS{'log'}},
@{$EXPORT_TAGS{'regex'}},
@{$EXPORT_TAGS{'time'}},
);
# could also do this:
#{ my %seen; push @{$EXPORT_TAGS{'all'}}, grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; }
$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
$EXPORT_TAGS{'most'} = [ @EXPORT ];
$EXPORT_TAGS{'EXPORT_OK'} = [ @EXPORT_OK ];
$EXPORT_TAGS{'EXPORT'} = [ @EXPORT ];
our $status_prefix = "";
our %ERRORS;
BEGIN {
# needs to be before die_sub(), otherwise could get 'Use of uninitialized value $HariSekhonUtils::ERRORS{"CRITICAL"} in exit' and exit with blank / 0 incorrect error code on early stage failures such as 'This Perl not built to support threads'
#
# Std Nagios Exit Codes. Not using weak nagios utils.pm. Also improves portability to not rely on it being present
%ERRORS = (
"OK" => 0,
"WARNING" => 1,
"CRITICAL" => 2,
"UNKNOWN" => 3,
"DEPENDENT" => 4
);
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/local/sbin';
# If we're a Nagios plugin check_* then make stderr go to stdout
if(substr(basename($0), 0, 6) eq "check_"){
open STDERR, ">&STDOUT";
select(STDERR);
$| = 1;
select(STDOUT);
$| = 1;
}
sub die_sub {
# this is auto-translated in to equivalent system error string, we're not interested in system interpretation
# so explicitly cast back to int so we can compare with std error codes
# XXX: $? can't be trusted because die calls leave this as zero, especially bad from Perl modules, which then prefixes "OK:" and returns zero exit code!!! Therefore no longer unifying quit() to use die, since this dual behaviour cannot be determined inside this sub. Now only call die for real errors, if UNKNOWN is set for code_error then leave UNKNOWN, otherwise force CRITICAL
my $exit_code = ( defined($?) and $? == $ERRORS{"UNKNOWN"} ? $ERRORS{"UNKNOWN"} : $ERRORS{"CRITICAL"} );
#$exit_code = (defined($exit_code) and $exit_code ne "" ? int($exit_code) : $ERRORS{"CRITICAL"});
my $str = "@_" || "Died";
# better to add the status prefix in here instead of in quit calls
#my $status_prefixes = join("|", keys %ERRORS);
#$str =~ s/:\s+(?:$status_prefixes):/:/g;
if(substr(basename($0), 0, 6) eq "check_"){
my $prefix = "";
foreach(keys %ERRORS){
if($exit_code == $ERRORS{$_}){
$prefix = $_;
last;
}
}
$prefix = "CRITICAL" unless $prefix;
$status_prefix = "" unless $status_prefix;
$str = "${status_prefix}${prefix}: $str";
}
# mimic original die behaviour by only showing code line when there is no newline at end of string
if(substr($str, -1, 1) eq "\n"){
print STDERR $str;
} else {
carp $str;
}
if(grep(/^$exit_code$/, values %ERRORS)){
exit $exit_code;
}
exit $ERRORS{"CRITICAL"};
};
if(substr(basename($0), 0, 6) eq "check_"){
$SIG{__DIE__} = \&die_sub;
}
# This is because the die handler causes program exit instead of return from eval {} block required for exception handling
sub try(&) {
my $old_die = $SIG{__DIE__};
if(defined($SIG{__DIE__})){
undef $SIG{__DIE__};
}
eval {$_[0]->()};
#$SIG{__DIE__} = \&die_sub;
$SIG{__DIE__} = $old_die;
}
sub catch(&) {
$_[0]->($@) if $@;
}
}
# quick prototype to allow me to use this just below
sub quit(@);
our $progname = basename $0;
$progname =~ /^([\w\.\/_-]+)$/ or quit("UNKNOWN", "Invalid program name - does not adhere to strict regex validation, you should name the program simply and sanely");
$progname = $1;
our $nagios_plugins_support_msg = "Please try latest version from https://github.com/HariSekhon/Nagios-Plugins, re-run on command line with -vvv and if problem persists paste full output from -vvv mode in to a ticket requesting a fix/update at https://github.com/HariSekhon/Nagios-Plugins/issues/new";
our $nagios_plugins_support_msg_api = "API may have changed. $nagios_plugins_support_msg";
# ============================================================================ #
our $critical;
our $debug = 0;
our $email;
our $expected_version;
our $help;
our $host;
our $github_repo;
our $json;
our $msg = "";
our $msg_err = "";
our $msg_threshold = "";
our $multiline;
our $nodes;
my @options;
our %options;
our $password;
our $port;
my $selflock;
our $status = "UNKNOWN";
our $sudo = "";
our $syslog_initialized = 0;
our $ssl;
our $ssl_ca_path;
our $ssl_noverify;
our $tls;
our $timeout_current_action = "";
our $timeout_default = 10;
our $timeout_max = 60;
our $timeout_min = 1;
our $timeout = undef;
our $usage_line = "usage: $progname [ options ]";
our $user;
our %thresholds;
# Standard ordering of usage options for help. Exported and overridable inside plugin to customize usage()
our @usage_order = qw/host port user users groups password database table query field regex warning critical ssl tls ssl-CA-path ssl-noverify tls-noverify multiline/;
# Not sure if I can relax the case sensitivity on these according to the Nagios Developer guidelines
my @valid_units = qw/% s ms us B KB MB GB TB c/;
our $verbose = 0;
our $version;
our $warning;
# ============================================================================ #
# Validation Regex - maybe should qr// here but it makes the vlog option output messy
# ============================================================================ #
# tried reversing these to be in $regex_blah format and not auto exporting but this turned out to be less intuitive from the perspective of a module caller and it was convenient to just use the regex in pieces of code without having to import them specially. This also breaks some code such as check_hadoop_jobtracker.pl which uses $domain_regex
my $domain_component = '\b[a-zA-Z0-9](?:[a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\b';
# validated against http://data.iana.org/TLD/tlds-alpha-by-domain.txt which lists all possible TLDs assigned by IANA
# this matches everything except the XN--\w{6,10} TLDs as of 8/10/2012
#our $tld_regex = '\b(?:[A-Za-z]{2,4}|london|museum|travel|local|localdomain|intra)\b';
# Using the official list now to be tighter and avoid matching things like node.role in elasticsearch
# to allow the prototype to be checked
sub open_file ($;$);
sub code_error (@);
our $tld_regex = "\\b(?i:";
my $total_tld_count = 0;
sub load_tlds($){
my $file = shift;
my $fh = open_file($file);
my $tld_count;
while(<$fh>){
chomp;
s/#.*//;
next if /^\s*$/;
if(/^([A-Za-z0-9-]+)$/){
$tld_regex .= "$1|";
$tld_count += 1;
} else {
warn "TLD: '$_' from tld file '$file' not validated, skipping that TLD";
}
}
# debug isn't set by this point
#warn "$tld_count tlds loaded from tld file '$file'\n";
$total_tld_count += $tld_count;
}
# downloaded from IANA, run 'make tld' to update
my $tld_file = dirname(__FILE__) . "/resources/tlds-alpha-by-domain.txt";
load_tlds($tld_file);
$total_tld_count > 1000 or code_error("$total_tld_count tlds loaded, expected > 1000");
my $custom_tlds = dirname(__FILE__) . "/resources/custom_tlds.txt";
if(-f $custom_tlds){
load_tlds($custom_tlds);
}
$tld_regex =~ s/\|$//;
$tld_regex .= ")\\b";
#print "tld_regex = $tld_regex\n";
# debug isn't set by this point
#warn "$total_tld_count tlds loaded\n";
$total_tld_count < 2000 or code_error("$total_tld_count tlds loaded, expected < 2000");
# AWS regex from http://blogs.aws.amazon.com/security/blog/tag/key+rotation
our $aws_access_key_regex = '(?<![A-Z0-9])[A-Z0-9]{20}(?![A-Z0-9])';
our $aws_secret_key_regex = '(?<![A-Za-z0-9/+=])[A-Za-z0-9/+=]{40}(?![A-Za-z0-9/+=])';
our $domain_regex = '(?:' . $domain_component . '\.)*' . $tld_regex;
our $domain_regex2 = '(?:' . $domain_component . '\.)+' . $tld_regex;
our $domain_regex_strict = $domain_regex2;
# must permit numbers as valid host identifiers that are being used in the wild in FQDNs
our $hostname_component = '\b[A-Za-z0-9](?:[A-Za-z0-9_\-]{0,61}[a-zA-Z0-9])?\b';
#our $aws_host_ip_regex = 'ip-(?:10-\d+-\d+-\d+|172-1[6-9]-\d+-\d+|172-2[0-9]-\d+-\d+|172-3[0-1]-\d+-\d+|192-168-\d+-\d+)';
# the ip- prefix gives it away as an IP so can be a bit more general and let's catch all IPs not just private ranges
our $aws_host_ip_regex = '\bip-\d+-\d+-\d+-\d+\b';
our $hostname_regex = "$hostname_component(?:\.$domain_regex)?";
our $aws_hostname_regex = "$aws_host_ip_regex(?:\.$domain_regex)?";
our $dirname_regex = '[\/\w\s\\.,:*()=%?+-]+';
our $filename_regex = $dirname_regex . '(?<![\/])';
our $rwxt_regex = '[r-][w-][x-][r-][w-][x-][r-][w-][xt-]';
our $fqdn_regex = $hostname_component . '\.' . $domain_regex;
our $aws_fqdn_regex = $aws_host_ip_regex . '\.' . $domain_regex;
# SECURITY NOTE: I'm allowing single quote through as it's found in Irish email addresses. This makes the $email_regex non-safe without further validation. This regex only tests whether it's a valid email address, nothing more. DO NOT UNTAINT EMAIL or pass to cmd to SQL without further validation!!!
our $email_regex = '\b[A-Za-z0-9](?:[A-Za-z0-9\._\%\'\+-]{0,62}[A-Za-z0-9\._\%\+-])?@' . $domain_regex . '\b';
# TODO: review this IP regex again
our $ip_prefix_regex = '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}';
our $ip_regex = $ip_prefix_regex . '(?:25[0-5]|2[0-4][0-9]|[01]?[1-9][0-9]|[01]?0[1-9]|[12]00|[0-9])\b'; # now allowing 0 or 255 as the final octet due to CIDR
our $subnet_mask_regex = '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[1-9][0-9]|[01]?0[1-9]|[12]00|[0-9])\b';
our $mac_regex = '\b[0-9A-Fa-f]{1,2}[:-](?:[0-9A-Fa-f]{1,2}[:-]){4}[0-9A-Fa-f]{1,2}\b';
our $host_regex = "\\b(?:$hostname_regex|$ip_regex)\\b";
# I did a scan of registered running process names across several hundred linux servers of a diverse group of enterprise applications with 500 unique process names (58k individual processes) to determine that there are cases with spaces, slashes, dashes, underscores, chevrons (<defunct>), dots (script.p[ly], in.tftpd etc) to determine what this regex should be. Incidentally it appears that Linux truncates registered process names to 15 chars.
# This is not from ps -ef etc it is the actual process registered name, hence init not [init] as it appears in ps output
our $process_name_regex = '\s*[\w_\.\/\<\>-][\w\s_\.\/\<\>-]*';
our $url_path_suffix_regex = '/(?:[\w.,:\/%&?!#=*|\[\]~+-]+)?';
our $url_regex = '\b(?i:https?://' . $host_regex . '(?::\d{1,5})?(?:' . $url_path_suffix_regex . ')?)';
our $user_regex = '\b[A-Za-z0-9][A-Za-z0-9\._-]*[A-Za-z0-9]\b';
our $column_regex = '\b[\w\:]+\b';
our $ldap_dn_regex = '\b\w+=[\w\s-]+(?:,\w+=[\w\s-]+)*\b';
our $krb5_principal_regex = "$user_regex(?:\/$hostname_regex)?(?:\@$domain_regex)?";
our $threshold_range_regex = qr/^(\@)?(-?\d+(?:\.\d+)?)(:)(-?\d+(?:\.\d+)?)?$/;
our $threshold_simple_regex = qr/^(-?\d+(?:\.\d+)?)$/;
our $label_regex = '\s*[\%\(\)\/\*\w-][\%\(\)\/\*\w\s-]+';
our $version_regex = '\d(\.\d+)*';
our $version_regex_lax = $version_regex . '-?.*';
# ============================================================================ #
# Options
# ============================================================================ #
# universal options added automatically when using get_options()
our %default_options = (
"D|debug+" => [ \$debug, "Debug code" ],
"t|timeout=i" => [ \$timeout, "Timeout in secs (\$TIMEOUT, default: $timeout_default)" ],
"v|verbose+" => [ \$verbose, "Verbose level (\$VERBOSE=<int>, or use multiple -v, -vv, -vvv)" ],
"V|version" => [ \$version, "Print version and exit" ],
"h|help" => [ \$help, "Print description and usage options" ],
);
# These two subroutines are primarily for my other programs such as my spotify programs which have necessarily longer run times and need a good way to set this and have the %default_options auto updated for usage() to automatically stay in sync with the live options
sub set_timeout_max ($) {
$timeout_max = shift;
isInt($timeout_max) or code_error("must pass an integer to set_timeout_max()");
}
sub set_timeout_default ($) {
$timeout_default = shift;
isInt($timeout_default) or code_error("must pass an integer to set_timeout_default()");
($timeout_default > $timeout_max) and code_error("\$timeout_default ($timeout_default) may not be higher than \$timeout_max ($timeout_max)");
($timeout_default < $timeout_min) and code_error("\$timeout_default ($timeout_default) may not be lower than \$timeout_min ($timeout_min)");
$timeout = $timeout_default;
$default_options{"t|timeout=i"} = [ \$timeout, "Timeout in secs (default: $timeout_default)" ];
}
sub set_timeout_range($$){
my $min = shift;
my $max = shift;
isInt($min) or code_error("non-integer passed to set_timeout_range for min (first arg)");
isInt($max) or code_error("non-integer passed to set_timeout_range for max (second arg)");
$timeout_min = $min;
$timeout_max = $max;
}
# ============================================================================ #
# Optional options
our %hostoptions = (
"H|host=s" => [ \$host, "Host to connect to" ],
"P|port=s" => [ \$port, "Port to connect to" ],
);
our %nodeoptions = (
"N|nodes=s" => [ \$nodes, "Nodes to connect to" ],
"P|port=s" => [ \$port, "Port to connect to if not appended to each node in the node list in the form 'host:port'" ],
);
our %useroptions = (
"u|user=s" => [ \$user, "User to connect with" ],
"p|password=s" => [ \$password, "Password to connect with" ],
);
our %multilineoption = (
"m|multiline" => [ \$multiline, "Multiline output for easier viewing" ],
);
our %thresholdoptions = (
"w|warning=s" => [ \$warning, "Warning threshold or ran:ge (inclusive)" ],
"c|critical=s" => [ \$critical, "Critical threshold or ran:ge (inclusive)" ],
);
our %emailoptions = (
"E|email=s" => [ \$email, "Email address" ],
);
our %expected_version_option = (
"e|expected=s" => [ \$expected_version, "Expected version regex, raises CRITICAL if not matching, optional" ]
);
our %ssloptions = (
"S|ssl" => [ \$ssl, "Use SSL connection" ],
"ssl-CA-path=s" => [ \$ssl_ca_path, "Path to CA certificate directory for validating SSL certificate (automatically enables --ssl)" ],
"ssl-noverify" => [ \$ssl_noverify, "Do not verify SSL certificate (automatically enables --ssl)" ],
);
our %tlsoptions = (
"T|tls" => [ \$tls, "Use TLS connection" ],
"ssl-CA-path=s" => [ \$ssl_ca_path, "Path to CA certificate directory for validating SSL certificate (automatically enables --tls)" ],
"tls-noverify" => [ \$ssl_noverify, "Do not verify SSL certificate (automatically enables --tls)" ],
);
my $short_options_len = 0;
my $long_options_len = 0;
#sub add_host_options($){
# my $name = shift;
# defined($name) or code_error("no name arg passed to add_host_options()");
# if(length($name) >= 4){
# $name = join " ", map {ucfirst} split " ", lc $name;
# }
# foreach(keys %hostoptions){
# $hostoptions{$_}[1] =~ s/^(.)/$name \L$1/;
# }
# %options = ( %options, %hostoptions );
#}
#sub add_user_options($){
# my $name = shift;
# defined($name) or code_error("no name arg passed to add_user_options()");
# if(length($name) >= 4){
# $name = join " ", map {ucfirst} split " ", lc $name;
# }
# foreach(keys %useroptions){
# $useroptions{$_}[1] =~ s/^(.)/$name \L$1/;
# }
# %options = ( %options, %useroptions );
#}
my $default_host;
sub set_host_default($;$){
#defined($default_host) and code_error("default host cannot be set twice");
# already defined, first one wins
defined($default_host) and not defined($_[1]) and return;
$default_host = shift;
isHost($default_host) or code_error("invalid host passed as first arg to set_host_default");
if(not defined($host)){
$host = $default_host;
}
$hostoptions{"H|host=s"}[1] =~ s/\)$/, default: $default_host\)/;
return $host;
}
my $default_port;
sub set_port_default($;$){
#defined($default_port) and code_error("default port cannot be set twice");
# already defined, first one wins
defined($default_port) and not defined($_[1]) and return;
$default_port = shift;
isPort($default_port) or code_error("invalid port passed as first arg to set_port_default");
if(not defined($port)){
$port = $default_port;
}
$hostoptions{"P|port=s"}[1] =~ s/\)$/, default: $default_port\)/;
return $port;
}
sub set_threshold_defaults($$){
our $default_warning = shift;
our $default_critical = shift;
isThreshold($default_warning) or code_error("invalid warning threshold passed as first arg to set_threshold_defaults()");
isThreshold($default_critical) or code_error("invalid critical threshold passed as second arg to set_threshold_defaults()");
$warning = $default_warning;
$critical = $default_critical;
$thresholdoptions{"w|warning=s"}[1] =~ s/\)$/, default: $default_warning\)/;
$thresholdoptions{"c|critical=s"}[1] =~ s/\)$/, default: $default_critical\)/;
}
# ============================================================================ #
# Environment Host/Port and User/Password Credentials
my @host_envs;
my @port_envs;
my @user_envs;
my @password_envs;
my $port_env_found = 0;
sub env_cred($){
my $name = shift;
$name = uc $name;
$name =~ s/[^A-Za-z0-9]/_/g;
$name .= "_" if $name;
push(@host_envs, "\$${name}HOST");
push(@port_envs, "\$${name}PORT");
push(@user_envs, "\$${name}USERNAME");
push(@user_envs, "\$${name}USER");
push(@password_envs, "\$${name}PASSWORD");
# Can't vlog here since verbose mode and debug mode aren't set until after option processing
if($ENV{"${name}HOST"} and not $host){
#vlog2("reading host from \$${name}HOST environment variable");
$host = $ENV{"${name}HOST"};
}
if($ENV{"${name}PORT"} and not $port_env_found){
#vlog2("reading port from \$${name}PORT environment variable");
$port = $ENV{"${name}PORT"};
$port_env_found++;
}
if($ENV{"${name}USERNAME"} and not $user){
#vlog2("reading user from \$${name}USERNAME environment variable");
$user = $ENV{"${name}USERNAME"};
} elsif($ENV{"${name}USER"} and not $user){
#vlog2("reading user from \$${name}USER environment variable");
$user = $ENV{"${name}USER"};
}
if($ENV{"${name}PASSWORD"} and not $password){
#vlog2("reading password from \$${name}PASSWORD environment variable");
$password = $ENV{"${name}PASSWORD"};
}
return 1;
}
sub env_creds($;$){
my $name = shift;
my $longname = shift;
( defined($name) and $name ) or code_error("no name arg passed to env_creds()");
unless($longname){
unless(isScalar(\$name)){
code_error("must supply longname second arg to env_creds() if first arg for ENV is not a scalar");
}
if($name ne uc $name){
$longname = $name;
} elsif(length($name) < 5){
$longname = $name;
} else {
$longname = join " ", map {ucfirst} split " ", lc $name;
}
}
if(isScalar(\$name)){
env_cred($name);
} elsif(isArray($name)){
foreach (@{$name}){
env_cred($_);
}
} else {
code_error("non-scalar/non-array ref passed as first arg to env_creds()");
}
env_cred("");
# if($ENV{"HOST"}){
# $host = $ENV{"HOST"} unless $host;
# }
# if($ENV{"PORT"}){
# $port = $ENV{"PORT"} unless $port;
# }
# if($ENV{"USERNAME"}){
# $user = $ENV{"USERNAME"} unless $user;
# } elsif($ENV{"USER"}){
# $user = $ENV{"USER"} unless $user;
# }
# if($ENV{"PASSWORD"}){
# $password = $ENV{"PASSWORD"} unless $password;
# }
$hostoptions{"H|host=s"}[1] = "$longname host (" . join(", ", @host_envs) . ")";
$hostoptions{"P|port=s"}[1] = "$longname port (" . join(", ", @port_envs) . ( defined($port) ? ", default: $port)" : ")");
#$nodeoptions{"N|node=s"}[1] = "$longname node (" . join(", ", @host_envs) . ")";
#$nodeoptions{"P|port=s"}[1] = "$longname port (" . join(", ", @port_envs) . ( defined($port) ? ", default: $port)" : ")");
$useroptions{"u|user=s"}[1] = "$longname user (" . join(", ", @user_envs) . ")";
$useroptions{"p|password=s"}[1] = "$longname password (" . join(", ", @password_envs) . ")";
return 1;
}
sub env_var($$){
my $name = shift;
my $var_ref = shift;
$name = uc $name;
$name =~ s/[^A-Za-z0-9]/_/g;
if($ENV{$name} and not defined($$var_ref)){
$$var_ref = $ENV{$name};
}
return 1;
}
sub env_vars($$){
my $name = shift;
my $var_ref = shift;
if(isScalar(\$name)){
env_var($name, $var_ref);
} elsif(isArray($name)){
foreach (@{$name}){
env_var($_, $var_ref);
}
} else {
code_error("non-scalar/non-array ref passed as first arg to env_vars()");
}
return 1;
}
# ============================================================================ #
# Nagios Exit Code Functions
# ============================================================================ #
# Set status safely - escalate only
# there is no ok() since that behaviour needs to be determined by scenario
sub unknown () {
if($status eq "OK"){
$status = "UNKNOWN";
}
}
sub warning () {
if($status ne "CRITICAL"){
$status = "WARNING";
}
}
sub critical () {