fix encoding of email addresses

Makefile.PL

@@ -28,7 +28,7 @@ WriteMakefile(
         DBIx::RunSQL
         Devel::Peek
         Dumpvalue
-        Email::Address
+        Email::Address::XS
         Email::MIME
         Email::Sender::Simple
         EV

bin/paused

@@ -132,14 +132,12 @@ package mypause_send_mail;
 
 use PAUSE::Logger '$Logger';
 
-our %hp_inside;
-
 sub send {
-  my($self,$header,$blurb) = @_;
+  my ($self,$header,$blurb) = @_;
 
   my %from  = exists $header->{From}
             ? ()
-            : (From => "PAUSE <$PAUSE::Config->{UPLOAD}>");
+            : (From => PAUSE::Email->noreply_email_header_object);
 
   my $email = Email::MIME->create(
     attributes => {
@@ -310,7 +308,7 @@ skip        =not yet verified
 
 
       mypause_send_mail->send({
-                               To => $PAUSE::Config->{ADMIN},
+                               To => PAUSE::Email->report_email_header_object,
                                Subject => "Mirror request from $package"
                               },
                               $blurb
@@ -399,10 +397,8 @@ sub woe {
     # fullname just to reuse sth2
     $asciiname ||= $fullname;
     $asciiname =~ s/[^\0-\177]/?/g;
-    my @To;
+
     my $pma = PAUSE::MailAddress->new_from_userid($userid);
-    my $to  = $pma->address;
-    push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$to>};
 
     my $blurb = "The URL $hash->{uri},
 requested for upload as $hash->{uriid} has problems
@@ -414,13 +410,17 @@ new trial.
 Virtually Yours,
 $Id\n";
 
-    for my $to (@To) {
-      mypause_send_mail->send({
-                               To => join(",",$to),
-                               Subject => "Upload problem $hash->{uriid}"
-                              },
-                              $blurb
-                             );
+    for my $to (
+      $pma->email_header_object,
+      PAUSE::Email->report_email_header_object,
+    ) {
+      mypause_send_mail->send(
+        {
+          To => $to,
+          Subject => "Upload problem $hash->{uriid}"
+        },
+        $blurb
+      );
     }
 
   } elsif ($hash->{nosuccesscount} == $PAUSE::Config->{MAXRETRIES}) {
@@ -470,10 +470,8 @@ but I couldn't ($!). Seems as if the admin has to do something\n\n";
     my($fullname, $asciiname) = $sth2->fetchrow_array;
     $asciiname ||= $fullname;
     $asciiname =~ s/[^\0-\177]/?/g;
-    my @To;
+
     my $pma = PAUSE::MailAddress->new_from_userid($userid);
-    my $address  = $pma->address;
-    push @To, $PAUSE::Config->{ADMIN}, qq{"$asciiname" <$address>};
 
     my $blurb;
     if ($self->{ErrNotGzip}) {
@@ -497,13 +495,17 @@ Virtually Yours,
 $Id\n";
     }
 
-    for my $to (@To) {
-      mypause_send_mail->send({
-                               To => join(",",$to),
-                               Subject => "Upload problem $hash->{uriid}"
-                              },
-                              $blurb
-                             );
+    for my $to (
+      $pma->email_header_object,
+      PAUSE::Email->report_email_header_object,
+    ) {
+      mypause_send_mail->send(
+        {
+          To => $to,
+          Subject => "Upload problem $hash->{uriid}"
+        },
+        $blurb
+      );
     }
 
     # don't writeback, it would defeat removing it.
@@ -534,14 +536,6 @@ sub welcome_file {
   $asciiname ||= $fullname;
   $asciiname =~ s/[^\0-\177]/?/g;
   my $dbh = $self->{DBH};
-  my $pma = PAUSE::MailAddress->new_from_userid($userid);
-  my $address  = $pma->address;
-  my @To = qq{"$asciiname" <$address>};
-  unless ($PAUSE::Config->{TESTHOST}) {
-      push @To, $PAUSE::Config->{TO_CPAN_TESTERS};
-      push @To, $PAUSE::Config->{'P5P'} if
-          $hash->{'mailto_p5p'}==1;
-  }
 
   my $blurb = "The URL";
   $blurb = "The uploaded file" if $hash->{uri} !~ m,/,;
@@ -587,14 +581,24 @@ CPAN Testers will start reporting results in an hour or so:
                  "Thanks,\n-- \n$Id"
                 );
 
+  my $pma = PAUSE::MailAddress->new_from_userid($userid);
+  my @To = $pma->email_header_object;
+
+  unless ($PAUSE::Config->{TESTHOST}) {
+    push @To, PAUSE::Email->email_header_object_for_addresses(
+      Email::Address::XS->new('CPAN Testers', $PAUSE::Config->{TO_CPAN_TESTERS}),
+    );
+  }
+
   for my $to (@To) {
-    mypause_send_mail->send({
-                             To => join(",",$to),
-                             Subject => "CPAN Upload: $hash->{uriid}",
-                             "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS},
-                            },
-                            $blurb
-                           );
+    mypause_send_mail->send(
+      {
+        To => $to,
+        Subject => "CPAN Upload: $hash->{uriid}",
+        "Reply-To" => $PAUSE::Config->{REPLY_TO_CPAN_TESTERS},
+      },
+      $blurb
+    );
   }
   $self->logge("Info: Sent 'has entered' email about uriid[$hash->{uriid}]");
   sleep 10;
@@ -777,7 +781,6 @@ sub verify_gzip_tar {
         if ($child_stat != 0) {
             $err =~ s/\n/ /g;
             $self->logge("Debug: child_stat[$child_stat]err[$err]");
-            my @To = $PAUSE::Config->{ADMIN};
 
             my $blurb = "For the resource [$uri]
  the command [$testinggzip -t $tpath]
@@ -787,15 +790,14 @@ sub verify_gzip_tar {
  The command [ls -l $tpath]
  gives [$ls]\n\n";
 
-            for my $to (@To) {
-                mypause_send_mail->send
-                    ({
-                      To      => $to,
-                      Subject => "Upload problem $uri"
-                     },
-                     $blurb
-                    );
-            }
+            mypause_send_mail->send(
+              {
+                To      => PAUSE::Email->report_email_header_object,
+                Subject => "Upload problem $uri"
+              },
+              $blurb
+            );
+
             if ($err =~ /not in gzip format/) {
                 $self->{URIRECORD}{nosuccesscount} = $PAUSE::Config->{MAXRETRIES} - 1;
                 $self->{ErrNotGzip}++;

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

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 <upload\@pause.perl.org>",
+      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 {
 <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">
 };
 

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 <upload\@pause.perl.org>",
+      To      => PAUSE::Email->report_email_header_object,
+      From    => PAUSE::Email->report_email_header_object,
     ],
     body_str => join(q{}, @blurb),
   );

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

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;
@@ -69,8 +70,6 @@ push @INC, $pauselib;
 $PAUSE::Config ||=
     {
      ABRA_EXPIRATION => 86400/4,
-     ADMIN => q{[email protected], [email protected]},
-     ADMINS => [qq(modules\@perl.org)],
      ANON_FTP_PASS => qq{k\@pause.perl.org},
      AUTHEN_DATA_SOURCE_NAME => "DBI:mysql:authen_pause",
      AUTHEN_PASSWORD_FLD => "password",
@@ -79,6 +78,7 @@ $PAUSE::Config ||=
      AUTHEN_BACKUP_DIR => '/home/pause/db-backup',
      BZCAT_PATH => (List::Util::first { -x $_ } ("/bin/bzcat", "/usr/bin/bzcat" )),
      BZIP2_PATH => (List::Util::first { -x $_ } ("/bin/bzip2", "/usr/bin/bzip2" )),
+     CONTACT_ADDRESS => q([email protected]),
      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),
@@ -92,6 +92,7 @@ $PAUSE::Config ||=
      HTTP_ERRORLOG => '/var/log/nginx/error.log', # harmless use in cron-daily
      INCOMING => 'file://data/pause/incoming/',
      INCOMING_LOC => '/data/pause/incoming',
+     INTERNAL_REPORT_ADDRESS => q{[email protected], [email protected]},
      MAIL_MAILER => ["sendmail"],
      MAXRETRIES => 16,
      MIRRORCONFIG => '/usr/local/mirror/mymirror.config',
@@ -103,6 +104,7 @@ $PAUSE::Config ||=
      ML_MIN_FILES => 20_000, # must be this many files to run mldistwatch
      MOD_DATA_SOURCE_NAME => "dbi:mysql:mod",
      NO_SUCCESS_BREAK => 900,
+     NOREPLY_ADDRESS => '[email protected]',
      P5P => '[email protected]',
      PID_DIR => "/home/pause/pid/",
      PAUSE_LOG => "/home/pause/log/paused.log",
@@ -118,7 +120,6 @@ $PAUSE::Config ||=
      TIMEOUT => 60*60,
      TRUST_IS_SSL_HEADER => 1,
      TMP => '/data/pause/tmp/',
-     UPLOAD => '[email protected]',
      # 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 ',

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;