diff --git a/Makefile.PL b/Makefile.PL index 864f34c2f..c272f6894 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -27,7 +27,7 @@ WriteMakefile( DBIx::RunSQL Devel::Peek Dumpvalue - Email::Address + Email::Address::XS Email::MIME Email::Sender::Simple EV diff --git a/bin/paused b/bin/paused index 56e0c9d78..f58fea47e 100755 --- a/bin/paused +++ b/bin/paused @@ -132,14 +132,12 @@ package mypause_send_mail; use PAUSE::Logger '$Logger'; -our %hp_inside; - sub send { - my($self,$header,$blurb) = @_; + my ($self,$header,$blurb) = @_; my %from = exists $header->{From} ? () - : (From => "PAUSE <$PAUSE::Config->{UPLOAD}>"); + : (From => PAUSE::Email->noreply_email_header_object); my $email = Email::MIME->create( attributes => { @@ -310,7 +308,7 @@ skip =not yet verified mypause_send_mail->send({ - To => $PAUSE::Config->{ADMIN}, + To => PAUSE::Email->report_email_header_object, Subject => "Mirror request from $package" }, $blurb @@ -399,10 +397,8 @@ sub woe { # fullname just to reuse sth2 $asciiname ||= $fullname; $asciiname =~ s/[^\0-\177]/?/g; - my @To; + my $pma = PAUSE::MailAddress->new_from_userid($userid); - my $to = $pma->address; - push @To, $PAUSE::Config->{ADMIN}, qq{<$to>}; my $blurb = "The URL $hash->{uri}, requested for upload as $hash->{uriid} has problems @@ -414,13 +410,17 @@ new trial. Virtually Yours, $Id\n"; - for my $to (@To) { - mypause_send_mail->send({ - To => join(",",$to), - Subject => "Upload problem $hash->{uriid}" - }, - $blurb - ); + for my $to ( + $pma->email_header_object, + PAUSE::Email->report_email_header_object, + ) { + mypause_send_mail->send( + { + To => $to, + Subject => "Upload problem $hash->{uriid}" + }, + $blurb + ); } } elsif ($hash->{nosuccesscount} == $PAUSE::Config->{MAXRETRIES}) { @@ -470,10 +470,8 @@ but I couldn't ($!). Seems as if the admin has to do something\n\n"; my($fullname, $asciiname) = $sth2->fetchrow_array; $asciiname ||= $fullname; $asciiname =~ s/[^\0-\177]/?/g; - my @To; + my $pma = PAUSE::MailAddress->new_from_userid($userid); - my $address = $pma->address; - push @To, $PAUSE::Config->{ADMIN}, qq{<$address>}; my $blurb; if ($self->{ErrNotGzip}) { @@ -497,13 +495,17 @@ Virtually Yours, $Id\n"; } - for my $to (@To) { - mypause_send_mail->send({ - To => join(",",$to), - Subject => "Upload problem $hash->{uriid}" - }, - $blurb - ); + for my $to ( + $pma->email_header_object, + PAUSE::Email->report_email_header_object, + ) { + mypause_send_mail->send( + { + To => $to, + Subject => "Upload problem $hash->{uriid}" + }, + $blurb + ); } # don't writeback, it would defeat removing it. @@ -534,14 +536,6 @@ sub welcome_file { $asciiname ||= $fullname; $asciiname =~ s/[^\0-\177]/?/g; my $dbh = $self->{DBH}; - my $pma = PAUSE::MailAddress->new_from_userid($userid); - my $address = $pma->address; - my @To = qq{<$address>}; - unless ($PAUSE::Config->{TESTHOST}) { - push @To, $PAUSE::Config->{TO_CPAN_TESTERS}; - push @To, $PAUSE::Config->{'P5P'} if - $hash->{'mailto_p5p'}==1; - } my $blurb = "The URL"; $blurb = "The uploaded file" if $hash->{uri} !~ m,/,; @@ -587,14 +581,24 @@ CPAN Testers will start reporting results in an hour or so: "Thanks,\n-- \n$Id" ); + my $pma = PAUSE::MailAddress->new_from_userid($userid); + my @To = $pma->email_header_object; + + unless ($PAUSE::Config->{TESTHOST}) { + push @To, PAUSE::Email->email_header_object_for_addresses( + Email::Address::XS->new('CPAN Testers', $PAUSE::Config->{TO_CPAN_TESTERS}), + ); + } + for my $to (@To) { - mypause_send_mail->send({ - To => join(",",$to), - Subject => "CPAN Upload: $hash->{uriid}", - "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS}, - }, - $blurb - ); + mypause_send_mail->send( + { + To => $to, + Subject => "CPAN Upload: $hash->{uriid}", + "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS}, + }, + $blurb + ); } $self->logge("Info: Sent 'has entered' email about uriid[$hash->{uriid}]"); sleep 10; @@ -777,7 +781,6 @@ sub verify_gzip_tar { if ($child_stat != 0) { $err =~ s/\n/ /g; $self->logge("Debug: child_stat[$child_stat]err[$err]"); - my @To = $PAUSE::Config->{ADMIN}; my $blurb = "For the resource [$uri] the command [$testinggzip -t $tpath] @@ -787,15 +790,14 @@ sub verify_gzip_tar { The command [ls -l $tpath] gives [$ls]\n\n"; - for my $to (@To) { - mypause_send_mail->send - ({ - To => $to, - Subject => "Upload problem $uri" - }, - $blurb - ); - } + mypause_send_mail->send( + { + To => PAUSE::Email->report_email_header_object, + Subject => "Upload problem $uri" + }, + $blurb + ); + if ($err =~ /not in gzip format/) { $self->{URIRECORD}{nosuccesscount} = $PAUSE::Config->{MAXRETRIES} - 1; $self->{ErrNotGzip}++; diff --git a/cpanfile b/cpanfile index 1580c3568..468398810 100644 --- a/cpanfile +++ b/cpanfile @@ -11,7 +11,7 @@ requires 'DBI'; requires 'DBD::mysql', '== 4.050'; requires 'DBD::SQLite'; requires 'Digest::SHA1'; -requires 'Email::Address'; +requires 'Email::Address::XS'; requires 'Email::MIME'; requires 'Email::Sender::Simple'; requires 'EV'; diff --git a/cron/cron-daily.pl b/cron/cron-daily.pl index 7151a8902..c9e7ee7bd 100755 --- a/cron/cron-daily.pl +++ b/cron/cron-daily.pl @@ -345,8 +345,8 @@ sub send_the_mail { }, header_str => [ Subject => $SUBJECT, - To => $PAUSE::Config->{ADMIN}, - From => "cron daemon cron-daily.pl ", + To => PAUSE::Email->report_email_header_object, + From => PAUSE::Email->report_email_header_object, ], body_str => join(q{}, @blurb), ); @@ -415,7 +415,7 @@ sub whois {

People, Mailinglists And Mailinglist Archives

-generated on $now UTC by $PAUSE::Config->{ADMIN} +generated on $now UTC by $PAUSE::Config->{INTERNAL_REPORT_ADDRESS}
 };
 
diff --git a/cron/cron-p6daily.pl b/cron/cron-p6daily.pl
index 37b7340c8..4a060db70 100755
--- a/cron/cron-p6daily.pl
+++ b/cron/cron-p6daily.pl
@@ -71,8 +71,8 @@ sub send_the_mail {
     },
     header_str => [
       Subject => $SUBJECT,
-      To      => $PAUSE::Config->{ADMIN},
-      From    => "cron daemon cron-p6daily.pl ",
+      To      => PAUSE::Email->report_email_header_object,
+      From    => PAUSE::Email->report_email_header_object,
     ],
     body_str => join(q{}, @blurb),
   );
diff --git a/lib/Bundle/Pause.pm b/lib/Bundle/Pause.pm
index 26e12eb3a..b4c3f99f6 100644
--- a/lib/Bundle/Pause.pm
+++ b/lib/Bundle/Pause.pm
@@ -34,7 +34,7 @@ DBD::mysql
 DBI
 DBIx::RunSQL
 DB_File::Lock
-Email::Address
+Email::Address::XS
 Email::MIME
 Email::Sender::Simple
 Encode::MIME::Header
diff --git a/lib/PAUSE.pm b/lib/PAUSE.pm
index 17574a341..27f4f71d3 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;
@@ -72,8 +73,6 @@ push @INC, $pauselib;
 $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",
@@ -82,6 +81,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),
@@ -95,6 +95,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',
@@ -106,6 +107,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",
@@ -121,7 +123,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
new file mode 100644
index 000000000..af4fe6337
--- /dev/null
+++ b/lib/PAUSE/Email.pm
@@ -0,0 +1,52 @@
+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->{INTERNAL_REPORT_ADDRESS};
+
+  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 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;
+
+  return $class->email_header_object_for_addresses(
+    Email::Address::XS->new("Perl Authors Upload Server", $PAUSE::Config->{NOREPLY_ADDRESS})
+  );
+}
+
+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;
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 409932445..474040b86 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 ();
@@ -622,7 +624,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: ";
@@ -630,9 +631,10 @@ sub mail_summary {
 
     my $email = Email::MIME->create(
         header_str => [
-            To      => $to,
+            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 67b6b4562..c73017bbb 100644
--- a/lib/PAUSE/mldistwatch.pm
+++ b/lib/PAUSE/mldistwatch.pm
@@ -604,9 +604,9 @@ 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}>",
+            From    => PAUSE::Email->noreply_email_header_object,
         ],
         attributes => {
             charset      => 'utf-8',
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..9a5176299 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);
@@ -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 $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 {
@@ -170,9 +183,11 @@ sub send_mail_multi {
 sub send_mail {
   my ($self, $header, $blurb) = @_;
 
-  my @hdebug = %$header; $self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) });
-  $header->{From}                        ||= qq{"Perl Authors Upload Server" <$PAUSE::Config->{UPLOAD}>};
-  $header->{"Reply-To"}                  ||= join ", ", @{$PAUSE::Config->{ADMINS}};
+  my @hdebug = %$header;
+  $self->log({level => "info", message => sprintf("hdebug[%s]", join "|", @hdebug) });
+
+  $header->{From} ||= PAUSE::Email->noreply_email_header_object;
+  $header->{"Reply-To"} ||= PAUSE::Email->contact_email_header_object;
 
   my $email = Email::MIME->create(
     header_str => [%$header],
diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm
index 5791fdafa..dc9e434a4 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/Admin.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/Admin.pm
@@ -156,7 +156,7 @@ sub edit_ml {
     if ($saw_a_change) {
       $pause->{changed} = 1;
       my $mailblurb = $c->render_to_string("email/admin/edit_ml", format => "email");
-      my @to = ($u->{secretemail}||$u->{email}, $mgr->config->mailto_admins);
+      my @to = ($u->{secretemail}||$u->{email}, PAUSE::Email->report_email_header_object);
       warn "sending to[@to]";
       warn "mailblurb[$mailblurb]";
       my $header = {
diff --git a/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm b/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm
index 8f542932a..d6ad73d79 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/Admin/User.pm
@@ -274,11 +274,14 @@ sub add_user_doit {
       # send emails to user and modules@perl.org; latter must censor the
       # user's email address
       my ($subject, $blurb) = $c->send_welcome_email( [$email], $userid, $email, $fullname, $homepage, $entered_by );
-      $c->send_welcome_email( $PAUSE::Config->{ADMINS}, $userid, "CENSORED", $fullname, $homepage, $entered_by );
+      $c->send_welcome_email(
+        [ $PAUSE::Config->{CONTACT_ADDRESS} ],
+        $userid, "CENSORED", $fullname, $homepage, $entered_by
+      );
 
       $pause->{subject} = $subject;
       $pause->{blurb}   = $blurb;
-      $pause->{send_to} = join(" AND ", @{$PAUSE::Config->{ADMINS}}, $email);
+      $pause->{send_to} = join(" AND ", $PAUSE::Config->{CONTACT_ADDRESS}, $email);
     }
 
     warn "Info: clearing all fields";
diff --git a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
index 5ea014ceb..b26ed2c8e 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/Public/RequestId.pm
@@ -2,7 +2,6 @@ package PAUSE::Web::Controller::Public::RequestId;
 
 use Mojo::Base "Mojolicious::Controller";
 use PAUSE::Web::Util::Encode;
-use Email::Address;
 
 sub request {
   my $c = shift;
@@ -54,14 +53,15 @@ sub request {
     my @errors = ();
     if ( $fullname ) {
       unless ($fullname =~ /[ ]/) {
-        push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to @{$PAUSE::Config->{ADMINS}}.";
+        push @errors, "Name does not look like a full civil name. Please accept our apologies if you believe we're wrong. In this case please write to $PAUSE::Config->{CONTACT_ADDRESS}.";
       }
     } else {
       push @errors, "You must supply a name\n";
     }
     if( $email ) {
-      my $addr_spec = $Email::Address::addr_spec;
-      push @errors, "Your email address doesn't look like valid email address.\n" unless $email =~ /\A$addr_spec\z/;
+      unless (PAUSE::Email->is_valid_email($email)) {
+        push @errors, "Your email address doesn't look like valid email address.\n";
+      }
     } else {
       push @errors, "You must supply an email address\n";
     }
@@ -141,9 +141,10 @@ sub request {
       }
     }
 
-    my @to = $mgr->config->mailto_admins;
+    my @to = PAUSE::Email->report_email_header_object;
     push @to, $email;
-    $pause->{send_to} = "@to";
+    $pause->{send_to} = "$email"; # I don't understand what this is for XXX -- rjbs, 2024-05-03
+
     my $time = time;
     if ($rationale) {
       # wrap it
@@ -248,8 +249,10 @@ sub _directly_add_user {
         my ( $subject, $blurb ) =
           $c->send_welcome_email( [$email], $userid, $email, $fullname, $homepage,
             $fullname );
-        $c->send_welcome_email( $PAUSE::Config->{ADMINS},
-            $userid, "CENSORED", $fullname, $homepage, $fullname );
+        $c->send_welcome_email(
+            [ $PAUSE::Config->{CONTACT_ADDRESS} ],
+            $userid, "CENSORED", $fullname, $homepage, $fullname
+        );
 
         $pause->{subject_for_user_addition} = $subject;
         $pause->{blurb_for_user_addition} = $blurb;
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User.pm b/lib/pause_2017/PAUSE/Web/Controller/User.pm
index b4b27de14..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->{ADMIN});
+    my @to = $mgr->prepare_sendto($u, $pause->{User}, 1);
     my $mailbody = $c->render_to_string("email/user/reindex", format => "email");
     my $header = {
                   Subject => "Scheduled for reindexing $u->{userid}"
@@ -274,7 +274,7 @@ sub reset_version {
   if ($blurb) {
     $pause->{blurb} = $blurb;
 
-    my @to = $mgr->prepare_sendto($u, $pause->{User}, $PAUSE::Config->{ADMIN});
+    my @to = $mgr->prepare_sendto($u, $pause->{User}, 1);
     my $mailbody = $c->render_to_string("email/user/reset_version", format => "email");
     my $header = {
                   Subject => "Version reset for $u->{userid}"
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
index 680ed8c4c..5bfb29591 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Cred.pm
@@ -1,7 +1,6 @@
 package PAUSE::Web::Controller::User::Cred;
 
 use Mojo::Base "Mojolicious::Controller";
-use Email::Address;
 use PAUSE::Web::Util::Encode;
 use Text::Unidecode;
 
@@ -27,7 +26,15 @@ sub edit {
     my $wantemail = $req->param("pause99_edit_cred_email");
     my $wantsecretemail = $req->param("pause99_edit_cred_secretemail");
     my $wantalias = $req->param("pause99_edit_cred_cpan_mail_alias");
-    my $addr_spec = $Email::Address::addr_spec;
+
+    # I don't know why this is like this.  I'm just reworking earlier code.
+    # -- rjbs, 2024-05-03
+    my $is_not_emaily = sub {
+      my ($inside) = $_[0] =~ /^\s*(.+)\s*$/;
+
+      ! PAUSE::Email->is_valid_email($inside);
+    };
+
     if ($wantemail=~/^\s*$/ && $wantsecretemail=~/^\s*$/) {
       $pause->{error}{no_email} = 1;
     } elsif ($wantalias eq "publ" && $wantemail=~/^\s*$/) {
@@ -38,9 +45,9 @@ sub edit {
       $pause->{error}{no_secret_email} = 1;
     } elsif ($wantalias eq "secr" && $wantsecretemail=~/\Q$cpan_alias\E/i) {
       $pause->{error}{secret_is_cpan_alias} = 1;
-    } elsif (defined $wantsecretemail && $wantsecretemail!~/^\s*$/ && $wantsecretemail!~/^\s*$addr_spec\s*$/) {
+    } elsif (defined $wantsecretemail && $wantsecretemail!~/^\s*$/ && $is_not_emaily->($wantsecretemail)) {
       $pause->{error}{invalid_secret} = 1;
-    } elsif (defined $wantemail && $wantemail!~/^\s*$/ && $wantemail!~/^\s*$addr_spec\s*$/ && $wantemail ne 'CENSORED') {
+    } elsif (defined $wantemail && $wantemail!~/^\s*$/ && $is_not_emaily->($wantemail) && $wantemail ne 'CENSORED') {
       $pause->{error}{invalid_public} = 1;
     } else {
       $consistentsubmit = 1;
@@ -183,6 +190,7 @@ sub edit {
           if ($nu->{userid} && $nu->{userid} eq $pause->{User}{userid}) {
             $pause->{User} = $nu;
           }
+
           # Send separate emails to user and public places because
           # CC leaks secretemail to others
           my @to;
@@ -190,13 +198,14 @@ sub edit {
           for my $lu ($u, $nu) {
             for my $att (qw(secretemail email)) {
               if ($lu->{$att}){
-                $umailset{qq{<$lu->{$att}>}} = 1;
+                $umailset{ $lu->{$att} } = 1;
                 last;
               }
             }
           }
-          push @to, join ", ", keys %umailset;
-          push @to, $mgr->config->mailto_admins if $mailto_admins;
+          push @to, sort keys %umailset;
+          push @to, PAUSE::Email->report_email_header_object if $mailto_admins;
+
           my $header = {Subject => "User update for $u->{userid}"};
           $mgr->send_mail_multi(\@to,$header, $mailblurb);
         } else {
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
index 822fc3790..d65c6c079 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Files.pm
@@ -121,23 +121,8 @@ sub delete {
     $pause->{blurb} = $blurb;
     $blurb = $c->render_to_string("email/user/delete_files", format => "email");
 
-    my %umailset;
-    my $name = $u->{asciiname} || $u->{fullname} || "";
-    my $Uname = $pause->{User}{asciiname} || $pause->{User}{fullname} || "";
-    if ($u->{secretemail}) {
-      $umailset{qq{"$name" <$u->{secretemail}>}} = 1;
-    } elsif ($u->{email}) {
-      $umailset{qq{"$name" <$u->{email}>}} = 1;
-    }
-    if ($u->{userid} ne $pause->{User}{userid}) {
-      if ($pause->{User}{secretemail}) {
-        $umailset{qq{"$Uname" <$pause->{User}{secretemail}>}} = 1;
-      }elsif ($pause->{User}{email}) {
-        $umailset{qq{"$Uname" <$pause->{User}{email}>}} = 1;
-      }
-    }
-    $umailset{$PAUSE::Config->{ADMIN}} = 1;
-    my @to = keys %umailset;
+    my @to = $mgr->prepare_sendto($u, $pause->{User}, 1);
+
     my $header = {
                   Subject => "Files of $u->{userid} scheduled for deletion"
                  };
diff --git a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
index 7f5169e29..b0e7bf9aa 100644
--- a/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
+++ b/lib/pause_2017/PAUSE/Web/Controller/User/Uri.pm
@@ -17,7 +17,7 @@ sub add {
   die PAUSE::Web::Exception
       ->new(ERROR =>
             "Unidentified error happened, please write to the PAUSE admins
- at $PAUSE::Config->{ADMIN} and help them identifying what's going on. Thanks!")
+ at $PAUSE::Config->{INTERNAL_REPORT_ADDRESS} and help them identifying what's going on. Thanks!")
           unless $u->{userid};
 
   my($tryupload) = 1; # everyone supports multipart now
@@ -136,7 +136,7 @@ sub add {
 
   # via FTP GET
 
-  warn "DEBUG: UPLOAD[$PAUSE::Config->{UPLOAD}]";
+  warn "DEBUG: UPLOAD[$PAUSE::Config->{NOREPLY_ADDRESS}]";
 
   # END OF UPLOAD OPTIONS
 }
@@ -181,7 +181,7 @@ Sorry, $uri could not be recognized as an uri (}),
                           $@,
                          Mojo::ByteStream->new(qq{\)Please
 try again or report errors to the administrator

})]); } else { require LWP::UserAgent; diff --git a/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm b/lib/pause_2017/PAUSE/Web/Plugin/GetActiveUserRecord.pm index 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..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->{ADMIN} ], $header, $otpwblurb); + $mgr->send_mail_multi( [ $email, PAUSE::Email->report_email_header_object ], $header, $otpwblurb); } sub _send_welcome_email { diff --git a/lib/pause_2017/templates/admin/user/add.html.ep b/lib/pause_2017/templates/admin/user/add.html.ep index 33e1d3d9b..ee659dc73 100644 --- a/lib/pause_2017/templates/admin/user/add.html.ep +++ b/lib/pause_2017/templates/admin/user/add.html.ep @@ -87,7 +87,7 @@ changed by <%= $row->{changedby} %>
Sending separate mails to: <%= $pause->{send_to} %>
-From: <%= $PAUSE::Config->{UPLOAD} %>
+From: <%= $PAUSE::Config->{NOREPLY_ADDRESS} %>
 Subject: <%= $pause->{subject} %>
 
 <%= $pause->{blurb} %>
diff --git a/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep b/lib/pause_2017/templates/email/admin/user/onetime_password.email.ep
index 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/lib/pause_2017/templates/public/request_id/request.html.ep b/lib/pause_2017/templates/public/request_id/request.html.ep
index 756318212..169be46b3 100644
--- a/lib/pause_2017/templates/public/request_id/request.html.ep
+++ b/lib/pause_2017/templates/public/request_id/request.html.ep
@@ -24,7 +24,7 @@
 

You'll also receive a welcome email like the one below.