From 10cb20ad23d2f670c850a61154d1cba545e4d5ee Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 20:35:17 -0400
Subject: [PATCH 01/17] paused: remove unused variable
---
bin/paused | 2 --
1 file changed, 2 deletions(-)
diff --git a/bin/paused b/bin/paused
index 85c4e7d16..9060b27a8 100755
--- a/bin/paused
+++ b/bin/paused
@@ -132,8 +132,6 @@ package mypause_send_mail;
use PAUSE::Logger '$Logger';
-our %hp_inside;
-
sub send {
my($self,$header,$blurb) = @_;
From 24b6699471ac7ab492f7a87f7ed3320c5e36eba3 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 19:34:19 -0400
Subject: [PATCH 02/17] PAUSE::Config: replace ADMINS with CONTACT_ADDRESS
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
ADMINS was an array reference. CONTACT_ADDRESS is a single address.
We just use ['modules@perl.org'] as ADMINS, and do things like
interpolate it into strings, meaning that if we had two addresses, we
would get:
Just email user@example.com other@example.mil
…which is weird. Also, having to deal with joining the ADMINS arrayref
is just a pain. Instead, make it one string!
---
lib/PAUSE.pm | 2 +-
lib/pause_1999/config.pm | 2 +-
lib/pause_1999/edit.pm | 8 ++++----
lib/pause_1999/main.pm | 2 +-
lib/pause_2017/PAUSE/Web/Config.pm | 2 +-
lib/pause_2017/PAUSE/Web/Context.pm | 8 +++++---
lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm | 7 +++++--
lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm | 8 +++++---
lib/pause_2017/templates/user/distperms/peek.html.ep | 2 +-
lib/pause_2017/templates/user/perms/peek.html.ep | 2 +-
t/lib/PAUSE/TestPAUSE.pm | 1 +
t/pause_2017/lib/Test/PAUSE/Web.pm | 2 +-
12 files changed, 27 insertions(+), 19 deletions(-)
diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 37576ce23..575fb95eb 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -70,7 +70,6 @@ $PAUSE::Config ||=
{
ABRA_EXPIRATION => 86400/4,
ADMIN => q{andreas.koenig.gmwojprw+pause@franz.ak.mind.de, neilb@neilb.org},
- ADMINS => [qq(modules\@perl.org)],
ANON_FTP_PASS => qq{k\@pause.perl.org},
AUTHEN_DATA_SOURCE_NAME => "DBI:mysql:authen_pause",
AUTHEN_PASSWORD_FLD => "password",
@@ -79,6 +78,7 @@ $PAUSE::Config ||=
AUTHEN_BACKUP_DIR => '/home/pause/db-backup',
BZCAT_PATH => (List::Util::first { -x $_ } ("/bin/bzcat", "/usr/bin/bzcat" )),
BZIP2_PATH => (List::Util::first { -x $_ } ("/bin/bzip2", "/usr/bin/bzip2" )),
+ CONTACT_ADDRESS => q(modules@perl.org),
CPAN_TESTERS => qq(cpan-uploads\@perl.org), # cpan-uploads is a mailing list, BINGOS relies on it
TO_CPAN_TESTERS => qq(cpan-uploads\@perl.org),
REPLY_TO_CPAN_TESTERS => qq(cpan-uploads\@perl.org),
diff --git a/lib/pause_1999/config.pm b/lib/pause_1999/config.pm
index 4743eb66b..e41b6de80 100644
--- a/lib/pause_1999/config.pm
+++ b/lib/pause_1999/config.pm
@@ -356,7 +356,7 @@ share_perms
CHARSET => $pause_1999::main::DO_UTF8 ? "utf-8" : "iso-8859-1",
EXECUTION_PLAN => $Exeplan,
MailMailerConstructorArgs => $PAUSE::Config->{MAIL_MAILER},
- MailtoAdmins => join(",",@{$PAUSE::Config->{ADMINS}}),
+ MailtoAdmins => $PAUSE::Config->{CONTACT_ADDRESS},
ModDsn => $PAUSE::Config->{MOD_DATA_SOURCE_NAME},
ModDsnPasswd => $PAUSE::Config->{MOD_DATA_SOURCE_PW},
ModDsnUser => $PAUSE::Config->{MOD_DATA_SOURCE_USER},
diff --git a/lib/pause_1999/edit.pm b/lib/pause_1999/edit.pm
index 6d849e9de..b5c811909 100644
--- a/lib/pause_1999/edit.pm
+++ b/lib/pause_1999/edit.pm
@@ -2458,7 +2458,7 @@ The PAUSE Team
# both users and mailing lists run this code
warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]";
- my(@to) = @{$PAUSE::Config->{ADMINS}};
+ my(@to) = $PAUSE::Config->{CONTACT_ADDRESS};
push @m, qq{ Sending separate mails to:
}, join(" AND ", @to, $email), qq{
@@ -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";
@@ -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}}.
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!
};
diff --git a/lib/pause_1999/main.pm b/lib/pause_1999/main.pm
index b935d2490..360a19661 100644
--- a/lib/pause_1999/main.pm
+++ b/lib/pause_1999/main.pm
@@ -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..ed5453163 100644
--- a/lib/pause_2017/PAUSE/Web/Context.pm
+++ b/lib/pause_2017/PAUSE/Web/Context.pm
@@ -167,9 +167,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} ||= qq{"Perl Authors Upload Server" <$PAUSE::Config->{UPLOAD}>};
+ $header->{"Reply-To"} ||= $PAUSE::Config->{CONTACT_ADDRESS};
my $email = Email::MIME->create(
header_str => [%$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..41ee2104b 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
@@ -54,7 +54,7 @@ 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";
@@ -246,8 +246,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/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/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm
index e423f6bff..faa1875aa 100644
--- a/t/lib/PAUSE/TestPAUSE.pm
+++ b/t/lib/PAUSE/TestPAUSE.pm
@@ -285,6 +285,7 @@ sub _build_pause_config_overrides {
my $overrides = {
AUTHEN_DATA_SOURCE_NAME => "$dsnbase/authen.sqlite",
CHECKSUMS_SIGNING_PROGRAM => "\0",
+ CONTACT_ADDRESS => q{admin-list@example.com},
GITROOT => $git_dir,
GZIP_OPTIONS => '',
MLROOT => File::Spec->catdir($ml_root),
diff --git a/t/pause_2017/lib/Test/PAUSE/Web.pm b/t/pause_2017/lib/Test/PAUSE/Web.pm
index 34b6338a1..68905b0ff 100644
--- a/t/pause_2017/lib/Test/PAUSE/Web.pm
+++ b/t/pause_2017/lib/Test/PAUSE/Web.pm
@@ -40,7 +40,7 @@ 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->{CONTACT_ADDRESS} = $TestEmail;
$PAUSE::Config->{CPAN_TESTERS} = $TestEmail;
$PAUSE::Config->{TO_CPAN_TESTERS} = $TestEmail;
$PAUSE::Config->{REPLY_TO_CPAN_TESTERS} = $TestEmail;
From 5232f615f2a882f2ed50aa8c35e41fbb5be1d4af Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Tue, 30 Apr 2024 19:08:25 -0400
Subject: [PATCH 03/17] TestPAUSE: set an ADMIN and CONTACT_ADDRESS while
testing
ADMIN is the address that many emails are sent from. Now that the code
will use this setting to make address objects, leaving it undef will not
do! We get warnings.
CONTACT_ADDRESS is the setting where we usually put "modules@perl.org",
where we tell people to send the admins mail. We will want to check
this in PAUSE daemon tests.
---
t/lib/PAUSE/TestPAUSE.pm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm
index faa1875aa..e33e4b622 100644
--- a/t/lib/PAUSE/TestPAUSE.pm
+++ b/t/lib/PAUSE/TestPAUSE.pm
@@ -283,6 +283,8 @@ sub _build_pause_config_overrides {
my $dsnbase = "DBI:SQLite:dbname=$db_root";
my $overrides = {
+ ADMIN => q{pause-admin@example.com},
+ 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},
From 03ff77fd8f2db3a9d06a33462b372f632f93090f Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Tue, 30 Apr 2024 19:37:00 -0400
Subject: [PATCH 04/17] PAUSE::Email: general-purpose email helper code
* admin_email_list - a List containing the emails in the ADMIN config
* email_list - given Email::Address::XS objects, make a List
* fromaddr_email_list - a List containing the email in the UPLOAD config
* is_valid_email - test whether a string is a single valid email address
---
lib/PAUSE.pm | 1 +
lib/PAUSE/Email.pm | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 37 insertions(+)
create mode 100644 lib/PAUSE/Email.pm
diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 575fb95eb..bc8e6e563 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -23,6 +23,7 @@ use File::Spec ();
use IO::File ();
use List::Util ();
use Digest::SHA ();
+use PAUSE::Email;
use Sys::Hostname ();
use Time::Piece;
use YAML::Syck;
diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm
new file mode 100644
index 000000000..d3d407479
--- /dev/null
+++ b/lib/PAUSE/Email.pm
@@ -0,0 +1,36 @@
+use v5.36.0;
+package PAUSE::Email;
+
+use Email::Address::XS ();
+use Email::MIME::Header::AddressList ();
+
+sub email_header_object_for_addresses ($class, @addresses) {
+ return Email::MIME::Header::AddressList->new(@addresses);
+}
+
+sub report_email_header_object ($class) {
+ require PAUSE;
+
+ my @addrs = split /\s*,\s*/, $PAUSE::Config->{ADMIN};
+
+ die "No PAUSE config entry for ADMIN!?" unless @addrs;
+
+ my @objects = map {; Email::Address::XS->new(undef, $_) } @addrs;
+
+ return $class->email_header_object_for_addresses(@objects);
+}
+
+sub is_valid_email ($class, $string) {
+ my $parse = Email::Address::XS->parse_bare_address($string);
+
+ # None at all! That's not a valid email.
+ return unless $parse;
+
+ # This could mean >1 address in $string, or various forms of "not a useful
+ # email" like "no domain".
+ return unless $parse->is_valid;
+
+ return 1;
+}
+
+1;
From 4f64249cd5a382c9568fdb5c1bb05484fe4097a6 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Tue, 30 Apr 2024 19:09:52 -0400
Subject: [PATCH 05/17] PAUSE::MailAddress: add an "email_header_object" method
There is a fair bit of rewriting here, hopefully making the code
clearer. The most important part, though, is adding the
->email_header_object method, which will give us an Add object suitable
for passing into header constructors.
---
lib/PAUSE/MailAddress.pm | 74 ++++++++++++++++++++++------------------
lib/PAUSE/dist.pm | 4 +--
2 files changed, 43 insertions(+), 35 deletions(-)
diff --git a/lib/PAUSE/MailAddress.pm b/lib/PAUSE/MailAddress.pm
index a3b9a09f8..04703b2f2 100644
--- a/lib/PAUSE/MailAddress.pm
+++ b/lib/PAUSE/MailAddress.pm
@@ -1,6 +1,9 @@
+use strict;
+use warnings;
+
package PAUSE::MailAddress;
+use Email::Address::XS;
use PAUSE ();
-use strict;
# use fields qw(address is_secret)
@@ -10,45 +13,50 @@ sub new {
}
sub new_from_userid {
- my($class,$userid) = @_;
- my $dbh = DBI->connect(
- $PAUSE::Config->{AUTHEN_DATA_SOURCE_NAME},
- $PAUSE::Config->{AUTHEN_DATA_SOURCE_USER},
- $PAUSE::Config->{AUTHEN_DATA_SOURCE_PW},
- { RaiseError => 1 }
- )
- or Carp::croak(qq{Can't DBI->connect(): $DBI::errstr});
- my $sth = $dbh->prepare("SELECT secretemail
- FROM $PAUSE::Config->{AUTHEN_USER_TABLE}
- WHERE $PAUSE::Config->{AUTHEN_USER_FLD}=?");
- $sth->execute($userid);
+ my($class, $userid) = @_;
+
+ my $authen_dbh = PAUSE::dbh('authen');
+ my ($secretemail) = $authen_dbh->selectrow_array(
+ "SELECT secretemail
+ FROM $PAUSE::Config->{AUTHEN_USER_TABLE}
+ WHERE $PAUSE::Config->{AUTHEN_USER_FLD}=?",
+ undef,
+ $userid,
+ );
+
my $me = {};
- my $addr;
- if ($sth->rows > 0) {
- ($addr) = $sth->fetchrow_array;
- }
- if ($addr) {
- $me->{address} = $addr;
+
+ if ($secretemail) {
+ $me->{address} = $secretemail;
$me->{is_secret} = 1;
- } else {
- my $dbh = DBI->connect(
- $PAUSE::Config->{MOD_DATA_SOURCE_NAME},
- $PAUSE::Config->{MOD_DATA_SOURCE_USER},
- $PAUSE::Config->{MOD_DATA_SOURCE_PW},
- { RaiseError => 1 }
- )
- or Carp::croak(qq{Can't DBI->connect(): $DBI::errstr});
- $sth = $dbh->prepare("SELECT email FROM users WHERE userid=?");
- $sth->execute($userid);
- if ($sth->rows >= 0){
- ($me->{address}) = $sth->fetchrow_array;
- }
- $me->{address} ||= "$userid\@cpan.org";
}
+
+ my $mod_dbh = PAUSE::dbh('mod');
+ my ($email, $fullname) = $mod_dbh->selectrow_array(
+ "SELECT email, fullname FROM users WHERE userid=?",
+ undef,
+ $userid,
+ );
+
+ $fullname = Encode::decode('UTF-8', $fullname) if length $fullname;
+
+ # The users.email column is NOT NULL, DEFAULT '', so we use || instead of //.
+ #
+ # Also, defaulting to USER@cpan.org is not going to age well, but for now,
+ # I'm sticking to the existing behavior. -- rjbs, 2024-04-30
+ $me->{address} ||= $email || "$userid\@cpan.org";
+
+ $me->{email_object} = Email::Address::XS->new($fullname, $me->{address});
+
bless $me, $class;
}
sub address { shift->{address} }
sub is_secret { shift->{is_secret} }
+sub email_header_object {
+ my ($self) = @_;
+ PAUSE::Email->email_header_object_for_addresses($self->{email_object});
+}
+
1;
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 6f4af0e14..110e87f8d 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -616,7 +616,6 @@ sub mail_summary {
warn "Unsent Report [@m]";
}
} else {
- my $to = sprintf "%s, %s", $pma->address, $PAUSE::Config->{ADMIN};
my $failed = "";
if ($status_over_all ne "OK") {
$failed = "Failed: ";
@@ -624,7 +623,8 @@ sub mail_summary {
my $email = Email::MIME->create(
header_str => [
- To => $to,
+ To => $pma->email_header_object,
+ Cc => PAUSE::Email->admin_email_header_object,
Subject => $failed."PAUSE indexer report $substrdistro",
From => "PAUSE <$PAUSE::Config->{UPLOAD}>",
],
From affc7f376af40476dab03014112313fd9e2575a9 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Tue, 30 Apr 2024 19:11:15 -0400
Subject: [PATCH 06/17] indexer: in one place, use proper email header
formatting
This is a test run for things to come. In most places, we only use the
user email address, not their name. But in some places, most especially
in paused, we use their name.
There were two problems there:
1. we were using the ASCII name, which we really don't need to do
2. we were not escaping any quotes (or anything else) in the name field,
which could cause problems if someone puts a double quote in their
fullname
It wasn't trivial to test and fix those locations because we don't
(yet!) have any tests for paused. This introduces the use of fullname
to mldistwatch, using the new form: get the PAUSE::MailAddress for the
user, then use its ->email_header_object method to create a
Email::MIME::Header::AddressList. We'll switch all the mailing to use
this, soon.
---
lib/PAUSE/dist.pm | 4 +++-
t/mldistwatch-misc.t | 38 ++++++++++++++++++++++++++++++++++++++
2 files changed, 41 insertions(+), 1 deletion(-)
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 110e87f8d..96db92592 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -3,6 +3,8 @@ use warnings;
package PAUSE::dist;
use vars qw(%CHECKSUMDONE $AUTOLOAD);
+use Email::Address::XS;
+use Email::MIME::Header::AddressList;
use Email::Sender::Simple qw(sendmail);
use File::Copy ();
use List::MoreUtils ();
@@ -624,7 +626,7 @@ sub mail_summary {
my $email = Email::MIME->create(
header_str => [
To => $pma->email_header_object,
- Cc => PAUSE::Email->admin_email_header_object,
+ Cc => PAUSE::Email->report_email_header_object,
Subject => $failed."PAUSE indexer report $substrdistro",
From => "PAUSE <$PAUSE::Config->{UPLOAD}>",
],
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:
From 393b8e65b382f18896d4d0f301f6709e2520fe36 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Tue, 30 Apr 2024 19:25:19 -0400
Subject: [PATCH 07/17] prereqs: add Email::Address::XS
I could not yet remove Email::Address, because we use its $addr_spec,
which is easy, but not trivial, to replace.
---
Makefile.PL | 1 +
cpanfile | 1 +
lib/Bundle/Pause.pm | 1 +
3 files changed, 3 insertions(+)
diff --git a/Makefile.PL b/Makefile.PL
index 8ebbeca66..ccd8b91ae 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -29,6 +29,7 @@ WriteMakefile(
Devel::Peek
Dumpvalue
Email::Address
+ Email::Address::XS
Email::MIME
Email::Sender::Simple
EV
diff --git a/cpanfile b/cpanfile
index d5c441dfa..8a2199b0b 100644
--- a/cpanfile
+++ b/cpanfile
@@ -12,6 +12,7 @@ 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/lib/Bundle/Pause.pm b/lib/Bundle/Pause.pm
index 5d18493a0..778475121 100644
--- a/lib/Bundle/Pause.pm
+++ b/lib/Bundle/Pause.pm
@@ -35,6 +35,7 @@ DBI
DBIx::RunSQL
DB_File::Lock
Email::Address
+Email::Address::XS
Email::MIME
Email::Sender::Simple
Encode::MIME::Header
From 750f7f5a60ae60c1b19df4e73e309f6838aa2d28 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 19:06:23 -0400
Subject: [PATCH 08/17] pause_2017 RequestId: use is_valid_email, not addr_spec
---
lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
index 41ee2104b..589ee97d3 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;
@@ -60,8 +59,9 @@ sub request {
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";
}
From 6f38d18eb866a04a17de0cb5c1d00b11f76462c2 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 19:06:36 -0400
Subject: [PATCH 09/17] pause_2017 Cred: use is_valid_email, not addr_spec
---
lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm | 15 +++++++++++----
1 file changed, 11 insertions(+), 4 deletions(-)
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
index 680ed8c4c..fdbf0cb9b 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;
From f423bf3d2f50636f35c5fb59c7b4b4620ebbe922 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 19:11:06 -0400
Subject: [PATCH 10/17] prereqs: drop Email::Address (non-XS version)
---
Makefile.PL | 1 -
cpanfile | 1 -
lib/Bundle/Pause.pm | 1 -
3 files changed, 3 deletions(-)
diff --git a/Makefile.PL b/Makefile.PL
index ccd8b91ae..c5d3e97f1 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -28,7 +28,6 @@ WriteMakefile(
DBIx::RunSQL
Devel::Peek
Dumpvalue
- Email::Address
Email::Address::XS
Email::MIME
Email::Sender::Simple
diff --git a/cpanfile b/cpanfile
index 8a2199b0b..0cdc3a636 100644
--- a/cpanfile
+++ b/cpanfile
@@ -11,7 +11,6 @@ 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';
diff --git a/lib/Bundle/Pause.pm b/lib/Bundle/Pause.pm
index 778475121..2234ec6b9 100644
--- a/lib/Bundle/Pause.pm
+++ b/lib/Bundle/Pause.pm
@@ -34,7 +34,6 @@ DBD::mysql
DBI
DBIx::RunSQL
DB_File::Lock
-Email::Address
Email::Address::XS
Email::MIME
Email::Sender::Simple
From 295e7bd262d76d4304d679b986ee08f8dd0e8027 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 19:52:59 -0400
Subject: [PATCH 11/17] update more email sending code to use email lists
---
cron/cron-daily.pl | 2 +-
cron/cron-p6daily.pl | 2 +-
lib/PAUSE/mldistwatch.pm | 2 +-
lib/pause_2017/PAUSE/Web/Context.pm | 2 +-
4 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl
index 7151a8902..7d994dc08 100755
--- a/cron/cron-daily.pl
+++ b/cron/cron-daily.pl
@@ -345,7 +345,7 @@ sub send_the_mail {
},
header_str => [
Subject => $SUBJECT,
- To => $PAUSE::Config->{ADMIN},
+ To => PAUSE::Email->report_email_header_object,
From => "cron daemon cron-daily.pl ",
],
body_str => join(q{}, @blurb),
diff --git a/cron/cron-p6daily.pl b/cron/cron-p6daily.pl
index 37b7340c8..cbf24ef4d 100755
--- a/cron/cron-p6daily.pl
+++ b/cron/cron-p6daily.pl
@@ -71,7 +71,7 @@ sub send_the_mail {
},
header_str => [
Subject => $SUBJECT,
- To => $PAUSE::Config->{ADMIN},
+ To => PAUSE::Email->report_email_header_object,
From => "cron daemon cron-p6daily.pl ",
],
body_str => join(q{}, @blurb),
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 180281653..2dac554eb 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -591,7 +591,7 @@ sub handle_alerts {
my $email = Email::MIME->create(
header_str => [
- To => $PAUSE::Config->{ADMIN},
+ To => PAUSE::Email->report_email_header_object,
Subject => "PAUSE upload indexing error",
From => "PAUSE <$PAUSE::Config->{UPLOAD}>",
],
diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm
index ed5453163..5289f6d82 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);
From a17df7d73ee8ceca14c27159bfeb2f4be2eb6658 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Wed, 1 May 2024 21:50:28 -0400
Subject: [PATCH 12/17] PAUSE::Email: add (and use) noreply_email_header_object
UPLOAD will become NOREPLY_ADDRESS soon.
---
bin/paused | 2 +-
cron/cron-daily.pl | 2 +-
cron/cron-p6daily.pl | 2 +-
lib/PAUSE/Email.pm | 8 ++++++++
lib/PAUSE/dist.pm | 2 +-
lib/PAUSE/mldistwatch.pm | 2 +-
lib/pause_2017/PAUSE/Web/Context.pm | 2 +-
7 files changed, 14 insertions(+), 6 deletions(-)
diff --git a/bin/paused b/bin/paused
index 9060b27a8..bfc573837 100755
--- a/bin/paused
+++ b/bin/paused
@@ -137,7 +137,7 @@ sub send {
my %from = exists $header->{From}
? ()
- : (From => "PAUSE <$PAUSE::Config->{UPLOAD}>");
+ : (From => PAUSE::Email->noreply_email_header_object);
my $email = Email::MIME->create(
attributes => {
diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl
index 7d994dc08..c8156cf47 100755
--- a/cron/cron-daily.pl
+++ b/cron/cron-daily.pl
@@ -346,7 +346,7 @@ sub send_the_mail {
header_str => [
Subject => $SUBJECT,
To => PAUSE::Email->report_email_header_object,
- From => "cron daemon cron-daily.pl ",
+ From => PAUSE::Email->report_email_header_object,
],
body_str => join(q{}, @blurb),
);
diff --git a/cron/cron-p6daily.pl b/cron/cron-p6daily.pl
index cbf24ef4d..4a060db70 100755
--- a/cron/cron-p6daily.pl
+++ b/cron/cron-p6daily.pl
@@ -72,7 +72,7 @@ sub send_the_mail {
header_str => [
Subject => $SUBJECT,
To => PAUSE::Email->report_email_header_object,
- From => "cron daemon cron-p6daily.pl ",
+ From => PAUSE::Email->report_email_header_object,
],
body_str => join(q{}, @blurb),
);
diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm
index d3d407479..f0f73e20f 100644
--- a/lib/PAUSE/Email.pm
+++ b/lib/PAUSE/Email.pm
@@ -20,6 +20,14 @@ sub report_email_header_object ($class) {
return $class->email_header_object_for_addresses(@objects);
}
+sub noreply_email_header_object ($class) {
+ require PAUSE;
+
+ return $class->email_header_object_for_addresses(
+ Email::Address::XS->new("Perl Authors Upload Server", $PAUSE::Config->{UPLOAD})
+ );
+}
+
sub is_valid_email ($class, $string) {
my $parse = Email::Address::XS->parse_bare_address($string);
diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm
index 96db92592..b0f4f8b23 100644
--- a/lib/PAUSE/dist.pm
+++ b/lib/PAUSE/dist.pm
@@ -628,7 +628,7 @@ sub mail_summary {
To => $pma->email_header_object,
Cc => PAUSE::Email->report_email_header_object,
Subject => $failed."PAUSE indexer report $substrdistro",
- From => "PAUSE <$PAUSE::Config->{UPLOAD}>",
+ From => PAUSE::Email->noreply_email_header_object,
],
attributes => {
charset => 'utf-8',
diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm
index 2dac554eb..ee0be80a0 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -593,7 +593,7 @@ sub handle_alerts {
header_str => [
To => PAUSE::Email->report_email_header_object,
Subject => "PAUSE upload indexing error",
- From => "PAUSE <$PAUSE::Config->{UPLOAD}>",
+ From => PAUSE::Email->noreply_email_header_object,
],
attributes => {
charset => 'utf-8',
diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm
index 5289f6d82..6b6740162 100644
--- a/lib/pause_2017/PAUSE/Web/Context.pm
+++ b/lib/pause_2017/PAUSE/Web/Context.pm
@@ -170,7 +170,7 @@ sub send_mail {
my @hdebug = %$header;
$self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) });
- $header->{From} ||= qq{"Perl Authors Upload Server" <$PAUSE::Config->{UPLOAD}>};
+ $header->{From} ||= PAUSE::Email->noreply_email_header_object;
$header->{"Reply-To"} ||= $PAUSE::Config->{CONTACT_ADDRESS};
my $email = Email::MIME->create(
From 454fcfa1e106a70b52162d75fbfaae79eeb1fcab Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Fri, 3 May 2024 21:46:24 -0400
Subject: [PATCH 13/17] PAUSE::Email: add (and use) contact_email_header_object
---
lib/PAUSE/Email.pm | 8 ++++++++
lib/pause_2017/PAUSE/Web/Context.pm | 2 +-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm
index f0f73e20f..1fb38e94b 100644
--- a/lib/PAUSE/Email.pm
+++ b/lib/PAUSE/Email.pm
@@ -20,6 +20,14 @@ sub report_email_header_object ($class) {
return $class->email_header_object_for_addresses(@objects);
}
+sub contact_email_header_object ($class) {
+ require PAUSE;
+
+ return $class->email_header_object_for_addresses(
+ Email::Address::XS->new("PAUSE Admins", $PAUSE::Config->{CONTACT_ADDRESS})
+ );
+}
+
sub noreply_email_header_object ($class) {
require PAUSE;
diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm
index 6b6740162..4a1568a25 100644
--- a/lib/pause_2017/PAUSE/Web/Context.pm
+++ b/lib/pause_2017/PAUSE/Web/Context.pm
@@ -171,7 +171,7 @@ sub send_mail {
$self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) });
$header->{From} ||= PAUSE::Email->noreply_email_header_object;
- $header->{"Reply-To"} ||= $PAUSE::Config->{CONTACT_ADDRESS};
+ $header->{"Reply-To"} ||= PAUSE::Email->contact_email_header_object;
my $email = Email::MIME->create(
header_str => [%$header],
From 6484ffaadea8a3fca416e3151f60439f42fb50b6 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Fri, 3 May 2024 20:04:23 -0400
Subject: [PATCH 14/17] PAUSE::Config: replace ADMIN with
INTERNAL_REPORT_ADDRESS
---
bin/paused | 8 +++----
cron/cron-daily.pl | 2 +-
lib/PAUSE.pm | 2 +-
lib/PAUSE/Email.pm | 2 +-
lib/pause_1999/edit.pm | 24 +++++++++----------
lib/pause_1999/main.pm | 2 +-
lib/pause_2017/PAUSE/Web/Controller/User.pm | 4 ++--
.../PAUSE/Web/Controller/User/Files.pm | 2 +-
.../PAUSE/Web/Controller/User/Uri.pm | 4 ++--
.../PAUSE/Web/Plugin/GetActiveUserRecord.pm | 4 ++--
.../PAUSE/Web/Plugin/UserRegistration.pm | 2 +-
.../admin/user/onetime_password.email.ep | 4 ++--
t/lib/PAUSE/TestPAUSE.pm | 2 +-
t/pause_2017/lib/Test/PAUSE/Web.pm | 2 +-
14 files changed, 32 insertions(+), 32 deletions(-)
diff --git a/bin/paused b/bin/paused
index bfc573837..e179a59c9 100755
--- a/bin/paused
+++ b/bin/paused
@@ -308,7 +308,7 @@ skip =not yet verified
mypause_send_mail->send({
- To => $PAUSE::Config->{ADMIN},
+ To => $PAUSE::Config->{INTERNAL_REPORT_ADDRESS},
Subject => "Mirror request from $package"
},
$blurb
@@ -400,7 +400,7 @@ sub woe {
my @To;
my $pma = PAUSE::MailAddress->new_from_userid($userid);
my $to = $pma->address;
- push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$to>};
+ push @To, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, qq{"$asciiname" <$to>};
my $blurb = "The URL $hash->{uri},
requested for upload as $hash->{uriid} has problems
@@ -471,7 +471,7 @@ but I couldn't ($!). Seems as if the admin has to do something\n\n";
my @To;
my $pma = PAUSE::MailAddress->new_from_userid($userid);
my $address = $pma->address;
- push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$address>};
+ push @To, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, qq{"$asciiname" <$address>};
my $blurb;
if ($self->{ErrNotGzip}) {
@@ -775,7 +775,7 @@ 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 @To = $PAUSE::Config->{INTERNAL_REPORT_ADDRESS};
my $blurb = "For the resource [$uri]
the command [$testinggzip -t $tpath]
diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl
index c8156cf47..c9e7ee7bd 100755
--- a/cron/cron-daily.pl
+++ b/cron/cron-daily.pl
@@ -415,7 +415,7 @@ sub whois {
-generated on $now UTC by $PAUSE::Config->{ADMIN}
+generated on $now UTC by $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}
};
diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index bc8e6e563..80336e38c 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -70,7 +70,6 @@ push @INC, $pauselib;
$PAUSE::Config ||=
{
ABRA_EXPIRATION => 86400/4,
- ADMIN => q{andreas.koenig.gmwojprw+pause@franz.ak.mind.de, neilb@neilb.org},
ANON_FTP_PASS => qq{k\@pause.perl.org},
AUTHEN_DATA_SOURCE_NAME => "DBI:mysql:authen_pause",
AUTHEN_PASSWORD_FLD => "password",
@@ -93,6 +92,7 @@ $PAUSE::Config ||=
HTTP_ERRORLOG => '/var/log/nginx/error.log', # harmless use in cron-daily
INCOMING => 'file://data/pause/incoming/',
INCOMING_LOC => '/data/pause/incoming',
+ INTERNAL_REPORT_ADDRESS => q{andreas.koenig.gmwojprw+pause@franz.ak.mind.de, neilb@neilb.org},
MAIL_MAILER => ["sendmail"],
MAXRETRIES => 16,
MIRRORCONFIG => '/usr/local/mirror/mymirror.config',
diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm
index 1fb38e94b..5461d0b35 100644
--- a/lib/PAUSE/Email.pm
+++ b/lib/PAUSE/Email.pm
@@ -11,7 +11,7 @@ sub email_header_object_for_addresses ($class, @addresses) {
sub report_email_header_object ($class) {
require PAUSE;
- my @addrs = split /\s*,\s*/, $PAUSE::Config->{ADMIN};
+ my @addrs = split /\s*,\s*/, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS};
die "No PAUSE config entry for ADMIN!?" unless @addrs;
diff --git a/lib/pause_1999/edit.pm b/lib/pause_1999/edit.pm
index b5c811909..376040af9 100644
--- a/lib/pause_1999/edit.pm
+++ b/lib/pause_1999/edit.pm
@@ -500,7 +500,7 @@ sub active_user_record {
die PAUSE::HeavyCGI::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!");
+ at $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} and help him identifying what's going on. Thanks!");
}
my $hiddenuser_h1 = $mgr->fetchrow($sth1, "fetchrow_hashref");
require YAML::Syck; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . YAML::Syck::Dump({hiddenuser_h1 => $hiddenuser_h1}); # XXX
@@ -598,7 +598,7 @@ sub active_user_record {
die PAUSE::HeavyCGI::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;
$mgr->{User} = $mgr->fetchrow($sth1, "fetchrow_hashref");
@@ -1394,7 +1394,7 @@ sub add_uri {
die PAUSE::HeavyCGI::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};
push @m, qq{};
my $can_multipart = $mgr->can_multipart;
@@ -1701,7 +1701,7 @@ into $her directory. The request used the following parameters:});
$mailblurb .= $self->wrappar($success);
$mailblurb .= "\n\nThanks for your contribution,\n-- \nThe PAUSE Team\n";
# my $header = {
-# To => qq{$PAUSE::Config->{ADMIN}, $u->{email}, $mgr->{User}{email}},
+# To => qq{$PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, $u->{email}, $mgr->{User}{email}},
# Subject => qq{Notification from PAUSE},
# };
my %umailset;
@@ -1719,7 +1719,7 @@ into $her directory. The request used the following parameters:});
$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 => "Notification from PAUSE",
@@ -1755,7 +1755,7 @@ Sorry, $uri could not be recognized as an uri (},
qq{\)
}]);
} 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);
@@ -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 360a19661..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);
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User.pm b/lib/pause_2017/PAUSE/Web/Controller/User.pm
index d15ffede7..97bba2a6c 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User.pm
@@ -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}, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS});
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}, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS});
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/Files.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
index 822fc3790..d3573f4dc 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
@@ -136,7 +136,7 @@ sub delete {
$umailset{qq{"$Uname" <$pause->{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"
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
index 7f5169e29..75314dfe7 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
@@ -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..c84ecd63b 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::Config->{INTERNAL_REPORT_ADDRESS} ], $header, $otpwblurb);
}
sub _send_welcome_email {
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/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm
index e33e4b622..006149ba4 100644
--- a/t/lib/PAUSE/TestPAUSE.pm
+++ b/t/lib/PAUSE/TestPAUSE.pm
@@ -283,13 +283,13 @@ sub _build_pause_config_overrides {
my $dsnbase = "DBI:SQLite:dbname=$db_root";
my $overrides = {
- ADMIN => q{pause-admin@example.com},
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/pause_2017/lib/Test/PAUSE/Web.pm b/t/pause_2017/lib/Test/PAUSE/Web.pm
index 68905b0ff..c8726130c 100644
--- a/t/pause_2017/lib/Test/PAUSE/Web.pm
+++ b/t/pause_2017/lib/Test/PAUSE/Web.pm
@@ -39,7 +39,7 @@ require PAUSE::Web::Config;
$PAUSE::Config->{DOCUMENT_ROOT} = "$AppRoot/htdocs";
$PAUSE::Config->{PID_DIR} = $TestRoot;
-$PAUSE::Config->{ADMIN} = $TestEmail;
+$PAUSE::Config->{INTERNAL_REPORT_ADDRESS} = $TestEmail;
$PAUSE::Config->{CONTACT_ADDRESS} = $TestEmail;
$PAUSE::Config->{CPAN_TESTERS} = $TestEmail;
$PAUSE::Config->{TO_CPAN_TESTERS} = $TestEmail;
From 8276da452a44174b73b16a22c4156907af97e6ce Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Fri, 3 May 2024 20:11:26 -0400
Subject: [PATCH 15/17] PAUSE::Config: replace UPLOAD with NOREPLY_ADDRESS
---
lib/PAUSE.pm | 2 +-
lib/PAUSE/Email.pm | 2 +-
lib/pause_1999/config.pm | 2 +-
lib/pause_1999/edit.pm | 18 +++++++++---------
.../PAUSE/Web/Controller/User/Uri.pm | 2 +-
.../templates/admin/user/add.html.ep | 2 +-
.../public/request_id/request.html.ep | 4 ++--
lib/pause_2017/templates/user/reindex.html.ep | 2 +-
t/pause_2017/lib/Test/PAUSE/Web.pm | 2 +-
9 files changed, 18 insertions(+), 18 deletions(-)
diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 80336e38c..3bfc839e2 100644
--- a/lib/PAUSE.pm
+++ b/lib/PAUSE.pm
@@ -104,6 +104,7 @@ $PAUSE::Config ||=
ML_MIN_FILES => 20_000, # must be this many files to run mldistwatch
MOD_DATA_SOURCE_NAME => "dbi:mysql:mod",
NO_SUCCESS_BREAK => 900,
+ NOREPLY_ADDRESS => 'upload@pause.perl.org',
P5P => 'release-announce@perl.org',
PID_DIR => "/home/pause/pid/",
PAUSE_LOG => "/home/pause/log/paused.log",
@@ -119,7 +120,6 @@ $PAUSE::Config ||=
TIMEOUT => 60*60,
TRUST_IS_SSL_HEADER => 1,
TMP => '/data/pause/tmp/',
- UPLOAD => 'upload@pause.perl.org',
# sign the auto-generated CHECKSUM files with:
CHECKSUMS_SIGNING_PROGRAM => 'gpg',
CHECKSUMS_SIGNING_ARGS => '-q --homedir /home/pause/pause-private/gnupg-pause-batch-signing-home --clearsign --default-key ',
diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm
index 5461d0b35..af4fe6337 100644
--- a/lib/PAUSE/Email.pm
+++ b/lib/PAUSE/Email.pm
@@ -32,7 +32,7 @@ sub noreply_email_header_object ($class) {
require PAUSE;
return $class->email_header_object_for_addresses(
- Email::Address::XS->new("Perl Authors Upload Server", $PAUSE::Config->{UPLOAD})
+ Email::Address::XS->new("Perl Authors Upload Server", $PAUSE::Config->{NOREPLY_ADDRESS})
);
}
diff --git a/lib/pause_1999/config.pm b/lib/pause_1999/config.pm
index e41b6de80..6415e8060 100644
--- a/lib/pause_1999/config.pm
+++ b/lib/pause_1999/config.pm
@@ -394,7 +394,7 @@ share_perms
}
- $self->{OurEmailFrom} = "\"Perl Authors Upload Server\" <$PAUSE::Config->{UPLOAD}>";
+ $self->{OurEmailFrom} = "\"Perl Authors Upload Server\" <$PAUSE::Config->{NOREPLY_ADDRESS}>";
# warn "Debug: OurEmailFrom=UPLOAD[$self->{OurEmailFrom}]";
my(@time) = gmtime; # sec,min,hour,day,month,year
my $quartal = int($time[4]/3) + 1; # 1..4
diff --git a/lib/pause_1999/edit.pm b/lib/pause_1999/edit.pm
index 376040af9..817a41baa 100644
--- a/lib/pause_1999/edit.pm
+++ b/lib/pause_1999/edit.pm
@@ -1654,7 +1654,7 @@ filename[%s].
# via FTP GET
- warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]";
+ warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]";
push @m, qq{
If you want me to fetch a
file from an URL, enter the full URL here. };
@@ -2457,12 +2457,12 @@ The PAUSE Team
# both users and mailing lists run this code
- warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]";
+ 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;
@@ -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
@@ -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
@@ -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();
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
index 75314dfe7..b0e7bf9aa 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
@@ -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
}
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} %>
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/pause_2017/lib/Test/PAUSE/Web.pm b/t/pause_2017/lib/Test/PAUSE/Web.pm
index c8726130c..ed75ad0d7 100644
--- a/t/pause_2017/lib/Test/PAUSE/Web.pm
+++ b/t/pause_2017/lib/Test/PAUSE/Web.pm
@@ -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/";
From 1ceabbe9ecf15b061c8e00e4d631505dbe7c860f Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Fri, 3 May 2024 21:26:21 -0400
Subject: [PATCH 16/17] paused: use email header objects for email headers
---
bin/paused | 98 ++++++++++++++++++++++++++++--------------------------
1 file changed, 51 insertions(+), 47 deletions(-)
diff --git a/bin/paused b/bin/paused
index e179a59c9..7d077ef47 100755
--- a/bin/paused
+++ b/bin/paused
@@ -133,7 +133,7 @@ package mypause_send_mail;
use PAUSE::Logger '$Logger';
sub send {
- my($self,$header,$blurb) = @_;
+ my ($self,$header,$blurb) = @_;
my %from = exists $header->{From}
? ()
@@ -308,7 +308,7 @@ skip =not yet verified
mypause_send_mail->send({
- To => $PAUSE::Config->{INTERNAL_REPORT_ADDRESS},
+ To => PAUSE::Email->report_email_header_object,
Subject => "Mirror request from $package"
},
$blurb
@@ -397,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->{INTERNAL_REPORT_ADDRESS}, qq{"$asciiname" <$to>};
my $blurb = "The URL $hash->{uri},
requested for upload as $hash->{uriid} has problems
@@ -412,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}) {
@@ -468,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->{INTERNAL_REPORT_ADDRESS}, qq{"$asciiname" <$address>};
my $blurb;
if ($self->{ErrNotGzip}) {
@@ -495,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.
@@ -532,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,/,;
@@ -585,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;
@@ -775,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->{INTERNAL_REPORT_ADDRESS};
my $blurb = "For the resource [$uri]
the command [$testinggzip -t $tpath]
@@ -785,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}++;
From 9c92e7f4f1c04c96982a50a6ac895986e8e01612 Mon Sep 17 00:00:00 2001
From: Ricardo Signes
Date: Fri, 3 May 2024 22:10:16 -0400
Subject: [PATCH 17/17] pause_2017: use email header objects when possible
I don't know this code well, so this may be a bit of a wreck.
First, `$mgr->prepare_sendto` is updated.
1. prefer fullname to asciiname, because it is more polite
2. use real email header generation, not just concat
3. if we had "Bob " and "Alice " we now only send one email,
not one per unique phrase; I think this is fine
Where the prepare_sendto code was basically duplicated, I have switched
things to use prepare_sendto.
Internal report emails now go to the internal reporting address, not the
public contact address.
In some places, the code was quite tough for me to read, so I just left
`$email` and the like used. This should work fine. It would be nice to
add phases later.
**I didn't understand this**: `$pause->{send_to}`. That was being set
to a string, but I don't know really why or how it was used, although I
saw some hints. The new code would've put ARRAY(0x1234) in that, so I
changed the text. I will seek advice.
---
lib/pause_2017/PAUSE/Web/Context.pm | 35 +++++++++++++------
lib/pause_2017/PAUSE/Web/Controller/Admin.pm | 2 +-
.../PAUSE/Web/Controller/Public/RequestId.pm | 5 +--
lib/pause_2017/PAUSE/Web/Controller/User.pm | 6 ++--
.../PAUSE/Web/Controller/User/Cred.pm | 8 +++--
.../PAUSE/Web/Controller/User/Files.pm | 19 ++--------
.../PAUSE/Web/Plugin/UserRegistration.pm | 2 +-
7 files changed, 39 insertions(+), 38 deletions(-)
diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm
index 4a1568a25..75326daa5 100644
--- a/lib/pause_2017/PAUSE/Web/Context.pm
+++ b/lib/pause_2017/PAUSE/Web/Context.pm
@@ -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 {
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/Public/RequestId.pm b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
index 589ee97d3..1b59d8521 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
@@ -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
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User.pm b/lib/pause_2017/PAUSE/Web/Controller/User.pm
index 97bba2a6c..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->{INTERNAL_REPORT_ADDRESS});
+ 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->{INTERNAL_REPORT_ADDRESS});
+ 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 fdbf0cb9b..5bfb29591 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
@@ -190,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;
@@ -197,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 d3573f4dc..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->{INTERNAL_REPORT_ADDRESS}} = 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/Plugin/UserRegistration.pm b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm
index c84ecd63b..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->{INTERNAL_REPORT_ADDRESS} ], $header, $otpwblurb);
+ $mgr->send_mail_multi( [ $email, PAUSE::Email->report_email_header_object ], $header, $otpwblurb);
}
sub _send_welcome_email {