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 174-177 sub send_or_die { Link Here
174
    $self->SUPER::send_or_die($args);
174
    $self->SUPER::send_or_die($args);
175
}
175
}
176
176
177
=head3 is_valid
178
179
    my $is_valid = Koha::Email->is_valid($email_address);
180
181
Return true is the email address passed in parameter is valid following RFC 2822.
182
183
=cut
184
185
sub is_valid {
186
    my ( $class, $email ) = @_;
187
    return ($email =~ m{$Email::Address::mailbox}) ? 1 : 0;
188
}
189
177
1;
190
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::Slurp qw( read_file );
27
use File::Slurp qw( read_file );
29
use List::MoreUtils qw( any );
28
use List::MoreUtils qw( any );
30
use Module::Load::Conditional qw( can_load );
29
use Module::Load::Conditional qw( can_load );
Lines 193-199 my $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist = ( $AnonymousPatr Link Here
193
192
194
my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
193
my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
195
194
196
my $warnPrefKohaAdminEmailAddress = C4::Context->preference('KohaAdminEmailAddress') !~ m/$Email::Address::mailbox/;
195
my $warnPrefKohaAdminEmailAddress = !Koha::Email->is_valid(C4::Context->preference('KohaAdminEmailAddress'));
197
196
198
my $c = Koha::Items->filter_by_visible_in_opac->count;
197
my $c = Koha::Items->filter_by_visible_in_opac->count;
199
my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');
198
my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');
(-)a/members/memberentry.pl (-4 / +4 lines)
Lines 34-39 use C4::Letters qw( SendAlerts ); Link Here
34
use C4::Form::MessagingPreferences;
34
use C4::Form::MessagingPreferences;
35
use Koha::AuthUtils;
35
use Koha::AuthUtils;
36
use Koha::AuthorisedValues;
36
use Koha::AuthorisedValues;
37
use Koha::Email;
37
use Koha::Patron::Debarments qw( AddDebarment DelDebarment GetDebarments );
38
use Koha::Patron::Debarments qw( AddDebarment DelDebarment GetDebarments );
38
use Koha::Cities;
39
use Koha::Cities;
39
use Koha::DateUtils qw( dt_from_string output_pref );
40
use Koha::DateUtils qw( dt_from_string output_pref );
Lines 44-50 use Koha::Patron::Categories; Link Here
44
use Koha::Patron::HouseboundRole;
45
use Koha::Patron::HouseboundRole;
45
use Koha::Patron::HouseboundRoles;
46
use Koha::Patron::HouseboundRoles;
46
use Koha::Token;
47
use Koha::Token;
47
use Email::Address;
48
use Koha::SMS::Providers;
48
use Koha::SMS::Providers;
49
49
50
my $input = CGI->new;
50
my $input = CGI->new;
Lines 386-398 if ($op eq 'save' || $op eq 'insert'){ Link Here
386
  my $emailalt = $input->param('B_email');
386
  my $emailalt = $input->param('B_email');
387
387
388
  if ($emailprimary) {
388
  if ($emailprimary) {
389
      push (@errors, "ERROR_bad_email") if ($emailprimary !~ m/$Email::Address::mailbox/);
389
      push (@errors, "ERROR_bad_email") unless Koha::Email->is_valid($emailprimary);
390
  }
390
  }
391
  if ($emailsecondary) {
391
  if ($emailsecondary) {
392
      push (@errors, "ERROR_bad_email_secondary") if ($emailsecondary !~ m/$Email::Address::mailbox/);
392
      push (@errors, "ERROR_bad_email_secondary") unless Koha::Email->is_valid($emailsecondary);
393
  }
393
  }
394
  if ($emailalt) {
394
  if ($emailalt) {
395
      push (@errors, "ERROR_bad_email_alternative") if ($emailalt !~ m/$Email::Address::mailbox/);
395
      push (@errors, "ERROR_bad_email_alternative") unless Koha::Email->is_valid($emailalt);
396
  }
396
  }
397
397
398
  if (C4::Context->preference('ExtendedPatronAttributes') and $input->param('setting_extended_patron_attributes')) {
398
  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 qw( dt_from_string output_pref );
37
use Koha::DateUtils qw( dt_from_string output_pref );
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 439-445 sub CheckForInvalidFields { Link Here
439
    my $borrower = shift;
439
    my $borrower = shift;
440
    my @invalidFields;
440
    my @invalidFields;
441
    if ($borrower->{'email'}) {
441
    if ($borrower->{'email'}) {
442
        unless ( $borrower->{'email'} =~ m/$Email::Address::mailbox/ ) {
442
        unless ( Koha::Email->is_valid($borrower->{email}) {
443
            push(@invalidFields, "email");
443
            push(@invalidFields, "email");
444
        } elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
444
        } elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
445
            my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
445
            my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
Lines 465-474 sub CheckForInvalidFields { Link Here
465
        delete $borrower->{'repeat_email'};
465
        delete $borrower->{'repeat_email'};
466
    }
466
    }
467
    if ($borrower->{'emailpro'}) {
467
    if ($borrower->{'emailpro'}) {
468
        push(@invalidFields, "emailpro") if ($borrower->{'emailpro'} !~ m/$Email::Address::mailbox/);
468
        push(@invalidFields, "emailpro") unless Koha::Email->is_valid($borrower->{'emailpro'});
469
    }
469
    }
470
    if ($borrower->{'B_email'}) {
470
    if ($borrower->{'B_email'}) {
471
        push(@invalidFields, "B_email") if ($borrower->{'B_email'} !~ m/$Email::Address::mailbox/);
471
        push(@invalidFields, "B_email") unless Koha::Email->is_valid($borrower->{'B_email'});
472
    }
472
    }
473
    if ( defined $borrower->{'password'}
473
    if ( defined $borrower->{'password'}
474
        and $borrower->{'password'} ne $borrower->{'password2'} )
474
        and $borrower->{'password'} ne $borrower->{'password2'} )
(-)a/opac/opac-shareshelf.pl (-2 / +2 lines)
Lines 25-37 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 qw( get_template_and_user );
29
use C4::Auth qw( get_template_and_user );
31
use C4::Context;
30
use C4::Context;
32
use C4::Letters;
31
use C4::Letters;
33
use C4::Output qw( output_html_with_http_headers );
32
use C4::Output qw( output_html_with_http_headers );
34
33
34
use Koha::Email;
35
use Koha::Patrons;
35
use Koha::Patrons;
36
use Koha::Virtualshelves;
36
use Koha::Virtualshelves;
37
use Koha::Virtualshelfshares;
37
use Koha::Virtualshelfshares;
Lines 195-201 sub process_addrlist { Link Here
195
    foreach my $a (@temp) {
195
    foreach my $a (@temp) {
196
        $a =~ s/^\s+//;
196
        $a =~ s/^\s+//;
197
        $a =~ s/\s+$//;
197
        $a =~ s/\s+$//;
198
        if ( $a =~ m/$Email::Address::mailbox/ ) {
198
        if ( Koha::Email->is_valid($a) ) {
199
            push @appr_addr, $a;
199
            push @appr_addr, $a;
200
        }
200
        }
201
        else {
201
        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 248-250 subtest 'send_or_die() tests' => sub { Link Here
248
    );
248
    );
249
    is( $email->header_str('Bcc'), undef, 'The Bcc header is unset' );
249
    is( $email->header_str('Bcc'), undef, 'The Bcc header is unset' );
250
};
250
};
251
- 
251
252
subtest 'is_valid' => sub {
253
    plan tests => 8;
254
255
    is(Koha::Email->is_valid('Fróm <from@example.com>'), 1);
256
    is(Koha::Email->is_valid('from@example.com'), 1);
257
    is(Koha::Email->is_valid('<from@example.com>'), 1);
258
259
    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"
260
    isnt(Koha::Email->is_valid('@example.com'), 1);
261
    isnt(Koha::Email->is_valid('example.com'), 1);
262
    isnt(Koha::Email->is_valid('root@localhost'), 1);
263
    isnt(Koha::Email->is_valid('from'), 1);
264
};

Return to bug 28870