anvil/Anvil/Tools/Validate.pm
Digimer 1cb42080c3 ** Major Changes **
We've decided to give up on trying to keep ScanCore, AN::Tools and Striker as three separate things. We had originally hoped to make ScanCore easily separatable from the Anvil!, but this was adding increasing complexity to the project and complexity is the enemy of reliability.

In this release, AN::Tools becomes Anvil::Tools, all configuration files move to /etc/anvil and all programs and data files move to /usr/sbin/anvil. Words files are now merged, as are SQL schemas (ScanCore agents will still maintain their own, later). The journald tag has changed from 'an-tools' to 'anvil'.

Other changes;
* Tools.t has been updated to handle existing tests. New methods and parameters still need to have tests added though.
* Added a simple test.pl script used for testing things outside the main program. It will be removed before final release.
* Added the simple 'watch_logs' bash script to more easily tail output.

Signed-off-by: Digimer <digimer@alteeve.ca>
2017-10-20 00:19:32 -04:00

549 lines
16 KiB
Perl
Executable File

package Anvil::Tools::Validate;
#
# This module contains methods used to validate types of data.
#
use strict;
use warnings;
use Data::Dumper;
use Scalar::Util qw(weaken isweak);
our $VERSION = "3.0.0";
my $THIS_FILE = "Validate.pm";
### Methods;
# form_field
# is_alphanumeric
# is_domain_name
# is_ipv4
# is_mac
# is_positive_integer
# is_subnet
# is_uuid
=pod
=encoding utf8
=head1 NAME
Anvil::Tools::Validate
Provides all methods related to data validation.
=head1 SYNOPSIS
use Anvil::Tools;
# Validate a common object handle on all Anvil::Tools modules.
my $anvil = Anvil::Tools->new();
# Access to methods using '$anvil->Validate->X'.
#
# Example using 'is_uuid()';
if ($anvil->Validate->is_uuid({uuid => $string}))
{
print "The UUID: [$string] is valid!\n";
}
=head1 METHODS
Methods in this module;
=cut
sub new
{
my $class = shift;
my $self = {};
bless $self, $class;
return ($self);
}
# Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent.
sub parent
{
my $self = shift;
my $parent = shift;
$self->{HANDLE}{TOOLS} = $parent if $parent;
# Defend against memory leads. See Scalar::Util'.
if (not isweak($self->{HANDLE}{TOOLS}))
{
weaken($self->{HANDLE}{TOOLS});;
}
return ($self->{HANDLE}{TOOLS});
}
#############################################################################################################
# Public methods #
#############################################################################################################
=head2 form_field
This validates that a given HTML form field is valid. It takes an input ID and the type of data that is expected. If it is sane, C<< 1 >> is returned. If it fails to validate, C<< 0 >> is returned and C<< cgi::<name>::alert >> is set to C<< 1 >>.
=head2 Parameters;
=head3 empty_ok (optional)
This can be set to C<< 1 >> to have this method return valid is the variable exists, is defined by is an empty string.
=head3 name (required)
This is the input field name, which is used to check C<< cgi::<name>::value >>.
=head3 type (required)
This is the type to be checked. Valid options are;
=head4 alphanumeric
=head4 domain_name
=head4 ipv4
=head4 mac
=head4 positive_integer
If this type is used, you can use the C<< zero >> parameter which can be set to C<< 1 >> to have a value of C<< 0 >> be considered valid.
=head4 subnet
=head4 uuid
=cut
sub form_field
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $valid = 1;
my $debug = 3;
my $name = defined $parameter->{name} ? $parameter->{name} : "";
my $type = defined $parameter->{type} ? $parameter->{type} : "";
my $empty_ok = defined $parameter->{empty_ok} ? $parameter->{empty_ok} : 0;
my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
name => $name,
type => $type,
empty_ok => $empty_ok,
}});
if ((not $name) or (not $type))
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
else
{
if ((not exists $anvil->data->{cgi}{$name}{value}) or (not defined $anvil->data->{cgi}{$name}{value}))
{
# Not defined
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
else
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "cgi::${name}::value" => $anvil->data->{cgi}{$name}{value} }});
if (not $anvil->data->{cgi}{$name}{value})
{
if (not $empty_ok)
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
}
elsif (($type eq "alphanumeric") && (not $anvil->Validate->is_alphanumeric({string => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "domain_name") && (not $anvil->Validate->is_domain_name({name => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "ipv4") && (not $anvil->Validate->is_ipv4({ip => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "mac") && (not $anvil->Validate->is_mac({mac => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "positive_integer") && (not $anvil->Validate->is_positive_integer({number => $anvil->data->{cgi}{$name}{value}, zero => $zero})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "subnet") && (not $anvil->Validate->is_subnet({subnet => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
elsif (($type eq "uuid") && (not $anvil->Validate->is_uuid({uuid => $anvil->data->{cgi}{$name}{value}})))
{
$valid = 0;
$anvil->data->{cgi}{$name}{alert} = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
}
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_alphanumeric
This verifies that the passed-in string contains only alpha-numeric characters. This is strict and will return invalid if spaces, hyphens or other characters are found.
NOTE: An empty string is considered invalid.
$string = "4words";
if ($anvil->Validate->is_alphanumeric({string => $string}))
{
print "The string: [$string] is valid!\n";
}
=head2 Parameters;
=head3 string (required)
This is the string name to validate.
=cut
sub is_alphanumeric
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $valid = 1;
my $debug = 3;
my $string = defined $parameter->{string} ? $parameter->{string} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
if (not $string)
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
if ($string !~ /^[a-zA-Z0-9]+$/)
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_domain_name
Checks if the passed-in string is a valid domain name. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not.
$name = "alteeve.com";
if ($anvil->Validate->is_domain_name({name => $name}))
{
print "The domain name: [$name] is valid!\n";
}
=head2 Parameters;
=head3 name (required)
This is the domain name to validate.
=cut
sub is_domain_name
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $valid = 1;
my $debug = 3;
my $name = $parameter->{name} ? $parameter->{name} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { name => $name }});
if (not $name)
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
elsif (($name !~ /^((([a-z]|[0-9]|\-)+)\.)+([a-z])+$/i) && (($name !~ /^\w+$/) && ($name !~ /-/)))
{
# Doesn't appear to be valid.
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_ipv4
Checks if the passed-in string is an IPv4 address. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not.
$ip = "111.222.33.44";
if ($anvil->Validate->is_ipv4({ip => $ip}))
{
print "The IP address: [$ip] is valid!\n";
}
=head2 Parameters;
=head3 ip (required)
This is the IP address to verify.
=cut
sub is_ipv4
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = 3;
my $ip = defined $parameter->{ip} ? $parameter->{ip} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }});
my $valid = 1;
if ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
{
# It is in the right format.
my $first_octet = $1;
my $second_octet = $2;
my $third_octet = $3;
my $fourth_octet = $4;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
first_octet => $first_octet,
second_octet => $second_octet,
third_octet => $third_octet,
fourth_octet => $fourth_octet,
}});
if (($first_octet < 0) or ($first_octet > 255) or
($second_octet < 0) or ($second_octet > 255) or
($third_octet < 0) or ($third_octet > 255) or
($fourth_octet < 0) or ($fourth_octet > 255))
{
# One of the octets is out of range.
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
}
else
{
# Not in the right format.
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_mac
Checks if the passed-in string is a valid network MAC address. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not.
=head2 Parameters;
=head3 mac (required)
This is the network MAC address to verify.
=cut
sub is_mac
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = 3;
my $mac = defined $parameter->{mac} ? $parameter->{mac} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mac => $mac }});
my $valid = 0;
if ($mac =~ /^([0-9a-f]{2}([:-]|$)){6}$/i)
{
# It is in the right format.
$valid = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_positive_integer
This method verifies that the passed in value is a positive integer.
NOTE: This method is strict and will only validate numbers without decimal places and that have no sign or a positive sign only (ie: C<< +3 >>, or C<< 3 >> are valid, but C<< -3 >> or C<< 3.0 >> are not).
my $number = 3;
if ($anvil->Validate->is_positive_integer({number => $number}))
{
print "The number: [$number] is valid!\n";
}
=head2 Parameters;
=head3 number (required)
This is the number to verify.
=head3 zero (optional)
If set, the number C<< 0 >> will be considered valid. By default, c<< 0 >> is not considered "positive".
=cut
sub is_positive_integer
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = 3;
my $valid = 1;
my $number = defined $parameter->{number} ? $parameter->{number} : "";
my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
number => $number,
zero => $zero,
}});
# We'll strip a positive leading character as that is allowed.
$number =~ s/^\+//;
# Now anything
if ($number !~ /^\d+$/)
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
if ((not $zero) && (not $number))
{
$valid = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_subnet
This method takes a subnet string and checks to see if it is a valid IPv4 address or CIDR notation. It returns 'C<< 1 >>' if it is a valid address. Otherwise it returns 'C<< 0 >>'.
=head2 Parameters;
=head3 subnet (required)
This is the address to verify.
=cut
sub is_subnet
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $valid = 0;
my $debug = 3;
my $subnet = defined $parameter->{subnet} ? $parameter->{subnet} : 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { subnet => $subnet }});
if ($subnet)
{
# We have something. Is it an IPv4 address?
if ($anvil->Validate->is_ipv4({ip => $subnet}))
{
# It is. Try converting it to a CIDR notation. If we get an empty string back, it isn't valid.
my $cidr = $anvil->Convert->cidr({subnet => $subnet});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { cidr => $cidr }});
if ($cidr)
{
# It's valid.
$valid = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
else
{
# OK, maybe it's a CIDR notation?
my $ip = $anvil->Convert->cidr({cidr => $subnet});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }});
if ($ip)
{
# There we go.
$valid = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
}
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid);
}
=head2 is_uuid
This method takes a UUID string and returns 'C<< 1 >>' if it is a valid UUID string. Otherwise it returns 'C<< 0 >>'.
NOTE: This method is strict and will only validate UUIDs that are lower case!
if ($anvil->Validate->is_uuid({uuid => $string}))
{
print "The UUID: [$string] is valid!\n";
}
=head2 Parameters;
=head3 uuid (required)
This is the UUID to verify.
=cut
sub is_uuid
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $uuid = defined $parameter->{uuid} ? $parameter->{uuid} : 0;
my $valid = 0;
if (($uuid) && ($uuid =~ /^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/))
{
$valid = 1;
}
return($valid);
}
1;