init III
This commit is contained in:
333
Perl OTRS/Kernel/System/CheckItem.pm
Normal file
333
Perl OTRS/Kernel/System/CheckItem.pm
Normal file
@@ -0,0 +1,333 @@
|
||||
# --
|
||||
# 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::CheckItem;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Email::Valid;
|
||||
|
||||
our @ObjectDependencies = (
|
||||
'Kernel::Config',
|
||||
'Kernel::System::Log',
|
||||
);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Kernel::System::CheckItem - check items
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
All item check functions.
|
||||
|
||||
=head1 PUBLIC INTERFACE
|
||||
|
||||
=head2 new()
|
||||
|
||||
Don't use the constructor directly, use the ObjectManager instead:
|
||||
|
||||
my $CheckItemObject = $Kernel::OM->Get('Kernel::System::CheckItem');
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ( $Type, %Param ) = @_;
|
||||
|
||||
# allocate new hash for object
|
||||
my $Self = {};
|
||||
bless( $Self, $Type );
|
||||
|
||||
return $Self;
|
||||
}
|
||||
|
||||
=head2 CheckError()
|
||||
|
||||
get the error of check item back
|
||||
|
||||
my $Error = $CheckItemObject->CheckError();
|
||||
|
||||
=cut
|
||||
|
||||
sub CheckError {
|
||||
my $Self = shift;
|
||||
|
||||
return $Self->{Error};
|
||||
}
|
||||
|
||||
=head2 CheckErrorType()
|
||||
|
||||
get the error's type of check item back
|
||||
|
||||
my $ErrorType = $CheckItemObject->CheckErrorType();
|
||||
|
||||
=cut
|
||||
|
||||
sub CheckErrorType {
|
||||
my $Self = shift;
|
||||
|
||||
return $Self->{ErrorType};
|
||||
}
|
||||
|
||||
=head2 CheckEmail()
|
||||
|
||||
returns true if check was successful, if it's false, get the error message
|
||||
from CheckError()
|
||||
|
||||
my $Valid = $CheckItemObject->CheckEmail(
|
||||
Address => 'info@example.com',
|
||||
);
|
||||
|
||||
=cut
|
||||
|
||||
sub CheckEmail {
|
||||
my ( $Self, %Param ) = @_;
|
||||
|
||||
# check needed stuff
|
||||
if ( !$Param{Address} ) {
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => 'Need Address!'
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
# get config object
|
||||
my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
|
||||
|
||||
# check if it's to do
|
||||
return 1 if !$ConfigObject->Get('CheckEmailAddresses');
|
||||
|
||||
# check valid email addresses
|
||||
my $RegExp = $ConfigObject->Get('CheckEmailValidAddress');
|
||||
if ( $RegExp && $Param{Address} =~ /$RegExp/i ) {
|
||||
return 1;
|
||||
}
|
||||
my $Error = '';
|
||||
|
||||
# Workaround for https://github.com/Perl-Email-Project/Email-Valid/issues/36:
|
||||
# remove comment from address when checking.
|
||||
$Param{Address} =~ s{ \s* \( [^()]* \) \s* $ }{}smxg;
|
||||
|
||||
# email address syntax check
|
||||
if ( !Email::Valid->address( $Param{Address} ) ) {
|
||||
$Error = "Invalid syntax";
|
||||
$Self->{ErrorType} = 'InvalidSyntax';
|
||||
}
|
||||
|
||||
# email address syntax check
|
||||
# period (".") may not be used to end the local part,
|
||||
# nor may two or more consecutive periods appear
|
||||
if ( $Param{Address} =~ /(\.\.)|(\.@)/ ) {
|
||||
$Error = "Invalid syntax";
|
||||
$Self->{ErrorType} = 'InvalidSyntax';
|
||||
}
|
||||
|
||||
# mx check
|
||||
elsif (
|
||||
$ConfigObject->Get('CheckMXRecord')
|
||||
&& eval { require Net::DNS } ## no critic
|
||||
)
|
||||
{
|
||||
|
||||
# get host
|
||||
my $Host = $Param{Address};
|
||||
$Host =~ s/^.*@(.*)$/$1/;
|
||||
$Host =~ s/\s+//g;
|
||||
$Host =~ s/(^\[)|(\]$)//g;
|
||||
|
||||
# do dns query
|
||||
my $Resolver = Net::DNS::Resolver->new();
|
||||
if ($Resolver) {
|
||||
|
||||
# it's no fun to have this hanging in the web interface
|
||||
$Resolver->tcp_timeout(3);
|
||||
$Resolver->udp_timeout(3);
|
||||
|
||||
# check if we need to use a specific name server
|
||||
my $Nameserver = $ConfigObject->Get('CheckMXRecord::Nameserver');
|
||||
if ($Nameserver) {
|
||||
$Resolver->nameservers($Nameserver);
|
||||
}
|
||||
|
||||
# A-record lookup to verify proper DNS setup
|
||||
my $Packet = $Resolver->send( $Host, 'A' );
|
||||
if ( !$Packet ) {
|
||||
$Self->{ErrorType} = 'InvalidDNS';
|
||||
$Error = "DNS problem: " . $Resolver->errorstring();
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => $Error,
|
||||
);
|
||||
}
|
||||
|
||||
else {
|
||||
# RFC 5321: first check MX record and fallback to A record if present.
|
||||
# mx record lookup
|
||||
my @MXRecords = Net::DNS::mx( $Resolver, $Host );
|
||||
|
||||
if ( !@MXRecords ) {
|
||||
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'debug',
|
||||
Message =>
|
||||
"$Host has no mail exchanger (MX) defined, trying A resource record instead.",
|
||||
);
|
||||
|
||||
# see if our previous A-record lookup returned a RR
|
||||
if ( scalar $Packet->answer() eq 0 ) {
|
||||
|
||||
$Self->{ErrorType} = 'InvalidMX';
|
||||
$Error = "$Host has no mail exchanger (MX) or A resource record defined.";
|
||||
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'debug',
|
||||
Message => $Error,
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $ConfigObject->Get('CheckMXRecord') ) {
|
||||
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => "Can't load Net::DNS, no mx lookups possible",
|
||||
);
|
||||
}
|
||||
|
||||
# check address
|
||||
if ( !$Error ) {
|
||||
|
||||
# check special stuff
|
||||
my $RegExp = $ConfigObject->Get('CheckEmailInvalidAddress');
|
||||
if ( $RegExp && $Param{Address} =~ /$RegExp/i ) {
|
||||
$Self->{Error} = "invalid $Param{Address} (config)!";
|
||||
$Self->{ErrorType} = 'InvalidConfig';
|
||||
return;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
|
||||
# remember error
|
||||
$Self->{Error} = "invalid $Param{Address} ($Error)! ";
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
=head2 StringClean()
|
||||
|
||||
clean a given string
|
||||
|
||||
my $StringRef = $CheckItemObject->StringClean(
|
||||
StringRef => \'String',
|
||||
TrimLeft => 0, # (optional) default 1
|
||||
TrimRight => 0, # (optional) default 1
|
||||
RemoveAllNewlines => 1, # (optional) default 0
|
||||
RemoveAllTabs => 1, # (optional) default 0
|
||||
RemoveAllSpaces => 1, # (optional) default 0
|
||||
);
|
||||
|
||||
=cut
|
||||
|
||||
sub StringClean {
|
||||
my ( $Self, %Param ) = @_;
|
||||
|
||||
if ( !$Param{StringRef} || ref $Param{StringRef} ne 'SCALAR' ) {
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => 'Need a scalar reference!'
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
return $Param{StringRef} if !defined ${ $Param{StringRef} };
|
||||
return $Param{StringRef} if ${ $Param{StringRef} } eq '';
|
||||
|
||||
# check for invalid utf8 characters and remove invalid strings
|
||||
if ( !utf8::valid( ${ $Param{StringRef} } ) ) {
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => "Removed string containing invalid utf8: '${ $Param{StringRef} }'!",
|
||||
);
|
||||
${ $Param{StringRef} } = '';
|
||||
return;
|
||||
}
|
||||
|
||||
# set default values
|
||||
$Param{TrimLeft} = defined $Param{TrimLeft} ? $Param{TrimLeft} : 1;
|
||||
$Param{TrimRight} = defined $Param{TrimRight} ? $Param{TrimRight} : 1;
|
||||
|
||||
my %TrimAction = (
|
||||
RemoveAllNewlines => qr{ [\n\r\f] }xms,
|
||||
RemoveAllTabs => qr{ \t }xms,
|
||||
RemoveAllSpaces => qr{ [ ] }xms,
|
||||
TrimLeft => qr{ \A \s+ }xms,
|
||||
TrimRight => qr{ \s+ \z }xms,
|
||||
);
|
||||
|
||||
ACTION:
|
||||
for my $Action ( sort keys %TrimAction ) {
|
||||
next ACTION if !$Param{$Action};
|
||||
|
||||
${ $Param{StringRef} } =~ s{ $TrimAction{$Action} }{}xmsg;
|
||||
}
|
||||
|
||||
return $Param{StringRef};
|
||||
}
|
||||
|
||||
=head2 CreditCardClean()
|
||||
|
||||
clean a given string and remove credit card
|
||||
|
||||
my ($StringRef, $Found) = $CheckItemObject->CreditCardClean(
|
||||
StringRef => \'String',
|
||||
);
|
||||
|
||||
=cut
|
||||
|
||||
sub CreditCardClean {
|
||||
my ( $Self, %Param ) = @_;
|
||||
|
||||
if ( !$Param{StringRef} || ref $Param{StringRef} ne 'SCALAR' ) {
|
||||
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
||||
Priority => 'error',
|
||||
Message => 'Need a scalar reference!'
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
return ( $Param{StringRef}, 0 ) if ${ $Param{StringRef} } eq '';
|
||||
return ( $Param{StringRef}, 0 ) if !defined ${ $Param{StringRef} };
|
||||
|
||||
# strip credit card numbers
|
||||
my $Count = 0;
|
||||
${ $Param{StringRef} } =~ s{
|
||||
\b(\d{4})(\s|\.|\+|_|-|\\|/)(\d{4})(\s|\.|\+|_|-|\\|/|)(\d{4})(\s|\.|\+|_|-|\\|/)(\d{3,4})\b
|
||||
}
|
||||
{
|
||||
$Count++;
|
||||
"$1$2XXXX$4XXXX$6$7";
|
||||
}egx;
|
||||
|
||||
return $Param{StringRef}, $Count;
|
||||
}
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user