1# --
2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/
3# --
4# This software comes with ABSOLUTELY NO WARRANTY. For details, see
5# the enclosed file COPYING for license information (GPL). If you
6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
7# --
8
9package Kernel::System::VariableCheck;
10
11use strict;
12use warnings;
13
14use Exporter qw(import);
15our %EXPORT_TAGS = (    ## no critic
16    all => [
17        'IsArrayRefWithData',
18        'IsHashRefWithData',
19        'IsInteger',
20        'IsIPv4Address',
21        'IsIPv6Address',
22        'IsMD5Sum',
23        'IsNotEqual',
24        'IsNumber',
25        'IsPositiveInteger',
26        'IsString',
27        'IsStringWithData',
28        'DataIsDifferent',
29    ],
30);
31Exporter::export_ok_tags('all');
32
33=head1 NAME
34
35Kernel::System::VariableCheck - helper functions to check variables
36
37=head1 DESCRIPTION
38
39Provides several helper functions to check variables, e.g.
40if a variable is a string, a hash ref etc. This is helpful for
41input data validation, for example.
42
43Call this module directly without instantiating:
44
45    use Kernel::System::VariableCheck qw(:all);             # export all functions into the calling package
46    use Kernel::System::VariableCheck qw(IsHashRefWitData); # export just one function
47
48    if (IsHashRefWithData($HashRef)) {
49        ...
50    }
51
52The functions can be grouped as follows:
53
54=head2 Variable type checks
55
56=over 4
57
58=item * L</IsString()>
59
60=item * L</IsStringWithData()>
61
62=item * L</IsArrayRefWithData()>
63
64=item * L</IsHashRefWithData()>
65
66=back
67
68=head2 Number checks
69
70=over 4
71
72=item * L</IsNumber()>
73
74=item * L</IsInteger()>
75
76=item * L</IsPositiveInteger()>
77
78=back
79
80=head2 Special data format checks
81
82=over 4
83
84=item * L</IsIPv4Address()>
85
86=item * L</IsIPv6Address()>
87
88=item * L</IsMD5Sum()>
89
90=back
91
92=head1 PUBLIC INTERFACE
93
94=head2 IsString()
95
96test supplied data to determine if it is a string - an empty string is valid
97
98returns 1 if data matches criteria or undef otherwise
99
100    my $Result = IsString(
101        'abc', # data to be tested
102    );
103
104=cut
105
106## no critic (Perl::Critic::Policy::Subroutines::RequireArgUnpacking)
107
108sub IsString {
109    my $TestData = $_[0];
110
111    return if scalar @_ ne 1;
112    return if ref $TestData;
113    return if !defined $TestData;
114
115    return 1;
116}
117
118=head2 IsStringWithData()
119
120test supplied data to determine if it is a non zero-length string
121
122returns 1 if data matches criteria or undef otherwise
123
124    my $Result = IsStringWithData(
125        'abc', # data to be tested
126    );
127
128=cut
129
130sub IsStringWithData {
131    my $TestData = $_[0];
132
133    return if !IsString(@_);
134    return if $TestData eq '';
135
136    return 1;
137}
138
139=head2 IsArrayRefWithData()
140
141test supplied data to determine if it is an array reference and contains at least one key
142
143returns 1 if data matches criteria or undef otherwise
144
145    my $Result = IsArrayRefWithData(
146        [ # data to be tested
147            'key',
148            ...
149        ],
150    );
151
152=cut
153
154sub IsArrayRefWithData {
155    my $TestData = $_[0];
156
157    return if scalar @_ ne 1;
158    return if ref $TestData ne 'ARRAY';
159    return if !@{$TestData};
160
161    return 1;
162}
163
164=head2 IsHashRefWithData()
165
166test supplied data to determine if it is a hash reference and contains at least one key/value pair
167
168returns 1 if data matches criteria or undef otherwise
169
170    my $Result = IsHashRefWithData(
171        { # data to be tested
172            'key' => 'value',
173            ...
174        },
175    );
176
177=cut
178
179sub IsHashRefWithData {
180    my $TestData = $_[0];
181
182    return if scalar @_ ne 1;
183    return if ref $TestData ne 'HASH';
184    return if !%{$TestData};
185
186    return 1;
187}
188
189=head2 IsNumber()
190
191test supplied data to determine if it is a number
192(integer, floating point, possible exponent, positive or negative)
193
194returns 1 if data matches criteria or undef otherwise
195
196    my $Result = IsNumber(
197        999, # data to be tested
198    );
199
200=cut
201
202sub IsNumber {
203    my $TestData = $_[0];
204
205    return if !IsStringWithData(@_);
206    return if $TestData !~ m{
207        \A [-]? (?: \d+ | \d* [.] \d+ | (?: \d+ [.]? \d* | \d* [.] \d+ ) [eE] [-+]? \d* ) \z
208    }xms;
209
210    return 1;
211}
212
213=head2 IsInteger()
214
215test supplied data to determine if it is an integer (only digits, positive or negative)
216
217returns 1 if data matches criteria or undef otherwise
218
219    my $Result = IsInteger(
220        999, # data to be tested
221    );
222
223=cut
224
225sub IsInteger {
226    my $TestData = $_[0];
227
228    return if !IsStringWithData(@_);
229    return if $TestData !~ m{ \A [-]? (?: 0 | [1-9] \d* ) \z }xms;
230
231    return 1;
232}
233
234=head2 IsPositiveInteger()
235
236test supplied data to determine if it is a positive integer (only digits and positive)
237
238returns 1 if data matches criteria or undef otherwise
239
240    my $Result = IsPositiveInteger(
241        999, # data to be tested
242    );
243
244=cut
245
246sub IsPositiveInteger {
247    my $TestData = $_[0];
248
249    return if !IsStringWithData(@_);
250    return if $TestData !~ m{ \A [1-9] \d* \z }xms;
251
252    return 1;
253}
254
255=head2 IsIPv4Address()
256
257test supplied data to determine if it is a valid IPv4 address (syntax check only)
258
259returns 1 if data matches criteria or undef otherwise
260
261    my $Result = IsIPv4Address(
262        '192.168.0.1', # data to be tested
263    );
264
265=cut
266
267sub IsIPv4Address {
268    my $TestData = $_[0];
269
270    return if !IsStringWithData(@_);
271    return if $TestData !~ m{ \A [\d\.]+ \z }xms;
272    my @Part = split '\.', $TestData;
273
274    # four parts delimited by '.' needed
275    return if scalar @Part ne 4;
276    for my $Part (@Part) {
277
278        # allow numbers 0 to 255, no leading zeroes
279        return if $Part !~ m{
280            \A (?: \d | [1-9] \d | [1] \d{2} | [2][0-4]\d | [2][5][0-5] ) \z
281        }xms;
282    }
283
284    return 1;
285}
286
287=head2 IsIPv6Address()
288
289test supplied data to determine if it is a valid IPv6 address (syntax check only)
290shorthand notation and mixed IPv6/IPv4 notation allowed
291# FIXME IPv6/IPv4 notation currently not supported
292
293returns 1 if data matches criteria or undef otherwise
294
295    my $Result = IsIPv6Address(
296        '0000:1111:2222:3333:4444:5555:6666:7777', # data to be tested
297    );
298
299=cut
300
301sub IsIPv6Address {
302    my $TestData = $_[0];
303
304    return if !IsStringWithData(@_);
305
306    # only hex characters (0-9,A-Z) plus separator ':' allowed
307    return if $TestData !~ m{ \A [\da-f:]+ \z }xmsi;
308
309    # special case - equals only zeroes
310    return 1 if $TestData eq '::';
311
312    # special cases - address must not start or end with single ':'
313    return if $TestData =~ m{ \A : [^:] }xms;
314    return if $TestData =~ m{ [^:] : \z }xms;
315
316    # special case - address must not start and end with ':'
317    return if $TestData =~ m{ \A : .+ : \z }xms;
318
319    my $SkipFirst;
320    if ( $TestData =~ m{ \A :: }xms ) {
321        $TestData  = 'X' . $TestData;
322        $SkipFirst = 1;
323    }
324    my $SkipLast;
325    if ( $TestData =~ m{ :: \z }xms ) {
326        $TestData .= 'X';
327        $SkipLast = 1;
328    }
329    my @Part = split ':', $TestData;
330    if ($SkipFirst) {
331        shift @Part;
332    }
333    if ($SkipLast) {
334        delete $Part[-1];
335    }
336    return if scalar @Part < 2 || scalar @Part > 8;
337    return if scalar @Part ne 8 && $TestData !~ m{ :: }xms;
338
339    # handle full addreses
340    if ( scalar @Part eq 8 ) {
341        my $EmptyPart;
342        PART:
343        for my $Part (@Part) {
344            if ( $Part eq '' ) {
345                return if $EmptyPart;
346                $EmptyPart = 1;
347                next PART;
348            }
349            return if $Part !~ m{ \A [\da-f]{1,4} \z }xmsi;
350        }
351    }
352
353    # handle shorthand addresses
354    my $ShortHandUsed;
355    PART:
356    for my $Part (@Part) {
357        next PART if $Part eq 'X';
358
359        # empty part means shorthand - do we already have more than one consecutive empty parts?
360        return if $Part eq '' && $ShortHandUsed;
361        if ( $Part eq '' ) {
362            $ShortHandUsed = 1;
363            next PART;
364        }
365        return if $Part !~ m{ \A [\da-f]{1,4} \z }xmsi;
366    }
367
368    return 1;
369}
370
371=head2 IsMD5Sum()
372
373test supplied data to determine if it is an C<MD5> sum (32 hex characters)
374
375returns 1 if data matches criteria or undef otherwise
376
377    my $Result = IsMD5Sum(
378        '6f1ed002ab5595859014ebf0951522d9', # data to be tested
379    );
380
381=cut
382
383sub IsMD5Sum {
384    my $TestData = $_[0];
385
386    return if !IsStringWithData(@_);
387    return if $TestData !~ m{ \A [\da-f]{32} \z }xmsi;
388
389    return 1;
390}
391
392=head2 DataIsDifferent()
393
394compares two data structures with each other. Returns 1 if
395they are different, undef otherwise.
396
397Data parameters need to be passed by reference and can be SCALAR,
398ARRAY or HASH.
399
400    my $DataIsDifferent = DataIsDifferent(
401        Data1 => \$Data1,
402        Data2 => \$Data2,
403    );
404
405=cut
406
407sub DataIsDifferent {
408    my (%Param) = @_;
409
410    # ''
411    if ( ref $Param{Data1} eq '' && ref $Param{Data2} eq '' ) {
412
413        # do nothing, it's ok
414        return if !defined $Param{Data1} && !defined $Param{Data2};
415
416        # return diff, because its different
417        return 1 if !defined $Param{Data1} || !defined $Param{Data2};
418
419        # return diff, because its different
420        return 1 if $Param{Data1} ne $Param{Data2};
421
422        # return, because its not different
423        return;
424    }
425
426    # SCALAR
427    if ( ref $Param{Data1} eq 'SCALAR' && ref $Param{Data2} eq 'SCALAR' ) {
428
429        # do nothing, it's ok
430        return if !defined ${ $Param{Data1} } && !defined ${ $Param{Data2} };
431
432        # return diff, because its different
433        return 1 if !defined ${ $Param{Data1} } || !defined ${ $Param{Data2} };
434
435        # return diff, because its different
436        return 1 if ${ $Param{Data1} } ne ${ $Param{Data2} };
437
438        # return, because its not different
439        return;
440    }
441
442    # ARRAY
443    if ( ref $Param{Data1} eq 'ARRAY' && ref $Param{Data2} eq 'ARRAY' ) {
444        my @A = @{ $Param{Data1} };
445        my @B = @{ $Param{Data2} };
446
447        # check if the count is different
448        return 1 if $#A ne $#B;
449
450        # compare array
451        COUNT:
452        for my $Count ( 0 .. $#A ) {
453
454            # do nothing, it's ok
455            next COUNT if !defined $A[$Count] && !defined $B[$Count];
456
457            # return diff, because its different
458            return 1 if !defined $A[$Count] || !defined $B[$Count];
459
460            if ( $A[$Count] ne $B[$Count] ) {
461                if ( ref $A[$Count] eq 'ARRAY' || ref $A[$Count] eq 'HASH' ) {
462                    return 1 if DataIsDifferent(
463                        Data1 => $A[$Count],
464                        Data2 => $B[$Count]
465                    );
466                    next COUNT;
467                }
468                return 1;
469            }
470        }
471        return;
472    }
473
474    # HASH
475    if ( ref $Param{Data1} eq 'HASH' && ref $Param{Data2} eq 'HASH' ) {
476        my %A = %{ $Param{Data1} };
477        my %B = %{ $Param{Data2} };
478
479        # compare %A with %B and remove it if checked
480        KEY:
481        for my $Key ( sort keys %A ) {
482
483            # Check if both are undefined
484            if ( !defined $A{$Key} && !defined $B{$Key} ) {
485                delete $A{$Key};
486                delete $B{$Key};
487                next KEY;
488            }
489
490            # return diff, because its different
491            return 1 if !defined $A{$Key} || !defined $B{$Key};
492
493            if ( $A{$Key} eq $B{$Key} ) {
494                delete $A{$Key};
495                delete $B{$Key};
496                next KEY;
497            }
498
499            # return if values are different
500            if ( ref $A{$Key} eq 'ARRAY' || ref $A{$Key} eq 'HASH' ) {
501                return 1 if DataIsDifferent(
502                    Data1 => $A{$Key},
503                    Data2 => $B{$Key}
504                );
505                delete $A{$Key};
506                delete $B{$Key};
507                next KEY;
508            }
509            return 1;
510        }
511
512        # check rest
513        return 1 if %B;
514        return;
515    }
516
517    if ( ref $Param{Data1} eq 'REF' && ref $Param{Data2} eq 'REF' ) {
518        return 1 if DataIsDifferent(
519            Data1 => ${ $Param{Data1} },
520            Data2 => ${ $Param{Data2} }
521        );
522        return;
523    }
524
525    return 1;
526}
527
5281;
529
530=head1 TERMS AND CONDITIONS
531
532This software is part of the OTRS project (L<https://otrs.org/>).
533
534This software comes with ABSOLUTELY NO WARRANTY. For details, see
535the enclosed file COPYING for license information (GPL). If you
536did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
537
538=cut
539