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