539 lines
12 KiB
Perl
539 lines
12 KiB
Perl
# --
|
|
# Copyright (C) 2001-2019 OTRS AG, https://otrs.com/
|
|
# --
|
|
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
|
|
# the enclosed file COPYING for license information (GPL). If you
|
|
# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
|
|
# --
|
|
|
|
package Kernel::System::VariableCheck;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Exporter qw(import);
|
|
our %EXPORT_TAGS = ( ## no critic
|
|
all => [
|
|
'IsArrayRefWithData',
|
|
'IsHashRefWithData',
|
|
'IsInteger',
|
|
'IsIPv4Address',
|
|
'IsIPv6Address',
|
|
'IsMD5Sum',
|
|
'IsNotEqual',
|
|
'IsNumber',
|
|
'IsPositiveInteger',
|
|
'IsString',
|
|
'IsStringWithData',
|
|
'DataIsDifferent',
|
|
],
|
|
);
|
|
Exporter::export_ok_tags('all');
|
|
|
|
=head1 NAME
|
|
|
|
Kernel::System::VariableCheck - helper functions to check variables
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Provides several helper functions to check variables, e.g.
|
|
if a variable is a string, a hash ref etc. This is helpful for
|
|
input data validation, for example.
|
|
|
|
Call this module directly without instantiating:
|
|
|
|
use Kernel::System::VariableCheck qw(:all); # export all functions into the calling package
|
|
use Kernel::System::VariableCheck qw(IsHashRefWitData); # export just one function
|
|
|
|
if (IsHashRefWithData($HashRef)) {
|
|
...
|
|
}
|
|
|
|
The functions can be grouped as follows:
|
|
|
|
=head2 Variable type checks
|
|
|
|
=over 4
|
|
|
|
=item * L</IsString()>
|
|
|
|
=item * L</IsStringWithData()>
|
|
|
|
=item * L</IsArrayRefWithData()>
|
|
|
|
=item * L</IsHashRefWithData()>
|
|
|
|
=back
|
|
|
|
=head2 Number checks
|
|
|
|
=over 4
|
|
|
|
=item * L</IsNumber()>
|
|
|
|
=item * L</IsInteger()>
|
|
|
|
=item * L</IsPositiveInteger()>
|
|
|
|
=back
|
|
|
|
=head2 Special data format checks
|
|
|
|
=over 4
|
|
|
|
=item * L</IsIPv4Address()>
|
|
|
|
=item * L</IsIPv6Address()>
|
|
|
|
=item * L</IsMD5Sum()>
|
|
|
|
=back
|
|
|
|
=head1 PUBLIC INTERFACE
|
|
|
|
=head2 IsString()
|
|
|
|
test supplied data to determine if it is a string - an empty string is valid
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsString(
|
|
'abc', # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
## no critic (Perl::Critic::Policy::Subroutines::RequireArgUnpacking)
|
|
|
|
sub IsString {
|
|
my $TestData = $_[0];
|
|
|
|
return if scalar @_ ne 1;
|
|
return if ref $TestData;
|
|
return if !defined $TestData;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsStringWithData()
|
|
|
|
test supplied data to determine if it is a non zero-length string
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsStringWithData(
|
|
'abc', # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsStringWithData {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsString(@_);
|
|
return if $TestData eq '';
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsArrayRefWithData()
|
|
|
|
test supplied data to determine if it is an array reference and contains at least one key
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsArrayRefWithData(
|
|
[ # data to be tested
|
|
'key',
|
|
...
|
|
],
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsArrayRefWithData {
|
|
my $TestData = $_[0];
|
|
|
|
return if scalar @_ ne 1;
|
|
return if ref $TestData ne 'ARRAY';
|
|
return if !@{$TestData};
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsHashRefWithData()
|
|
|
|
test supplied data to determine if it is a hash reference and contains at least one key/value pair
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsHashRefWithData(
|
|
{ # data to be tested
|
|
'key' => 'value',
|
|
...
|
|
},
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsHashRefWithData {
|
|
my $TestData = $_[0];
|
|
|
|
return if scalar @_ ne 1;
|
|
return if ref $TestData ne 'HASH';
|
|
return if !%{$TestData};
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsNumber()
|
|
|
|
test supplied data to determine if it is a number
|
|
(integer, floating point, possible exponent, positive or negative)
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsNumber(
|
|
999, # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsNumber {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
return if $TestData !~ m{
|
|
\A [-]? (?: \d+ | \d* [.] \d+ | (?: \d+ [.]? \d* | \d* [.] \d+ ) [eE] [-+]? \d* ) \z
|
|
}xms;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsInteger()
|
|
|
|
test supplied data to determine if it is an integer (only digits, positive or negative)
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsInteger(
|
|
999, # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsInteger {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
return if $TestData !~ m{ \A [-]? (?: 0 | [1-9] \d* ) \z }xms;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsPositiveInteger()
|
|
|
|
test supplied data to determine if it is a positive integer (only digits and positive)
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsPositiveInteger(
|
|
999, # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsPositiveInteger {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
return if $TestData !~ m{ \A [1-9] \d* \z }xms;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsIPv4Address()
|
|
|
|
test supplied data to determine if it is a valid IPv4 address (syntax check only)
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsIPv4Address(
|
|
'192.168.0.1', # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsIPv4Address {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
return if $TestData !~ m{ \A [\d\.]+ \z }xms;
|
|
my @Part = split '\.', $TestData;
|
|
|
|
# four parts delimited by '.' needed
|
|
return if scalar @Part ne 4;
|
|
for my $Part (@Part) {
|
|
|
|
# allow numbers 0 to 255, no leading zeroes
|
|
return if $Part !~ m{
|
|
\A (?: \d | [1-9] \d | [1] \d{2} | [2][0-4]\d | [2][5][0-5] ) \z
|
|
}xms;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsIPv6Address()
|
|
|
|
test supplied data to determine if it is a valid IPv6 address (syntax check only)
|
|
shorthand notation and mixed IPv6/IPv4 notation allowed
|
|
# FIXME IPv6/IPv4 notation currently not supported
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsIPv6Address(
|
|
'0000:1111:2222:3333:4444:5555:6666:7777', # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsIPv6Address {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
|
|
# only hex characters (0-9,A-Z) plus separator ':' allowed
|
|
return if $TestData !~ m{ \A [\da-f:]+ \z }xmsi;
|
|
|
|
# special case - equals only zeroes
|
|
return 1 if $TestData eq '::';
|
|
|
|
# special cases - address must not start or end with single ':'
|
|
return if $TestData =~ m{ \A : [^:] }xms;
|
|
return if $TestData =~ m{ [^:] : \z }xms;
|
|
|
|
# special case - address must not start and end with ':'
|
|
return if $TestData =~ m{ \A : .+ : \z }xms;
|
|
|
|
my $SkipFirst;
|
|
if ( $TestData =~ m{ \A :: }xms ) {
|
|
$TestData = 'X' . $TestData;
|
|
$SkipFirst = 1;
|
|
}
|
|
my $SkipLast;
|
|
if ( $TestData =~ m{ :: \z }xms ) {
|
|
$TestData .= 'X';
|
|
$SkipLast = 1;
|
|
}
|
|
my @Part = split ':', $TestData;
|
|
if ($SkipFirst) {
|
|
shift @Part;
|
|
}
|
|
if ($SkipLast) {
|
|
delete $Part[-1];
|
|
}
|
|
return if scalar @Part < 2 || scalar @Part > 8;
|
|
return if scalar @Part ne 8 && $TestData !~ m{ :: }xms;
|
|
|
|
# handle full addreses
|
|
if ( scalar @Part eq 8 ) {
|
|
my $EmptyPart;
|
|
PART:
|
|
for my $Part (@Part) {
|
|
if ( $Part eq '' ) {
|
|
return if $EmptyPart;
|
|
$EmptyPart = 1;
|
|
next PART;
|
|
}
|
|
return if $Part !~ m{ \A [\da-f]{1,4} \z }xmsi;
|
|
}
|
|
}
|
|
|
|
# handle shorthand addresses
|
|
my $ShortHandUsed;
|
|
PART:
|
|
for my $Part (@Part) {
|
|
next PART if $Part eq 'X';
|
|
|
|
# empty part means shorthand - do we already have more than one consecutive empty parts?
|
|
return if $Part eq '' && $ShortHandUsed;
|
|
if ( $Part eq '' ) {
|
|
$ShortHandUsed = 1;
|
|
next PART;
|
|
}
|
|
return if $Part !~ m{ \A [\da-f]{1,4} \z }xmsi;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 IsMD5Sum()
|
|
|
|
test supplied data to determine if it is an C<MD5> sum (32 hex characters)
|
|
|
|
returns 1 if data matches criteria or undef otherwise
|
|
|
|
my $Result = IsMD5Sum(
|
|
'6f1ed002ab5595859014ebf0951522d9', # data to be tested
|
|
);
|
|
|
|
=cut
|
|
|
|
sub IsMD5Sum {
|
|
my $TestData = $_[0];
|
|
|
|
return if !IsStringWithData(@_);
|
|
return if $TestData !~ m{ \A [\da-f]{32} \z }xmsi;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 DataIsDifferent()
|
|
|
|
compares two data structures with each other. Returns 1 if
|
|
they are different, undef otherwise.
|
|
|
|
Data parameters need to be passed by reference and can be SCALAR,
|
|
ARRAY or HASH.
|
|
|
|
my $DataIsDifferent = DataIsDifferent(
|
|
Data1 => \$Data1,
|
|
Data2 => \$Data2,
|
|
);
|
|
|
|
=cut
|
|
|
|
sub DataIsDifferent {
|
|
my (%Param) = @_;
|
|
|
|
# ''
|
|
if ( ref $Param{Data1} eq '' && ref $Param{Data2} eq '' ) {
|
|
|
|
# do nothing, it's ok
|
|
return if !defined $Param{Data1} && !defined $Param{Data2};
|
|
|
|
# return diff, because its different
|
|
return 1 if !defined $Param{Data1} || !defined $Param{Data2};
|
|
|
|
# return diff, because its different
|
|
return 1 if $Param{Data1} ne $Param{Data2};
|
|
|
|
# return, because its not different
|
|
return;
|
|
}
|
|
|
|
# SCALAR
|
|
if ( ref $Param{Data1} eq 'SCALAR' && ref $Param{Data2} eq 'SCALAR' ) {
|
|
|
|
# do nothing, it's ok
|
|
return if !defined ${ $Param{Data1} } && !defined ${ $Param{Data2} };
|
|
|
|
# return diff, because its different
|
|
return 1 if !defined ${ $Param{Data1} } || !defined ${ $Param{Data2} };
|
|
|
|
# return diff, because its different
|
|
return 1 if ${ $Param{Data1} } ne ${ $Param{Data2} };
|
|
|
|
# return, because its not different
|
|
return;
|
|
}
|
|
|
|
# ARRAY
|
|
if ( ref $Param{Data1} eq 'ARRAY' && ref $Param{Data2} eq 'ARRAY' ) {
|
|
my @A = @{ $Param{Data1} };
|
|
my @B = @{ $Param{Data2} };
|
|
|
|
# check if the count is different
|
|
return 1 if $#A ne $#B;
|
|
|
|
# compare array
|
|
COUNT:
|
|
for my $Count ( 0 .. $#A ) {
|
|
|
|
# do nothing, it's ok
|
|
next COUNT if !defined $A[$Count] && !defined $B[$Count];
|
|
|
|
# return diff, because its different
|
|
return 1 if !defined $A[$Count] || !defined $B[$Count];
|
|
|
|
if ( $A[$Count] ne $B[$Count] ) {
|
|
if ( ref $A[$Count] eq 'ARRAY' || ref $A[$Count] eq 'HASH' ) {
|
|
return 1 if DataIsDifferent(
|
|
Data1 => $A[$Count],
|
|
Data2 => $B[$Count]
|
|
);
|
|
next COUNT;
|
|
}
|
|
return 1;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
# HASH
|
|
if ( ref $Param{Data1} eq 'HASH' && ref $Param{Data2} eq 'HASH' ) {
|
|
my %A = %{ $Param{Data1} };
|
|
my %B = %{ $Param{Data2} };
|
|
|
|
# compare %A with %B and remove it if checked
|
|
KEY:
|
|
for my $Key ( sort keys %A ) {
|
|
|
|
# Check if both are undefined
|
|
if ( !defined $A{$Key} && !defined $B{$Key} ) {
|
|
delete $A{$Key};
|
|
delete $B{$Key};
|
|
next KEY;
|
|
}
|
|
|
|
# return diff, because its different
|
|
return 1 if !defined $A{$Key} || !defined $B{$Key};
|
|
|
|
if ( $A{$Key} eq $B{$Key} ) {
|
|
delete $A{$Key};
|
|
delete $B{$Key};
|
|
next KEY;
|
|
}
|
|
|
|
# return if values are different
|
|
if ( ref $A{$Key} eq 'ARRAY' || ref $A{$Key} eq 'HASH' ) {
|
|
return 1 if DataIsDifferent(
|
|
Data1 => $A{$Key},
|
|
Data2 => $B{$Key}
|
|
);
|
|
delete $A{$Key};
|
|
delete $B{$Key};
|
|
next KEY;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
# check rest
|
|
return 1 if %B;
|
|
return;
|
|
}
|
|
|
|
if ( ref $Param{Data1} eq 'REF' && ref $Param{Data2} eq 'REF' ) {
|
|
return 1 if DataIsDifferent(
|
|
Data1 => ${ $Param{Data1} },
|
|
Data2 => ${ $Param{Data2} }
|
|
);
|
|
return;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
1;
|
|
|
|
=head1 TERMS AND CONDITIONS
|
|
|
|
This software is part of the OTRS project (L<https://otrs.org/>).
|
|
|
|
This software comes with ABSOLUTELY NO WARRANTY. For details, see
|
|
the enclosed file COPYING for license information (GPL). If you
|
|
did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
|
|
|
|
=cut
|