Attachment #127748 for bug #28870

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




    my $args = {};
    $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
    Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
        unless Koha::Email->is_valid($args->{from}); # from is mandatory

    $args->{subject} = $params->{subject} // '';


    }

    Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
        unless Koha::Email->is_valid($args->{to}); # to is mandatory

    my $addresses = {};
    $addresses->{reply_to} = $params->{reply_to};

        Koha::Exceptions::BadParameter->throw(
            "Invalid '$address' parameter: " . $addresses->{$address} )
          if $addresses->{$address}
            and !Koha::Email->is_valid($addresses->{$address});
    }

    $args->{cc} = $addresses->{cc}

    $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;

Lines 24-30 use Modern::Perl; Link Here

(-)a/about.pl (-2 / +1 lines)
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 199-205 my $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist = ( $AnonymousPatr Link Here
199		198
200	my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );	199	my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
201		200
202	my $warnPrefKohaAdminEmailAddress = C4::Context->preference('KohaAdminEmailAddress') !~ m/$Email::Address::mailbox/;	201	my $warnPrefKohaAdminEmailAddress = !Koha::Email->is_valid(C4::Context->preference('KohaAdminEmailAddress'));
203		202
204	my $c = Koha::Items->filter_by_visible_in_opac->count;	203	my $c = Koha::Items->filter_by_visible_in_opac->count;
205	my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');	204	my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');




use C4::Form::MessagingPreferences;
use Koha::AuthUtils;
use Koha::AuthorisedValues;
use Koha::Email;
use Koha::Patron::Debarments;
use Koha::Cities;
use Koha::DateUtils;

use Koha::Patron::HouseboundRole;
use Koha::Patron::HouseboundRoles;
use Koha::Token;
use Email::Address;
use Koha::SMS::Providers;

use vars qw($debug);

  my $emailalt = $input->param('B_email');

  if ($emailprimary) {
      push (@errors, "ERROR_bad_email") unless Koha::Email->is_valid($emailprimary);
  }
  if ($emailsecondary) {
      push (@errors, "ERROR_bad_email_secondary") unless Koha::Email->is_valid($emailsecondary);
  }
  if ($emailalt) {
      push (@errors, "ERROR_bad_email_alternative") unless Koha::Email->is_valid($emailalt);
  }

  if (C4::Context->preference('ExtendedPatronAttributes') and $input->param('setting_extended_patron_attributes')) {




use Koha::Patron::Modification;
use Koha::Patron::Modifications;
use C4::Scrubber;
use Email::Address;
use Koha::DateUtils;
use Koha::Email;
use Koha::Libraries;
use Koha::Patron::Attribute::Types;
use Koha::Patron::Attributes;

    my $borrower = shift;
    my @invalidFields;
    if ($borrower->{'email'}) {
        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?

        delete $borrower->{'repeat_email'};
    }
    if ($borrower->{'emailpro'}) {
        push(@invalidFields, "emailpro") unless Koha::Email->is_valid($borrower->{'emailpro'});
    }
    if ($borrower->{'B_email'}) {
        push(@invalidFields, "B_email") unless Koha::Email->is_valid($borrower->{'B_email'});
    }
    if ( defined $borrower->{'password'}
        and $borrower->{'password'} ne $borrower->{'password2'} )




  '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';

use CGI qw ( -utf8 );
use Email::Address;

use C4::Auth;
use C4::Context;

use C4::Members ();
use C4::Output;

use Koha::Email;
use Koha::Patrons;
use Koha::Virtualshelves;
use Koha::Virtualshelfshares;

    foreach my $a (@temp) {
        $a =~ s/^\s+//;
        $a =~ s/\s+$//;
        if ( Koha::Email->is_valid($a) ) {
            push @appr_addr, $a;
        }
        else {





use Modern::Perl;

use Test::More tests => 4;

use Test::MockModule;
use Test::Exception;

    );
    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);
};

Return to bug 28870

Lines 78-84 sub create { Link Here

(-)a/Koha/Email.pm (-3 / +16 lines)
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;

Lines 36-41 use C4::Letters; Link Here

(-)a/members/memberentry.pl (-4 / +4 lines)
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')) {

Lines 34-41 use Koha::Patron::Consent; Link Here

(-)a/opac/opac-memberentry.pl (-4 / +4 lines)
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 445-451 sub CheckForInvalidFields { Link Here
445	my $borrower = shift;	445	my $borrower = shift;
446	my @invalidFields;	446	my @invalidFields;
447	if ($borrower->{'email'}) {	447	if ($borrower->{'email'}) {
448	unless ( $borrower->{'email'} =~ m/$Email::Address::mailbox/ ) {	448	unless ( Koha::Email->is_valid($borrower->{email}) ) {
449	push(@invalidFields, "email");	449	push(@invalidFields, "email");
450	} elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {	450	} elsif ( C4::Context->preference("PatronSelfRegistrationEmailMustBeUnique") ) {
451	my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?	451	my $patrons_with_same_email = Koha::Patrons->search( # FIXME Should be search_limited?
Lines 471-480 sub CheckForInvalidFields { Link Here
471	delete $borrower->{'repeat_email'};	471	delete $borrower->{'repeat_email'};
472	}	472	}
473	if ($borrower->{'emailpro'}) {	473	if ($borrower->{'emailpro'}) {
474	push(@invalidFields, "emailpro") if ($borrower->{'emailpro'} !~ m/$Email::Address::mailbox/);	474	push(@invalidFields, "emailpro") unless Koha::Email->is_valid($borrower->{'emailpro'});
475	}	475	}
476	if ($borrower->{'B_email'}) {	476	if ($borrower->{'B_email'}) {
477	push(@invalidFields, "B_email") if ($borrower->{'B_email'} !~ m/$Email::Address::mailbox/);	477	push(@invalidFields, "B_email") unless Koha::Email->is_valid($borrower->{'B_email'});
478	}	478	}
479	if ( defined $borrower->{'password'}	479	if ( defined $borrower->{'password'}
480	and $borrower->{'password'} ne $borrower->{'password2'} )	480	and $borrower->{'password'} ne $borrower->{'password2'} )

Lines 17-23 Link Here

(-)a/t/Koha/Email.t (-2 / +15 lines)
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	};

Lines 25-31 use constant SHELVES_URL => Link Here

(-)a/opac/opac-shareshelf.pl (-2 / +2 lines)
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 {