Adding upstream version 1.22.4.upstream/1.22.4

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

1 files changed, 327 insertions, 0 deletions

diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl
new file mode 100755
index 0000000..6c86cd9
--- /dev/null
+++ b/scripts/dpkg-scansources.pl
@@ -0,0 +1,327 @@
+#!/usr/bin/perl
+#
+# Copyright © 1999 Roderick Schertler
+# Copyright © 2002 Wichert Akkerman <wakkerma@debian.org>
+# Copyright © 2006-2009, 2011-2015 Guillem Jover <guillem@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, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+use Getopt::Long qw(:config posix_default bundling_values no_ignorecase);
+use List::Util qw(any);
+use File::Find;
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control;
+use Dpkg::Checksums;
+use Dpkg::Compression::FileHandle;
+use Dpkg::Compression;
+
+textdomain('dpkg-dev');
+
+# Hash of lists. The constants below describe what is in the lists.
+my %override;
+use constant {
+    O_PRIORITY      => 0,
+    O_SECTION       => 1,
+    O_MAINT_FROM    => 2,   # undef for non-specific, else listref
+    O_MAINT_TO      => 3,   # undef if there's no maint override
+};
+
+my %extra_override;
+
+my %priority = (
+    'extra' => 1,
+    'optional' => 2,
+    'standard' => 3,
+    'important' => 4,
+    'required' => 5,
+);
+
+# Switches
+
+my $debug = 0;
+my $no_sort = 0;
+my $src_override = undef;
+my $extra_override_file = undef;
+my @sources;
+
+my @option_spec = (
+    'debug!' => \$debug,
+    'help|?' => sub { usage(); exit 0; },
+    'version' => sub { version(); exit 0; },
+    'no-sort|n' => \$no_sort,
+    'source-override|s=s' => \$src_override,
+    'extra-override|e=s' => \$extra_override_file,
+);
+
+sub version {
+    printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
+}
+
+sub usage {
+    printf g_(
+"Usage: %s [<option>...] <binary-path> [<override-file> [<path-prefix>]] > Sources
+
+Options:
+  -n, --no-sort            don't sort by package before outputting.
+  -e, --extra-override <file>
+                           use extra override file.
+  -s, --source-override <file>
+                           use file for additional source overrides, default
+                           is regular override file with .src appended.
+      --debug              turn debugging on.
+  -?, --help               show this help message.
+      --version            show the version.
+
+See the man page for the full documentation.
+"), $Dpkg::PROGNAME;
+}
+
+sub load_override {
+    my $file = shift;
+    local $_;
+
+    my $comp_file = Dpkg::Compression::FileHandle->new(filename => $file);
+    while (<$comp_file>) {
+        s/#.*//;
+	next if /^\s*$/;
+	s/\s+$//;
+
+	my @data = split ' ', $_, 4;
+	unless (@data == 3 || @data == 4) {
+	    warning(g_('invalid override entry at line %d (%d fields)'),
+	            $., 0 + @data);
+	    next;
+	}
+	my ($package, $priority, $section, $maintainer) = @data;
+	if (exists $override{$package}) {
+	    warning(g_('ignoring duplicate override entry for %s at line %d'),
+	            $package, $.);
+	    next;
+	}
+	if (!$priority{$priority}) {
+	    warning(g_('ignoring override entry for %s, invalid priority %s'),
+	            $package, $priority);
+	    next;
+	}
+
+	$override{$package} = [];
+	$override{$package}[O_PRIORITY] = $priority;
+	$override{$package}[O_SECTION] = $section;
+	if (!defined $maintainer) {
+	    # do nothing
+        } elsif ($maintainer =~ /^(.*\S)\s*=>\s*(.*)$/) {
+	    $override{$package}[O_MAINT_TO] = $2;
+	    $override{$package}[O_MAINT_FROM] = [split m{\s*//\s*}, $1];
+        } else {
+	    $override{$package}[O_MAINT_TO] = $maintainer;
+	}
+    }
+    close($comp_file);
+}
+
+sub load_src_override {
+    my ($user_file, $regular_file) = @_;
+    my ($file);
+    local $_;
+
+    if (defined $user_file) {
+	$file = $user_file;
+    } elsif (defined $regular_file) {
+        my $comp = compression_guess_from_filename($regular_file);
+        if (defined($comp)) {
+	    $file = $regular_file;
+            my $ext = compression_get_file_extension($comp);
+            $file =~ s/\.$ext$/.src.$ext/;
+        } else {
+	    $file = "$regular_file.src";
+        }
+        return unless -e $file;
+    } else {
+	return;
+    }
+
+    debug(1, "source override file $file");
+    my $comp_file = Dpkg::Compression::FileHandle->new(filename => $file);
+    while (<$comp_file>) {
+        s/#.*//;
+	next if /^\s*$/;
+	s/\s+$//;
+
+	my @data = split ' ';
+	unless (@data == 2) {
+	    warning(g_('invalid source override entry at line %d (%d fields)'),
+	            $., 0 + @data);
+	    next;
+	}
+
+	my ($package, $section) = @data;
+	my $key = "source/$package";
+	if (exists $override{$key}) {
+	    warning(g_('ignoring duplicate source override entry for %s at line %d'),
+	            $package, $.);
+	    next;
+	}
+	$override{$key} = [];
+	$override{$key}[O_SECTION] = $section;
+    }
+    close($comp_file);
+}
+
+sub load_override_extra
+{
+    my $extra_override = shift;
+    my $comp_file = Dpkg::Compression::FileHandle->new(filename => $extra_override);
+
+    while (<$comp_file>) {
+	s/\#.*//;
+	s/\s+$//;
+	next unless $_;
+
+	my ($p, $field, $value) = split(/\s+/, $_, 3);
+        $extra_override{$p}{$field} = $value;
+    }
+    close($comp_file);
+}
+
+# Given PREFIX and DSC-FILE, process the file and returns the fields.
+
+sub process_dsc {
+    my ($prefix, $file) = @_;
+
+    my $basename = $file;
+    ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
+    my $dir = ($basename =~ s{^(.*)/}{}) ? $1 : '';
+    $dir = "$prefix$dir";
+    $dir =~ s{/+$}{};
+    $dir = '.' if $dir eq '';
+
+    # Parse ‘.dsc’ file.
+    my $fields = Dpkg::Control->new(type => CTRL_DSC);
+    $fields->load($file);
+    $fields->set_options(type => CTRL_REPO_SRC);
+
+    # Get checksums
+    my $checksums = Dpkg::Checksums->new();
+    $checksums->add_from_file($file, key => $basename);
+    $checksums->add_from_control($fields, use_files_for_md5 => 1);
+
+    my $source = $fields->{Source};
+    my @binary = split /\s*,\s*/, $fields->{Binary} // '';
+
+    error(g_('no binary packages specified in %s'), $file) unless (@binary);
+
+    # Rename the source field to package.
+    $fields->{Package} = $fields->{Source};
+    delete $fields->{Source};
+
+    # The priority for the source package is the highest priority of the
+    # binary packages it produces.
+    my @binary_by_priority = sort {
+        ($override{$a} ? $priority{$override{$a}[O_PRIORITY]} : 0)
+        <=>
+        ($override{$b} ? $priority{$override{$b}[O_PRIORITY]} : 0)
+    } @binary;
+    my $priority_override = $override{$binary_by_priority[-1]};
+    my $priority = $priority_override ?
+                   $priority_override->[O_PRIORITY] :
+                   undef;
+    $fields->{Priority} = $priority if defined $priority;
+
+    # For the section override, first check for a record from the source
+    # override file, else use the regular override file.
+    my $section_override = $override{"source/$source"} || $override{$source};
+    my $section = $section_override ?
+                  $section_override->[O_SECTION] :
+                  undef;
+    $fields->{Section} = $section if defined $section;
+
+    # For the maintainer override, use the override record for the first
+    # binary. Modify the maintainer if necessary.
+    my $maintainer_override = $override{$binary[0]};
+    if ($maintainer_override && defined $maintainer_override->[O_MAINT_TO]) {
+        if (!defined $maintainer_override->[O_MAINT_FROM] ||
+            any { $fields->{Maintainer} eq $_ }
+                @{ $maintainer_override->[O_MAINT_FROM] }) {
+            $fields->{Maintainer} = $maintainer_override->[O_MAINT_TO];
+        }
+    }
+
+    # Process extra override
+    if (exists $extra_override{$source}) {
+        my ($field, $value);
+        while (($field, $value) = each %{$extra_override{$source}}) {
+            $fields->{$field} = $value;
+        }
+    }
+
+    # A directory field will be inserted just before the files field.
+    $fields->{Directory} = $dir;
+
+    $checksums->export_to_control($fields, use_files_for_md5 => 1);
+
+    push @sources, $fields;
+}
+
+### Main
+
+{
+    local $SIG{__WARN__} = sub { usageerr($_[0]) };
+    GetOptions(@option_spec);
+}
+
+usageerr(g_('one to three arguments expected'))
+    if not 1 <= @ARGV <= 3;
+
+push @ARGV, undef if @ARGV < 2;
+push @ARGV, '' if @ARGV < 3;
+my ($dir, $override, $prefix) = @ARGV;
+
+report_options(debug_level => $debug);
+
+load_override $override if defined $override;
+load_src_override $src_override, $override;
+load_override_extra $extra_override_file if defined $extra_override_file;
+
+my @dsc;
+my $scan_dsc = sub {
+    push @dsc, $File::Find::name if m/\.dsc$/;
+};
+
+find({ follow => 1, follow_skip => 2, wanted => $scan_dsc }, $dir);
+foreach my $fn (@dsc) {
+    # FIXME: Fix it instead to not die on syntax and general errors?
+    eval {
+        process_dsc($prefix, $fn);
+    };
+    if ($@) {
+        warn $@;
+        next;
+    }
+}
+
+if (not $no_sort) {
+    @sources = sort {
+        $a->{Package} . $a->{Version} cmp $b->{Package} . $b->{Version}
+    } @sources;
+}
+foreach my $dsc (@sources) {
+    $dsc->output(\*STDOUT);
+    print "\n";
+}