1#!/usr/bin/perl 2# 3# dd-list: Generate a list of maintainers of packages. 4# 5# Written by Joey Hess <joeyh@debian.org> 6# Modifications by James McCoy <jamessan@debian.org> 7# Based on a python implementation by Lars Wirzenius. 8# Copyright 2005 Lars Wirzenius, Joey Hess 9# 10# This program is free software; you can redistribute it and/or modify 11# it under the terms of the GNU General Public License as published by 12# the Free Software Foundation; either version 2 of the License, or 13# (at your option) any later version. 14# 15# This program is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU General Public License for more details. 19# 20# You should have received a copy of the GNU General Public License 21# along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23use strict; 24use warnings; 25use FileHandle; 26use Getopt::Long qw(:config bundling permute no_getopt_compat); 27use Dpkg::Version; 28use Dpkg::IPC; 29 30my $uncompress; 31 32BEGIN { 33 $uncompress = eval { 34 require IO::Uncompress::AnyUncompress; 35 IO::Uncompress::AnyUncompress->import('$AnyUncompressError'); 36 1; 37 }; 38} 39 40my $version = '###VERSION###'; 41 42sub normalize_package { 43 my $name = shift; 44 # Remove any arch-qualifier 45 $name =~ s/:.*//; 46 return lc($name); 47} 48 49sub sort_developers { 50 return map { $_->[0] } 51 sort { $a->[1] cmp $b->[1] } 52 map { [$_, uc] } @_; 53} 54 55sub help { 56 print <<"EOF"; 57Usage: dd-list [options] [package ...] 58 59 -h, --help 60 Print this help text. 61 62 -i, --stdin 63 Read package names from the standard input. 64 65 -d, --dctrl 66 Read package list in Debian control data from standard input. 67 68 -z, --uncompress 69 Try to uncompress the --dctrl input before parsing. Supported 70 compression formats are gz, bzip2 and xz. 71 72 -s, --sources SOURCES_FILE 73 Read package information from given SOURCES_FILE instead of all files 74 matching /var/lib/apt/lists/*_source_Sources. Can be specified 75 multiple times. The files can be gz, bzip2 or xz compressed. 76 77 -u, --uploaders 78 Also list Uploaders of packages, not only the listed Maintainers 79 (this is the default behaviour, use --nouploaders to prevent this). 80 81 -nou, --nouploaders 82 Only list package Maintainers, do not list Uploaders. 83 84 -b, --print-binary 85 If binary package names are given as input, print these names 86 in the output instead of corresponding source packages. 87 88 -V, --version 89 Print version (it\'s $version by the way). 90EOF 91} 92 93my $use_stdin = 0; 94my $use_dctrl = 0; 95my $source_files = []; 96my $show_uploaders = 1; 97my $opt_uncompress = 0; 98my $print_binary = 0; 99GetOptions( 100 "help|h" => sub { help(); exit }, 101 "stdin|i" => \$use_stdin, 102 "dctrl|d" => \$use_dctrl, 103 "sources|s=s@" => \$source_files, 104 "uploaders|u!" => \$show_uploaders, 105 'z|uncompress' => \$opt_uncompress, 106 "print-binary|b" => \$print_binary, 107 "version" => sub { print "dd-list version $version\n" }) 108 or do { 109 help(); 110 exit(1); 111 }; 112 113if ($opt_uncompress && !$uncompress) { 114 warn 115"You must have the libio-compress-perl package installed to use the -z option.\n"; 116 exit 1; 117} 118 119my %dict; 120my $errors = 0; 121my %package_name; 122 123sub parsefh { 124 my ($fh, $fname, $check_package) = @_; 125 local $/ = "\n\n"; 126 my $package_names; 127 if ($check_package) { 128 $package_names = sprintf '(?:^| )(%s)(?:,|$)', 129 join '|', map { "\Q$_\E" } 130 keys %package_name; 131 } 132 my %sources; 133 while (<$fh>) { 134 my ($package, $source, $binaries, $maintainer, @uploaders); 135 136 # These source packages are only kept around because of stale binaries 137 # on old archs or due to Built-Using relationships. 138 if (/^Extra-Source-Only:\s+yes/m) { 139 next; 140 } 141 142 # Binary is shown in _source_Sources and contains all binaries produced by 143 # that source package 144 if (/^Binary:\s+(.*(?:\n .*)*)$/m) { 145 $binaries = $1; 146 $binaries =~ s/\n//; 147 } 148 # Package is shown both in _source_Sources and _binary-*. It is the 149 # name of the package, source or binary respectively, being described 150 # in that control stanza 151 if (/^Package:\s+(.*)$/m) { 152 $package = $1; 153 } 154 # Source is shown in _binary-* and specifies the source package which 155 # produced the binary being described 156 if (/^Source:\s+(.*)$/m) { 157 $source = $1; 158 } 159 if (/^Maintainer:\s+(.*)$/m) { 160 $maintainer = $1; 161 } 162 if (/^Uploaders:\s+(.*(?:\n .*)*)$/m) { 163 my $matches = $1; 164 $matches =~ s/\n//g; 165 @uploaders = split /(?<=>)\s*,\s*/, $matches; 166 } 167 my $version = '0~0~0'; 168 if (/^Version:\s+(.*)$/m) { 169 $version = $1; 170 } 171 172 if (defined $maintainer 173 && (defined $package || defined $source || defined $binaries)) { 174 $source ||= $package; 175 $binaries ||= $package; 176 my @names; 177 if ($check_package) { 178 my @pkgs; 179 if (@pkgs = ($binaries =~ m/$package_names/g)) { 180 $sources{$source}{$version}{binaries} = [@pkgs]; 181 } elsif ($source !~ m/$package_names/) { 182 next; 183 } 184 } else { 185 $sources{$source}{$version}{binaries} = [$binaries]; 186 } 187 $sources{$source}{$version}{maintainer} = $maintainer; 188 $sources{$source}{$version}{uploaders} = [@uploaders]; 189 } else { 190 warn "E: parse error in stanza $. of $fname\n"; 191 $errors = 1; 192 } 193 } 194 195 for my $source (keys %sources) { 196 my @versions 197 = sort map { Dpkg::Version->new($_) } keys %{ $sources{$source} }; 198 my $version = $versions[-1]; 199 my $srcinfo = $sources{$source}{$version}; 200 my @names; 201 if ($check_package) { 202 $package_name{$source}--; 203 $package_name{$_}-- for @{ $srcinfo->{binaries} }; 204 } 205 @names = $print_binary ? @{ $srcinfo->{binaries} } : $source; 206 push @{ $dict{ $srcinfo->{maintainer} } }, @names; 207 if ($show_uploaders && @{ $srcinfo->{uploaders} }) { 208 foreach my $uploader (@{ $srcinfo->{uploaders} }) { 209 push @{ $dict{$uploader} }, map "$_ (U)", @names; 210 } 211 } 212 } 213} 214 215if ($use_dctrl) { 216 my $fh; 217 if ($uncompress) { 218 $fh = IO::Uncompress::AnyUncompress->new('-') 219 or die "E: Unable to decompress STDIN: $AnyUncompressError\n"; 220 } else { 221 $fh = \*STDIN; 222 } 223 parsefh($fh, 'STDIN'); 224} else { 225 my @packages; 226 if ($use_stdin) { 227 while (my $line = <STDIN>) { 228 chomp $line; 229 $line =~ s/^\s+|\s+$//g; 230 push @packages, split(' ', $line); 231 } 232 } else { 233 @packages = @ARGV; 234 } 235 for my $name (@packages) { 236 $package_name{ normalize_package($name) } = 1; 237 } 238 239 my $apt_version; 240 spawn( 241 exec => ['dpkg-query', '-W', '-f', '${source:Version}', 'apt'], 242 to_string => \$apt_version, 243 wait_child => 1, 244 nocheck => 1 245 ); 246 247 my $useAptHelper = 0; 248 if (defined $apt_version) { 249 $useAptHelper 250 = version_compare_relation($apt_version, REL_GE, '1.1.8'); 251 } 252 253 unless (@{$source_files}) { 254 if ($useAptHelper) { 255 my ($sources, $err); 256 spawn( 257 exec => [ 258 'apt-get', 'indextargets', 259 '--format', '$(FILENAME)', 260 'Created-By: Sources' 261 ], 262 to_string => \$sources, 263 error_to_string => \$err, 264 wait_child => 1, 265 nocheck => 1 266 ); 267 if ($? >> 8) { 268 die "Unable to get list of Sources files from apt: $err\n"; 269 } 270 271 $source_files = [split(/\n/, $sources)]; 272 } else { 273 $source_files = [glob('/var/lib/apt/lists/*_source_Sources')]; 274 } 275 } 276 277 foreach my $source (@{$source_files}) { 278 my $fh; 279 if ($useAptHelper) { 280 my $good = open($fh, '-|', '/usr/lib/apt/apt-helper', 'cat-file', 281 $source); 282 if (!$good) { 283 warn 284"E: Couldn't run apt-helper to get contents of '$source': $!\n"; 285 $errors = 1; 286 next; 287 } 288 } else { 289 if ($opt_uncompress 290 || ($uncompress && $source =~ m/\.(?:gz|bz2|xz)$/)) { 291 $fh = IO::Uncompress::AnyUncompress->new($source); 292 } else { 293 $fh = FileHandle->new("<$source"); 294 } 295 unless (defined $fh) { 296 warn "E: Couldn't open $source\n"; 297 $errors = 1; 298 next; 299 } 300 } 301 parsefh($fh, $source, 1); 302 close $fh; 303 } 304} 305 306foreach my $developer (sort_developers(keys %dict)) { 307 print "$developer\n"; 308 my %seen; 309 foreach my $package (sort @{ $dict{$developer} }) { 310 next if $seen{$package}; 311 $seen{$package} = 1; 312 print " $package\n"; 313 } 314 print "\n"; 315} 316 317foreach my $package (grep { $package_name{$_} > 0 } keys %package_name) { 318 warn "E: Unknown package: $package\n"; 319 $errors = 1; 320} 321 322exit($errors); 323