Adding upstream version 2.23.4+deb12u1.upstream/2.23.4+deb12u1upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 353 insertions, 0 deletions

diff --git a/scripts/who-permits-upload.pl b/scripts/who-permits-upload.pl
new file mode 100755
index 0000000..6f82eed
--- /dev/null
+++ b/scripts/who-permits-upload.pl
@@ -0,0 +1,353 @@
+#!/usr/bin/perl
+
+# who-permits-upload - Retrieve permissions granted to Debian Maintainers (DM)
+# Copyright (C) 2012 Arno Töll <arno@debian.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+use strict;
+use Dpkg::Control;
+use LWP::UserAgent;
+use Encode::Locale;
+use Encode;
+use Getopt::Long;
+use constant {
+    TYPE_PACKAGE => "package",
+    TYPE_UID     => "uid",
+    TYPE_SPONSOR => "sponsor"
+};
+use constant { SPONSOR_FINGERPRINT => 0, SPONSOR_NAME => 1 };
+use List::Util qw(first);
+
+our $DM_URL = "https://ftp-master.debian.org/dm.txt";
+our $KEYRING
+  = "/usr/share/keyrings/debian-keyring.gpg:/usr/share/keyrings/debian-maintainers.gpg";
+our $TYPE = "package";
+our $GPG  = first { !system('sh', '-c', "command -v $_ >/dev/null 2>&1") }
+  qw(gpg2 gpg);
+our ($HELP, @ARGUMENTS, @DM_DATA, %GPG_CACHE);
+
+binmode STDIN,  ':encoding(console_in)';
+binmode STDOUT, ':encoding(console_out)';
+binmode STDERR, ':encoding(console_out)';
+
+=encoding utf8
+
+=head1 NAME
+
+who-permits-upload - look-up Debian Maintainer access control lists
+
+=head1 SYNOPSIS
+
+B<who-permits-upload> [B<-h>] [B<-s> I<keyring>] [B<-d> I<dm_url>] [B<-s> I<search_type>] I<query> [I<query> ...]
+
+=head1 DESCRIPTION
+
+B<who-permits-upload> looks up the given Debian Maintainer (DM) upload permissions
+from ftp-master.debian.org and parses them in a human readable way. The tool can
+search by DM name, sponsor (the person who granted the permission) and by package.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--dmfile=>I<dm_url>, B<-d> I<dm_url>
+
+Retrieve the DM permission file from the supplied URL. When this option is not
+present, the default value I<https://ftp-master.debian.org/dm.txt> is used.
+
+=item B<--help>, B<-h>
+
+Display a usage summary and exit.
+
+=item B<--keyring=>I<keyring>, B<-s> I<keyring>
+
+Use the supplied GnuPG keyrings to look-up GPG fingerprints from the DM permission
+file. When not present, the default Debian Developer and Maintainer keyrings are used
+(I</usr/share/keyrings/debian-keyring.gpg> and
+I</usr/share/keyrings/debian-maintainers.gpg>, installed by the I<debian-keyring>
+package).
+
+Separate keyrings with a colon ":".
+
+=item B<--search=>I<search_type>, B<-s> I<search_type>
+
+Modify the look-up behavior. This influences the
+interpretation of the I<query> argument. Supported search types are:
+
+=over 4
+
+=item B<package>
+
+Search for a source package name. This is also the default when B<--search> is omitted.
+Since package names are unique, this will return given ACLs - if any - for a
+single package.
+
+=item B<uid>
+
+Search for a Debian Maintainer. This should be (a fraction of) a name. It will
+return all ACLs assigned to matching maintainers.
+
+=item B<sponsor>
+
+Search for a sponsor (i.e. a Debian Developer) who granted DM permissions. This
+will return all ACLs given by the supplied developer.
+
+Note that this is an expensive operation which may take some time.
+
+=back
+
+=item I<query>
+
+A case sensitive argument to be looked up in the ACL permission file. The exact
+interpretation of this argument is dependent by the B<--search> argument.
+
+This argument can be repeated.
+
+=back
+
+=head1 EXIT VALUE
+
+=over 4
+
+=item 0Z<>
+
+Success
+
+=item 1Z<>
+
+An error occurred
+
+=item 2Z<>
+
+The command line was not understood
+
+=back
+
+=head1 EXAMPLES
+
+=over 4
+
+=item who-permits-upload --search=sponsor arno@debian.org
+
+Search for all DM upload permissions given by the UID "arno@debian.org". Note,
+that only primary UIDs will match.
+
+=item who-permits-upload -s=sponsor "Arno Töll"
+
+Same as above, but use a full name instead.
+
+=item who-permits-upload apache2
+
+Look up who gave upload permissions for the apache2 source package.
+
+=item who-permits-upload --search=uid "Paul Tagliamonte"
+
+Look up all DM upload permissions given to "Paul Tagliamonte".
+
+=back
+
+=head1 AUTHOR
+
+B<who-permits-upload> was written by Arno Töll <arno@debian.org> and is licensed
+under the terms of the General Public License (GPL) version 2 or later.
+
+=head1 SEE ALSO
+
+B<gpg>(1), B<gpg2>(1), B<who-uploads>(1)
+
+S<I<https://lists.debian.org/debian-devel-announce/2012/09/msg00008.html>>
+
+=cut
+
+GetOptions(
+    "help|h"      => \$HELP,
+    "keyring|k=s" => \$KEYRING,
+    "dmfile|d=s"  => \$DM_URL,
+    "search|s=s"  => \$TYPE,
+);
+# pop positionals
+@ARGUMENTS = @ARGV;
+
+$TYPE = lc($TYPE);
+if ($TYPE eq 'package') {
+    $TYPE = TYPE_PACKAGE;
+} elsif ($TYPE eq 'uid') {
+    $TYPE = TYPE_UID;
+} elsif ($TYPE eq 'sponsor') {
+    $TYPE = TYPE_SPONSOR;
+} else {
+    usage();
+}
+
+if ($HELP) {
+    usage();
+}
+
+if (not @ARGUMENTS) {
+    usage();
+}
+
+sub usage {
+    print STDERR (
+"Usage: $0 [-h][-s KEYRING][-d DM_URL][-s SEARCH_TYPE] QUERY [QUERY ...]\n"
+    );
+    print STDERR "Retrieve permissions granted to Debian Maintainers (DM)\n";
+    print STDERR "\n";
+    print STDERR "-h, --help\n";
+    print STDERR "\t\t\tDisplay this usage summary and exit\n";
+    print STDERR "-k, --keyring=KEYRING\n";
+    print STDERR
+      "\t\t\tUse the supplied keyring file(s) instead of the default\n";
+    print STDERR "\t\t\tkeyring. Separate arguments by a colon (\":\")\n";
+    print STDERR "-d, --dmfile=DM_URL\n";
+    print STDERR "\t\t\tRetrieve DM permissions from the supplied URL.\n";
+    print STDERR "\t\t\tDefault is https://ftp-master.debian.org/dm.txt\n";
+    print STDERR "-s, --search=SEARCH_TYPE\n";
+    print STDERR "\t\t\tSupplied QUERY arguments are interpreted as:\n";
+    print STDERR
+      "\t\t\tpackage name when SEARCH_TYPE is \"package\" (default)\n";
+    print STDERR "\t\t\tDM user name id when SEARCH_TYPE is \"uid\"\n";
+    print STDERR "\t\t\tsponsor user id when SEARCH_TYPE is \"sponsor\"\n";
+    exit 2;
+}
+
+sub leave {
+    my $reason = shift;
+    chomp $reason;
+    print STDERR "$reason\n";
+    exit 1;
+}
+
+sub lookup_fingerprint {
+    my $fingerprint = shift;
+
+    if (exists $GPG_CACHE{$fingerprint}) {
+        return $GPG_CACHE{$fingerprint};
+    }
+
+    my @gpg_arguments;
+    foreach my $keyring (split(":", "$KEYRING")) {
+        if (!-f $keyring) {
+            leave("Keyring $keyring is not accessible");
+        }
+        push(@gpg_arguments, ("--keyring", $keyring));
+    }
+    push(
+        @gpg_arguments,
+        (
+            "--no-options",         "--no-auto-check-trustdb",
+            "--no-default-keyring", "--list-key",
+            "--with-colons",        encode(locale => $fingerprint)));
+    open(CMD, '-|', $GPG, @gpg_arguments) || leave "$GPG: $!\n";
+    binmode CMD, ':utf8';
+    my $uid;
+    while (my $l = <CMD>) {
+        if ($l =~ /^uid/) {
+            my $id = (split(":", $l))[9];
+            if (!defined($uid)) {
+                $uid = $id;
+            }
+            if ($id =~ /debian\.org/) {
+                $uid = $id;
+ # Consume the rest of the output to avoid a potential SIGPIPE when closing CMD
+                my @junk = <CMD>;
+                last;
+            }
+        }
+    }
+    close(CMD)
+      || leave("gpg returned an error looking for $fingerprint: " . ($? >> 8));
+
+    $GPG_CACHE{$fingerprint} = $uid;
+
+    return $uid;
+}
+
+sub parse_data {
+    my $raw_data = shift;
+    my $parser
+      = Dpkg::Control->new(type => CTRL_UNKNOWN, allow_duplicate => 1);
+    open(my $fh, '+<:utf8', \$raw_data)
+      || leave('unable to read dm data: ' . $!);
+    my @dm_data = ();
+
+    while ($parser->parse($fh)) {
+        foreach my $package (split(/,/, $parser->{Allow})) {
+            if ($package =~ m/([a-z0-9\+\-\.]+)\s+\((\w+)\)/s) {
+                my @package_row = (
+                    $1, $parser->{Fingerprint},
+                    $parser->{Uid}, $2, SPONSOR_FINGERPRINT
+                );
+                push(@dm_data, \@package_row);
+            }
+        }
+    }
+    return @dm_data;
+}
+
+sub find_matching_row {
+    my $pattern = shift;
+    my $type    = shift;
+    my @return_rows;
+    foreach my $package (@DM_DATA) {
+        # $package is an array ref in the format
+        # (package, dm_fingerprint, dm_uid, sponsor_fingerprint callback)
+        push(@return_rows, $package)
+          if ($type eq TYPE_PACKAGE && $pattern eq $package->[0]);
+        push(@return_rows, $package)
+          if ($type eq TYPE_UID && $package->[2] =~ m/$pattern/);
+        if ($type eq TYPE_SPONSOR) {
+            # the sponsor function is a key id so far, mark we looked it up
+            # already
+            $package->[3] = lookup_fingerprint($package->[3]);
+            $package->[4] = SPONSOR_NAME;
+            if ($package->[3] =~ m/$pattern/) {
+                push(@return_rows, $package);
+            }
+        }
+    }
+    return @return_rows;
+}
+
+my $http = LWP::UserAgent->new;
+$http->timeout(10);
+$http->env_proxy;
+
+my $response = $http->get($DM_URL);
+if ($response->is_success) {
+    @DM_DATA = parse_data($response->content);
+} else {
+    leave "Could not retrieve DM file: $DM_URL Server returned: "
+      . $response->status_line;
+}
+
+foreach my $argument (@ARGUMENTS) {
+    $argument = decode(locale => $argument);
+    my @rows = find_matching_row($argument, $TYPE);
+    if (not @rows) {
+        leave("No $TYPE matches $argument");
+    }
+    foreach my $row (@rows) {
+    # $package is an array ref in the format
+    # (package, dm_fingerprint, dm_uid, sponsor_fingerprint, sponsor_type_flag)
+        my $sponsor = $row->[3];
+        if ($row->[4] != SPONSOR_NAME) {
+            $row->[3] = lookup_fingerprint($row->[3]);
+        }
+        printf("Package: %s DM: %s Sponsor: %s\n",
+            $row->[0], $row->[2], $row->[3]);
+    }
+}