summaryrefslogtreecommitdiffstats
path: root/scripts/dd-list.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rwxr-xr-xscripts/dd-list.pl322
1 files changed, 322 insertions, 0 deletions
diff --git a/scripts/dd-list.pl b/scripts/dd-list.pl
new file mode 100755
index 0000000..d1dbcfb
--- /dev/null
+++ b/scripts/dd-list.pl
@@ -0,0 +1,322 @@
+#!/usr/bin/perl
+#
+# dd-list: Generate a list of maintainers of packages.
+#
+# Written by Joey Hess <joeyh@debian.org>
+# Modifications by James McCoy <jamessan@debian.org>
+# Based on a python implementation by Lars Wirzenius.
+# Copyright 2005 Lars Wirzenius, Joey Hess
+#
+# 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, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+use FileHandle;
+use Getopt::Long qw(:config bundling permute no_getopt_compat);
+use Dpkg::Version;
+use Dpkg::IPC;
+
+my $uncompress;
+
+BEGIN {
+ $uncompress = eval {
+ require IO::Uncompress::AnyUncompress;
+ IO::Uncompress::AnyUncompress->import('$AnyUncompressError');
+ 1;
+ };
+}
+
+my $version = '###VERSION###';
+
+sub normalize_package {
+ my $name = shift;
+ # Remove any arch-qualifier
+ $name =~ s/:.*//;
+ return lc($name);
+}
+
+sub sort_developers {
+ return map { $_->[0] }
+ sort { $a->[1] cmp $b->[1] }
+ map { [$_, uc] } @_;
+}
+
+sub help {
+ print <<"EOF";
+Usage: dd-list [options] [package ...]
+
+ -h, --help
+ Print this help text.
+
+ -i, --stdin
+ Read package names from the standard input.
+
+ -d, --dctrl
+ Read package list in Debian control data from standard input.
+
+ -z, --uncompress
+ Try to uncompress the --dctrl input before parsing. Supported
+ compression formats are gz, bzip2 and xz.
+
+ -s, --sources SOURCES_FILE
+ Read package information from given SOURCES_FILE instead of all files
+ matching /var/lib/apt/lists/*_source_Sources. Can be specified
+ multiple times. The files can be gz, bzip2 or xz compressed.
+
+ -u, --uploaders
+ Also list Uploaders of packages, not only the listed Maintainers
+ (this is the default behaviour, use --nouploaders to prevent this).
+
+ -nou, --nouploaders
+ Only list package Maintainers, do not list Uploaders.
+
+ -b, --print-binary
+ If binary package names are given as input, print these names
+ in the output instead of corresponding source packages.
+
+ -V, --version
+ Print version (it\'s $version by the way).
+EOF
+}
+
+my $use_stdin = 0;
+my $use_dctrl = 0;
+my $source_files = [];
+my $show_uploaders = 1;
+my $opt_uncompress = 0;
+my $print_binary = 0;
+GetOptions(
+ "help|h" => sub { help(); exit },
+ "stdin|i" => \$use_stdin,
+ "dctrl|d" => \$use_dctrl,
+ "sources|s=s@" => \$source_files,
+ "uploaders|u!" => \$show_uploaders,
+ 'z|uncompress' => \$opt_uncompress,
+ "print-binary|b" => \$print_binary,
+ "version" => sub { print "dd-list version $version\n" })
+ or do {
+ help();
+ exit(1);
+ };
+
+if ($opt_uncompress && !$uncompress) {
+ warn
+"You must have the libio-compress-perl package installed to use the -z option.\n";
+ exit 1;
+}
+
+my %dict;
+my $errors = 0;
+my %package_name;
+
+sub parsefh {
+ my ($fh, $fname, $check_package) = @_;
+ local $/ = "\n\n";
+ my $package_names;
+ if ($check_package) {
+ $package_names = sprintf '(?:^| )(%s)(?:,|$)',
+ join '|', map { "\Q$_\E" }
+ keys %package_name;
+ }
+ my %sources;
+ while (<$fh>) {
+ my ($package, $source, $binaries, $maintainer, @uploaders);
+
+ # These source packages are only kept around because of stale binaries
+ # on old archs or due to Built-Using relationships.
+ if (/^Extra-Source-Only:\s+yes/m) {
+ next;
+ }
+
+ # Binary is shown in _source_Sources and contains all binaries produced by
+ # that source package
+ if (/^Binary:\s+(.*(?:\n .*)*)$/m) {
+ $binaries = $1;
+ $binaries =~ s/\n//;
+ }
+ # Package is shown both in _source_Sources and _binary-*. It is the
+ # name of the package, source or binary respectively, being described
+ # in that control stanza
+ if (/^Package:\s+(.*)$/m) {
+ $package = $1;
+ }
+ # Source is shown in _binary-* and specifies the source package which
+ # produced the binary being described
+ if (/^Source:\s+(.*)$/m) {
+ $source = $1;
+ }
+ if (/^Maintainer:\s+(.*)$/m) {
+ $maintainer = $1;
+ }
+ if (/^Uploaders:\s+(.*(?:\n .*)*)$/m) {
+ my $matches = $1;
+ $matches =~ s/\n//g;
+ @uploaders = split /(?<=>)\s*,\s*/, $matches;
+ }
+ my $version = '0~0~0';
+ if (/^Version:\s+(.*)$/m) {
+ $version = $1;
+ }
+
+ if (defined $maintainer
+ && (defined $package || defined $source || defined $binaries)) {
+ $source ||= $package;
+ $binaries ||= $package;
+ my @names;
+ if ($check_package) {
+ my @pkgs;
+ if (@pkgs = ($binaries =~ m/$package_names/g)) {
+ $sources{$source}{$version}{binaries} = [@pkgs];
+ } elsif ($source !~ m/$package_names/) {
+ next;
+ }
+ } else {
+ $sources{$source}{$version}{binaries} = [$binaries];
+ }
+ $sources{$source}{$version}{maintainer} = $maintainer;
+ $sources{$source}{$version}{uploaders} = [@uploaders];
+ } else {
+ warn "E: parse error in stanza $. of $fname\n";
+ $errors = 1;
+ }
+ }
+
+ for my $source (keys %sources) {
+ my @versions
+ = sort map { Dpkg::Version->new($_) } keys %{ $sources{$source} };
+ my $version = $versions[-1];
+ my $srcinfo = $sources{$source}{$version};
+ my @names;
+ if ($check_package) {
+ $package_name{$source}--;
+ $package_name{$_}-- for @{ $srcinfo->{binaries} };
+ }
+ @names = $print_binary ? @{ $srcinfo->{binaries} } : $source;
+ push @{ $dict{ $srcinfo->{maintainer} } }, @names;
+ if ($show_uploaders && @{ $srcinfo->{uploaders} }) {
+ foreach my $uploader (@{ $srcinfo->{uploaders} }) {
+ push @{ $dict{$uploader} }, map "$_ (U)", @names;
+ }
+ }
+ }
+}
+
+if ($use_dctrl) {
+ my $fh;
+ if ($uncompress) {
+ $fh = IO::Uncompress::AnyUncompress->new('-')
+ or die "E: Unable to decompress STDIN: $AnyUncompressError\n";
+ } else {
+ $fh = \*STDIN;
+ }
+ parsefh($fh, 'STDIN');
+} else {
+ my @packages;
+ if ($use_stdin) {
+ while (my $line = <STDIN>) {
+ chomp $line;
+ $line =~ s/^\s+|\s+$//g;
+ push @packages, split(' ', $line);
+ }
+ } else {
+ @packages = @ARGV;
+ }
+ for my $name (@packages) {
+ $package_name{ normalize_package($name) } = 1;
+ }
+
+ my $apt_version;
+ spawn(
+ exec => ['dpkg-query', '-W', '-f', '${source:Version}', 'apt'],
+ to_string => \$apt_version,
+ wait_child => 1,
+ nocheck => 1
+ );
+
+ my $useAptHelper = 0;
+ if (defined $apt_version) {
+ $useAptHelper
+ = version_compare_relation($apt_version, REL_GE, '1.1.8');
+ }
+
+ unless (@{$source_files}) {
+ if ($useAptHelper) {
+ my ($sources, $err);
+ spawn(
+ exec => [
+ 'apt-get', 'indextargets',
+ '--format', '$(FILENAME)',
+ 'Created-By: Sources'
+ ],
+ to_string => \$sources,
+ error_to_string => \$err,
+ wait_child => 1,
+ nocheck => 1
+ );
+ if ($? >> 8) {
+ die "Unable to get list of Sources files from apt: $err\n";
+ }
+
+ $source_files = [split(/\n/, $sources)];
+ } else {
+ $source_files = [glob('/var/lib/apt/lists/*_source_Sources')];
+ }
+ }
+
+ foreach my $source (@{$source_files}) {
+ my $fh;
+ if ($useAptHelper) {
+ my $good = open($fh, '-|', '/usr/lib/apt/apt-helper', 'cat-file',
+ $source);
+ if (!$good) {
+ warn
+"E: Couldn't run apt-helper to get contents of '$source': $!\n";
+ $errors = 1;
+ next;
+ }
+ } else {
+ if ($opt_uncompress
+ || ($uncompress && $source =~ m/\.(?:gz|bz2|xz)$/)) {
+ $fh = IO::Uncompress::AnyUncompress->new($source);
+ } else {
+ $fh = FileHandle->new("<$source");
+ }
+ unless (defined $fh) {
+ warn "E: Couldn't open $source\n";
+ $errors = 1;
+ next;
+ }
+ }
+ parsefh($fh, $source, 1);
+ close $fh;
+ }
+}
+
+foreach my $developer (sort_developers(keys %dict)) {
+ print "$developer\n";
+ my %seen;
+ foreach my $package (sort @{ $dict{$developer} }) {
+ next if $seen{$package};
+ $seen{$package} = 1;
+ print " $package\n";
+ }
+ print "\n";
+}
+
+foreach my $package (grep { $package_name{$_} > 0 } keys %package_name) {
+ warn "E: Unknown package: $package\n";
+ $errors = 1;
+}
+
+exit($errors);