Adding upstream version 2.23.4+deb12u1.upstream/2.23.4+deb12u1upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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);