1#!/usr/bin/perl
2
3# who-permits-upload - Retrieve permissions granted to Debian Maintainers (DM)
4# Copyright (C) 2012 Arno Töll <arno@debian.org>
5#
6# This program is free software; you can redistribute it and/or
7# modify it under the terms of the GNU General Public License
8# as published by the Free Software Foundation; either version 2
9# of the License, or (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
19
20use strict;
21use Dpkg::Control;
22use LWP::UserAgent;
23use Encode::Locale;
24use Encode;
25use Getopt::Long;
26use constant {
27    TYPE_PACKAGE => "package",
28    TYPE_UID     => "uid",
29    TYPE_SPONSOR => "sponsor"
30};
31use constant { SPONSOR_FINGERPRINT => 0, SPONSOR_NAME => 1 };
32use List::Util qw(first);
33
34our $DM_URL = "https://ftp-master.debian.org/dm.txt";
35our $KEYRING
36  = "/usr/share/keyrings/debian-keyring.gpg:/usr/share/keyrings/debian-maintainers.gpg";
37our $TYPE = "package";
38our $GPG  = first { !system('sh', '-c', "command -v $_ >/dev/null 2>&1") }
39qw(gpg2 gpg);
40our ($HELP, @ARGUMENTS, @DM_DATA, %GPG_CACHE);
41
42binmode STDIN,  ':encoding(console_in)';
43binmode STDOUT, ':encoding(console_out)';
44binmode STDERR, ':encoding(console_out)';
45
46=encoding utf8
47
48=head1 NAME
49
50who-permits-upload - look-up Debian Maintainer access control lists
51
52=head1 SYNOPSIS
53
54B<who-permits-upload> [B<-h>] [B<-s> I<keyring>] [B<-d> I<dm_url>] [B<-s> I<search_type>] I<query> [I<query> ...]
55
56=head1 DESCRIPTION
57
58B<who-permits-upload> looks up the given Debian Maintainer (DM) upload permissions
59from ftp-master.debian.org and parses them in a human readable way. The tool can
60search by DM name, sponsor (the person who granted the permission) and by package.
61
62=head1 OPTIONS
63
64=over 4
65
66=item B<--dmfile=>I<dm_url>, B<-d> I<dm_url>
67
68Retrieve the DM permission file from the supplied URL. When this option is not
69present, the default value I<https://ftp-master.debian.org/dm.txt> is used.
70
71=item B<--help>, B<-h>
72
73Display a usage summary and exit.
74
75=item B<--keyring=>I<keyring>, B<-s> I<keyring>
76
77Use the supplied GnuPG keyrings to look-up GPG fingerprints from the DM permission
78file. When not present, the default Debian Developer and Maintainer keyrings are used
79(I</usr/share/keyrings/debian-keyring.gpg> and
80I</usr/share/keyrings/debian-maintainers.gpg>, installed by the I<debian-keyring>
81package).
82
83Separate keyrings with a colon ":".
84
85=item B<--search=>I<search_type>, B<-s> I<search_type>
86
87Modify the look-up behavior. This influences the
88interpretation of the I<query> argument. Supported search types are:
89
90=over 4
91
92=item B<package>
93
94Search for a source package name. This is also the default when B<--search> is omitted.
95Since package names are unique, this will return given ACLs - if any - for a
96single package.
97
98=item B<uid>
99
100Search for a Debian Maintainer. This should be (a fraction of) a name. It will
101return all ACLs assigned to matching maintainers.
102
103=item B<sponsor>
104
105Search for a sponsor (i.e. a Debian Developer) who granted DM permissions. This
106will return all ACLs given by the supplied developer.
107
108Note that this is an expensive operation which may take some time.
109
110=back
111
112=item I<query>
113
114A case sensitive argument to be looked up in the ACL permission file. The exact
115interpretation of this argument is dependent by the B<--search> argument.
116
117This argument can be repeated.
118
119=back
120
121=head1 EXIT VALUE
122
123=over 4
124
125=item 0Z<>
126
127Success
128
129=item 1Z<>
130
131An error occurred
132
133=item 2Z<>
134
135The command line was not understood
136
137=back
138
139=head1 EXAMPLES
140
141=over 4
142
143=item who-permits-upload --search=sponsor arno@debian.org
144
145Search for all DM upload permissions given by the UID "arno@debian.org". Note,
146that only primary UIDs will match.
147
148=item who-permits-upload -s=sponsor "Arno Töll"
149
150Same as above, but use a full name instead.
151
152=item who-permits-upload apache2
153
154Look up who gave upload permissions for the apache2 source package.
155
156=item who-permits-upload --search=uid "Paul Tagliamonte"
157
158Look up all DM upload permissions given to "Paul Tagliamonte".
159
160=back
161
162=head1 AUTHOR
163
164B<who-permits-upload> was written by Arno Töll <arno@debian.org> and is licensed
165under the terms of the General Public License (GPL) version 2 or later.
166
167=head1 SEE ALSO
168
169B<gpg>(1), B<gpg2>(1), B<who-uploads>(1)
170
171S<I<https://lists.debian.org/debian-devel-announce/2012/09/msg00008.html>>
172
173=cut
174
175GetOptions(
176    "help|h"      => \$HELP,
177    "keyring|k=s" => \$KEYRING,
178    "dmfile|d=s"  => \$DM_URL,
179    "search|s=s"  => \$TYPE,
180);
181# pop positionals
182@ARGUMENTS = @ARGV;
183
184$TYPE = lc($TYPE);
185if ($TYPE eq 'package') {
186    $TYPE = TYPE_PACKAGE;
187} elsif ($TYPE eq 'uid') {
188    $TYPE = TYPE_UID;
189} elsif ($TYPE eq 'sponsor') {
190    $TYPE = TYPE_SPONSOR;
191} else {
192    usage();
193}
194
195if ($HELP) {
196    usage();
197}
198
199if (not @ARGUMENTS) {
200    usage();
201}
202
203sub usage {
204    print STDERR (
205"Usage: $0 [-h][-s KEYRING][-d DM_URL][-s SEARCH_TYPE] QUERY [QUERY ...]\n"
206    );
207    print STDERR "Retrieve permissions granted to Debian Maintainers (DM)\n";
208    print STDERR "\n";
209    print STDERR "-h, --help\n";
210    print STDERR "\t\t\tDisplay this usage summary and exit\n";
211    print STDERR "-k, --keyring=KEYRING\n";
212    print STDERR
213      "\t\t\tUse the supplied keyring file(s) instead of the default\n";
214    print STDERR "\t\t\tkeyring. Separate arguments by a colon (\":\")\n";
215    print STDERR "-d, --dmfile=DM_URL\n";
216    print STDERR "\t\t\tRetrieve DM permissions from the supplied URL.\n";
217    print STDERR "\t\t\tDefault is https://ftp-master.debian.org/dm.txt\n";
218    print STDERR "-s, --search=SEARCH_TYPE\n";
219    print STDERR "\t\t\tSupplied QUERY arguments are interpreted as:\n";
220    print STDERR
221      "\t\t\tpackage name when SEARCH_TYPE is \"package\" (default)\n";
222    print STDERR "\t\t\tDM user name id when SEARCH_TYPE is \"uid\"\n";
223    print STDERR "\t\t\tsponsor user id when SEARCH_TYPE is \"sponsor\"\n";
224    exit 2;
225}
226
227sub leave {
228    my $reason = shift;
229    chomp $reason;
230    print STDERR "$reason\n";
231    exit 1;
232}
233
234sub lookup_fingerprint {
235    my $fingerprint = shift;
236    my $uid         = "";
237
238    if (exists $GPG_CACHE{$fingerprint}) {
239        return $GPG_CACHE{$fingerprint};
240    }
241
242    my @gpg_arguments;
243    foreach my $keyring (split(":", "$KEYRING")) {
244        if (!-f $keyring) {
245            leave("Keyring $keyring is not accessible");
246        }
247        push(@gpg_arguments, ("--keyring", $keyring));
248    }
249    push(
250        @gpg_arguments,
251        (
252            "--no-options",         "--no-auto-check-trustdb",
253            "--no-default-keyring", "--list-key",
254            "--with-colons",        encode(locale => $fingerprint)));
255    open(CMD, '-|', $GPG, @gpg_arguments) || leave "$GPG: $!\n";
256    binmode CMD, ':utf8';
257    while (my $l = <CMD>) {
258        if ($l =~ /^pub/) {
259            $uid = $l;
260 # Consume the rest of the output to avoid a potential SIGPIPE when closing CMD
261            my @junk = <CMD>;
262            last;
263        }
264    }
265    my @fields = split(":", $uid);
266    $uid = $fields[9];
267    close(CMD)
268      || leave("gpg returned an error looking for $fingerprint: " . ($? >> 8));
269
270    $GPG_CACHE{$fingerprint} = $uid;
271
272    return $uid;
273}
274
275sub parse_data {
276    my $raw_data = shift;
277    my $parser
278      = Dpkg::Control->new(type => CTRL_UNKNOWN, allow_duplicate => 1);
279    open(my $fh, '+<:utf8', \$raw_data)
280      || leave('unable to read dm data: ' . $!);
281    my @dm_data = ();
282
283    while ($parser->parse($fh)) {
284        foreach my $package (split(/,/, $parser->{Allow})) {
285            if ($package =~ m/([a-z0-9\+\-\.]+)\s+\((\w+)\)/s) {
286                my @package_row = (
287                    $1, $parser->{Fingerprint},
288                    $parser->{Uid}, $2, SPONSOR_FINGERPRINT
289                );
290                push(@dm_data, \@package_row);
291            }
292        }
293    }
294    return @dm_data;
295}
296
297sub find_matching_row {
298    my $pattern = shift;
299    my $type    = shift;
300    my @return_rows;
301    foreach my $package (@DM_DATA) {
302        # $package is an array ref in the format
303        # (package, dm_fingerprint, dm_uid, sponsor_fingerprint callback)
304        push(@return_rows, $package)
305          if ($type eq TYPE_PACKAGE && $pattern eq $package->[0]);
306        push(@return_rows, $package)
307          if ($type eq TYPE_UID && $package->[2] =~ m/$pattern/);
308        if ($type eq TYPE_SPONSOR) {
309            # the sponsor function is a key id so far, mark we looked it up
310            # already
311            $package->[3] = lookup_fingerprint($package->[3]);
312            $package->[4] = SPONSOR_NAME;
313            if ($package->[3] =~ m/$pattern/) {
314                push(@return_rows, $package);
315            }
316        }
317    }
318    return @return_rows;
319}
320
321my $http = LWP::UserAgent->new;
322$http->timeout(10);
323$http->env_proxy;
324
325my $response = $http->get($DM_URL);
326if ($response->is_success) {
327    @DM_DATA = parse_data($response->content);
328} else {
329    leave "Could not retrieve DM file: $DM_URL Server returned: "
330      . $response->status_line;
331}
332
333foreach my $argument (@ARGUMENTS) {
334    $argument = decode(locale => $argument);
335    my @rows = find_matching_row($argument, $TYPE);
336    if (not @rows) {
337        leave("No $TYPE matches $argument");
338    }
339    foreach my $row (@rows) {
340    # $package is an array ref in the format
341    # (package, dm_fingerprint, dm_uid, sponsor_fingerprint, sponsor_type_flag)
342        my $sponsor = $row->[3];
343        if ($row->[4] != SPONSOR_NAME) {
344            $row->[3] = lookup_fingerprint($row->[3]);
345        }
346        printf("Package: %s DM: %s Sponsor: %s\n",
347            $row->[0], $row->[2], $row->[3]);
348    }
349}
350