View | Details | Raw Unified | Return to bug 28870
Collapse All | Expand All

(-)a/Koha/Email.pm (-3 / +16 lines)
Lines 78-84 sub create { Link Here
78
    my $args = {};
78
    my $args = {};
79
    $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
79
    $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
80
    Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
80
    Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
81
        unless $args->{from} =~ m/$Email::Address::mailbox/; # from is mandatory
81
        unless Koha::Email->is_valid($args->{from}); # from is mandatory
82
82
83
    $args->{subject} = $params->{subject} // '';
83
    $args->{subject} = $params->{subject} // '';
84
84
Lines 90-96 sub create { Link Here
90
    }
90
    }
91
91
92
    Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
92
    Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
93
        unless $args->{to} =~ m/$Email::Address::mailbox/; # to is mandatory
93
        unless Koha::Email->is_valid($args->{to}); # to is mandatory
94
94
95
    my $addresses = {};
95
    my $addresses = {};
96
    $addresses->{reply_to} = $params->{reply_to};
96
    $addresses->{reply_to} = $params->{reply_to};
Lines 112-118 sub create { Link Here
112
        Koha::Exceptions::BadParameter->throw(
112
        Koha::Exceptions::BadParameter->throw(
113
            "Invalid '$address' parameter: " . $addresses->{$address} )
113
            "Invalid '$address' parameter: " . $addresses->{$address} )
114
          if $addresses->{$address}
114
          if $addresses->{$address}
115
            and $addresses->{$address} !~ m/$Email::Address::mailbox/;
115
            and !Koha::Email->is_valid($addresses->{$address});
116
    }
116
    }
117
117
118
    $args->{cc} = $addresses->{cc}
118
    $args->{cc} = $addresses->{cc}
Lines 185-188 sub send_or_die { Link Here
185
    $self->SUPER::send_or_die($args);
185
    $self->SUPER::send_or_die($args);
186
}
186
}
187
187
188
=head3 is_valid
189
190
    my $is_valid = Koha::Email->is_valid($email_address);
191
192
Return true is the email address passed in parameter is valid following RFC 2822.
193
194
=cut
195
196
sub is_valid {
197
    my ( $class, $email ) = @_;
198
    return ($email =~ m{$Email::Address::mailbox}) ? 1 : 0;
199
}
200
188
1;
201
1;
(-)a/about.pl (-2 / +1 lines)
Lines 24-30 use Modern::Perl; Link Here
24
24
25
use CGI qw ( -utf8 );
25
use CGI qw ( -utf8 );
26
use DateTime::TimeZone;
26
use DateTime::TimeZone;
27
use Email::Address;
28
use File::Spec;
27
use File::Spec;
29
use File::Slurp;
28
use File::Slurp;
30
use List::MoreUtils qw/ any /;
29
use List::MoreUtils qw/ any /;
Lines 200-206 my $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist = ( $AnonymousPatr Link Here
200
199
201
my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
200
my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
202
201
203
my $warnPrefKohaAdminEmailAddress = C4::Context->preference('KohaAdminEmailAddress') !~ m/$Email::Address::mailbox/;
202
my $warnPrefKohaAdminEmailAddress = !Koha::Email->is_valid(C4::Context->preference('KohaAdminEmailAddress'));
204
203
205
my $c = Koha::Items->filter_by_visible_in_opac->count;
204
my $c = Koha::Items->filter_by_visible_in_opac->count;
206
my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');
205
my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');
(-)a/members/memberentry.pl (-4 / +4 lines)
Lines 36-41 use C4::Letters; Link Here
36
use C4::Form::MessagingPreferences;
36
use C4::Form::MessagingPreferences;
37
use Koha::AuthUtils;
37
use Koha::AuthUtils;
38
use Koha::AuthorisedValues;
38
use Koha::AuthorisedValues;
39
use Koha::Email;
39
use Koha::Patron::Debarments;
40
use Koha::Patron::Debarments;
40
use Koha::Cities;
41
use Koha::Cities;
41
use Koha::DateUtils;
42
use Koha::DateUtils;
Lines 46-52 use Koha::Patron::Categories; Link Here
46
use Koha::Patron::HouseboundRole;
47
use Koha::Patron::HouseboundRole;
47
use Koha::Patron::HouseboundRoles;
48
use Koha::Patron::HouseboundRoles;
48
use Koha::Token;
49
use Koha::Token;
49
use Email::Address;
50
use Koha::SMS::Providers;
50
use Koha::SMS::Providers;
51
51
52
use vars qw($debug);
52
use vars qw($debug);
Lines 400-412 if ($op eq 'save' || $op eq 'insert'){ Link Here
400
  my $emailalt = $input->param('B_email');
400
  my $emailalt = $input->param('B_email');
401
401
402
  if ($emailprimary) {
402
  if ($emailprimary) {
403
      push (@errors, "ERROR_bad_email") if ($emailprimary !~ m/$Email::Address::mailbox/);
403
      push (@errors, "ERROR_bad_email") unless Koha::Email->is_valid($emailprimary);
404
  }
404
  }
405
  if ($emailsecondary) {
405
  if ($emailsecondary) {
406
      push (@errors, "ERROR_bad_email_secondary") if ($emailsecondary !~ m/$Email::Address::mailbox/);
406
      push (@errors, "ERROR_bad_email_secondary") unless Koha::Email->is_valid($emailsecondary);
407
  }
407
  }
408
  if ($emailalt) {
408
  if ($emailalt) {
409
      push (@errors, "ERROR_bad_email_alternative") if ($emailalt !~ m/$Email::Address::mailbox/);
409
      push (@errors, "ERROR_bad_email_alternative") unless Koha::Email->is_valid($emailalt);
410
  }
410
  }
411
411
412
  if (C4::Context->preference('ExtendedPatronAttributes') and $input->param('setting_extended_patron_attributes')) {
412
  if (C4::Context->preference('ExtendedPatronAttributes') and $input->param('setting_extended_patron_attributes')) {
(-)a/opac/opac-memberentry.pl (-4 / +4 lines)
Lines 34-41 use Koha::Patron::Consent; Link Here
34
use Koha::Patron::Modification;
34
use Koha::Patron::Modification;
35
use Koha::Patron::Modifications;
35
use Koha::Patron::Modifications;
36
use C4::Scrubber;
36
use C4::Scrubber;
37
use Email::Address;
38
use Koha::DateUtils;
37
use Koha::DateUtils;
38
use Koha::Email;
39
use Koha::Libraries;
39
use Koha::Libraries;
40
use Koha::Patron::Attribute::Types;
40
use Koha::Patron::Attribute::Types;
41
use Koha::Patron::Attributes;
41
use Koha::Patron::Attributes;
Lines 444-450 sub CheckForInvalidFields { Link Here
444
    my $borrower = shift;
444
    my $borrower = shift;
445
    my @invalidFields;
445
    my @invalidFields;
446
    if ($borrower->{'email'}) {
446
    if ($borrower->{'email'}) {
447
        unless ( $borrower->{'email'} =~ m/$Email::Address::mailbox/ ) {
447
        unless ( Koha::Email->is_valid($borrower->{email}) ) {
448
            push(@invalidFields, "email");
448
            push(@invalidFields, "email");
449
        } elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
449
        } elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
450
            my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
450
            my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
Lines 470-479 sub CheckForInvalidFields { Link Here
470
        delete $borrower->{'repeat_email'};
470
        delete $borrower->{'repeat_email'};
471
    }
471
    }
472
    if ($borrower->{'emailpro'}) {
472
    if ($borrower->{'emailpro'}) {
473
        push(@invalidFields, "emailpro") if ($borrower->{'emailpro'} !~ m/$Email::Address::mailbox/);
473
        push(@invalidFields, "emailpro") unless Koha::Email->is_valid($borrower->{'emailpro'});
474
    }
474
    }
475
    if ($borrower->{'B_email'}) {
475
    if ($borrower->{'B_email'}) {
476
        push(@invalidFields, "B_email") if ($borrower->{'B_email'} !~ m/$Email::Address::mailbox/);
476
        push(@invalidFields, "B_email") unless Koha::Email->is_valid($borrower->{'B_email'});
477
    }
477
    }
478
    if ( defined $borrower->{'password'}
478
    if ( defined $borrower->{'password'}
479
        and $borrower->{'password'} ne $borrower->{'password2'} )
479
        and $borrower->{'password'} ne $borrower->{'password2'} )
(-)a/opac/opac-shareshelf.pl (-2 / +2 lines)
Lines 25-31 use constant SHELVES_URL => Link Here
25
  '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';
25
  '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';
26
26
27
use CGI qw ( -utf8 );
27
use CGI qw ( -utf8 );
28
use Email::Address;
29
28
30
use C4::Auth;
29
use C4::Auth;
31
use C4::Context;
30
use C4::Context;
Lines 33-38 use C4::Letters; Link Here
33
use C4::Members ();
32
use C4::Members ();
34
use C4::Output;
33
use C4::Output;
35
34
35
use Koha::Email;
36
use Koha::Patrons;
36
use Koha::Patrons;
37
use Koha::Virtualshelves;
37
use Koha::Virtualshelves;
38
use Koha::Virtualshelfshares;
38
use Koha::Virtualshelfshares;
Lines 196-202 sub process_addrlist { Link Here
196
    foreach my $a (@temp) {
196
    foreach my $a (@temp) {
197
        $a =~ s/^\s+//;
197
        $a =~ s/^\s+//;
198
        $a =~ s/\s+$//;
198
        $a =~ s/\s+$//;
199
        if ( $a =~ m/$Email::Address::mailbox/ ) {
199
        if ( Koha::Email->is_valid($a) ) {
200
            push @appr_addr, $a;
200
            push @appr_addr, $a;
201
        }
201
        }
202
        else {
202
        else {
(-)a/t/Koha/Email.t (-2 / +15 lines)
Lines 17-23 Link Here
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
19
20
use Test::More tests => 3;
20
use Test::More tests => 4;
21
21
22
use Test::MockModule;
22
use Test::MockModule;
23
use Test::Exception;
23
use Test::Exception;
Lines 252-254 subtest 'send_or_die() tests' => sub { Link Here
252
    is( $from, 'sender@example.com', 'If "from" is not explicitly passed, extract from Sender header' );
252
    is( $from, 'sender@example.com', 'If "from" is not explicitly passed, extract from Sender header' );
253
    is( $email->header_str('Sender'), undef, 'The Sender header is unset' );
253
    is( $email->header_str('Sender'), undef, 'The Sender header is unset' );
254
};
254
};
255
- 
255
256
subtest 'is_valid' => sub {
257
    plan tests => 8;
258
259
    is(Koha::Email->is_valid('Fróm <from@example.com>'), 1);
260
    is(Koha::Email->is_valid('from@example.com'), 1);
261
    is(Koha::Email->is_valid('<from@example.com>'), 1);
262
263
    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"
264
    isnt(Koha::Email->is_valid('@example.com'), 1);
265
    isnt(Koha::Email->is_valid('example.com'), 1);
266
    isnt(Koha::Email->is_valid('root@localhost'), 1);
267
    isnt(Koha::Email->is_valid('from'), 1);
268
};

Return to bug 28870