# --
# 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).
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.
=cut