summaryrefslogtreecommitdiffstats
path: root/scripts/who-permits-upload.pl
blob: 6f82eedc16c9913d67a14f6de7e8c699ae7796d1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
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]);
    }
}