From a10091b9b091f7d7a8648d1f52e7823fd7f9fdcc Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Thu, 27 Oct 2022 23:13:55 -0500
Subject: [PATCH] Revise email_addresses and rename it to
 directory_email_addresses

This also adds a new feature:  email addresses can be registered only for
certain subdirectories belonging to a package if desired, by listing them
in an "email" file at the corresponding location in the configuration tree.
This uses the same code as is used to locate authorized keyrings.

The use of pattern matching to extract email addresses is a precaution,
although observant readers may notice that the patterns are very lax.
Perl taint mode checks do not require this, since the email addresses will
be written to a socket rather than passed as command arguments, and hash
keys, used here for efficient de-duplication, do not carry taintedness.
---
 gatekeeper.pl | 74 ++++++++++++++++++++++++++++++++-------------------
 1 file changed, 46 insertions(+), 28 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index a09802e..a9d1241 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -915,12 +915,35 @@ sub directory_keyrings {
   return @keyrings;
 }
 
-sub email_addresses {
-  my $package_name = shift;
-  my @ret;
+=item @addresses = directory_email_addresses ( $directory )
+
+Return list of email addresses configured to receive notification of
+activity on DIRECTORY.  These are from both the inherited per-directory
+"email" files and the maintainer addresses registered for the package in
+the maintainers.bypkg file.
+
+=cut
+
+sub directory_email_addresses {
+  my $directory = shift;
+
+  local *_;
+
+  my @directory = File::Spec::Unix->splitdir($directory);
+  my $package_name = $directory[0];
+  # Quote this once here to avoid recompiling the pattern for each line of
+  # the maintainers.bypkg file; the \Q and \E are probably not needed,
+  # since package names should not contain regex metacharacters but are an
+  # extra protection measure, in case a package name contains "+" or so.
+  my $package_name_re = qr/^\Q$package_name\E\s+-\s+/;
 
-  open (EMAIL_FILE, "<", "$package_config_base/$package_name/email")
-    or fatal(<<"END",1);
+  my %addresses;
+
+  my @email_files = directory_configuration_files('email', $directory);
+
+  # While per-directory email lists are now supported, the per-package list
+  # is still required to be present.
+  fatal(<<"END",1)
 The directory line should start with the name of the package for which you
 are trying to upload a file, e.g. gcc, gawk, or gimp. We have no package
 named '$package_name'. If this is a new GNU package, please ensure that you
@@ -931,35 +954,30 @@ The GPG key must be registered separately for each package, so this needs
 to be done even if you are already registered for uploading with another
 package.
 END
+  unless -f File::Spec->catfile($package_config_base, $package_name, 'email');
 
-  while (<EMAIL_FILE>) {
-    chomp;
-    my $line = $_;
-    next if (grep($_ eq $line,@ret) > 0); # Skip duplicates
-    push (@ret, $line)
-      if $line =~ /^[[:graph:]]+@[[:graph:]]+$/; # simple sanity check
+  foreach my $file (@email_files) {
+    open EMAIL_FILE, '<', $file or ftp_abort("open($file) failed: $!");
+    while (<EMAIL_FILE>) {
+      chomp;
+      $addresses{$1}++
+	if m/^([[:graph:]]+[@][[:graph:]]+)$/; # simple sanity check and untaint
+    }
+    close EMAIL_FILE or ftp_warn("close($file) failed: $!");
   }
 
-  close (EMAIL_FILE)
-    or ftp_warn("close($package_config_base/$package_name/email) failed: $!");
-
   # Now also look for all maintainer addresses in the maintainers.bypkg file
-  open (EMAIL_FILE, "<", "$maintainers_bypkg");
+  open EMAIL_FILE, '<', $maintainers_bypkg
+    or ftp_abort("open($maintainers_bypkg) failed: $!");
   while (<EMAIL_FILE>) {
     chomp;
-    my @tmp = split(/ - /,$_,2);
-    next unless ($tmp[0] eq $package_name);
-    # The while loop below needs a proper scalar to work.
-    my $e = $tmp[1];
-    while ($e =~ /([[:graph:]]+@[[:graph:]]+)/g) {
-	my $f = $1;
-	$f =~ s/[<>,]//g;
-      push (@ret, $f) unless exists {map { $_ => 1 } @ret}->{$f};
-    }
+    next unless m/$package_name_re/g; # find the line for this package
+    # crawl through it, collecting email addresses
+    $addresses{$1}++ while m/\G[^<]*<([^@]+[@][^>]+)>/g;
   }
-  close (EMAIL_FILE);
+  close EMAIL_FILE or ftp_warn("close($maintainers_bypkg) failed: $!");
 
-  return @ret;
+  return keys %addresses;
 }
 
 
@@ -1736,8 +1754,8 @@ sub interpret_directive {
   }
 
   # Set email addresses
-  if (defined $header{package}) {
-    my @a = email_addresses($header{package});
+  if (defined $header{directory}) {
+    my @a = directory_email_addresses($header{directory});
     foreach my $address (@a) {
       # Do not include duplicates
       push (@{$info{email}}, $address)
-- 
2.25.1