Adding upstream version 2.23.7.upstream/2.23.7upstream

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

1 files changed, 1239 insertions, 0 deletions

diff --git a/scripts/debdiff.pl b/scripts/debdiff.pl
new file mode 100755
index 0000000..4bcffc1
--- /dev/null
+++ b/scripts/debdiff.pl
@@ -0,0 +1,1239 @@
+#!/usr/bin/perl
+
+# Original shell script version:
+# Copyright 1998,1999 Yann Dirson <dirson@debian.org>
+# Perl version:
+# Copyright 1999,2000,2001 by Julian Gilbey <jdg@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License, version 2 ONLY,
+# as published by the Free Software Foundation.
+#
+# 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.
+
+use 5.006_000;
+use strict;
+use warnings;
+use Cwd;
+use Dpkg::IPC;
+use File::Copy qw(cp move);
+use File::Basename;
+use File::Spec;
+use File::Path qw/ rmtree /;
+use File::Temp qw/ tempdir tempfile /;
+use Devscripts::Compression;
+use Devscripts::Versort;
+
+# Predeclare functions
+sub wdiff_control_files($$$$$);
+sub process_debc($$);
+sub process_debI($);
+sub mktmpdirs();
+sub fatal(@);
+
+my $progname = basename($0);
+my $modified_conf_msg;
+my $exit_status = 0;
+my $dummyname   = "---DUMMY---";
+
+my $compression_re = compression_get_file_extension_regex();
+
+sub usage {
+    print <<"EOF";
+Usage: $progname [option]
+   or: $progname [option] ... deb1 deb2
+   or: $progname [option] ... changes1 changes2
+   or: $progname [option] ... dsc1 dsc2
+   or: $progname [option] ... --from deb1a deb1b ... --to deb2a deb2b ...
+Valid options are:
+    --no-conf, --noconf
+                          Don\'t read devscripts config files;
+                          must be the first option given
+   --help, -h             Display this message
+   --version, -v          Display version and copyright info
+   --move FROM TO,        The prefix FROM in first packages has
+     -m FROM TO             been renamed TO in the new packages
+                            only affects comparing binary packages
+                            (multiple permitted)
+   --move-regex FROM TO,  The prefix FROM in first packages has
+                            been renamed TO in the new packages
+                            only affects comparing binary packages
+                            (multiple permitted), using regexp substitution
+   --dirs, -d             Note changes in directories as well as files
+   --nodirs               Do not note changes in directories (default)
+   --nocontrol            Skip comparing control files
+   --control              Do compare control files
+   --controlfiles FILE,FILE,...
+                          Which control files to compare; default is just
+                            control; could include preinst, etc, config or
+                            ALL to compare all control files present
+   --wp, --wl, --wt       Pass the option -p, -l, -t respectively to wdiff
+                            (only one should be used)
+   --wdiff-source-control When processing source packages, compare control
+                            files as with --control for binary packages
+   --no-wdiff-source-control
+                          Do not do so (default)
+   --show-moved           Indicate also all files which have moved
+                            between packages
+   --noshow-moved         Do not also indicate all files which have moved
+                            between packages (default)
+   --renamed FROM TO      The package formerly called FROM has been
+                            renamed TO; only of interest with --show-moved
+                            (multiple permitted)
+   --quiet, -q            Be quiet if no differences were found
+   --exclude PATTERN      Exclude files whose basenames match PATTERN
+   --ignore-space, -w     Ignore whitespace in diffs
+   --diffstat             Include the result of diffstat before the diff
+   --no-diffstat          Do not do so (default)
+   --auto-ver-sort        When comparing source packages, ensure the
+                          comparison is performed in version order
+   --no-auto-ver-sort     Do not do so (default)
+   --unpack-tarballs      Unpack tarballs found in the top level source
+                          directory (default)
+   --no-unpack-tarballs   Do not do so
+   --apply-patches        If either old or new package is in 3.0 (quilt)
+                          format, apply the patch series and remove .pc
+                          before comparison
+   --no-apply-patches     Do not do so (default)
+
+Default settings modified by devscripts configuration files:
+$modified_conf_msg
+
+Use the diffoscope package for deeper comparisons of .deb files.
+EOF
+}
+
+my $version = <<"EOF";
+This is $progname, from the Debian devscripts package, version ###VERSION###
+This code is copyright 1999,2000,2001 by Julian Gilbey <jdg\@debian.org>,
+based on original code which is copyright 1998,1999 by
+Yann Dirson <dirson\@debian.org>
+This program comes with ABSOLUTELY NO WARRANTY.
+You are free to redistribute this code under the terms of the
+GNU General Public License, version 2 ONLY.
+EOF
+
+# Start by setting default values
+
+my $debsdir;
+my $debsdir_warning;
+my $ignore_dirs          = 1;
+my $compare_control      = 1;
+my $controlfiles         = 'control';
+my $show_moved           = 0;
+my $wdiff_opt            = '';
+my @diff_opts            = ();
+my $show_diffstat        = 0;
+my $wdiff_source_control = 0;
+my $auto_ver_sort        = 0;
+my $unpack_tarballs      = 1;
+my $apply_patches        = 0;
+
+my $quiet = 0;
+
+# Next, read read configuration files and then command line
+# The next stuff is boilerplate
+
+if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
+    $modified_conf_msg = "  (no configuration files read)";
+    shift;
+} else {
+    my @config_files = ('/etc/devscripts.conf', '~/.devscripts');
+    my %config_vars  = (
+        'DEBDIFF_DIRS'                 => 'no',
+        'DEBDIFF_CONTROL'              => 'yes',
+        'DEBDIFF_CONTROLFILES'         => 'control',
+        'DEBDIFF_SHOW_MOVED'           => 'no',
+        'DEBDIFF_WDIFF_OPT'            => '',
+        'DEBDIFF_SHOW_DIFFSTAT'        => 'no',
+        'DEBDIFF_WDIFF_SOURCE_CONTROL' => 'no',
+        'DEBDIFF_AUTO_VER_SORT'        => 'no',
+        'DEBDIFF_UNPACK_TARBALLS'      => 'yes',
+        'DEBDIFF_APPLY_PATCHES'        => 'no',
+        'DEBRELEASE_DEBS_DIR'          => '..',
+    );
+    my %config_default = %config_vars;
+
+    my $shell_cmd;
+    # Set defaults
+    foreach my $var (keys %config_vars) {
+        $shell_cmd .= "$var='$config_vars{$var}';\n";
+    }
+    $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n";
+    $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
+    # Read back values
+    foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
+    my $shell_out = `/bin/bash -c '$shell_cmd'`;
+    @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1;
+
+    # Check validity
+    $config_vars{'DEBDIFF_DIRS'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_DIRS'} = 'no';
+    $config_vars{'DEBDIFF_CONTROL'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_CONTROL'} = 'yes';
+    $config_vars{'DEBDIFF_SHOW_MOVED'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_SHOW_MOVED'} = 'no';
+    $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} = 'no';
+    $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} = 'no';
+    $config_vars{'DEBDIFF_AUTO_VER_SORT'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_AUTO_VER_SORT'} = 'no';
+    $config_vars{'DEBDIFF_UNPACK_TARBALLS'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_UNPACK_TARBALLS'} = 'yes';
+    $config_vars{'DEBDIFF_APPLY_PATCHES'} =~ /^(yes|no)$/
+      or $config_vars{'DEBDIFF_APPLY_PATCHES'} = 'no';
+    # We do not replace this with a default directory to avoid accidentally
+    # installing a broken package
+    $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%/+%/%;
+    $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%(.)/$%$1%;
+    $debsdir_warning
+      = "config file specified DEBRELEASE_DEBS_DIR directory $config_vars{'DEBRELEASE_DEBS_DIR'} does not exist!";
+
+    foreach my $var (sort keys %config_vars) {
+        if ($config_vars{$var} ne $config_default{$var}) {
+            $modified_conf_msg .= "  $var=$config_vars{$var}\n";
+        }
+    }
+    $modified_conf_msg ||= "  (none)\n";
+    chomp $modified_conf_msg;
+
+    $debsdir         = $config_vars{'DEBRELEASE_DEBS_DIR'};
+    $ignore_dirs     = $config_vars{'DEBDIFF_DIRS'} eq 'yes'   ? 0 : 1;
+    $compare_control = $config_vars{'DEBDIFF_CONTROL'} eq 'no' ? 0 : 1;
+    $controlfiles    = $config_vars{'DEBDIFF_CONTROLFILES'};
+    $show_moved = $config_vars{'DEBDIFF_SHOW_MOVED'} eq 'yes'       ? 1  : 0;
+    $wdiff_opt  = $config_vars{'DEBDIFF_WDIFF_OPT'} =~ /^-([plt])$/ ? $1 : '';
+    $show_diffstat = $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} eq 'yes' ? 1  : 0;
+    $wdiff_source_control
+      = $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} eq 'yes' ? 1 : 0;
+    $auto_ver_sort = $config_vars{'DEBDIFF_AUTO_VER_SORT'} eq 'yes' ? 1 : 0;
+    $unpack_tarballs
+      = $config_vars{'DEBDIFF_UNPACK_TARBALLS'} eq 'yes' ? 1 : 0;
+    $apply_patches = $config_vars{'DEBDIFF_APPLY_PATCHES'} eq 'yes' ? 1 : 0;
+
+}
+
+# Are they a pair of debs, changes or dsc files, or a list of debs?
+my $type     = '';
+my @excludes = ();
+my @move     = ();
+my %renamed  = ();
+my $opt_debsdir;
+
+# handle command-line options
+
+while (@ARGV) {
+    if ($ARGV[0] =~ /^(--help|-h)$/)    { usage();        exit 0; }
+    if ($ARGV[0] =~ /^(--version|-v)$/) { print $version; exit 0; }
+    if ($ARGV[0] =~ /^(--move(-regex)?|-m)$/) {
+        fatal
+"Malformed command-line option $ARGV[0]; run $progname --help for more info"
+          unless @ARGV >= 3;
+
+        my $regex = $ARGV[0] eq '--move-regex' ? 1 : 0;
+        shift @ARGV;
+
+        # Ensure from and to values all begin with a slash
+        # dpkg -c produces filenames such as ./usr/lib/filename
+        my $from = shift;
+        my $to   = shift;
+        $from =~ s%^\./%/%;
+        $to   =~ s%^\./%/%;
+
+        if ($regex) {
+            # quote ':' in the from and to patterns;
+            # used later as a pattern delimiter
+            $from =~ s/:/\\:/g;
+            $to   =~ s/:/\\:/g;
+        }
+        push @move, [$regex, $from, $to];
+    } elsif ($ARGV[0] eq '--renamed') {
+        fatal
+"Malformed command-line option $ARGV[0]; run $progname --help for more info"
+          unless @ARGV >= 3;
+        shift @ARGV;
+
+        my $from = shift;
+        my $to   = shift;
+        $renamed{$from} = $to;
+    } elsif ($ARGV[0] eq '--exclude') {
+        fatal
+"Malformed command-line option $ARGV[0]; run $progname --help for more info"
+          unless @ARGV >= 2;
+        shift @ARGV;
+
+        my $exclude = shift;
+        push @excludes, $exclude;
+    } elsif ($ARGV[0] =~ s/^--exclude=//) {
+        my $exclude = shift;
+        push @excludes, $exclude;
+    } elsif ($ARGV[0] eq '--controlfiles') {
+        fatal
+"Malformed command-line option $ARGV[0]; run $progname --help for more info"
+          unless @ARGV >= 2;
+        shift @ARGV;
+
+        $controlfiles = shift;
+    } elsif ($ARGV[0] =~ s/^--controlfiles=//) {
+        $controlfiles = shift;
+    } elsif ($ARGV[0] eq '--debs-dir') {
+        fatal
+"Malformed command-line option $ARGV[0]; run $progname --help for more info"
+          unless @ARGV >= 2;
+        shift @ARGV;
+
+        $opt_debsdir = shift;
+    } elsif ($ARGV[0] =~ s/^--debs-dir=//) {
+        $opt_debsdir = shift;
+    } elsif ($ARGV[0] =~ /^(--dirs|-d)$/) {
+        $ignore_dirs = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--nodirs') {
+        $ignore_dirs = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^(--quiet|-q)$/) {
+        $quiet = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^(--show-moved|-s)$/) {
+        $show_moved = 1;
+        shift;
+    } elsif ($ARGV[0] eq '--noshow-moved') {
+        $show_moved = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--nocontrol') {
+        $compare_control = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--control') {
+        $compare_control = 1;
+        shift;
+    } elsif ($ARGV[0] eq '--from') {
+        $type = 'debs';
+        last;
+    } elsif ($ARGV[0] =~ /^--w([plt])$/) {
+        $wdiff_opt = "-$1";
+        shift;
+    } elsif ($ARGV[0] =~ /^(--ignore-space|-w)$/) {
+        push @diff_opts, "-w";
+        shift;
+    } elsif ($ARGV[0] eq '--diffstat') {
+        $show_diffstat = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?diffstat$/) {
+        $show_diffstat = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--wdiff-source-control') {
+        $wdiff_source_control = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?wdiff-source-control$/) {
+        $wdiff_source_control = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--auto-ver-sort') {
+        $auto_ver_sort = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?auto-ver-sort$/) {
+        $auto_ver_sort = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--unpack-tarballs') {
+        $unpack_tarballs = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?unpack-tarballs$/) {
+        $unpack_tarballs = 0;
+        shift;
+    } elsif ($ARGV[0] eq '--apply-patches') {
+        $apply_patches = 1;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?apply-patches$/) {
+        $apply_patches = 0;
+        shift;
+    } elsif ($ARGV[0] =~ /^--no-?conf$/) {
+        fatal "--no-conf is only acceptable as the first command-line option!";
+    }
+
+    # Not a recognised option
+    elsif ($ARGV[0] =~ /^-/) {
+        fatal
+"Unrecognised command-line option $ARGV[0]; run $progname --help for more info";
+    } else {
+        # End of command line options
+        last;
+    }
+}
+
+for my $exclude (@excludes) {
+    if ($exclude =~ m{/}) {
+        print STDERR
+"$progname: warning: --exclude patterns are matched against the basename, so --exclude='$exclude' will not exclude anything\n";
+    }
+}
+
+my $guessed_version = 0;
+
+if ($opt_debsdir) {
+    $opt_debsdir =~ s%^/+%/%;
+    $opt_debsdir =~ s%(.)/$%$1%;
+    $debsdir_warning = "--debs-dir directory $opt_debsdir does not exist!";
+    $debsdir         = $opt_debsdir;
+}
+
+# If no file is given, assume that we are in a source directory
+# and try to create a diff with the previous version
+if (@ARGV == 0) {
+    my $namepat = qr/[-+0-9a-z.]/i;
+
+    fatal $debsdir_warning unless -d $debsdir;
+
+    fatal "Can't read file: debian/changelog" unless -r "debian/changelog";
+    open CHL, "debian/changelog";
+    while (<CHL>) {
+        if (/^(\w$namepat*)\s\((\d+:)?(.+)\)((\s+$namepat+)+)\;\surgency=.+$/)
+        {
+            unshift @ARGV, $debsdir . "/" . $1 . "_" . $3 . ".dsc";
+            $guessed_version++;
+        }
+        last if $guessed_version > 1;
+    }
+    close CHL;
+}
+
+if (!$type) {
+    # we need 2 deb files or changes files to compare
+    fatal "Need exactly two deb files or changes files to compare"
+      unless @ARGV == 2;
+
+    foreach my $i (0, 1) {
+        fatal "Can't read file: $ARGV[$i]" unless -r $ARGV[$i];
+    }
+
+    if    ($ARGV[0] =~ /\.deb$/)     { $type = 'deb'; }
+    elsif ($ARGV[0] =~ /\.udeb$/)    { $type = 'deb'; }
+    elsif ($ARGV[0] =~ /\.changes$/) { $type = 'changes'; }
+    elsif ($ARGV[0] =~ /\.dsc$/)     { $type = 'dsc'; }
+    else {
+        fatal
+"Could not recognise files; the names should end .deb, .udeb, .changes or .dsc";
+    }
+    if ($ARGV[1] !~ /\.$type$/ && ($type ne 'deb' || $ARGV[1] !~ /\.udeb$/)) {
+        fatal
+"The two filenames must have the same suffix, either .deb, .udeb, .changes or .dsc";
+    }
+}
+
+# We collect up the individual deb information in the hashes
+# %debs1 and %debs2, each key of which is a .deb name and each value is
+# a list ref.  Note we need to use our, not my, as we will be symbolically
+# referencing these variables
+my @CommonDebs = ();
+my @singledeb;
+our (
+    %debs1, %debs2, %files1, %files2,    @D1,
+    @D2,    $dir1,  $dir2,   %DebPaths1, %DebPaths2
+);
+
+if ($type eq 'deb') {
+    no strict 'refs';
+    foreach my $i (1, 2) {
+        my $deb = shift;
+        my ($debc, $debI) = ('', '');
+        my %dpkg_env = (LC_ALL => 'C');
+        eval {
+            spawn(
+                exec       => ['dpkg-deb', '-c', $deb],
+                env        => \%dpkg_env,
+                to_string  => \$debc,
+                wait_child => 1
+            );
+        };
+        if ($@) {
+            fatal "dpkg-deb -c $deb failed!";
+        }
+
+        eval {
+            spawn(
+                exec       => ['dpkg-deb', '-I', $deb],
+                env        => \%dpkg_env,
+                to_string  => \$debI,
+                wait_child => 1
+            );
+        };
+        if ($@) {
+            fatal "dpkg-deb -I $deb failed!";
+        }
+        # Store the name for later
+        $singledeb[$i] = $deb;
+        # get package name itself
+        $deb =~ s,.*/,,;
+        $deb =~ s/_.*//;
+        @{"D$i"} = @{ process_debc($debc, $i) };
+        push @{"D$i"}, @{ process_debI($debI) };
+    }
+} elsif ($type eq 'changes' or $type eq 'debs') {
+    # Have to parse .changes files or remaining arguments
+    my $pwd = cwd;
+    foreach my $i (1, 2) {
+        my (@debs) = ();
+        if ($type eq 'debs') {
+            if (@ARGV < 2) {
+                # Oops!  There should be at least --from|--to deb ...
+                fatal
+"Missing .deb names or missing --to!  (Run debdiff -h for help)\n";
+            }
+            shift;    # get rid of --from or --to
+            while (@ARGV and $ARGV[0] ne '--to') {
+                push @debs, shift;
+            }
+
+            # Is there only one .deb listed?
+            if (@debs == 1) {
+                $singledeb[$i] = $debs[0];
+            }
+        } else {
+            my $changes = shift;
+            open CHANGES, $changes
+              or fatal "Couldn't open $changes: $!";
+            my $infiles = 0;
+            while (<CHANGES>) {
+                last if $infiles and /^[^ ]/;
+                /^Files:/ and $infiles = 1, next;
+                next unless $infiles;
+                if (/ (\S*.u?deb)$/) {
+                    my $file = $1;
+                    $file !~ m,[/\x00],
+                      or fatal "File name contains invalid characters: $file";
+                    push @debs, dirname($changes) . '/' . $file;
+                }
+            }
+            close CHANGES
+              or fatal "Problem reading $changes: $!";
+
+            # Is there only one .deb listed?
+            if (@debs == 1) {
+                $singledeb[$i] = $debs[0];
+            }
+        }
+
+        foreach my $deb (@debs) {
+            no strict 'refs';
+            fatal "Can't read file: $deb" unless -r $deb;
+            my ($debc, $debI) = ('', '');
+            my %dpkg_env = (LC_ALL => 'C');
+            eval {
+                spawn(
+                    exec       => ['dpkg-deb', '-c', $deb],
+                    to_string  => \$debc,
+                    env        => \%dpkg_env,
+                    wait_child => 1
+                );
+            };
+            if ($@) {
+                fatal "dpkg-deb -c $deb failed!";
+            }
+            eval {
+                spawn(
+                    exec       => ['dpkg-deb', '-I', $deb],
+                    to_string  => \$debI,
+                    env        => \%dpkg_env,
+                    wait_child => 1
+                );
+            };
+            if ($@) {
+                fatal "dpkg-deb -I $deb failed!";
+            }
+            my $debpath = $deb;
+            # get package name itself
+            $deb =~ s,.*/,,;
+            $deb =~ s/_.*//;
+            $deb = $renamed{$deb} if $i == 1 and exists $renamed{$deb};
+            if (exists ${"debs$i"}{$deb}) {
+                warn
+"Same package name appears more than once (possibly due to renaming): $deb\n";
+            } else {
+                ${"debs$i"}{$deb} = 1;
+            }
+            ${"DebPaths$i"}{$deb} = $debpath;
+            foreach my $file (@{ process_debc($debc, $i) }) {
+                ${"files$i"}{$file} ||= "";
+                ${"files$i"}{$file} .= "$deb:";
+            }
+            foreach my $control (@{ process_debI($debI) }) {
+                ${"files$i"}{$control} ||= "";
+                ${"files$i"}{$control} .= "$deb:";
+            }
+        }
+        no strict 'refs';
+        @{"D$i"} = keys %{"files$i"};
+        # Go back again
+        chdir $pwd or fatal "Couldn't chdir $pwd: $!";
+    }
+} elsif ($type eq 'dsc') {
+    # Compare source packages
+    my $pwd = cwd;
+
+    my (@origs, @diffs, @dscs, @dscformats, @versions);
+    foreach my $i (1, 2) {
+        my $dsc = shift;
+        chdir dirname($dsc)
+          or fatal "Couldn't chdir ", dirname($dsc), ": $!";
+
+        $dscs[$i] = cwd() . '/' . basename($dsc);
+
+        open DSC, basename($dsc) or fatal "Couldn't open $dsc: $!";
+
+        my $infiles = 0;
+        while (<DSC>) {
+            if (/^Files:/) {
+                $infiles = 1;
+                next;
+            } elsif (/^Format: (.*)$/) {
+                $dscformats[$i] = $1;
+            } elsif (/^Version: (.*)$/) {
+                $versions[$i - 1] = [$1, $i];
+            }
+            next unless $infiles;
+            last if /^\s*$/;
+            last if /^[-\w]+:/;    # don't expect this, but who knows?
+            chomp;
+
+            # This had better match
+            if (/^\s+[0-9a-f]{32}\s+\d+\s+(\S+)$/) {
+                my $file = $1;
+                $file !~ m,[/\x00],
+                  or fatal "File name contains invalid characters: $file";
+                if ($file =~ /\.diff\.gz$/) {
+                    $diffs[$i] = cwd() . '/' . $file;
+                } elsif ($file =~ /((?:\.orig)?\.tar\.$compression_re|\.git)$/)
+                {
+                    $origs[$i] = $file;
+                }
+            } else {
+                warn "Unrecognised file line in .dsc:\n$_\n";
+            }
+        }
+
+        close DSC or fatal "Problem closing $dsc: $!";
+        # Go back again
+        chdir $pwd or fatal "Couldn't chdir $pwd: $!";
+    }
+
+    @versions = Devscripts::Versort::versort(@versions);
+    # If the versions are currently out of order, should we swap them?
+    if (    $auto_ver_sort
+        and !$guessed_version
+        and $versions[0][1] == 1
+        and $versions[0][0] ne $versions[1][0]) {
+        foreach my $var ((\@origs, \@diffs, \@dscs, \@dscformats)) {
+            my $temp = @{$var}[1];
+            @{$var}[1] = @{$var}[2];
+            @{$var}[2] = $temp;
+        }
+    }
+
+    # Do we have interdiff?
+    system("command -v interdiff >/dev/null 2>&1");
+    my $use_interdiff = ($? == 0) ? 1 : 0;
+    system("command -v diffstat >/dev/null 2>&1");
+    my $have_diffstat = ($? == 0) ? 1 : 0;
+    system("command -v wdiff >/dev/null 2>&1");
+    my $have_wdiff = ($? == 0) ? 1 : 0;
+
+    my ($fh, $filename) = tempfile(
+        "debdiffXXXXXX",
+        SUFFIX => ".diff",
+        DIR    => File::Spec->tmpdir,
+        UNLINK => 1
+    );
+
+    # When wdiffing source control files we always fully extract both source
+    # packages as it's the easiest way of getting the debian/control file,
+    # particularly if the orig tar ball contains one which is patched in the
+    # diffs
+    if (    $origs[1] eq $origs[2]
+        and defined $diffs[1]
+        and defined $diffs[2]
+        and scalar(@excludes) == 0
+        and $use_interdiff
+        and !$wdiff_source_control) {
+        # same orig tar ball, interdiff exists and not wdiffing
+
+        my $tmpdir = tempdir(CLEANUP => 1);
+        eval {
+            spawn(
+                exec => ['interdiff', '-z', @diff_opts, $diffs[1], $diffs[2]],
+                to_file    => $filename,
+                wait_child => 1,
+                # Make interdiff put its tempfiles in $tmpdir, so they're
+                # automatically cleaned up
+                env => { TMPDIR => $tmpdir });
+        };
+
+        # If interdiff fails for some reason, we'll fall back to our manual
+        # diffing.
+        unless ($@) {
+            if ($have_diffstat and $show_diffstat) {
+                my $header
+                  = "diffstat for "
+                  . basename($diffs[1]) . " "
+                  . basename($diffs[2]) . "\n\n";
+                $header =~ s/\.diff\.gz//g;
+                print $header;
+                spawn(
+                    exec       => ['diffstat', $filename],
+                    wait_child => 1
+                );
+                print "\n";
+            }
+
+            if (-s $filename) {
+                open(INTERDIFF, '<', $filename);
+                while (<INTERDIFF>) {
+                    print $_;
+                }
+                close INTERDIFF;
+
+                $exit_status = 1;
+            }
+            exit $exit_status;
+        }
+    }
+
+    # interdiff ran and failed, or any other situation
+    if (!$use_interdiff) {
+        warn
+"Warning: You do not seem to have interdiff (in the patchutils package)\ninstalled; this program would use it if it were available.\n";
+    }
+    # possibly different orig tarballs, or no interdiff installed,
+    # or wdiffing debian/control
+    our ($sdir1, $sdir2);
+    mktmpdirs();
+
+    for my $i (1, 2) {
+        no strict 'refs';
+        my @opts = ('-x');
+        if ($dscformats[$i] eq '3.0 (quilt)' && !$apply_patches) {
+            push @opts, '--skip-patches';
+        }
+        my $diri = ${"dir$i"};
+        eval {
+            spawn(
+                exec       => ['dpkg-source', @opts, $dscs[$i]],
+                to_file    => '/dev/null',
+                chdir      => $diri,
+                wait_child => 1
+            );
+        };
+        if ($@) {
+            my $dir = dirname $dscs[1] if $i == 2;
+            $dir = dirname $dscs[2] if $i == 1;
+            cp "$dir/$origs[$i]",
+              $diri || fatal "copy $dir/$origs[$i] $diri: $!";
+            my $dscx = basename $dscs[$i];
+            cp $diffs[$i], $diri || fatal "copy $diffs[$i] $diri: $!";
+            cp $dscs[$i],  $diri || fatal "copy $dscs[$i] $diri: $!";
+            spawn(
+                exec       => ['dpkg-source', @opts, $dscx],
+                to_file    => '/dev/null',
+                chdir      => $diri,
+                wait_child => 1
+            );
+        }
+        opendir DIR, $diri;
+        while ($_ = readdir(DIR)) {
+            next if $_ eq '.' || $_ eq '..' || !-d "$diri/$_";
+            ${"sdir$i"} = $_;
+            last;
+        }
+        closedir(DIR);
+        my $sdiri = ${"sdir$i"};
+
+# also unpack tarballs found in the top level source directory so we can compare their contents too
+        next unless $unpack_tarballs;
+        opendir DIR, $diri . '/' . $sdiri;
+
+        my $tarballs = 1;
+        while ($_ = readdir(DIR)) {
+            my $unpacked = "=unpacked-tar" . $tarballs . "=";
+            my $filename = $_;
+            if ($filename =~ s/\.tar\.$compression_re$//) {
+                my $comp = compression_guess_from_filename($_);
+                $tarballs++;
+                spawn(
+                    exec       => ['tar', "--$comp", '-xf', $_],
+                    to_file    => '/dev/null',
+                    wait_child => 1,
+                    chdir      => "$diri/$sdiri",
+                    nocheck    => 1
+                );
+                if (-d "$diri/$sdiri/$filename") {
+                    move "$diri/$sdiri/$filename", "$diri/$sdiri/$unpacked";
+                }
+            }
+        }
+        closedir(DIR);
+        if ($dscformats[$i] eq '3.0 (quilt)' && $apply_patches) {
+            spawn(
+                exec       => ['rm', '-fr', "$diri/$sdiri/.pc"],
+                wait_child => 1
+            );
+        }
+    }
+
+    my @command = ("diff", "-Nru", @diff_opts);
+    for my $exclude (@excludes) {
+        push @command, ("--exclude", $exclude);
+    }
+    push @command, ("$dir1/$sdir1", "$dir2/$sdir2");
+
+# Execute diff and remove the common prefixes $dir1/$dir2, so the patch can be used with -p1,
+# as if when interdiff would have been used:
+    spawn(
+        exec       => \@command,
+        to_file    => $filename,
+        wait_child => 1,
+        nocheck    => 1
+    );
+
+    if ($have_diffstat and $show_diffstat) {
+        print "diffstat for $sdir1 $sdir2\n\n";
+        spawn(
+            exec       => ['diffstat', $filename],
+            wait_child => 1
+        );
+        print "\n";
+    }
+
+    if ($have_wdiff and $wdiff_source_control) {
+        # Abuse global variables slightly to create some temporary directories
+        my $tempdir1 = $dir1;
+        my $tempdir2 = $dir2;
+        mktmpdirs();
+        our $wdiffdir1 = $dir1;
+        our $wdiffdir2 = $dir2;
+        $dir1 = $tempdir1;
+        $dir2 = $tempdir2;
+        our @cf;
+
+        if ($controlfiles eq 'ALL') {
+            @cf = ('control');
+        } else {
+            @cf = split /,/, $controlfiles;
+        }
+
+        no strict 'refs';
+        for my $i (1, 2) {
+            foreach my $file (@cf) {
+                cp ${"dir$i"} . '/' . ${"sdir$i"} . "/debian/$file",
+                  ${"wdiffdir$i"};
+            }
+        }
+        use strict 'refs';
+
+        # We don't support "ALL" for source packages as that would
+        # wdiff debian/*
+        $exit_status = wdiff_control_files($wdiffdir1, $wdiffdir2, $dummyname,
+            $controlfiles eq 'ALL' ? 'control' : $controlfiles, $exit_status);
+        print "\n";
+
+        # Clean up
+        rmtree([$wdiffdir1, $wdiffdir2]);
+    }
+
+    if (!-f $filename) {
+        fatal "Creation of diff file $filename failed!";
+    } elsif (-s $filename) {
+        open(DIFF, '<', $filename)
+          or fatal "Opening diff file $filename failed!";
+
+        while (<DIFF>) {
+            s/^--- $dir1\//--- /;
+            s/^\+\+\+ $dir2\//+++ /;
+            s/^(diff .*) $dir1\/\Q$sdir1\E/$1 $sdir1/;
+            s/^(diff .*) $dir2\/\Q$sdir2\E/$1 $sdir2/;
+            print;
+        }
+        close DIFF;
+
+        $exit_status = 1;
+    }
+
+    exit $exit_status;
+} else {
+    fatal "Internal error: \$type = $type unrecognised";
+}
+
+# Compare
+# Start by a piece of common code to set up the @CommonDebs list and the like
+
+my (@deblosses, @debgains);
+
+{
+    my %debs;
+    grep $debs{$_}--, keys %debs1;
+    grep $debs{$_}++, keys %debs2;
+
+    @deblosses  = sort grep $debs{$_} < 0, keys %debs;
+    @debgains   = sort grep $debs{$_} > 0, keys %debs;
+    @CommonDebs = sort grep $debs{$_} == 0, keys %debs;
+}
+
+if ($show_moved and $type ne 'deb') {
+    if (@debgains) {
+        my $msg
+          = "Warning: these package names were in the second list but not in the first:";
+        print $msg, "\n", '-' x length $msg, "\n";
+        print join("\n", @debgains), "\n\n";
+    }
+
+    if (@deblosses) {
+        print "\n" if @debgains;
+        my $msg
+          = "Warning: these package names were in the first list but not in the second:";
+        print $msg, "\n", '-' x length $msg, "\n";
+        print join("\n", @deblosses), "\n\n";
+    }
+
+    # We start by determining which files are in the first set of debs, the
+    # second set of debs or both.
+    my %files;
+    grep $files{$_}--, @D1;
+    grep $files{$_}++, @D2;
+
+    my @old  = sort grep $files{$_} < 0, keys %files;
+    my @new  = sort grep $files{$_} > 0, keys %files;
+    my @same = sort grep $files{$_} == 0, keys %files;
+
+    # We store any changed files in a hash of hashes %changes, where
+    # $changes{$from}{$to} is an array of files which have moved
+    # from package $from to package $to; $from or $to is '-' if
+    # the files have appeared or disappeared
+
+    my %changes;
+    my @funny;    # for storing changed files which appear in multiple debs
+
+    foreach my $file (@old) {
+        my @firstdebs = split /:/, $files1{$file};
+        foreach my $firstdeb (@firstdebs) {
+            push @{ $changes{$firstdeb}{'-'} }, $file;
+        }
+    }
+
+    foreach my $file (@new) {
+        my @seconddebs = split /:/, $files2{$file};
+        foreach my $seconddeb (@seconddebs) {
+            push @{ $changes{'-'}{$seconddeb} }, $file;
+        }
+    }
+
+    foreach my $file (@same) {
+        # Are they identical?
+        next if $files1{$file} eq $files2{$file};
+
+        # Ah, they're not the same.  If the file has moved from one deb
+        # to another, we'll put a note in that pair.  But if the file
+        # was in more than one deb or ends up in more than one deb, we'll
+        # list it separately.
+        my @fdebs1 = split(/:/, $files1{$file});
+        my @fdebs2 = split(/:/, $files2{$file});
+
+        if (@fdebs1 == 1 && @fdebs2 == 1) {
+            push @{ $changes{ $fdebs1[0] }{ $fdebs2[0] } }, $file;
+        } else {
+            # two packages to one or vice versa, or something like that
+            push @funny, [$file, \@fdebs1, \@fdebs2];
+        }
+    }
+
+    # This is not a very efficient way of doing things if there are
+    # lots of debs involved, but since that is highly unlikely, it
+    # shouldn't be much of an issue
+    my $changed = 0;
+
+    for my $deb1 (sort(keys %debs1), '-') {
+        next unless exists $changes{$deb1};
+        for my $deb2 ('-', sort keys %debs2) {
+            next unless exists $changes{$deb1}{$deb2};
+            my $msg;
+            if (!$changed) {
+                print
+"[The following lists of changes regard files as different if they have\ndifferent names, permissions or owners.]\n\n";
+            }
+            if ($deb1 eq '-') {
+                $msg
+                  = "New files in second set of .debs, found in package $deb2";
+            } elsif ($deb2 eq '-') {
+                $msg
+                  = "Files only in first set of .debs, found in package $deb1";
+            } else {
+                $msg = "Files moved from package $deb1 to package $deb2";
+            }
+            print $msg, "\n", '-' x length $msg, "\n";
+            print join("\n", @{ $changes{$deb1}{$deb2} }), "\n\n";
+            $changed = 1;
+        }
+    }
+
+    if (@funny) {
+        my $msg
+          = "Files moved or copied from at least TWO packages or to at least TWO packages";
+        print $msg, "\n", '-' x length $msg, "\n";
+        for my $funny (@funny) {
+            print $$funny[0], "\n";    # filename and details
+            print "From package", (@{ $$funny[1] } > 1 ? "s" : ""), ": ";
+            print join(", ", @{ $$funny[1] }),                      "\n";
+            print "To package", (@{ $$funny[2] } > 1 ? "s" : ""),   ": ";
+            print join(", ", @{ $$funny[2] }),                      "\n";
+        }
+        $changed = 1;
+    }
+
+    if (!$quiet && !$changed) {
+        print
+          "File lists identical on package level (after any substitutions)\n";
+    }
+    $exit_status = 1 if $changed;
+} else {
+    my %files;
+    grep $files{$_}--, @D1;
+    grep $files{$_}++, @D2;
+
+    my @losses = sort grep $files{$_} < 0, keys %files;
+    my @gains  = sort grep $files{$_} > 0, keys %files;
+
+    if (@losses == 0 && @gains == 0) {
+        print "File lists identical (after any substitutions)\n"
+          unless $quiet;
+    } else {
+        print
+"[The following lists of changes regard files as different if they have\ndifferent names, permissions or owners.]\n\n";
+    }
+
+    if (@gains) {
+        my $msg;
+        if ($type eq 'debs') {
+            $msg = "Files in second set of .debs but not in first";
+        } else {
+            $msg = sprintf "Files in second .%s but not in first",
+              $type eq 'deb' ? 'deb' : 'changes';
+        }
+        print $msg, "\n", '-' x length $msg, "\n";
+        print join("\n", @gains), "\n";
+        $exit_status = 1;
+    }
+
+    if (@losses) {
+        print "\n" if @gains;
+        my $msg;
+        if ($type eq 'debs') {
+            $msg = "Files in first set of .debs but not in second";
+        } else {
+            $msg = sprintf "Files in first .%s but not in second",
+              $type eq 'deb' ? 'deb' : 'changes';
+        }
+        print $msg, "\n", '-' x length $msg, "\n";
+        print join("\n", @losses), "\n";
+        $exit_status = 1;
+    }
+}
+
+# We compare the control files (at least the dependency fields)
+if (defined $singledeb[1] and defined $singledeb[2]) {
+    @CommonDebs            = ($dummyname);
+    $DebPaths1{$dummyname} = $singledeb[1];
+    $DebPaths2{$dummyname} = $singledeb[2];
+}
+
+exit $exit_status unless (@CommonDebs > 0) and $compare_control;
+
+unless (system("command -v wdiff >/dev/null 2>&1") == 0) {
+    warn "Can't compare control files; wdiff package not installed\n";
+    exit $exit_status;
+}
+
+for my $debname (@CommonDebs) {
+    no strict 'refs';
+    mktmpdirs();
+
+    for my $i (1, 2) {
+        my $debpath = "${\"DebPaths$i\"}{$debname}";
+        my $diri    = ${"dir$i"};
+        eval {
+            spawn(
+                exec       => ['dpkg-deb', '-e', $debpath, $diri],
+                wait_child => 1
+            );
+        };
+        if ($@) {
+            my $msg = "dpkg-deb -e ${\"DebPaths$i\"}{$debname} failed!";
+            rmtree([$dir1, $dir2]);
+            fatal $msg;
+        }
+    }
+
+    use strict 'refs';
+    $exit_status = wdiff_control_files($dir1, $dir2, $debname, $controlfiles,
+        $exit_status);
+
+    # Clean up
+    rmtree([$dir1, $dir2]);
+}
+
+exit $exit_status;
+
+###### Subroutines
+
+# This routine takes the output of dpkg-deb -c and returns
+# a processed listref
+sub process_debc($$) {
+    my ($data, $number) = @_;
+    my (@filelist);
+
+    # Format of dpkg-deb -c output:
+    # permissions owner/group size date time name ['->' link destination]
+    $data =~ s/^(\S+)\s+(\S+)\s+(\S+\s+){3}/$1  $2   /mg;
+    $data =~ s,   \./,   /,mg;
+    @filelist = grep !m|   /$|, split /\n/, $data;   # don't bother keeping '/'
+
+    # Are we keeping directory names in our filelists?
+    if ($ignore_dirs) {
+        @filelist = grep !m|/$|, @filelist;
+    }
+
+    # Do the "move" substitutions in the order received for the first debs
+    if ($number == 1 and @move) {
+        my @split_filelist
+          = map { m/^(\S+)  (\S+)   (.*)/ && [$1, $2, $3] } @filelist;
+        for my $move (@move) {
+            my $regex = $$move[0];
+            my $from  = $$move[1];
+            my $to    = $$move[2];
+            map {
+                if   ($regex) { eval "\$\$_[2] =~ s:$from:$to:g"; }
+                else          { $$_[2] =~ s/\Q$from\E/$to/; }
+            } @split_filelist;
+        }
+        @filelist = map { "$$_[0]  $$_[1]   $$_[2]" } @split_filelist;
+    }
+
+    return \@filelist;
+}
+
+# This does the same for dpkg-deb -I
+sub process_debI($) {
+    my ($data) = @_;
+    my (@filelist);
+
+    # Format of dpkg-deb -c output:
+    # 2 (always?) header lines
+    #   nnnn bytes,    nnn lines   [*]  filename    [interpreter]
+    # Package: ...
+    # rest of control file
+
+    foreach (split /\n/, $data) {
+        last if /^Package:/;
+        next unless /^\s+\d+\s+bytes,\s+\d+\s+lines\s+(\*)?\s+([\-\w]+)/;
+        my $control = $2;
+        my $perms   = ($1 ? "-rwxr-xr-x" : "-rw-r--r--");
+        push @filelist, "$perms  root/root   DEBIAN/$control";
+    }
+
+    return \@filelist;
+}
+
+sub wdiff_control_files($$$$$) {
+    my ($dir1, $dir2, $debname, $controlfiles, $origstatus) = @_;
+    return
+          unless defined $dir1
+      and defined $dir2
+      and defined $debname
+      and defined $controlfiles;
+    my @cf;
+    my $status = $origstatus;
+    if ($controlfiles eq 'ALL') {
+        # only need to list one directory as we are only comparing control
+        # files in both packages
+        @cf = grep { !/md5sums/ } map { basename($_); } glob("$dir1/*");
+    } else {
+        @cf = split /,/, $controlfiles;
+    }
+
+    foreach my $cf (@cf) {
+        next unless -f "$dir1/$cf" and -f "$dir2/$cf";
+        if ($cf eq 'control' or $cf eq 'conffiles' or $cf eq 'shlibs') {
+            for my $file ("$dir1/$cf", "$dir2/$cf") {
+                my ($fd, @hdrs);
+                open $fd, '<', $file or fatal "Cannot read $file: $!";
+                while (<$fd>) {
+                    if (/^\s/ and @hdrs > 0) {
+                        $hdrs[$#hdrs] .= $_;
+                    } else {
+                        push @hdrs, $_;
+                    }
+                }
+                close $fd;
+                chmod 0644, $file;
+                open $fd, '>', $file or fatal "Cannot write $file: $!";
+                print $fd sort @hdrs;
+                close $fd;
+            }
+        }
+        my $usepkgname = $debname eq $dummyname ? "" : " of package $debname";
+        my @opts       = ('-n');
+        push @opts, $wdiff_opt if $wdiff_opt;
+        my ($wdiff, $wdiff_error) = ('', '');
+        spawn(
+            exec            => ['wdiff', @opts, "$dir1/$cf", "$dir2/$cf"],
+            to_string       => \$wdiff,
+            error_to_string => \$wdiff_error,
+            wait_child      => 1,
+            nocheck         => 1
+        );
+        if ($? && ($? >> 8) != 1) {
+            print "$wdiff_error\n";
+            warn "wdiff failed\n";
+        } else {
+            if (!$?) {
+                if (!$quiet) {
+                    print
+"\nNo differences were encountered between the $cf files$usepkgname\n";
+                }
+            } elsif ($wdiff_opt) {
+                # Don't try messing with control codes
+                my $msg = ucfirst($cf) . " files$usepkgname: wdiff output";
+                print "\n", $msg, "\n", '-' x length $msg, "\n";
+                print $wdiff;
+                $status = 1;
+            } else {
+                my @output;
+                @output = split /\n/, $wdiff;
+                @output = grep /(\[-|\{\+)/, @output;
+                my $msg = ucfirst($cf)
+                  . " files$usepkgname: lines which differ (wdiff format)";
+                print "\n", $msg, "\n", '-' x length $msg, "\n";
+                print join("\n", @output), "\n";
+                $status = 1;
+            }
+        }
+    }
+
+    return $status;
+}
+
+sub mktmpdirs () {
+    no strict 'refs';
+
+    for my $i (1, 2) {
+        ${"dir$i"} = tempdir(CLEANUP => 1);
+        fatal "Couldn't create temp directory"
+          if not defined ${"dir$i"};
+    }
+}
+
+sub fatal(@) {
+    my ($pack, $file, $line);
+    ($pack, $file, $line) = caller();
+    (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
+    $msg =~ s/\n\n$/\n/;
+    die $msg;
+}