Bug 28870: Move email address validation to a specific class method

To ease testing and future changes if needed.

Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Nick Clemens <nick@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Koha/Email.pm

@@ -78,7 +78,7 @@ sub create {
     my $args = {};
     $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
     Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
-        unless $args->{from} =~ m/$Email::Address::mailbox/; # from is mandatory
+        unless Koha::Email->is_valid($args->{from}); # from is mandatory
 
     $args->{subject} = $params->{subject} // '';
 
@@ -90,7 +90,7 @@ sub create {
     }
 
     Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
-        unless $args->{to} =~ m/$Email::Address::mailbox/; # to is mandatory
+        unless Koha::Email->is_valid($args->{to}); # to is mandatory
 
     my $addresses = {};
     $addresses->{reply_to} = $params->{reply_to};
@@ -112,7 +112,7 @@ sub create {
         Koha::Exceptions::BadParameter->throw(
             "Invalid '$address' parameter: " . $addresses->{$address} )
           if $addresses->{$address}
-            and $addresses->{$address} !~ m/$Email::Address::mailbox/;
+            and !Koha::Email->is_valid($addresses->{$address});
     }
 
     $args->{cc} = $addresses->{cc}
@@ -174,4 +174,17 @@ sub send_or_die {
     $self->SUPER::send_or_die($args);
 }
 
+=head3 is_valid
+
+    my $is_valid = Koha::Email->is_valid($email_address);
+
+Return true is the email address passed in parameter is valid following RFC 2822.
+
+=cut
+
+sub is_valid {
+    my ( $class, $email ) = @_;
+    return ($email =~ m{$Email::Address::mailbox}) ? 1 : 0;
+}
+
 1;

about.pl

@@ -24,7 +24,6 @@ use Modern::Perl;
 
 use CGI qw ( -utf8 );
 use DateTime::TimeZone;
-use Email::Address;
 use File::Slurp qw( read_file );
 use List::MoreUtils qw( any );
 use Module::Load::Conditional qw( can_load );
@@ -193,7 +192,7 @@ my $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist = ( $AnonymousPatr
 
 my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
 
-my $warnPrefKohaAdminEmailAddress = C4::Context->preference('KohaAdminEmailAddress') !~ m/$Email::Address::mailbox/;
+my $warnPrefKohaAdminEmailAddress = !Koha::Email->is_valid(C4::Context->preference('KohaAdminEmailAddress'));
 
 my $c = Koha::Items->filter_by_visible_in_opac->count;
 my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');

members/memberentry.pl

@@ -34,6 +34,7 @@ use C4::Letters qw( SendAlerts );
 use C4::Form::MessagingPreferences;
 use Koha::AuthUtils;
 use Koha::AuthorisedValues;
+use Koha::Email;
 use Koha::Patron::Debarments qw( AddDebarment DelDebarment GetDebarments );
 use Koha::Cities;
 use Koha::DateUtils qw( dt_from_string output_pref );
@@ -44,7 +45,6 @@ use Koha::Patron::Categories;
 use Koha::Patron::HouseboundRole;
 use Koha::Patron::HouseboundRoles;
 use Koha::Token;
-use Email::Address;
 use Koha::SMS::Providers;
 
 my $input = CGI->new;
@@ -386,13 +386,13 @@ if ($op eq 'save' || $op eq 'insert'){
   my $emailalt = $input->param('B_email');
 
   if ($emailprimary) {
-      push (@errors, "ERROR_bad_email") if ($emailprimary !~ m/$Email::Address::mailbox/);
+      push (@errors, "ERROR_bad_email") unless Koha::Email->is_valid($emailprimary);
   }
   if ($emailsecondary) {
-      push (@errors, "ERROR_bad_email_secondary") if ($emailsecondary !~ m/$Email::Address::mailbox/);
+      push (@errors, "ERROR_bad_email_secondary") unless Koha::Email->is_valid($emailsecondary);
   }
   if ($emailalt) {
-      push (@errors, "ERROR_bad_email_alternative") if ($emailalt !~ m/$Email::Address::mailbox/);
+      push (@errors, "ERROR_bad_email_alternative") unless Koha::Email->is_valid($emailalt);
   }
 
   if (C4::Context->preference('ExtendedPatronAttributes') and $input->param('setting_extended_patron_attributes')) {

opac/opac-memberentry.pl

@@ -34,8 +34,8 @@ use Koha::Patron::Consent;
 use Koha::Patron::Modification;
 use Koha::Patron::Modifications;
 use C4::Scrubber;
-use Email::Address;
 use Koha::DateUtils qw( dt_from_string output_pref );
+use Koha::Email;
 use Koha::Libraries;
 use Koha::Patron::Attribute::Types;
 use Koha::Patron::Attributes;
@@ -439,7 +439,7 @@ sub CheckForInvalidFields {
     my $borrower = shift;
     my @invalidFields;
     if ($borrower->{'email'}) {
-        unless ( $borrower->{'email'} =~ m/$Email::Address::mailbox/ ) {
+        unless ( Koha::Email->is_valid($borrower->{email}) ) {
             push(@invalidFields, "email");
         } elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
             my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
@@ -465,10 +465,10 @@ sub CheckForInvalidFields {
         delete $borrower->{'repeat_email'};
     }
     if ($borrower->{'emailpro'}) {
-        push(@invalidFields, "emailpro") if ($borrower->{'emailpro'} !~ m/$Email::Address::mailbox/);
+        push(@invalidFields, "emailpro") unless Koha::Email->is_valid($borrower->{'emailpro'});
     }
     if ($borrower->{'B_email'}) {
-        push(@invalidFields, "B_email") if ($borrower->{'B_email'} !~ m/$Email::Address::mailbox/);
+        push(@invalidFields, "B_email") unless Koha::Email->is_valid($borrower->{'B_email'});
     }
     if ( defined $borrower->{'password'}
         and $borrower->{'password'} ne $borrower->{'password2'} )

opac/opac-shareshelf.pl

@@ -25,13 +25,13 @@ use constant SHELVES_URL =>
   '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';
 
 use CGI qw ( -utf8 );
-use Email::Address;
 
 use C4::Auth qw( get_template_and_user );
 use C4::Context;
 use C4::Letters;
 use C4::Output qw( output_html_with_http_headers );
 
+use Koha::Email;
 use Koha::Patrons;
 use Koha::Virtualshelves;
 use Koha::Virtualshelfshares;
@@ -195,7 +195,7 @@ sub process_addrlist {
     foreach my $a (@temp) {
         $a =~ s/^\s+//;
         $a =~ s/\s+$//;
-        if ( $a =~ m/$Email::Address::mailbox/ ) {
+        if ( Koha::Email->is_valid($a) ) {
             push @appr_addr, $a;
         }
         else {

t/Koha/Email.t

@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 use Test::MockModule;
 use Test::Exception;
@@ -248,3 +248,17 @@ subtest 'send_or_die() tests' => sub {
     );
     is( $email->header_str('Bcc'), undef, 'The Bcc header is unset' );
 };
+
+subtest 'is_valid' => sub {
+    plan tests => 8;
+
+    is(Koha::Email->is_valid('Fróm <from@example.com>'), 1);
+    is(Koha::Email->is_valid('from@example.com'), 1);
+    is(Koha::Email->is_valid('<from@example.com>'), 1);
+
+    is(Koha::Email->is_valid('<from@fróm.com>'), 0); # "In accordance with RFC 822 and its descendants, this module demands that email addresses be ASCII only"
+    isnt(Koha::Email->is_valid('@example.com'), 1);
+    isnt(Koha::Email->is_valid('example.com'), 1);
+    isnt(Koha::Email->is_valid('root@localhost'), 1);
+    isnt(Koha::Email->is_valid('from'), 1);
+};