diff options
Diffstat (limited to 'scripts/who-permits-upload.pl')
| -rwxr-xr-x | scripts/who-permits-upload.pl | 353 |
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]); + } +} |