diff --git a/Makefile.PL b/Makefile.PL
index 8ebbeca66..c5d3e97f1 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -28,7 +28,7 @@ WriteMakefile(
DBIx::RunSQL
Devel::Peek
Dumpvalue
- Email::Address
+ Email::Address::XS
Email::MIME
Email::Sender::Simple
EV
diff --git a/bin/paused b/bin/paused
index 85c4e7d16..7d077ef47 100755
--- a/bin/paused
+++ b/bin/paused
@@ -132,14 +132,12 @@ package mypause_send_mail;
use PAUSE::Logger '$Logger';
-our %hp_inside;
-
sub send {
- my($self,$header,$blurb) = @_;
+ my ($self,$header,$blurb) = @_;
my %from = exists $header->{From}
? ()
- : (From => "PAUSE <$PAUSE::Config->{UPLOAD}>");
+ : (From => PAUSE::Email->noreply_email_header_object);
my $email = Email::MIME->create(
attributes => {
@@ -310,7 +308,7 @@ skip =not yet verified
mypause_send_mail->send({
- To => $PAUSE::Config->{ADMIN},
+ To => PAUSE::Email->report_email_header_object,
Subject => "Mirror request from $package"
},
$blurb
@@ -399,10 +397,8 @@ sub woe {
# fullname just to reuse sth2
$asciiname ||= $fullname;
$asciiname =~ s/[^\0-\177]/?/g;
- my @To;
+
my $pma = PAUSE::MailAddress->new_from_userid($userid);
- my $to = $pma->address;
- push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$to>};
my $blurb = "The URL $hash->{uri},
requested for upload as $hash->{uriid} has problems
@@ -414,13 +410,17 @@ new trial.
Virtually Yours,
$Id\n";
- for my $to (@To) {
- mypause_send_mail->send({
- To => join(",",$to),
- Subject => "Upload problem $hash->{uriid}"
- },
- $blurb
- );
+ for my $to (
+ $pma->email_header_object,
+ PAUSE::Email->report_email_header_object,
+ ) {
+ mypause_send_mail->send(
+ {
+ To => $to,
+ Subject => "Upload problem $hash->{uriid}"
+ },
+ $blurb
+ );
}
} elsif ($hash->{nosuccesscount} == $PAUSE::Config->{MAXRETRIES}) {
@@ -470,10 +470,8 @@ but I couldn't ($!). Seems as if the admin has to do something\n\n";
my($fullname, $asciiname) = $sth2->fetchrow_array;
$asciiname ||= $fullname;
$asciiname =~ s/[^\0-\177]/?/g;
- my @To;
+
my $pma = PAUSE::MailAddress->new_from_userid($userid);
- my $address = $pma->address;
- push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$address>};
my $blurb;
if ($self->{ErrNotGzip}) {
@@ -497,13 +495,17 @@ Virtually Yours,
$Id\n";
}
- for my $to (@To) {
- mypause_send_mail->send({
- To => join(",",$to),
- Subject => "Upload problem $hash->{uriid}"
- },
- $blurb
- );
+ for my $to (
+ $pma->email_header_object,
+ PAUSE::Email->report_email_header_object,
+ ) {
+ mypause_send_mail->send(
+ {
+ To => $to,
+ Subject => "Upload problem $hash->{uriid}"
+ },
+ $blurb
+ );
}
# don't writeback, it would defeat removing it.
@@ -534,14 +536,6 @@ sub welcome_file {
$asciiname ||= $fullname;
$asciiname =~ s/[^\0-\177]/?/g;
my $dbh = $self->{DBH};
- my $pma = PAUSE::MailAddress->new_from_userid($userid);
- my $address = $pma->address;
- my @To = qq{"$asciiname" <$address>};
- unless ($PAUSE::Config->{TESTHOST}) {
- push @To, $PAUSE::Config->{TO_CPAN_TESTERS};
- push @To, $PAUSE::Config->{'P5P'} if
- $hash->{'mailto_p5p'}==1;
- }
my $blurb = "The URL";
$blurb = "The uploaded file" if $hash->{uri} !~ m,/,;
@@ -587,14 +581,24 @@ CPAN Testers will start reporting results in an hour or so:
"Thanks,\n-- \n$Id"
);
+ my $pma = PAUSE::MailAddress->new_from_userid($userid);
+ my @To = $pma->email_header_object;
+
+ unless ($PAUSE::Config->{TESTHOST}) {
+ push @To, PAUSE::Email->email_header_object_for_addresses(
+ Email::Address::XS->new('CPAN Testers', $PAUSE::Config->{TO_CPAN_TESTERS}),
+ );
+ }
+
for my $to (@To) {
- mypause_send_mail->send({
- To => join(",",$to),
- Subject => "CPAN Upload: $hash->{uriid}",
- "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS},
- },
- $blurb
- );
+ mypause_send_mail->send(
+ {
+ To => $to,
+ Subject => "CPAN Upload: $hash->{uriid}",
+ "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS},
+ },
+ $blurb
+ );
}
$self->logge("Info: Sent 'has entered' email about uriid[$hash->{uriid}]");
sleep 10;
@@ -777,7 +781,6 @@ sub verify_gzip_tar {
if ($child_stat != 0) {
$err =~ s/\n/ /g;
$self->logge("Debug: child_stat[$child_stat]err[$err]");
- my @To = $PAUSE::Config->{ADMIN};
my $blurb = "For the resource [$uri]
the command [$testinggzip -t $tpath]
@@ -787,15 +790,14 @@ sub verify_gzip_tar {
The command [ls -l $tpath]
gives [$ls]\n\n";
- for my $to (@To) {
- mypause_send_mail->send
- ({
- To => $to,
- Subject => "Upload problem $uri"
- },
- $blurb
- );
- }
+ mypause_send_mail->send(
+ {
+ To => PAUSE::Email->report_email_header_object,
+ Subject => "Upload problem $uri"
+ },
+ $blurb
+ );
+
if ($err =~ /not in gzip format/) {
$self->{URIRECORD}{nosuccesscount} = $PAUSE::Config->{MAXRETRIES} - 1;
$self->{ErrNotGzip}++;
diff --git a/cpanfile b/cpanfile
index d5c441dfa..0cdc3a636 100644
--- a/cpanfile
+++ b/cpanfile
@@ -11,7 +11,7 @@ requires 'DBI';
requires 'DBD::mysql', '== 4.050';
requires 'DBD::SQLite';
requires 'Digest::SHA1';
-requires 'Email::Address';
+requires 'Email::Address::XS';
requires 'Email::MIME';
requires 'Email::Sender::Simple';
requires 'EV';
diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl
index 7151a8902..c9e7ee7bd 100755
--- a/cron/cron-daily.pl
+++ b/cron/cron-daily.pl
@@ -345,8 +345,8 @@ sub send_the_mail {
},
header_str => [
Subject => $SUBJECT,
- To => $PAUSE::Config->{ADMIN},
- From => "cron daemon cron-daily.pl People, Mailinglists And
Mailinglist Archives
-generated on $now UTC by $PAUSE::Config->{ADMIN}
+generated on $now UTC by $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}
};
diff --git a/cron/cron-p6daily.pl b/cron/cron-p6daily.pl
index 37b7340c8..4a060db70 100755
--- a/cron/cron-p6daily.pl
+++ b/cron/cron-p6daily.pl
@@ -71,8 +71,8 @@ sub send_the_mail {
},
header_str => [
Subject => $SUBJECT,
- To => $PAUSE::Config->{ADMIN},
- From => "cron daemon cron-p6daily.pl
Please try again or report errors to the administrator
}]); } else { my $filename; @@ -2126,7 +2126,7 @@ glory is collected on http://history.perl.org/backpan/}); $umailset{qq{"$Uname" <$mgr->{User}{email}>}} = 1; } } - $umailset{$PAUSE::Config->{ADMIN}} = 1; + $umailset{$PAUSE::Config->{INTERNAL_REPORT_ADDRESS}} = 1; my @to = keys %umailset; my $header = { Subject => "Files of $u->{userid} scheduled for deletion" @@ -2383,7 +2383,7 @@ Description: }; my $otpwblurb = qq{ (This mail has been generated automatically by the Perl Authors Upload -Server on behalf of the admin $PAUSE::Config->{ADMIN}) +Server on behalf of the admin $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}) As already described in a separate message, you\'re a registered Perl Author with the userid $userid. For the sake of approval I have @@ -2402,14 +2402,14 @@ possible, otherwise your password can be intercepted by third parties. Thanks & Regards, -- -$PAUSE::Config->{ADMIN} +$PAUSE::Config->{INTERNAL_REPORT_ADDRESS} }; my $header = { Subject => $subject, }; warn "header[$header]otpwblurb[$otpwblurb]"; - $mgr->send_mail_multi([$email,$PAUSE::Config->{ADMIN}], + $mgr->send_mail_multi([$email,$PAUSE::Config->{INTERNAL_REPORT_ADDRESS}], $header, $otpwblurb); @@ -2457,12 +2457,12 @@ The PAUSE Team # both users and mailing lists run this code - warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]"; - my(@to) = @{$PAUSE::Config->{ADMINS}}; + warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]"; + my(@to) = $PAUSE::Config->{CONTACT_ADDRESS}; push @m, qq{ Sending separate mails to: }, join(" AND ", @to, $email), qq{-From: $PAUSE::Config->{UPLOAD} +From: $PAUSE::Config->{NOREPLY_ADDRESS} Subject: $subject\n}; my($blurb) = join "", @blurb; @@ -2870,7 +2870,7 @@ sub request_id { my @errors = (); if ( $fullname ) { unless ($fullname =~ /[ ]/) { - push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to @{$PAUSE::Config->{ADMINS}}."; + push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to $PAUSE::Config->{CONTACT_ADDRESS}."; } } else { push @errors, "You must supply a name\n"; @@ -3065,7 +3065,7 @@ MAIL }{$1}xg; $blurbcopy =~ s|(>http.*?)U|$1\n U|gs; # break the long URL push @m, qq{-From: $PAUSE::Config->{UPLOAD} +From: $PAUSE::Config->{NOREPLY_ADDRESS} Subject: $subject $blurbcopy @@ -3613,7 +3613,7 @@ sub edit_mod { $u->{userid}. Please note, only modules that are already registered in the module list can be edited here. If you believe, this is a bug, please contact - @{$PAUSE::Config->{ADMINS}}. }; + $PAUSE::Config->{CONTACT_ADDRESS}. }; return @m; } @@ -4394,9 +4394,9 @@ The PAUSE Team my($blurb) = join "", @blurb; require HTML::Entities; my($blurbcopy) = HTML::Entities::encode($blurb,"<>&"); - warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]"; + warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]"; push @m, qq{-From: $PAUSE::Config->{UPLOAD} +From: $PAUSE::Config->{NOREPLY_ADDRESS} Subject: $subject $blurbcopy @@ -4967,9 +4967,9 @@ Peek at the current permissions: my($blurbcopy) = HTML::Entities::encode($blurb,"<>&"); $blurbcopy =~ s|(https?://[^\s\"]+)|$1|g; $blurbcopy =~ s|(>http.*?)U|$1\n U|gs; # break the long URL - # warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]"; + # warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]"; push @m, qq{-From: $PAUSE::Config->{UPLOAD} +From: $PAUSE::Config->{NOREPLY_ADDRESS} Subject: $subject $blurbcopy @@ -5747,7 +5747,7 @@ sub peek_perms {The contents of the tables presented on this page are mostly generated automatically, so please report any errors you - observe to @{$PAUSE::Config->{ADMINS}} so that the tables + observe to $PAUSE::Config->{CONTACT_ADDRESS} so that the tables can be corrected.--Thank you!
}; @@ -5951,7 +5951,7 @@ decision. again. As it is done by a cron job, it may take up to an hour until the indexer actually executes the command. If this doesn't repair the index, please email me. }; + href="mailto:$PAUSE::Config->{NOREPLY_ADDRESS}">email me. }; require Cwd; my $cwd = Cwd::cwd(); @@ -6063,7 +6063,7 @@ Estimated time of job completion: %s $umailset{qq{"$Uname" <$mgr->{User}{email}>}} = 1; } } - $umailset{$PAUSE::Config->{ADMIN}} = 1; + $umailset{$PAUSE::Config->{INTERNAL_REPORT_ADDRESS}} = 1; my $header = { Subject => "Scheduled for reindexing $u->{userid}" }; @@ -7223,7 +7223,7 @@ packages have their recorded version set to 'undef'. $umailset{qq{"$Uname" <$mgr->{User}{email}>}} = 1; } } - $umailset{$PAUSE::Config->{ADMIN}} = 1; + $umailset{$PAUSE::Config->{INTERNAL_REPORT_ADDRESS}} = 1; my $header = { Subject => "Version reset for $u->{userid}" }; diff --git a/lib/pause_1999/main.pm b/lib/pause_1999/main.pm index b935d2490..b739dcd90 100644 --- a/lib/pause_1999/main.pm +++ b/lib/pause_1999/main.pm @@ -284,7 +284,7 @@ sub database_alert { my $server = $self->myurl->can("host") ? $self->myurl->host : $self->myurl->hostname; my $header = { From => "database_alert", - To => $PAUSE::Config->{ADMIN}, + To => $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, Subject => "PAUSE Database Alert $server", }; $self->send_mail($header,$mess); @@ -438,7 +438,7 @@ sub send_mail { my @hdebug = %$header; $self->{REQ}->logger({level => 'error', message => sprintf("hdebug[%s]", join "|", @hdebug) }); $header->{From} ||= $self->{OurEmailFrom}; - $header->{"Reply-To"} ||= join ", ", @{$PAUSE::Config->{ADMINS}}; + $header->{"Reply-To"} ||= $PAUSE::Config->{CONTACT_ADDRESS}; if ($] > 5.007) { require Encode; diff --git a/lib/pause_2017/PAUSE/Web/Config.pm b/lib/pause_2017/PAUSE/Web/Config.pm index 04d4e1230..c454d0fd6 100644 --- a/lib/pause_2017/PAUSE/Web/Config.pm +++ b/lib/pause_2017/PAUSE/Web/Config.pm @@ -651,6 +651,6 @@ our $Valid_Userid = qr/^[A-Z]{3,9}$/; sub valid_userid { $Valid_Userid } -sub mailto_admins { join(",", @{$PAUSE::Config->{ADMINS}}) } +sub mailto_admins { $PAUSE::Config->{CONTACT_ADDRESS} } 1; diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm index aa84e0b2f..75326daa5 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -91,7 +91,7 @@ sub database_alert { my $server = $self->hostname; my $header = { From => "database_alert", - To => $PAUSE::Config->{ADMIN}, + To => PAUSE::Email->report_email_header_object, Subject => "PAUSE Database Alert $server", }; $self->send_mail($header, $mess); @@ -132,26 +132,39 @@ sub fetchrow { ### Mailer sub prepare_sendto { - my ($self, $active_user, $pause_user, @admin) = @_; + my ($self, $active_user, $pause_user, $include_admin) = @_; + # %umailset is just used to uniq mail targets. Keys are email addresses we + # will send to. The values are the names. If we end up seeing two entries + # for one address, it will only be emailed once. This is acceptable. + # -- rjbs, 2024-05-03 my %umailset; - my $name = $active_user->{asciiname} || $active_user->{fullname} || ""; - my $Uname = $pause_user->{asciiname} || $pause_user->{fullname} || ""; + my $name = $active_user->{fullname} || $active_user->{asciiname} || ""; + my $Uname = $pause_user->{fullname} || $pause_user->{asciiname} || ""; if ($active_user->{secretemail}) { - $umailset{qq{"$name" <$active_user->{secretemail}>}} = 1; + $umailset{ $active_user->{secretemail} } = $name; } elsif ($active_user->{email}) { - $umailset{qq{"$name" <$active_user->{email}>}} = 1; + $umailset{ $active_user->{email} } = $name; } if ($active_user->{userid} ne $pause_user->{userid}) { if ($pause_user->{secretemail}) { - $umailset{qq{"$Uname" <$pause_user->{secretemail}>}} = 1; - }elsif ($pause_user->{email}) { - $umailset{qq{"$Uname" <$pause_user->{email}>}} = 1; + $umailset{ $pause_user->{secretemail} } = $Uname; + } elsif ($pause_user->{email}) { + $umailset{ $pause_user->{email} } = $Uname; } } - my @to = keys %umailset; - push @to, @admin if @admin; - @to; + + my @to; + for my $addr (sort keys %umailset) { + my $addr = Email::Address::XS->new($umailset{$addr}, $addr); + push @to, PAUSE::Email->email_header_object_for_addresses($addr); + } + + if ($include_admin) { + push @to, PAUSE::Email->report_email_header_object; + } + + return @to; } sub send_mail_multi { @@ -167,9 +180,11 @@ sub send_mail_multi { sub send_mail { my ($self, $header, $blurb) = @_; - my @hdebug = %$header; $self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) }); - $header->{From} ||= qq{"Perl Authors Upload Server" <$PAUSE::Config->{UPLOAD}>}; - $header->{"Reply-To"} ||= join ", ", @{$PAUSE::Config->{ADMINS}}; + my @hdebug = %$header; + $self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) }); + + $header->{From} ||= PAUSE::Email->noreply_email_header_object; + $header->{"Reply-To"} ||= PAUSE::Email->contact_email_header_object; my $email = Email::MIME->create( header_str => [%$header], diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm index ed601df7b..47fef7b91 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm @@ -156,7 +156,7 @@ sub edit_ml { if ($saw_a_change) { $pause->{changed} = 1; my $mailblurb = $c->render_to_string("email/admin/edit_ml", format => "email"); - my @to = ($u->{secretemail}||$u->{email}, $mgr->config->mailto_admins); + my @to = ($u->{secretemail}||$u->{email}, PAUSE::Email->report_email_header_object); warn "sending to[@to]"; warn "mailblurb[$mailblurb]"; my $header = { diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm index 8f542932a..d6ad73d79 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm @@ -274,11 +274,14 @@ sub add_user_doit { # send emails to user and modules@perl.org; latter must censor the # user's email address my ($subject, $blurb) = $c->send_welcome_email( [$email], $userid, $email, $fullname, $homepage, $entered_by ); - $c->send_welcome_email( $PAUSE::Config->{ADMINS}, $userid, "CENSORED", $fullname, $homepage, $entered_by ); + $c->send_welcome_email( + [ $PAUSE::Config->{CONTACT_ADDRESS} ], + $userid, "CENSORED", $fullname, $homepage, $entered_by + ); $pause->{subject} = $subject; $pause->{blurb} = $blurb; - $pause->{send_to} = join(" AND ", @{$PAUSE::Config->{ADMINS}}, $email); + $pause->{send_to} = join(" AND ", $PAUSE::Config->{CONTACT_ADDRESS}, $email); } warn "Info: clearing all fields"; diff --git a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm index f1058ba7e..1b59d8521 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm @@ -2,7 +2,6 @@ package PAUSE::Web::Controller::Public::RequestId; use Mojo::Base "Mojolicious::Controller"; use PAUSE::Web::Util::Encode; -use Email::Address; sub request { my $c = shift; @@ -54,14 +53,15 @@ sub request { my @errors = (); if ( $fullname ) { unless ($fullname =~ /[ ]/) { - push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to @{$PAUSE::Config->{ADMINS}}."; + push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to $PAUSE::Config->{CONTACT_ADDRESS}."; } } else { push @errors, "You must supply a name\n"; } if( $email ) { - my $addr_spec = $Email::Address::addr_spec; - push @errors, "Your email address doesn't look like valid email address.\n" unless $email =~ /\A$addr_spec\z/; + unless (PAUSE::Email->is_valid_email($email)) { + push @errors, "Your email address doesn't look like valid email address.\n"; + } } else { push @errors, "You must supply an email address\n"; } @@ -141,9 +141,10 @@ sub request { } } - my @to = $mgr->config->mailto_admins; + my @to = PAUSE::Email->report_email_header_object; push @to, $email; - $pause->{send_to} = "@to"; + $pause->{send_to} = "$email"; # I don't understand what this is for XXX -- rjbs, 2024-05-03 + my $time = time; if ($rationale) { # wrap it @@ -246,8 +247,10 @@ sub _directly_add_user { my ( $subject, $blurb ) = $c->send_welcome_email( [$email], $userid, $email, $fullname, $homepage, $fullname ); - $c->send_welcome_email( $PAUSE::Config->{ADMINS}, - $userid, "CENSORED", $fullname, $homepage, $fullname ); + $c->send_welcome_email( + [ $PAUSE::Config->{CONTACT_ADDRESS} ], + $userid, "CENSORED", $fullname, $homepage, $fullname + ); $pause->{subject_for_user_addition} = $subject; $pause->{blurb_for_user_addition} = $blurb; diff --git a/lib/pause_2017/PAUSE/Web/Controller/User.pm b/lib/pause_2017/PAUSE/Web/Controller/User.pm index d15ffede7..29decae25 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/User.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/User.pm @@ -109,7 +109,7 @@ sub edit_uris { $pause->{changed} = 1; my $mailbody = $c->render_to_string("email/user/edit_uris", format => "email"); - my @to = $mgr->prepare_sendto($u, $pause->{User}, $mgr->config->mailto_admins); + my @to = $mgr->prepare_sendto($u, $pause->{User}, 1); my $header = { Subject => "Uri update for $selectedrec->{uriid}" }; @@ -204,7 +204,7 @@ sub reindex { $pause->{blurb} = $blurb; $pause->{eta} = $eta; - my @to = $mgr->prepare_sendto($u, $pause->{User}, $PAUSE::Config->{ADMIN}); + my @to = $mgr->prepare_sendto($u, $pause->{User}, 1); my $mailbody = $c->render_to_string("email/user/reindex", format => "email"); my $header = { Subject => "Scheduled for reindexing $u->{userid}" @@ -274,7 +274,7 @@ sub reset_version { if ($blurb) { $pause->{blurb} = $blurb; - my @to = $mgr->prepare_sendto($u, $pause->{User}, $PAUSE::Config->{ADMIN}); + my @to = $mgr->prepare_sendto($u, $pause->{User}, 1); my $mailbody = $c->render_to_string("email/user/reset_version", format => "email"); my $header = { Subject => "Version reset for $u->{userid}" diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm index 680ed8c4c..5bfb29591 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm @@ -1,7 +1,6 @@ package PAUSE::Web::Controller::User::Cred; use Mojo::Base "Mojolicious::Controller"; -use Email::Address; use PAUSE::Web::Util::Encode; use Text::Unidecode; @@ -27,7 +26,15 @@ sub edit { my $wantemail = $req->param("pause99_edit_cred_email"); my $wantsecretemail = $req->param("pause99_edit_cred_secretemail"); my $wantalias = $req->param("pause99_edit_cred_cpan_mail_alias"); - my $addr_spec = $Email::Address::addr_spec; + + # I don't know why this is like this. I'm just reworking earlier code. + # -- rjbs, 2024-05-03 + my $is_not_emaily = sub { + my ($inside) = $_[0] =~ /^\s*(.+)\s*$/; + + ! PAUSE::Email->is_valid_email($inside); + }; + if ($wantemail=~/^\s*$/ && $wantsecretemail=~/^\s*$/) { $pause->{error}{no_email} = 1; } elsif ($wantalias eq "publ" && $wantemail=~/^\s*$/) { @@ -38,9 +45,9 @@ sub edit { $pause->{error}{no_secret_email} = 1; } elsif ($wantalias eq "secr" && $wantsecretemail=~/\Q$cpan_alias\E/i) { $pause->{error}{secret_is_cpan_alias} = 1; - } elsif (defined $wantsecretemail && $wantsecretemail!~/^\s*$/ && $wantsecretemail!~/^\s*$addr_spec\s*$/) { + } elsif (defined $wantsecretemail && $wantsecretemail!~/^\s*$/ && $is_not_emaily->($wantsecretemail)) { $pause->{error}{invalid_secret} = 1; - } elsif (defined $wantemail && $wantemail!~/^\s*$/ && $wantemail!~/^\s*$addr_spec\s*$/ && $wantemail ne 'CENSORED') { + } elsif (defined $wantemail && $wantemail!~/^\s*$/ && $is_not_emaily->($wantemail) && $wantemail ne 'CENSORED') { $pause->{error}{invalid_public} = 1; } else { $consistentsubmit = 1; @@ -183,6 +190,7 @@ sub edit { if ($nu->{userid} && $nu->{userid} eq $pause->{User}{userid}) { $pause->{User} = $nu; } + # Send separate emails to user and public places because # CC leaks secretemail to others my @to; @@ -190,13 +198,14 @@ sub edit { for my $lu ($u, $nu) { for my $att (qw(secretemail email)) { if ($lu->{$att}){ - $umailset{qq{<$lu->{$att}>}} = 1; + $umailset{ $lu->{$att} } = 1; last; } } } - push @to, join ", ", keys %umailset; - push @to, $mgr->config->mailto_admins if $mailto_admins; + push @to, sort keys %umailset; + push @to, PAUSE::Email->report_email_header_object if $mailto_admins; + my $header = {Subject => "User update for $u->{userid}"}; $mgr->send_mail_multi(\@to,$header, $mailblurb); } else { diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm index 822fc3790..d65c6c079 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm @@ -121,23 +121,8 @@ sub delete { $pause->{blurb} = $blurb; $blurb = $c->render_to_string("email/user/delete_files", format => "email"); - my %umailset; - my $name = $u->{asciiname} || $u->{fullname} || ""; - my $Uname = $pause->{User}{asciiname} || $pause->{User}{fullname} || ""; - if ($u->{secretemail}) { - $umailset{qq{"$name" <$u->{secretemail}>}} = 1; - } elsif ($u->{email}) { - $umailset{qq{"$name" <$u->{email}>}} = 1; - } - if ($u->{userid} ne $pause->{User}{userid}) { - if ($pause->{User}{secretemail}) { - $umailset{qq{"$Uname" <$pause->{User}{secretemail}>}} = 1; - }elsif ($pause->{User}{email}) { - $umailset{qq{"$Uname" <$pause->{User}{email}>}} = 1; - } - } - $umailset{$PAUSE::Config->{ADMIN}} = 1; - my @to = keys %umailset; + my @to = $mgr->prepare_sendto($u, $pause->{User}, 1); + my $header = { Subject => "Files of $u->{userid} scheduled for deletion" }; diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm index 7f5169e29..b0e7bf9aa 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm @@ -17,7 +17,7 @@ sub add { die PAUSE::Web::Exception ->new(ERROR => "Unidentified error happened, please write to the PAUSE admins - at $PAUSE::Config->{ADMIN} and help them identifying what's going on. Thanks!") + at $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} and help them identifying what's going on. Thanks!") unless $u->{userid}; my($tryupload) = 1; # everyone supports multipart now @@ -136,7 +136,7 @@ sub add { # via FTP GET - warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]"; + warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]"; # END OF UPLOAD OPTIONS } @@ -181,7 +181,7 @@ Sorry, $uri could not be recognized as an uri (}), $@, Mojo::ByteStream->new(qq{\)Please try again or report errors to the administrator
})]); } else { require LWP::UserAgent; diff --git a/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm b/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm index ab8a88b07..ceca53eea 100644 --- a/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm +++ b/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm @@ -64,7 +64,7 @@ sub _get { $sth1->rows, $sth1->rows, )); - die PAUSE::Web::Exception->new(ERROR => "Unidentified error happened, please write to the PAUSE admin at $PAUSE::Config->{ADMIN} and help him identifying what's going on. Thanks!"); + die PAUSE::Web::Exception->new(ERROR => "Unidentified error happened, please write to the PAUSE admin at $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} and help him identifying what's going on. Thanks!"); } my $hiddenuser_h1 = $mgr->fetchrow($sth1, "fetchrow_hashref"); @@ -157,7 +157,7 @@ sub _get { die PAUSE::Web::Exception ->new(ERROR => "Unidentified error happened, please write to the PAUSE admin - at $PAUSE::Config->{ADMIN} and help them identify what's going on. Thanks!") + at $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} and help them identify what's going on. Thanks!") unless $sth1->rows; $pause->{User} = $mgr->fetchrow($sth1, "fetchrow_hashref"); diff --git a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm index d592228c4..e9a849c8e 100644 --- a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm +++ b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm @@ -92,7 +92,7 @@ sub _send_otp_email { }; my $header_str = join "\n", map {"$_: $header->{$_}"} keys %$header; warn "header[$header_str]otpwblurb[$otpwblurb]"; - $mgr->send_mail_multi( [ $email, $PAUSE::Config->{ADMIN} ], $header, $otpwblurb); + $mgr->send_mail_multi( [ $email, PAUSE::Email->report_email_header_object ], $header, $otpwblurb); } sub _send_welcome_email { diff --git a/lib/pause_2017/templates/admin/user/add.html.ep b/lib/pause_2017/templates/admin/user/add.html.ep index 33e1d3d9b..ee659dc73 100644 --- a/lib/pause_2017/templates/admin/user/add.html.ep +++ b/lib/pause_2017/templates/admin/user/add.html.ep @@ -87,7 +87,7 @@ changed by <%= $row->{changedby} %>
Sending separate mails to: <%= $pause->{send_to} %>-From: <%= $PAUSE::Config->{UPLOAD} %> +From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %> Subject: <%= $pause->{subject} %> <%= $pause->{blurb} %> diff --git a/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep b/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep index 5b7aee6e6..9f744dd5e 100644 --- a/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep +++ b/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep @@ -4,7 +4,7 @@ % (This mail has been generated automatically by the Perl Authors Upload -Server on behalf of the admin <%== $PAUSE::Config->{ADMIN} %>) +Server on behalf of the admin <%== $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} %>) As already described in a separate message, you're a registered Perl Author with the userid <%== $pause->{userid} %>. For the sake of approval I have @@ -23,4 +23,4 @@ possible, otherwise your password can be intercepted by third parties. Thanks & Regards, -- -<%== $PAUSE::Config->{ADMIN} %> +<%== $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} %> diff --git a/lib/pause_2017/templates/public/request_id/request.html.ep b/lib/pause_2017/templates/public/request_id/request.html.ep index 756318212..169be46b3 100644 --- a/lib/pause_2017/templates/public/request_id/request.html.ep +++ b/lib/pause_2017/templates/public/request_id/request.html.ep @@ -24,7 +24,7 @@You'll also receive a welcome email like the one below.
-From: <%= $PAUSE::Config->{UPLOAD} %> +From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %> Subject: <%= $pause->{subject_for_user_addition} %> <%== $pause->{blurb_for_user_addition} %> @@ -37,7 +37,7 @@ Subject: <%= $pause->{subject_for_user_addition} %> % elsif ($pause->{blurbcopy}) { Sending mail to: <%= $pause->{send_to} %>-From: <%= $PAUSE::Config->{UPLOAD} %> +From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %> Subject: <%= $pause->{subject} %> <%== $pause->{blurbcopy} %> diff --git a/lib/pause_2017/templates/user/distperms/peek.html.ep b/lib/pause_2017/templates/user/distperms/peek.html.ep index 132e6c29e..41579cca9 100644 --- a/lib/pause_2017/templates/user/distperms/peek.html.ep +++ b/lib/pause_2017/templates/user/distperms/peek.html.ep @@ -33,7 +33,7 @@ View permission per module page.The contents of the tables presented on this page are mostly generated automatically, so please report any errors you -observe to <%= "@{$PAUSE::Config->{ADMINS}}" %> so that the tables +observe to <%= "$PAUSE::Config->{CONTACT_ADDRESS}" %> so that the tables can be corrected.--Thank you!
<%= select_field 'pause99_peek_dist_perms_by' => [ diff --git a/lib/pause_2017/templates/user/perms/peek.html.ep b/lib/pause_2017/templates/user/perms/peek.html.ep index d0d0d5ea8..ec4efea7a 100644 --- a/lib/pause_2017/templates/user/perms/peek.html.ep +++ b/lib/pause_2017/templates/user/perms/peek.html.ep @@ -28,7 +28,7 @@ View permission per distribution page.
The contents of the tables presented on this page are mostly generated automatically, so please report any errors you -observe to <%= "@{$PAUSE::Config->{ADMINS}}" %> so that the tables +observe to <%= "$PAUSE::Config->{CONTACT_ADDRESS}" %> so that the tables can be corrected.--Thank you!
<%= select_field 'pause99_peek_perms_by' => [ diff --git a/lib/pause_2017/templates/user/reindex.html.ep b/lib/pause_2017/templates/user/reindex.html.ep index be2863966..161b5d728 100644 --- a/lib/pause_2017/templates/user/reindex.html.ep +++ b/lib/pause_2017/templates/user/reindex.html.ep @@ -14,7 +14,7 @@ -
With this form you can tell the indexer to index selected files again. As it is done by a cron job, it may take up to an hour until the indexer actually executes the command. If this doesn't repair the index, please email me.
+With this form you can tell the indexer to index selected files again. As it is done by a cron job, it may take up to an hour until the indexer actually executes the command. If this doesn't repair the index, please email me.
% if (%$files) { % if ($pause->{mailbody}) { diff --git a/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm index e423f6bff..006149ba4 100644 --- a/t/lib/PAUSE/TestPAUSE.pm +++ b/t/lib/PAUSE/TestPAUSE.pm @@ -283,10 +283,13 @@ sub _build_pause_config_overrides { my $dsnbase = "DBI:SQLite:dbname=$db_root"; my $overrides = { + ADMIN_LIST => q{admin-list@example.com}, AUTHEN_DATA_SOURCE_NAME => "$dsnbase/authen.sqlite", CHECKSUMS_SIGNING_PROGRAM => "\0", + CONTACT_ADDRESS => q{admin-list@example.com}, GITROOT => $git_dir, GZIP_OPTIONS => '', + INTERNAL_REPORT_ADDRESS => q{pause-admin@example.com}, MLROOT => File::Spec->catdir($ml_root), ML_CHOWN_GROUP => +(getgrgid($)))[0], ML_CHOWN_USER => +(getpwuid($>))[0], diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t index f75a4d290..0beee2fb0 100644 --- a/t/mldistwatch-misc.t +++ b/t/mldistwatch-misc.t @@ -1,6 +1,8 @@ use strict; use warnings; +use utf8; + use 5.10.1; use lib 't/lib'; use lib 't/privatelib'; # Stub PrivatePAUSE @@ -581,6 +583,42 @@ subtest "do not index dists without META file" => sub { ); }; +subtest "quotes in username" => sub { + my $pause = PAUSE::TestPAUSE->init_new; + + my $initial_result = $pause->test_reindex; + + my $dbh = $initial_result->connect_mod_db; + + $dbh->do( + "INSERT INTO users (userid, email, fullname, asciiname) + VALUES (?, ?, ?, ?)", + undef, + 'PERSON', 'person@example.com', q{R★S"'}, q{R*S"' }, + ); + + $pause->upload_author_fake(PERSON => 'Not-Very-Meta-1.234.tar.gz', { + omitted_files => [ qw( META.yml META.json ) ], + }); + + my $result = $pause->test_reindex; + + my $email_mime = ($result->deliveries)[0]->{email}->object; + + my ($to) = ($result->deliveries)[0]->{email}->object->header_as_obj('To'); + my ($cc) = ($result->deliveries)[0]->{email}->object->header_as_obj('Cc'); + + my @to_addresses = $to->addresses; + is(@to_addresses, 1, "there is one To address"); + is($to_addresses[0]->address, q{person@example.com}, "To address is right"); + is($to_addresses[0]->phrase, q{R★S"' }, "To name is right"); + + my @cc_addresses = $cc->addresses; + is(@cc_addresses, 1, "there is one To address"); + is($cc_addresses[0]->address, q{pause-admin@example.com}, "Cc address is right"); + is($cc_addresses[0]->phrase, undef, "To name is right"); +}; + done_testing; # Local Variables: diff --git a/t/pause_2017/lib/Test/PAUSE/Web.pm b/t/pause_2017/lib/Test/PAUSE/Web.pm index 34b6338a1..ed75ad0d7 100644 --- a/t/pause_2017/lib/Test/PAUSE/Web.pm +++ b/t/pause_2017/lib/Test/PAUSE/Web.pm @@ -39,8 +39,8 @@ require PAUSE::Web::Config; $PAUSE::Config->{DOCUMENT_ROOT} = "$AppRoot/htdocs"; $PAUSE::Config->{PID_DIR} = $TestRoot; -$PAUSE::Config->{ADMIN} = $TestEmail; -$PAUSE::Config->{ADMINS} = [$TestEmail]; +$PAUSE::Config->{INTERNAL_REPORT_ADDRESS} = $TestEmail; +$PAUSE::Config->{CONTACT_ADDRESS} = $TestEmail; $PAUSE::Config->{CPAN_TESTERS} = $TestEmail; $PAUSE::Config->{TO_CPAN_TESTERS} = $TestEmail; $PAUSE::Config->{REPLY_TO_CPAN_TESTERS} = $TestEmail; @@ -51,8 +51,8 @@ $PAUSE::Config->{ML_CHOWN_USER} = 'ishigaki'; $PAUSE::Config->{ML_CHOWN_GROUP} = 'ishigaki'; $PAUSE::Config->{ML_MIN_INDEX_LINES} = 0; $PAUSE::Config->{ML_MIN_FILES} = 0; +$PAUSE::Config->{NOREPLY_ADDRESS} = $TestEmail; $PAUSE::Config->{RUNDATA} = "$TestRoot/rundata"; -$PAUSE::Config->{UPLOAD} = $TestEmail; $PAUSE::Config->{HAVE_PERLBAL} = 0; $PAUSE::Config->{SLEEP} = 1; $PAUSE::Config->{INCOMING} = "file://$TestRoot/incoming/";