From a29be1bda4a23f03a2116bb9287e1230b233176e Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Wed, 1 May 2024 20:35:17 -0400 Subject: [PATCH 01/27] paused: remove unused variable --- bin/paused | 2 -- 1 file changed, 2 deletions(-) diff --git a/bin/paused b/bin/paused index 56e0c9d78..8531f5308 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 08bae29ddcce20ed7572a3bf06c192c5627a2cd0 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Wed, 1 May 2024 19:34:19 -0400 Subject: [PATCH 02/27] 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_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 +- 9 files changed, 21 insertions(+), 13 deletions(-) diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm index c025c0568..4a65f4083 100644 --- a/lib/PAUSE.pm +++ b/lib/PAUSE.pm @@ -74,7 +74,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", @@ -83,6 +82,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_2017/PAUSE/Web/Config.pm b/lib/pause_2017/PAUSE/Web/Config.pm index 9ed79e5b0..2fbbdc992 100644 --- a/lib/pause_2017/PAUSE/Web/Config.pm +++ b/lib/pause_2017/PAUSE/Web/Config.pm @@ -671,6 +671,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 98fca4969..557a181af 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -170,9 +170,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 5ea014ceb..92b92581f 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"; @@ -248,8 +248,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 2fe1b5ed0..9c368d215 100644 --- a/lib/pause_2017/templates/user/distperms/peek.html.ep +++ b/lib/pause_2017/templates/user/distperms/peek.html.ep @@ -32,7 +32,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 28c630f50..dd954c798 100644 --- a/lib/pause_2017/templates/user/perms/peek.html.ep +++ b/lib/pause_2017/templates/user/perms/peek.html.ep @@ -27,7 +27,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 3af92670e..03226b25c 100644 --- a/t/lib/PAUSE/TestPAUSE.pm +++ b/t/lib/PAUSE/TestPAUSE.pm @@ -324,6 +324,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 801aa9250..c4a0157e0 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 9427090cfc1d653efbc7b119794beaf3936c4a4d Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 30 Apr 2024 19:08:25 -0400 Subject: [PATCH 03/27] 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 03226b25c..691cec3bf 100644 --- a/t/lib/PAUSE/TestPAUSE.pm +++ b/t/lib/PAUSE/TestPAUSE.pm @@ -322,6 +322,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 33bcf7290b9d287958264806c67620152bc7145a Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 30 Apr 2024 19:37:00 -0400 Subject: [PATCH 04/27] 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 4a65f4083..94aaaddc2 100644 --- a/lib/PAUSE.pm +++ b/lib/PAUSE.pm @@ -24,6 +24,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 ef4bcfeb9f44d2e428778bc762196e2fc2429fbe Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 30 Apr 2024 19:09:52 -0400 Subject: [PATCH 05/27] 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 6474bf304..b324fed69 100644 --- a/lib/PAUSE/dist.pm +++ b/lib/PAUSE/dist.pm @@ -550,7 +550,6 @@ sub _send_email { my $substrdistro = substr $distro, 5; my $pma = PAUSE::MailAddress->new_from_userid($author); - my $to = sprintf "%s, %s", $pma->address, $PAUSE::Config->{ADMIN}; my $failed = ""; if ($status_over_all ne "OK") { @@ -559,7 +558,8 @@ sub _send_email { 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 fddb16afc7128b89efcd402fdf23f635087d9554 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 30 Apr 2024 19:11:15 -0400 Subject: [PATCH 06/27] 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 b324fed69..e690f37f7 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 File::Copy (); use List::MoreUtils (); use PAUSE (); @@ -559,7 +561,7 @@ sub _send_email { 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 7c4b49b7d..9428fb166 100644 --- a/t/mldistwatch-misc.t +++ b/t/mldistwatch-misc.t @@ -1,6 +1,8 @@ use strict; use warnings; +use utf8; + use v5.36.0; use lib 't/lib'; use lib 't/privatelib'; # Stub PrivatePAUSE @@ -725,6 +727,42 @@ subtest "indexer ran, but nothing indexed" => 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"'<xmp>}, + ); + + $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"'<xmp>}, "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 5abdfc27b772b4004a7240fb252649b80ea3d816 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Tue, 30 Apr 2024 19:25:19 -0400 Subject: [PATCH 07/27] 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 864f34c2f..93b1b04f4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -28,6 +28,7 @@ WriteMakefile( Devel::Peek Dumpvalue Email::Address + Email::Address::XS Email::MIME Email::Sender::Simple EV diff --git a/cpanfile b/cpanfile index 1580c3568..ce905b98c 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 26e12eb3a..b1df95763 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 2c531380367993aeb52b6b5f9548f01777b84e6b Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 1 May 2024 19:06:23 -0400 Subject: [PATCH 08/27] 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 92b92581f..67a619fb0 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 ba6b3d958a82e4f215966db788f4f83cb2a33cc4 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 1 May 2024 19:06:36 -0400 Subject: [PATCH 09/27] 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 e9f8544d4c346340c1028c0003a33ba3edd0c567 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 1 May 2024 19:11:06 -0400 Subject: [PATCH 10/27] 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 93b1b04f4..c272f6894 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -27,7 +27,6 @@ WriteMakefile( DBIx::RunSQL Devel::Peek Dumpvalue - Email::Address Email::Address::XS Email::MIME Email::Sender::Simple diff --git a/cpanfile b/cpanfile index ce905b98c..468398810 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 b1df95763..b4c3f99f6 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 c84b94075d86092e7f6232fe6d785c048ffc94cb Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 1 May 2024 19:52:59 -0400 Subject: [PATCH 11/27] 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 <upload\@pause.perl.org>", ], 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 <upload\@pause.perl.org>", ], body_str => join(q{}, @blurb), diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm index 3a91f654f..9b3fe5928 100644 --- a/lib/PAUSE/mldistwatch.pm +++ b/lib/PAUSE/mldistwatch.pm @@ -594,7 +594,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 557a181af..5c3426347 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -94,7 +94,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 d32c30a45c346b4d2e661cf92bd0b0d250bfa5f9 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 1 May 2024 21:50:28 -0400 Subject: [PATCH 12/27] 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 8531f5308..341ff3a01 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..74ae2c05e 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 <upload\@pause.perl.org>", + From => PAUSE::Email->noreply_email_header_object, ], body_str => join(q{}, @blurb), ); diff --git a/cron/cron-p6daily.pl b/cron/cron-p6daily.pl index cbf24ef4d..adca4cdef 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 <upload\@pause.perl.org>", + From => PAUSE::Email->noreply_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 e690f37f7..0b284ebd5 100644 --- a/lib/PAUSE/dist.pm +++ b/lib/PAUSE/dist.pm @@ -563,7 +563,7 @@ sub _send_email { 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 9b3fe5928..edfd4acb9 100644 --- a/lib/PAUSE/mldistwatch.pm +++ b/lib/PAUSE/mldistwatch.pm @@ -596,7 +596,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 5c3426347..b755fb48c 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -173,7 +173,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 52660471f8182e08f71cfa7d61f4f381302504a4 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Fri, 3 May 2024 21:46:24 -0400 Subject: [PATCH 13/27] 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 b755fb48c..5b4d7fa74 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -174,7 +174,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 bf6210e67e024601dc9d0938a58754fd51b92293 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Fri, 3 May 2024 20:04:23 -0400 Subject: [PATCH 14/27] 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_2017/PAUSE/Web/Controller/User.pm | 4 ++-- lib/pause_2017/PAUSE/Web/Controller/User/Files.pm | 2 +- lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm | 4 ++-- lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm | 4 ++-- lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm | 2 +- .../templates/email/admin/user/onetime_password.email.ep | 4 ++-- t/lib/PAUSE/TestPAUSE.pm | 2 +- t/pause_2017/lib/Test/PAUSE/Web.pm | 2 +- 12 files changed, 19 insertions(+), 19 deletions(-) diff --git a/bin/paused b/bin/paused index 341ff3a01..2ed2507dd 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{<$to>}; + push @To, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, qq{<$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{<$address>}; + push @To, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, qq{<$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 74ae2c05e..0155ad7ab 100755 --- a/cron/cron-daily.pl +++ b/cron/cron-daily.pl @@ -415,7 +415,7 @@ sub whois { <body> <h3>People, <a href="#mailinglists">Mailinglists</a> And <a href="#mlarchives">Mailinglist Archives</a> </h3> -<i>generated on $now UTC by $PAUSE::Config->{ADMIN}</i> +<i>generated on $now UTC by $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}</i> <pre xml:space="preserve"> }; diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm index 94aaaddc2..6337565e9 100644 --- a/lib/PAUSE.pm +++ b/lib/PAUSE.pm @@ -74,7 +74,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", @@ -97,6 +96,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_2017/PAUSE/Web/Controller/User.pm b/lib/pause_2017/PAUSE/Web/Controller/User.pm index b4b27de14..1870b0b7b 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, <b>$uri</b> could not be recognized as an uri (}), $@, Mojo::ByteStream->new(qq{\)Please try again or report errors to <a href="mailto:}), - $PAUSE::Config->{ADMIN}, + $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, Mojo::ByteStream->new(qq{">the administrator</a></p>})]); } 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 73c4a5fab..79adca92e 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 0d06e2401..4a9f783df 100644 --- a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm +++ b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm @@ -93,7 +93,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 1d8f66403..6f0b14d4a 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 @@ -20,4 +20,4 @@ password is expired automatically. 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 691cec3bf..7a0e93d37 100644 --- a/t/lib/PAUSE/TestPAUSE.pm +++ b/t/lib/PAUSE/TestPAUSE.pm @@ -322,13 +322,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 c4a0157e0..fcba8649b 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 0dcc6d701e9f4af62622bfbce8a6c83804b54cd0 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Fri, 3 May 2024 20:11:26 -0400 Subject: [PATCH 15/27] PAUSE::Config: replace UPLOAD with NOREPLY_ADDRESS --- lib/PAUSE.pm | 2 +- lib/PAUSE/Email.pm | 2 +- lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm | 2 +- lib/pause_2017/templates/admin/user/add.html.ep | 2 +- lib/pause_2017/templates/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 +- 7 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm index 6337565e9..3ba652e82 100644 --- a/lib/PAUSE.pm +++ b/lib/PAUSE.pm @@ -108,6 +108,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', # used as a sender address, ideally only used by the receiver for filtering incoming email P5P => 'release-announce@perl.org', PID_DIR => "/home/pause/pid/", PAUSE_LOG => "/home/pause/log/paused.log", @@ -123,7 +124,6 @@ $PAUSE::Config ||= TIMEOUT => 60*60, TRUST_IS_SSL_HEADER => 1, TMP => '/data/pause/tmp/', - UPLOAD => 'upload@pause.perl.org', # used as a sender address, ideally only used by the receiver for filtering incoming email # 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_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&#160;by&#160;<%= $row->{changedby} %><br> Sending separate mails to: <%= $pause->{send_to} %> <pre> -From: <%= $PAUSE::Config->{UPLOAD} %> +From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %> Subject: <%= $pause->{subject} %> <%= $pause->{blurb} %> 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 @@ <p>You'll also receive a welcome email like the one below.</p> <pre class="email_sent"> -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} %> <pre class="email_sent"> -From: <%= $PAUSE::Config->{UPLOAD} %> +From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %> Subject: <%= $pause->{subject} %> <%== $pause->{blurbcopy} %> 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 @@ </ul> -<p>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 <a href="mailto:<%= $PAUSE::Config->{UPLOAD} %>">email me</a>.</p> +<p>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 <a href="mailto:<%= $PAUSE::Config->{CONTACT_ADDRESS} %>">email me</a>.</p> % 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 fcba8649b..00dd53f4c 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 b62e53812758d52ada4c802f66210fa63d19b708 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Fri, 3 May 2024 21:26:21 -0400 Subject: [PATCH 16/27] 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 2ed2507dd..f58fea47e 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{<$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{<$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{<$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 9c3c8c781eb1d7f6395ad922871fd4c49657dc60 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Fri, 3 May 2024 22:10:16 -0400 Subject: [PATCH 17/27] 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 <x@y>" and "Alice <x@y>" 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 | 4 +-- .../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, 40 insertions(+), 39 deletions(-) diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm index 5b4d7fa74..6db898fd5 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -135,26 +135,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 $xs_addr = Email::Address::XS->new($umailset{$addr}, $addr); + push @to, PAUSE::Email->email_header_object_for_addresses($xs_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 5791fdafa..a6244763c 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 = { @@ -199,7 +199,7 @@ sub change_user_status { $pause->{changed} = 1; $pause->{new_ustatus} = $new_ustatus; my $mailblurb = $c->render_to_string("email/admin/change_user_status", 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 67a619fb0..b26ed2c8e 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 1870b0b7b..12d8b8f2e 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 4a9f783df..7d90f3274 100644 --- a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm +++ b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm @@ -93,7 +93,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 { From 97760129e6c63b626adcd4f3e19aaa552383ccf0 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Wed, 21 Oct 2026 21:19:05 -0400 Subject: [PATCH 18/27] pause_2026 API Upload: use CONTACT_ADDRESS, not ADMIN This is the address a user is told to write to when their upload URI can't be recognized, so it should be the public contact address. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/pause_2026/PAUSE/API/Controller/Upload.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/pause_2026/PAUSE/API/Controller/Upload.pm b/lib/pause_2026/PAUSE/API/Controller/Upload.pm index a6216a3e0..f4cbdd2e9 100644 --- a/lib/pause_2026/PAUSE/API/Controller/Upload.pm +++ b/lib/pause_2026/PAUSE/API/Controller/Upload.pm @@ -67,7 +67,7 @@ Sorry, <b>$uri</b> could not be recognized as an uri (}), $@, Mojo::ByteStream->new(qq{\)Please try again or report errors to <a href="mailto:}), - $PAUSE::Config->{ADMIN}, + $PAUSE::Config->{CONTACT_ADDRESS}, Mojo::ByteStream->new(qq{">the administrator</a></p>})]); } else { require LWP::UserAgent; From b9ae1390dce524a684b532afcc4bb2064f10e62d Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:30:03 -0400 Subject: [PATCH 19/27] use CONTACT_ADDRESS in all user-facing text INTERNAL_REPORT_ADDRESS is where the software sends reports for the admins to read. It is not where we should tell users to write, and it should not appear on the public whois page or in the welcome email. CONTACT_ADDRESS exists for exactly that, so use it everywhere a human other than an admin will see the address. Co-Authored-By: Claude <noreply@anthropic.com> --- cron/cron-daily.pl | 2 +- lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm | 4 ++-- lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm | 4 ++-- .../templates/email/admin/user/onetime_password.email.ep | 4 ++-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl index 0155ad7ab..ee10b5447 100755 --- a/cron/cron-daily.pl +++ b/cron/cron-daily.pl @@ -415,7 +415,7 @@ sub whois { <body> <h3>People, <a href="#mailinglists">Mailinglists</a> And <a href="#mlarchives">Mailinglist Archives</a> </h3> -<i>generated on $now UTC by $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}</i> +<i>generated on $now UTC by $PAUSE::Config->{CONTACT_ADDRESS}</i> <pre xml:space="preserve"> }; diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm index b0e7bf9aa..b1da1f9f7 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->{INTERNAL_REPORT_ADDRESS} and help them identifying what's going on. Thanks!") + at $PAUSE::Config->{CONTACT_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, <b>$uri</b> could not be recognized as an uri (}), $@, Mojo::ByteStream->new(qq{\)Please try again or report errors to <a href="mailto:}), - $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}, + $PAUSE::Config->{CONTACT_ADDRESS}, Mojo::ByteStream->new(qq{">the administrator</a></p>})]); } 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 79adca92e..a575410fa 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->{INTERNAL_REPORT_ADDRESS} 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->{CONTACT_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->{INTERNAL_REPORT_ADDRESS} and help them identify what's going on. Thanks!") + at $PAUSE::Config->{CONTACT_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/templates/email/admin/user/onetime_password.email.ep b/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep index 6f0b14d4a..f0984e123 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->{INTERNAL_REPORT_ADDRESS} %>) +Server on behalf of the admin <%== $PAUSE::Config->{CONTACT_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 @@ -20,4 +20,4 @@ password is expired automatically. Thanks & Regards, -- -<%== $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} %> +<%== $PAUSE::Config->{CONTACT_ADDRESS} %> From 408137c2c77986b1aaa8361e430c1c4b5d75f918 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:30:03 -0400 Subject: [PATCH 20/27] PAUSE::Email: name the right config key when dying The report address lives in INTERNAL_REPORT_ADDRESS now, but the error message still said ADMIN. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/PAUSE/Email.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm index af4fe6337..11e77a5db 100644 --- a/lib/PAUSE/Email.pm +++ b/lib/PAUSE/Email.pm @@ -13,7 +13,7 @@ sub report_email_header_object ($class) { my @addrs = split /\s*,\s*/, $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}; - die "No PAUSE config entry for ADMIN!?" unless @addrs; + die "No PAUSE config entry for INTERNAL_REPORT_ADDRESS!?" unless @addrs; my @objects = map {; Email::Address::XS->new(undef, $_) } @addrs; From 6d80a5244dddeca97140dbcd754db3fa11afa6b5 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:55:50 -0400 Subject: [PATCH 21/27] TestPAUSE: drop the ADMIN_LIST override, which nothing reads Co-Authored-By: Claude <noreply@anthropic.com> --- t/lib/PAUSE/TestPAUSE.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm index 7a0e93d37..b46ac35a5 100644 --- a/t/lib/PAUSE/TestPAUSE.pm +++ b/t/lib/PAUSE/TestPAUSE.pm @@ -322,7 +322,6 @@ 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}, From 002edab87e869e821c5e713a01bac0d2110f300b Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:55:50 -0400 Subject: [PATCH 22/27] PAUSE::dist: drop two imports it never uses directly All the header objects are built by PAUSE::Email and PAUSE::MailAddress, so dist.pm does not need these classes itself. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/PAUSE/dist.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm index 0b284ebd5..fbfdb6e96 100644 --- a/lib/PAUSE/dist.pm +++ b/lib/PAUSE/dist.pm @@ -3,8 +3,6 @@ use warnings; package PAUSE::dist; use vars qw(%CHECKSUMDONE $AUTOLOAD); -use Email::Address::XS; -use Email::MIME::Header::AddressList; use File::Copy (); use List::MoreUtils (); use PAUSE (); From 4bbb746115d0ee18fb3022843e8d189c4332563a Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:55:51 -0400 Subject: [PATCH 23/27] load the modules we call, instead of relying on someone else to PAUSE::MailAddress called Encode and PAUSE::Email without loading either, and several pause_2017 files and paused called into PAUSE::Email and Email::Address::XS the same way. These all worked because something else had loaded the module first, which is not a property worth depending on. Co-Authored-By: Claude <noreply@anthropic.com> --- bin/paused | 2 ++ lib/PAUSE/MailAddress.pm | 2 ++ lib/pause_2017/PAUSE/Web/Context.pm | 2 ++ lib/pause_2017/PAUSE/Web/Controller/Admin.pm | 1 + lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm | 1 + lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm | 1 + lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm | 1 + 7 files changed, 10 insertions(+) diff --git a/bin/paused b/bin/paused index f58fea47e..100ac742b 100755 --- a/bin/paused +++ b/bin/paused @@ -34,8 +34,10 @@ use IO::File (); use IPC::Run3 (); use LWP (); use Digest::SHA (); +use Email::Address::XS (); use Email::MIME (); use Email::Sender::Simple (); +use PAUSE::Email (); use PAUSE::MailAddress (); use POSIX ":sys_wait_h"; use Path::Tiny; diff --git a/lib/PAUSE/MailAddress.pm b/lib/PAUSE/MailAddress.pm index 04703b2f2..61a8f3d6e 100644 --- a/lib/PAUSE/MailAddress.pm +++ b/lib/PAUSE/MailAddress.pm @@ -3,7 +3,9 @@ use warnings; package PAUSE::MailAddress; use Email::Address::XS; +use Encode (); use PAUSE (); +use PAUSE::Email; # use fields qw(address is_secret) diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm index 6db898fd5..f902a1436 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -7,7 +7,9 @@ use Encode; use Sys::Hostname (); use Email::Sender::Simple; use Email::MIME; +use Email::Address::XS; use Data::Dumper; +use PAUSE::Email; use PAUSE::Web::Exception; use Crypt::URandom; diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm index a6244763c..0b2719395 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm @@ -1,6 +1,7 @@ package PAUSE::Web::Controller::Admin; use Mojo::Base "Mojolicious::Controller"; +use PAUSE::Email; sub email_for_admin { my $c = shift; diff --git a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm index b26ed2c8e..0dd791ba1 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm @@ -1,6 +1,7 @@ package PAUSE::Web::Controller::Public::RequestId; use Mojo::Base "Mojolicious::Controller"; +use PAUSE::Email; use PAUSE::Web::Util::Encode; sub request { diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm index 5bfb29591..43767dad4 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm @@ -1,6 +1,7 @@ package PAUSE::Web::Controller::User::Cred; use Mojo::Base "Mojolicious::Controller"; +use PAUSE::Email; use PAUSE::Web::Util::Encode; use Text::Unidecode; diff --git a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm index 7d90f3274..b737f5cc8 100644 --- a/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm +++ b/lib/pause_2017/PAUSE/Web/Plugin/UserRegistration.pm @@ -1,6 +1,7 @@ package PAUSE::Web::Plugin::UserRegistration; use Mojo::Base "Mojolicious::Plugin"; +use PAUSE::Email; use PAUSE::Crypt; use HTTP::Tiny 0.059; use IO::Socket::SSL 1.56; From 330a7e670c60b3f7c3f1f524682ced2f66b9bae8 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:55:51 -0400 Subject: [PATCH 24/27] PAUSE::Email: stop warning on every invalid email address parse_bare_address always returns an object, so the "did we get one" check was never false. Worse, the object overloads stringification, and evaluating it in boolean context stringifies it, which warns "Argument contains empty address" for exactly the inputs we are here to reject. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/PAUSE/Email.pm | 3 --- 1 file changed, 3 deletions(-) diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm index 11e77a5db..5daf61425 100644 --- a/lib/PAUSE/Email.pm +++ b/lib/PAUSE/Email.pm @@ -39,9 +39,6 @@ sub noreply_email_header_object ($class) { 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; From 685928b0aab5753af452095d81c4290f37a76016 Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:55:51 -0400 Subject: [PATCH 25/27] t/mldistwatch-misc: label the Cc assertions as Cc, not To Co-Authored-By: Claude <noreply@anthropic.com> --- t/mldistwatch-misc.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t index 9428fb166..21e229201 100644 --- a/t/mldistwatch-misc.t +++ b/t/mldistwatch-misc.t @@ -758,9 +758,9 @@ subtest "quotes in username" => sub { is($to_addresses[0]->phrase, q{R★S"'<xmp>}, "To name is right"); my @cc_addresses = $cc->addresses; - is(@cc_addresses, 1, "there is one To address"); + is(@cc_addresses, 1, "there is one Cc 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"); + is($cc_addresses[0]->phrase, undef, "Cc name is right"); }; done_testing; From 6ab49b4da364b86e74ee3ecd339d56ada139265a Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:56:03 -0400 Subject: [PATCH 26/27] pause_2017: log email recipients as strings, not HASH(0x...) Now that recipients can be Email::MIME::Header::AddressList objects, interpolating them into the "sending to" and hdebug log lines printed the object's address. PAUSE::Email->header_value_as_string hands back either the plain string or the list's as_string form. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/PAUSE/Email.pm | 7 +++++++ lib/pause_2017/PAUSE/Web/Context.pm | 5 +++-- lib/pause_2017/PAUSE/Web/Controller/Admin.pm | 6 ++++-- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/lib/PAUSE/Email.pm b/lib/PAUSE/Email.pm index 5daf61425..8d3520bbc 100644 --- a/lib/PAUSE/Email.pm +++ b/lib/PAUSE/Email.pm @@ -36,6 +36,13 @@ sub noreply_email_header_object ($class) { ); } +# Header values are now sometimes Email::MIME::Header::AddressList objects, +# which do not stringify. This gives back something fit for a log line. +sub header_value_as_string ($class, $value) { + return $value unless ref $value; + return $value->as_string; +} + sub is_valid_email ($class, $string) { my $parse = Email::Address::XS->parse_bare_address($string); diff --git a/lib/pause_2017/PAUSE/Web/Context.pm b/lib/pause_2017/PAUSE/Web/Context.pm index f902a1436..1d7931b51 100644 --- a/lib/pause_2017/PAUSE/Web/Context.pm +++ b/lib/pause_2017/PAUSE/Web/Context.pm @@ -174,7 +174,8 @@ sub prepare_sendto { sub send_mail_multi { my ($self, $to, $header, $mailblurb) = @_; - warn "sending to[@$to]"; + warn sprintf "sending to[%s]", + join " ", map {; PAUSE::Email->header_value_as_string($_) } @$to; warn "mailblurb[$mailblurb]"; for my $to2 (@$to) { $header->{To} = $to2; @@ -185,7 +186,7 @@ sub send_mail_multi { sub send_mail { my ($self, $header, $blurb) = @_; - my @hdebug = %$header; + my @hdebug = map {; PAUSE::Email->header_value_as_string($_) } %$header; $self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) }); $header->{From} ||= PAUSE::Email->noreply_email_header_object; diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm index 0b2719395..6723fd8e8 100644 --- a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm +++ b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm @@ -158,7 +158,8 @@ sub edit_ml { $pause->{changed} = 1; my $mailblurb = $c->render_to_string("email/admin/edit_ml", format => "email"); my @to = ($u->{secretemail}||$u->{email}, PAUSE::Email->report_email_header_object); - warn "sending to[@to]"; + warn sprintf "sending to[%s]", + join " ", map {; PAUSE::Email->header_value_as_string($_) } @to; warn "mailblurb[$mailblurb]"; my $header = { Subject => "Mailinglist update for $selectedrec->{maillistid}" @@ -201,7 +202,8 @@ sub change_user_status { $pause->{new_ustatus} = $new_ustatus; my $mailblurb = $c->render_to_string("email/admin/change_user_status", format => "email"); my @to = ($u->{secretemail}||$u->{email}, PAUSE::Email->report_email_header_object); - warn "sending to[@to]"; + warn sprintf "sending to[%s]", + join " ", map {; PAUSE::Email->header_value_as_string($_) } @to; warn "mailblurb[$mailblurb]"; my $header = { Subject => "User status update for $user" From b72c6c5d4220d83406e8e88c03fccf587e86a47b Mon Sep 17 00:00:00 2001 From: Ricardo Signes <rjbs@semiotic.systems> Date: Sat, 24 Oct 2026 12:58:53 -0400 Subject: [PATCH 27/27] PAUSE::mldistwatch: load Encode, which it calls Like the other modules fixed up recently, this only worked because something else loaded Encode first. Co-Authored-By: Claude <noreply@anthropic.com> --- lib/PAUSE/mldistwatch.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm index edfd4acb9..fe59c3a5e 100644 --- a/lib/PAUSE/mldistwatch.pm +++ b/lib/PAUSE/mldistwatch.pm @@ -16,6 +16,7 @@ use DirHandle (); use Dumpvalue (); use DynaLoader (); use Email::MIME; +use Encode (); use Exporter (); use ExtUtils::MakeMaker (); use ExtUtils::Manifest;