Adding upstream version 1.21.22.upstream/1.21.22upstream

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

81 files changed, 23901 insertions, 0 deletions

diff --git a/scripts/Dpkg/Arch.pm b/scripts/Dpkg/Arch.pm
new file mode 100644
index 0000000..3d8d095
--- /dev/null
+++ b/scripts/Dpkg/Arch.pm
@@ -0,0 +1,707 @@
+# Copyright © 2006-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/>.
+
+package Dpkg::Arch;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Arch - handle architectures
+
+=head1 DESCRIPTION
+
+The Dpkg::Arch module provides functions to handle Debian architectures,
+wildcards, and mapping from and to GNU triplets.
+
+No symbols are exported by default. The :all tag can be used to import all
+symbols. The :getters, :parsers, :mappers and :operators tags can be used
+to import specific symbol subsets.
+
+=cut
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '1.03';
+our @EXPORT_OK = qw(
+    get_raw_build_arch
+    get_raw_host_arch
+    get_build_arch
+    get_host_arch
+    get_host_gnu_type
+    get_valid_arches
+    debarch_eq
+    debarch_is
+    debarch_is_wildcard
+    debarch_is_illegal
+    debarch_is_concerned
+    debarch_to_abiattrs
+    debarch_to_cpubits
+    debarch_to_gnutriplet
+    debarch_to_debtuple
+    debarch_to_multiarch
+    debarch_list_parse
+    debtuple_to_debarch
+    debtuple_to_gnutriplet
+    gnutriplet_to_debarch
+    gnutriplet_to_debtuple
+    gnutriplet_to_multiarch
+);
+our %EXPORT_TAGS = (
+    all => [ @EXPORT_OK ],
+    getters => [ qw(
+        get_raw_build_arch
+        get_raw_host_arch
+        get_build_arch
+        get_host_arch
+        get_host_gnu_type
+        get_valid_arches
+    ) ],
+    parsers => [ qw(
+        debarch_list_parse
+    ) ],
+    mappers => [ qw(
+        debarch_to_abiattrs
+        debarch_to_gnutriplet
+        debarch_to_debtuple
+        debarch_to_multiarch
+        debtuple_to_debarch
+        debtuple_to_gnutriplet
+        gnutriplet_to_debarch
+        gnutriplet_to_debtuple
+        gnutriplet_to_multiarch
+    ) ],
+    operators => [ qw(
+        debarch_eq
+        debarch_is
+        debarch_is_wildcard
+        debarch_is_illegal
+        debarch_is_concerned
+    ) ],
+);
+
+
+use Exporter qw(import);
+use List::Util qw(any);
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::BuildEnv;
+
+my (@cpu, @os);
+my (%cputable, %ostable);
+my (%cputable_re, %ostable_re);
+my (%cpubits, %cpuendian);
+my %abibits;
+
+my %debtuple_to_debarch;
+my %debarch_to_debtuple;
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $arch = get_raw_build_arch()
+
+Get the raw build Debian architecture, without taking into account variables
+from the environment.
+
+=cut
+
+sub get_raw_build_arch()
+{
+    state $build_arch;
+
+    return $build_arch if defined $build_arch;
+
+    # Note: We *always* require an installed dpkg when inferring the
+    # build architecture. The bootstrapping case is handled by
+    # dpkg-architecture itself, by avoiding computing the DEB_BUILD_
+    # variables when they are not requested.
+
+    ## no critic (TestingAndDebugging::ProhibitNoWarnings)
+    no warnings qw(exec);
+    $build_arch = qx(dpkg --print-architecture);
+    syserr('dpkg --print-architecture failed') if $? >> 8;
+
+    chomp $build_arch;
+    return $build_arch;
+}
+
+=item $arch = get_build_arch()
+
+Get the build Debian architecture, using DEB_BUILD_ARCH from the environment
+if available.
+
+=cut
+
+sub get_build_arch()
+{
+    return Dpkg::BuildEnv::get('DEB_BUILD_ARCH') || get_raw_build_arch();
+}
+
+{
+    my %cc_host_gnu_type;
+
+    sub get_host_gnu_type()
+    {
+        my $CC = $ENV{CC} || 'gcc';
+
+        return $cc_host_gnu_type{$CC} if defined $cc_host_gnu_type{$CC};
+
+        ## no critic (TestingAndDebugging::ProhibitNoWarnings)
+        no warnings qw(exec);
+        $cc_host_gnu_type{$CC} = qx($CC -dumpmachine);
+	if ($? >> 8) {
+            $cc_host_gnu_type{$CC} = '';
+	} else {
+            chomp $cc_host_gnu_type{$CC};
+	}
+
+        return $cc_host_gnu_type{$CC};
+    }
+
+    sub set_host_gnu_type
+    {
+        my ($host_gnu_type) = @_;
+        my $CC = $ENV{CC} || 'gcc';
+
+        $cc_host_gnu_type{$CC} = $host_gnu_type;
+    }
+}
+
+=item $arch = get_raw_host_arch()
+
+Get the raw host Debian architecture, without taking into account variables
+from the environment.
+
+=cut
+
+sub get_raw_host_arch()
+{
+    state $host_arch;
+
+    return $host_arch if defined $host_arch;
+
+    my $host_gnu_type = get_host_gnu_type();
+
+    if ($host_gnu_type eq '') {
+        warning(g_('cannot determine CC system type, falling back to ' .
+                   'default (native compilation)'));
+    } else {
+        my (@host_archtuple) = gnutriplet_to_debtuple($host_gnu_type);
+        $host_arch = debtuple_to_debarch(@host_archtuple);
+
+        if (defined $host_arch) {
+            $host_gnu_type = debtuple_to_gnutriplet(@host_archtuple);
+        } else {
+            warning(g_('unknown CC system type %s, falling back to ' .
+                       'default (native compilation)'), $host_gnu_type);
+            $host_gnu_type = '';
+        }
+        set_host_gnu_type($host_gnu_type);
+    }
+
+    if (!defined($host_arch)) {
+        # Switch to native compilation.
+        $host_arch = get_raw_build_arch();
+    }
+
+    return $host_arch;
+}
+
+=item $arch = get_host_arch()
+
+Get the host Debian architecture, using DEB_HOST_ARCH from the environment
+if available.
+
+=cut
+
+sub get_host_arch()
+{
+    return Dpkg::BuildEnv::get('DEB_HOST_ARCH') || get_raw_host_arch();
+}
+
+=item @arch_list = get_valid_arches()
+
+Get an array with all currently known Debian architectures.
+
+=cut
+
+sub get_valid_arches()
+{
+    _load_cputable();
+    _load_ostable();
+
+    my @arches;
+
+    foreach my $os (@os) {
+	foreach my $cpu (@cpu) {
+	    my $arch = debtuple_to_debarch(split(/-/, $os, 3), $cpu);
+	    push @arches, $arch if defined($arch);
+	}
+    }
+
+    return @arches;
+}
+
+my %table_loaded;
+sub _load_table
+{
+    my ($table, $loader) = @_;
+
+    return if $table_loaded{$table};
+
+    local $_;
+    local $/ = "\n";
+
+    open my $table_fh, '<', "$Dpkg::DATADIR/$table"
+	or syserr(g_('cannot open %s'), $table);
+    while (<$table_fh>) {
+	$loader->($_);
+    }
+    close $table_fh;
+
+    $table_loaded{$table} = 1;
+}
+
+sub _load_cputable
+{
+    _load_table('cputable', sub {
+	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) {
+	    $cputable{$1} = $2;
+	    $cputable_re{$1} = $3;
+	    $cpubits{$1} = $4;
+	    $cpuendian{$1} = $5;
+	    push @cpu, $1;
+	}
+    });
+}
+
+sub _load_ostable
+{
+    _load_table('ostable', sub {
+	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
+	    $ostable{$1} = $2;
+	    $ostable_re{$1} = $3;
+	    push @os, $1;
+	}
+    });
+}
+
+sub _load_abitable()
+{
+    _load_table('abitable', sub {
+        if (m/^(?!\#)(\S+)\s+(\S+)/) {
+            $abibits{$1} = $2;
+        }
+    });
+}
+
+sub _load_tupletable()
+{
+    _load_cputable();
+
+    _load_table('tupletable', sub {
+	if (m/^(?!\#)(\S+)\s+(\S+)/) {
+	    my $debtuple = $1;
+	    my $debarch = $2;
+
+	    if ($debtuple =~ /<cpu>/) {
+		foreach my $_cpu (@cpu) {
+		    (my $dt = $debtuple) =~ s/<cpu>/$_cpu/;
+		    (my $da = $debarch) =~ s/<cpu>/$_cpu/;
+
+		    next if exists $debarch_to_debtuple{$da}
+		         or exists $debtuple_to_debarch{$dt};
+
+		    $debarch_to_debtuple{$da} = $dt;
+		    $debtuple_to_debarch{$dt} = $da;
+		}
+	    } else {
+		$debarch_to_debtuple{$2} = $1;
+		$debtuple_to_debarch{$1} = $2;
+	    }
+	}
+    });
+}
+
+sub debtuple_to_gnutriplet(@)
+{
+    my ($abi, $libc, $os, $cpu) = @_;
+
+    _load_cputable();
+    _load_ostable();
+
+    return unless
+        defined $abi && defined $libc && defined $os && defined $cpu &&
+        exists $cputable{$cpu} && exists $ostable{"$abi-$libc-$os"};
+    return join('-', $cputable{$cpu}, $ostable{"$abi-$libc-$os"});
+}
+
+sub gnutriplet_to_debtuple($)
+{
+    my $gnu = shift;
+    return unless defined($gnu);
+    my ($gnu_cpu, $gnu_os) = split(/-/, $gnu, 2);
+    return unless defined($gnu_cpu) && defined($gnu_os);
+
+    _load_cputable();
+    _load_ostable();
+
+    my ($os, $cpu);
+
+    foreach my $_cpu (@cpu) {
+	if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
+	    $cpu = $_cpu;
+	    last;
+	}
+    }
+
+    foreach my $_os (@os) {
+	if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
+	    $os = $_os;
+	    last;
+	}
+    }
+
+    return if !defined($cpu) || !defined($os);
+    return (split(/-/, $os, 3), $cpu);
+}
+
+=item $multiarch = gnutriplet_to_multiarch($gnutriplet)
+
+Map a GNU triplet into a Debian multiarch triplet.
+
+=cut
+
+sub gnutriplet_to_multiarch($)
+{
+    my $gnu = shift;
+    my ($cpu, $cdr) = split(/-/, $gnu, 2);
+
+    if ($cpu =~ /^i[4567]86$/) {
+	return "i386-$cdr";
+    } else {
+	return $gnu;
+    }
+}
+
+=item $multiarch = debarch_to_multiarch($arch)
+
+Map a Debian architecture into a Debian multiarch triplet.
+
+=cut
+
+sub debarch_to_multiarch($)
+{
+    my $arch = shift;
+
+    return gnutriplet_to_multiarch(debarch_to_gnutriplet($arch));
+}
+
+sub debtuple_to_debarch(@)
+{
+    my ($abi, $libc, $os, $cpu) = @_;
+
+    _load_tupletable();
+
+    if (!defined $abi || !defined $libc || !defined $os || !defined $cpu) {
+	return;
+    } elsif (exists $debtuple_to_debarch{"$abi-$libc-$os-$cpu"}) {
+	return $debtuple_to_debarch{"$abi-$libc-$os-$cpu"};
+    } else {
+	return;
+    }
+}
+
+sub debarch_to_debtuple($)
+{
+    my $arch = shift;
+
+    return if not defined $arch;
+
+    _load_tupletable();
+
+    if ($arch =~ /^linux-([^-]*)/) {
+	# XXX: Might disappear in the future, not sure yet.
+	$arch = $1;
+    }
+
+    my $tuple = $debarch_to_debtuple{$arch};
+
+    if (defined($tuple)) {
+        my @tuple = split /-/, $tuple, 4;
+        return @tuple if wantarray;
+        return {
+            abi => $tuple[0],
+            libc => $tuple[1],
+            os => $tuple[2],
+            cpu => $tuple[3],
+        };
+    } else {
+	return;
+    }
+}
+
+=item $gnutriplet = debarch_to_gnutriplet($arch)
+
+Map a Debian architecture into a GNU triplet.
+
+=cut
+
+sub debarch_to_gnutriplet($)
+{
+    my $arch = shift;
+
+    return debtuple_to_gnutriplet(debarch_to_debtuple($arch));
+}
+
+=item $arch = gnutriplet_to_debarch($gnutriplet)
+
+Map a GNU triplet into a Debian architecture.
+
+=cut
+
+sub gnutriplet_to_debarch($)
+{
+    my $gnu = shift;
+
+    return debtuple_to_debarch(gnutriplet_to_debtuple($gnu));
+}
+
+sub debwildcard_to_debtuple($)
+{
+    my $arch = shift;
+    my @tuple = split /-/, $arch, 4;
+
+    if (any { $_ eq 'any' } @tuple) {
+	if (scalar @tuple == 4) {
+	    return @tuple;
+	} elsif (scalar @tuple == 3) {
+	    return ('any', @tuple);
+	} elsif (scalar @tuple == 2) {
+	    return ('any', 'any', @tuple);
+	} else {
+	    return ('any', 'any', 'any', 'any');
+	}
+    } else {
+	return debarch_to_debtuple($arch);
+    }
+}
+
+sub debarch_to_abiattrs($)
+{
+    my $arch = shift;
+    my ($abi, $libc, $os, $cpu) = debarch_to_debtuple($arch);
+
+    if (defined($cpu)) {
+        _load_abitable();
+
+        return ($abibits{$abi} // $cpubits{$cpu}, $cpuendian{$cpu});
+    } else {
+        return;
+    }
+}
+
+sub debarch_to_cpubits($)
+{
+    my $arch = shift;
+    my (undef, undef, undef, $cpu) = debarch_to_debtuple($arch);
+
+    if (defined $cpu) {
+        return $cpubits{$cpu};
+    } else {
+        return;
+    }
+}
+
+=item $bool = debarch_eq($arch_a, $arch_b)
+
+Evaluate the equality of a Debian architecture, by comparing with another
+Debian architecture. No wildcard matching is performed.
+
+=cut
+
+sub debarch_eq($$)
+{
+    my ($a, $b) = @_;
+
+    return 1 if ($a eq $b);
+
+    my @a = debarch_to_debtuple($a);
+    my @b = debarch_to_debtuple($b);
+
+    return 0 if scalar @a != 4 or scalar @b != 4;
+
+    return $a[0] eq $b[0] && $a[1] eq $b[1] && $a[2] eq $b[2] && $a[3] eq $b[3];
+}
+
+=item $bool = debarch_is($arch, $arch_wildcard)
+
+Evaluate the identity of a Debian architecture, by matching with an
+architecture wildcard.
+
+=cut
+
+sub debarch_is($$)
+{
+    my ($real, $alias) = @_;
+
+    return 1 if ($alias eq $real or $alias eq 'any');
+
+    my @real = debarch_to_debtuple($real);
+    my @alias = debwildcard_to_debtuple($alias);
+
+    return 0 if scalar @real != 4 or scalar @alias != 4;
+
+    if (($alias[0] eq $real[0] || $alias[0] eq 'any') &&
+        ($alias[1] eq $real[1] || $alias[1] eq 'any') &&
+        ($alias[2] eq $real[2] || $alias[2] eq 'any') &&
+        ($alias[3] eq $real[3] || $alias[3] eq 'any')) {
+	return 1;
+    }
+
+    return 0;
+}
+
+=item $bool = debarch_is_wildcard($arch)
+
+Evaluate whether a Debian architecture is an architecture wildcard.
+
+=cut
+
+sub debarch_is_wildcard($)
+{
+    my $arch = shift;
+
+    return 0 if $arch eq 'all';
+
+    my @tuple = debwildcard_to_debtuple($arch);
+
+    return 0 if scalar @tuple != 4;
+    return 1 if any { $_ eq 'any' } @tuple;
+    return 0;
+}
+
+=item $bool = debarch_is_illegal($arch, %options)
+
+Validate an architecture name.
+
+If the "positive" option is set to a true value, only positive architectures
+will be accepted, otherwise negated architectures are allowed.
+
+=cut
+
+sub debarch_is_illegal
+{
+    my ($arch, %opts) = @_;
+    my $arch_re = qr/[a-zA-Z0-9][a-zA-Z0-9-]*/;
+
+    if ($opts{positive}) {
+        return $arch !~ m/^$arch_re$/;
+    } else {
+        return $arch !~ m/^!?$arch_re$/;
+    }
+}
+
+=item $bool = debarch_is_concerned($arch, @arches)
+
+Evaluate whether a Debian architecture applies to the list of architecture
+restrictions, as usually found in dependencies inside square brackets.
+
+=cut
+
+sub debarch_is_concerned
+{
+    my ($host_arch, @arches) = @_;
+
+    my $seen_arch = 0;
+    foreach my $arch (@arches) {
+        $arch = lc $arch;
+
+        if ($arch =~ /^!/) {
+            my $not_arch = $arch;
+            $not_arch =~ s/^!//;
+
+            if (debarch_is($host_arch, $not_arch)) {
+                $seen_arch = 0;
+                last;
+            } else {
+                # !arch includes by default all other arches
+                # unless they also appear in a !otherarch
+                $seen_arch = 1;
+            }
+        } elsif (debarch_is($host_arch, $arch)) {
+            $seen_arch = 1;
+            last;
+        }
+    }
+    return $seen_arch;
+}
+
+=item @array = debarch_list_parse($arch_list, %options)
+
+Parse an architecture list.
+
+If the "positive" option is set to a true value, only positive architectures
+will be accepted, otherwise negated architectures are allowed.
+
+=cut
+
+sub debarch_list_parse
+{
+    my ($arch_list, %opts) = @_;
+    my @arch_list = split ' ', $arch_list;
+
+    foreach my $arch (@arch_list) {
+        if (debarch_is_illegal($arch, %opts)) {
+            error(g_("'%s' is not a legal architecture in list '%s'"),
+                  $arch, $arch_list);
+        }
+    }
+
+    return @arch_list;
+}
+
+1;
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.03 (dpkg 1.19.1)
+
+New argument: Accept a "positive" option in debarch_is_illegal() and
+debarch_list_parse().
+
+=head2 Version 1.02 (dpkg 1.18.19)
+
+New import tags: ":all", ":getters", ":parsers", ":mappers", ":operators".
+
+=head2 Version 1.01 (dpkg 1.18.5)
+
+New functions: debarch_is_illegal(), debarch_list_parse().
+
+=head2 Version 1.00 (dpkg 1.18.2)
+
+Mark the module as public.
+
+=head1 SEE ALSO
+
+dpkg-architecture(1).
diff --git a/scripts/Dpkg/Build/Info.pm b/scripts/Dpkg/Build/Info.pm
new file mode 100644
index 0000000..d789a36
--- /dev/null
+++ b/scripts/Dpkg/Build/Info.pm
@@ -0,0 +1,97 @@
+# Copyright © 2016-2022 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/>.
+
+package Dpkg::Build::Info;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+our @EXPORT_OK = qw(
+    get_build_env_whitelist
+    get_build_env_allowed
+);
+
+use Exporter qw(import);
+
+use Dpkg::BuildInfo;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Build::Info - handle build information
+
+=head1 DESCRIPTION
+
+The Dpkg::Build::Info module provides functions to handle the build
+information.
+
+This module is deprecated, use Dpkg::BuildInfo instead.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @envvars = get_build_env_allowed()
+
+Get an array with the allowed list of environment variables that can affect
+the build, but are still not privacy revealing.
+
+This is a deprecated alias for Dpkg::BuildInfo::get_build_env_allowed().
+
+=cut
+
+sub get_build_env_allowed {
+    #warnings::warnif('deprecated',
+    #    'Dpkg::Build::Info::get_build_env_allowed() is deprecated, ' .
+    #    'use Dpkg::BuildInfo::get_build_env_allowed() instead');
+    return Dpkg::BuildInfo::get_build_env_allowed();
+}
+
+=item @envvars = get_build_env_whitelist()
+
+This is a deprecated alias for Dpkg::BuildInfo::get_build_env_allowed().
+
+=cut
+
+sub get_build_env_whitelist {
+    warnings::warnif('deprecated',
+        'Dpkg::Build::Info::get_build_env_whitelist() is deprecated, ' .
+        'use Dpkg::BuildInfo::get_build_env_allowed() instead');
+    return Dpkg::BuildInfo::get_build_env_allowed();
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.21.14)
+
+Deprecate module: replaced by Dpkg::BuildInfo.
+
+=head2 Version 1.01 (dpkg 1.20.1)
+
+New function: get_build_env_allowed().
+
+Deprecated function: get_build_env_whitelist().
+
+=head2 Version 1.00 (dpkg 1.18.14)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildEnv.pm b/scripts/Dpkg/BuildEnv.pm
new file mode 100644
index 0000000..1b6295b
--- /dev/null
+++ b/scripts/Dpkg/BuildEnv.pm
@@ -0,0 +1,113 @@
+# Copyright © 2012 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/>.
+
+package Dpkg::BuildEnv;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+my %env_modified = ();
+my %env_accessed = ();
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildEnv - track build environment
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildEnv module is used by dpkg-buildflags to track the build
+environment variables being used and modified.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item set($varname, $value)
+
+Update the build environment variable $varname with value $value. Record
+it as being accessed and modified.
+
+=cut
+
+sub set {
+    my ($varname, $value) = @_;
+    $env_modified{$varname} = 1;
+    $env_accessed{$varname} = 1;
+    $ENV{$varname} = $value;
+}
+
+=item get($varname)
+
+Get the build environment variable $varname value. Record it as being
+accessed.
+
+=cut
+
+sub get {
+    my $varname = shift;
+    $env_accessed{$varname} = 1;
+    return $ENV{$varname};
+}
+
+=item has($varname)
+
+Return a boolean indicating whether the environment variable exists.
+Record it as being accessed.
+
+=cut
+
+sub has {
+    my $varname = shift;
+    $env_accessed{$varname} = 1;
+    return exists $ENV{$varname};
+}
+
+=item @list = list_accessed()
+
+Returns a list of all environment variables that have been accessed.
+
+=cut
+
+sub list_accessed {
+    my @list = sort keys %env_accessed;
+    return @list;
+}
+
+=item @list = list_modified()
+
+Returns a list of all environment variables that have been modified.
+
+=cut
+
+sub list_modified {
+    my @list = sort keys %env_modified;
+    return @list;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm
new file mode 100644
index 0000000..5975bb0
--- /dev/null
+++ b/scripts/Dpkg/BuildFlags.pm
@@ -0,0 +1,612 @@
+# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2022 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/>.
+
+package Dpkg::BuildFlags;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.06';
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::BuildEnv;
+use Dpkg::ErrorHandling;
+use Dpkg::Vendor qw(run_vendor_hook);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildFlags - query build flags
+
+=head1 DESCRIPTION
+
+This class is used by dpkg-buildflags and can be used
+to query the same information.
+
+=head1 METHODS
+
+=over 4
+
+=item $bf = Dpkg::BuildFlags->new()
+
+Create a new Dpkg::BuildFlags object. It will be initialized based
+on the value of several configuration files and environment variables.
+
+If the option B<vendor_defaults> is set to false, then no vendor defaults are
+initialized (it defaults to true).
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+    };
+    bless $self, $class;
+
+    $opts{vendor_defaults} //= 1;
+
+    if ($opts{vendor_defaults}) {
+        $self->load_vendor_defaults();
+    } else {
+        $self->_init_vendor_defaults();
+    }
+    return $self;
+}
+
+sub _init_vendor_defaults {
+    my $self = shift;
+
+    $self->{features} = {};
+    $self->{builtins} = {};
+    $self->{optvals} = {};
+    $self->{flags} = {
+	ASFLAGS => '',
+	CPPFLAGS => '',
+	CFLAGS   => '',
+	CXXFLAGS => '',
+	OBJCFLAGS   => '',
+	OBJCXXFLAGS => '',
+	GCJFLAGS => '',
+	DFLAGS   => '',
+	FFLAGS   => '',
+	FCFLAGS  => '',
+	LDFLAGS  => '',
+    };
+    $self->{origin} = {
+	ASFLAGS => 'vendor',
+	CPPFLAGS => 'vendor',
+	CFLAGS   => 'vendor',
+	CXXFLAGS => 'vendor',
+	OBJCFLAGS   => 'vendor',
+	OBJCXXFLAGS => 'vendor',
+	GCJFLAGS => 'vendor',
+	DFLAGS   => 'vendor',
+	FFLAGS   => 'vendor',
+	FCFLAGS  => 'vendor',
+	LDFLAGS  => 'vendor',
+    };
+    $self->{maintainer} = {
+	ASFLAGS => 0,
+	CPPFLAGS => 0,
+	CFLAGS   => 0,
+	CXXFLAGS => 0,
+	OBJCFLAGS   => 0,
+	OBJCXXFLAGS => 0,
+	GCJFLAGS => 0,
+	DFLAGS   => 0,
+	FFLAGS   => 0,
+	FCFLAGS  => 0,
+	LDFLAGS  => 0,
+    };
+}
+
+=item $bf->load_vendor_defaults()
+
+Reset the flags stored to the default set provided by the vendor.
+
+=cut
+
+sub load_vendor_defaults {
+    my $self = shift;
+
+    $self->_init_vendor_defaults();
+
+    # The vendor hook will add the feature areas build flags.
+    run_vendor_hook('update-buildflags', $self);
+}
+
+=item $bf->load_system_config()
+
+Update flags from the system configuration.
+
+=cut
+
+sub load_system_config {
+    my $self = shift;
+
+    $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system');
+}
+
+=item $bf->load_user_config()
+
+Update flags from the user configuration.
+
+=cut
+
+sub load_user_config {
+    my $self = shift;
+
+    my $confdir = $ENV{XDG_CONFIG_HOME};
+    $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
+    if (length $confdir) {
+        $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
+    }
+}
+
+=item $bf->load_environment_config()
+
+Update flags based on user directives stored in the environment. See
+dpkg-buildflags(1) for details.
+
+=cut
+
+sub load_environment_config {
+    my $self = shift;
+
+    foreach my $flag (keys %{$self->{flags}}) {
+	my $envvar = 'DEB_' . $flag . '_SET';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->set($flag, Dpkg::BuildEnv::get($envvar), 'env');
+	}
+	$envvar = 'DEB_' . $flag . '_STRIP';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->strip($flag, Dpkg::BuildEnv::get($envvar), 'env');
+	}
+	$envvar = 'DEB_' . $flag . '_APPEND';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->append($flag, Dpkg::BuildEnv::get($envvar), 'env');
+	}
+	$envvar = 'DEB_' . $flag . '_PREPEND';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->prepend($flag, Dpkg::BuildEnv::get($envvar), 'env');
+	}
+    }
+}
+
+=item $bf->load_maintainer_config()
+
+Update flags based on maintainer directives stored in the environment. See
+dpkg-buildflags(1) for details.
+
+=cut
+
+sub load_maintainer_config {
+    my $self = shift;
+
+    foreach my $flag (keys %{$self->{flags}}) {
+	my $envvar = 'DEB_' . $flag . '_MAINT_SET';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->set($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
+	}
+	$envvar = 'DEB_' . $flag . '_MAINT_STRIP';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->strip($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
+	}
+	$envvar = 'DEB_' . $flag . '_MAINT_APPEND';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->append($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
+	}
+	$envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
+	if (Dpkg::BuildEnv::has($envvar)) {
+	    $self->prepend($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
+	}
+    }
+}
+
+
+=item $bf->load_config()
+
+Call successively load_system_config(), load_user_config(),
+load_environment_config() and load_maintainer_config() to update the
+default build flags defined by the vendor.
+
+=cut
+
+sub load_config {
+    my $self = shift;
+
+    $self->load_system_config();
+    $self->load_user_config();
+    $self->load_environment_config();
+    $self->load_maintainer_config();
+}
+
+=item $bf->unset($flag)
+
+Unset the build flag $flag, so that it will not be known anymore.
+
+=cut
+
+sub unset {
+    my ($self, $flag) = @_;
+
+    delete $self->{flags}->{$flag};
+    delete $self->{origin}->{$flag};
+    delete $self->{maintainer}->{$flag};
+}
+
+=item $bf->set($flag, $value, $source, $maint)
+
+Update the build flag $flag with value $value and record its origin as
+$source (if defined). Record it as maintainer modified if $maint is
+defined and true.
+
+=cut
+
+sub set {
+    my ($self, $flag, $value, $src, $maint) = @_;
+    $self->{flags}->{$flag} = $value;
+    $self->{origin}->{$flag} = $src if defined $src;
+    $self->{maintainer}->{$flag} = $maint if $maint;
+}
+
+=item $bf->set_feature($area, $feature, $enabled)
+
+Update the boolean state of whether a specific feature within a known
+feature area has been enabled. The only currently known feature areas
+are "future", "qa", "sanitize", "optimize", "hardening" and "reproducible".
+
+=cut
+
+sub set_feature {
+    my ($self, $area, $feature, $enabled) = @_;
+    $self->{features}{$area}{$feature} = $enabled;
+}
+
+=item $bf->get_feature($area, $feature)
+
+Returns the value for the given feature within a known feature area.
+This is relevant for builtin features where the feature has a ternary
+state of true, false and undef, and where the latter cannot be retrieved
+with use_feature().
+
+=cut
+
+sub get_feature {
+    my ($self, $area, $feature) = @_;
+
+    return if ! $self->has_features($area);
+    return $self->{features}{$area}{$feature};
+}
+
+=item $bf->use_feature($area, $feature)
+
+Returns true if the given feature within a known feature areas has been
+enabled, and false otherwise.
+The only currently recognized feature areas are "future", "qa", "sanitize",
+"optimize", "hardening" and "reproducible".
+
+=cut
+
+sub use_feature {
+    my ($self, $area, $feature) = @_;
+
+    return 0 if ! $self->has_features($area);
+    return 0 if ! $self->{features}{$area}{$feature};
+    return 1;
+}
+
+=item $bf->set_builtin($area, $feature, $enabled)
+
+Update the boolean state of whether a specific feature within a known
+feature area is handled (even if only in some architectures) as a builtin
+default by the compiler.
+
+=cut
+
+sub set_builtin {
+    my ($self, $area, $feature, $enabled) = @_;
+    $self->{builtins}{$area}{$feature} = $enabled;
+}
+
+=item $bf->get_builtins($area)
+
+Return, for the given area, a hash with keys as feature names, and values
+as booleans indicating whether the feature is handled as a builtin default
+by the compiler or not. Only features that might be handled as builtins on
+some architectures are returned as part of the hash. Missing features mean
+they are currently never handled as builtins by the compiler.
+
+=cut
+
+sub get_builtins {
+    my ($self, $area) = @_;
+    return if ! exists $self->{builtins}{$area};
+    return %{$self->{builtins}{$area}};
+}
+
+=item $bf->set_option_value($option, $value)
+
+B<Private> method to set the value of a build option.
+Do not use outside of the dpkg project.
+
+=cut
+
+sub set_option_value {
+    my ($self, $option, $value) = @_;
+
+    $self->{optvals}{$option} = $value;
+}
+
+=item $bf->get_option_value($option)
+
+B<Private> method to get the value of a build option.
+Do not use outside of the dpkg project.
+
+=cut
+
+sub get_option_value {
+    my ($self, $option) = @_;
+
+    return $self->{optvals}{$option};
+}
+
+=item $bf->strip($flag, $value, $source, $maint)
+
+Update the build flag $flag by stripping the flags listed in $value and
+record its origin as $source (if defined). Record it as maintainer modified
+if $maint is defined and true.
+
+=cut
+
+sub strip {
+    my ($self, $flag, $value, $src, $maint) = @_;
+
+    my %strip = map { $_ => 1 } split /\s+/, $value;
+
+    $self->{flags}->{$flag} = join q{ }, grep {
+        ! exists $strip{$_}
+    } split q{ }, $self->{flags}{$flag};
+    $self->{origin}->{$flag} = $src if defined $src;
+    $self->{maintainer}->{$flag} = $maint if $maint;
+}
+
+=item $bf->append($flag, $value, $source, $maint)
+
+Append the options listed in $value to the current value of the flag $flag.
+Record its origin as $source (if defined). Record it as maintainer modified
+if $maint is defined and true.
+
+=cut
+
+sub append {
+    my ($self, $flag, $value, $src, $maint) = @_;
+    if (length($self->{flags}->{$flag})) {
+        $self->{flags}->{$flag} .= " $value";
+    } else {
+        $self->{flags}->{$flag} = $value;
+    }
+    $self->{origin}->{$flag} = $src if defined $src;
+    $self->{maintainer}->{$flag} = $maint if $maint;
+}
+
+=item $bf->prepend($flag, $value, $source, $maint)
+
+Prepend the options listed in $value to the current value of the flag $flag.
+Record its origin as $source (if defined). Record it as maintainer modified
+if $maint is defined and true.
+
+=cut
+
+sub prepend {
+    my ($self, $flag, $value, $src, $maint) = @_;
+    if (length($self->{flags}->{$flag})) {
+        $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag};
+    } else {
+        $self->{flags}->{$flag} = $value;
+    }
+    $self->{origin}->{$flag} = $src if defined $src;
+    $self->{maintainer}->{$flag} = $maint if $maint;
+}
+
+
+=item $bf->update_from_conffile($file, $source)
+
+Update the current build flags based on the configuration directives
+contained in $file. See dpkg-buildflags(1) for the format of the directives.
+
+$source is the origin recorded for any build flag set or modified.
+
+=cut
+
+sub update_from_conffile {
+    my ($self, $file, $src) = @_;
+    local $_;
+
+    return unless -e $file;
+    open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
+    while (<$conf_fh>) {
+        chomp;
+        next if /^\s*#/; # Skip comments
+        next if /^\s*$/; # Skip empty lines
+        if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
+            my ($op, $flag, $value) = ($1, $2, $3);
+            unless (exists $self->{flags}->{$flag}) {
+                warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag);
+                $self->{flags}->{$flag} = '';
+            }
+            if (lc($op) eq 'set') {
+                $self->set($flag, $value, $src);
+            } elsif (lc($op) eq 'strip') {
+                $self->strip($flag, $value, $src);
+            } elsif (lc($op) eq 'append') {
+                $self->append($flag, $value, $src);
+            } elsif (lc($op) eq 'prepend') {
+                $self->prepend($flag, $value, $src);
+            }
+        } else {
+            warning(g_('line %d of %s is invalid, it has been ignored'), $., $file);
+        }
+    }
+    close($conf_fh);
+}
+
+=item $bf->get($flag)
+
+Return the value associated to the flag. It might be undef if the
+flag doesn't exist.
+
+=cut
+
+sub get {
+    my ($self, $key) = @_;
+    return $self->{flags}{$key};
+}
+
+=item $bf->get_feature_areas()
+
+Return the feature areas (i.e. the area values has_features will return
+true for).
+
+=cut
+
+sub get_feature_areas {
+    my $self = shift;
+
+    return keys %{$self->{features}};
+}
+
+=item $bf->get_features($area)
+
+Return, for the given area, a hash with keys as feature names, and values
+as booleans indicating whether the feature is enabled or not.
+
+=cut
+
+sub get_features {
+    my ($self, $area) = @_;
+    return %{$self->{features}{$area}};
+}
+
+=item $bf->get_origin($flag)
+
+Return the origin associated to the flag. It might be undef if the
+flag doesn't exist.
+
+=cut
+
+sub get_origin {
+    my ($self, $key) = @_;
+    return $self->{origin}{$key};
+}
+
+=item $bf->is_maintainer_modified($flag)
+
+Return true if the flag is modified by the maintainer.
+
+=cut
+
+sub is_maintainer_modified {
+    my ($self, $key) = @_;
+    return $self->{maintainer}{$key};
+}
+
+=item $bf->has_features($area)
+
+Returns true if the given area of features is known, and false otherwise.
+The only currently recognized feature areas are "future", "qa", "sanitize",
+"optimize", "hardening" and "reproducible".
+
+=cut
+
+sub has_features {
+    my ($self, $area) = @_;
+    return exists $self->{features}{$area};
+}
+
+=item $bf->has($option)
+
+Returns a boolean indicating whether the flags exists in the object.
+
+=cut
+
+sub has {
+    my ($self, $key) = @_;
+    return exists $self->{flags}{$key};
+}
+
+=item @flags = $bf->list()
+
+Returns the list of flags stored in the object.
+
+=cut
+
+sub list {
+    my $self = shift;
+    my @list = sort keys %{$self->{flags}};
+    return @list;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.06 (dpkg 1.21.15)
+
+New method: $bf->get_feature().
+
+=head2 Version 1.05 (dpkg 1.21.14)
+
+New option: 'vendor_defaults' in new().
+
+New methods: $bf->load_vendor_defaults(), $bf->use_feature(),
+$bf->set_builtin(), $bf->get_builtins().
+
+=head2 Version 1.04 (dpkg 1.20.0)
+
+New method: $bf->unset().
+
+=head2 Version 1.03 (dpkg 1.16.5)
+
+New method: $bf->get_feature_areas() to list possible values for
+$bf->get_features.
+
+New method $bf->is_maintainer_modified() and new optional parameter to
+$bf->set(), $bf->append(), $bf->prepend(), $bf->strip().
+
+=head2 Version 1.02 (dpkg 1.16.2)
+
+New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature().
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+New method: $bf->prepend() very similar to append(). Implement support of
+the prepend operation everywhere.
+
+New method: $bf->load_maintainer_config() that update the build flags
+based on the package maintainer directives.
+
+=head2 Version 1.00 (dpkg 1.15.7)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildInfo.pm b/scripts/Dpkg/BuildInfo.pm
new file mode 100644
index 0000000..7be6bc7
--- /dev/null
+++ b/scripts/Dpkg/BuildInfo.pm
@@ -0,0 +1,154 @@
+# Copyright © 2016-2022 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/>.
+
+package Dpkg::BuildInfo;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+our @EXPORT_OK = qw(
+    get_build_env_allowed
+);
+
+use Exporter qw(import);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildInfo - handle build information
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildInfo module provides functions to handle the build
+information.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @envvars = get_build_env_allowed()
+
+Get an array with the allowed list of environment variables that can affect
+the build, but are still not privacy revealing.
+
+=cut
+
+my @env_allowed = (
+    # Toolchain.
+    qw(
+        CC
+        CPP
+        CXX
+        OBJC
+        OBJCXX
+        PC
+        FC
+        M2C
+        AS
+        LD
+        AR
+        RANLIB
+        MAKE
+        AWK
+        LEX
+        YACC
+    ),
+    # Toolchain flags.
+    qw(
+        ASFLAGS
+        CFLAGS
+        CPPFLAGS
+        CXXFLAGS
+        OBJCFLAGS
+        OBJCXXFLAGS
+        GCJFLAGS
+        DFLAGS
+        FFLAGS
+        LDFLAGS
+        ARFLAGS
+        MAKEFLAGS
+    ),
+    # Dynamic linker, see ld(1).
+    qw(
+        LD_LIBRARY_PATH
+    ),
+    # Locale, see locale(1).
+    qw(
+        LANG
+        LC_ALL
+        LC_CTYPE
+        LC_NUMERIC
+        LC_TIME
+        LC_COLLATE
+        LC_MONETARY
+        LC_MESSAGES
+        LC_PAPER
+        LC_NAME
+        LC_ADDRESS
+        LC_TELEPHONE
+        LC_MEASUREMENT
+        LC_IDENTIFICATION
+    ),
+    # Build flags, see dpkg-buildpackage(1).
+    qw(
+        DEB_BUILD_OPTIONS
+        DEB_BUILD_PROFILES
+    ),
+    # DEB_flag_{SET,STRIP,APPEND,PREPEND} will be recorded after being merged
+    # with system config and user config.
+    # See deb-vendor(1).
+    qw(
+        DEB_VENDOR
+    ),
+    # See dpkg(1).
+    qw(
+        DPKG_ROOT
+        DPKG_ADMINDIR
+    ),
+    # See dpkg-architecture(1).
+    qw(
+        DPKG_DATADIR
+    ),
+    # See Dpkg::Vendor(3).
+    qw(
+        DPKG_ORIGINS_DIR
+    ),
+    # See dpkg-gensymbols(1).
+    qw(
+        DPKG_GENSYMBOLS_CHECK_LEVEL
+    ),
+    # See <https://reproducible-builds.org/specs/source-date-epoch>.
+    qw(
+        SOURCE_DATE_EPOCH
+    ),
+);
+
+sub get_build_env_allowed {
+    return @env_allowed;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.21.14)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildOptions.pm b/scripts/Dpkg/BuildOptions.pm
new file mode 100644
index 0000000..62a84ea
--- /dev/null
+++ b/scripts/Dpkg/BuildOptions.pm
@@ -0,0 +1,246 @@
+# Copyright © 2007 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2008, 2012-2017 Guillem Jover <guillem@debian.org>
+# Copyright © 2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::BuildOptions;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::BuildEnv;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildOptions - parse and update build options
+
+=head1 DESCRIPTION
+
+This class can be used to manipulate options stored
+in environment variables like DEB_BUILD_OPTIONS and
+DEB_BUILD_MAINT_OPTIONS.
+
+=head1 METHODS
+
+=over 4
+
+=item $bo = Dpkg::BuildOptions->new(%opts)
+
+Create a new Dpkg::BuildOptions object. It will be initialized based
+on the value of the environment variable named $opts{envvar} (or
+DEB_BUILD_OPTIONS if that option is not set).
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        options => {},
+	source => {},
+	envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
+    };
+    bless $self, $class;
+    $self->merge(Dpkg::BuildEnv::get($self->{envvar}), $self->{envvar});
+    return $self;
+}
+
+=item $bo->reset()
+
+Reset the object to not have any option (it's empty).
+
+=cut
+
+sub reset {
+    my $self = shift;
+    $self->{options} = {};
+    $self->{source} = {};
+}
+
+=item $bo->merge($content, $source)
+
+Merge the options set in $content and record that they come from the
+source $source. $source is mainly used in warning messages currently
+to indicate where invalid options have been detected.
+
+$content is a space separated list of options with optional assigned
+values like "nocheck parallel=2".
+
+=cut
+
+sub merge {
+    my ($self, $content, $source) = @_;
+    return 0 unless defined $content;
+    my $count = 0;
+    foreach (split(/\s+/, $content)) {
+	unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
+            warning(g_('invalid flag in %s: %s'), $source, $_);
+            next;
+        }
+	$count += $self->set($1, $2, $source);
+    }
+    return $count;
+}
+
+=item $bo->set($option, $value, [$source])
+
+Store the given option in the object with the given value. It's legitimate
+for a value to be undefined if the option is a simple boolean (its
+presence means true, its absence means false). The $source is optional
+and indicates where the option comes from.
+
+The known options have their values checked for sanity. Options without
+values have their value removed and options with invalid values are
+discarded.
+
+=cut
+
+sub set {
+    my ($self, $key, $value, $source) = @_;
+
+    # Sanity checks
+    if ($key =~ /^(terse|noopt|nostrip|nocheck)$/ && defined($value)) {
+	$value = undef;
+    } elsif ($key eq 'parallel')  {
+	$value //= '';
+	return 0 if $value !~ /^\d*$/;
+    }
+
+    $self->{options}{$key} = $value;
+    $self->{source}{$key} = $source;
+
+    return 1;
+}
+
+=item $bo->get($option)
+
+Return the value associated to the option. It might be undef even if the
+option exists. You might want to check with $bo->has($option) to verify if
+the option is stored in the object.
+
+=cut
+
+sub get {
+    my ($self, $key) = @_;
+    return $self->{options}{$key};
+}
+
+=item $bo->has($option)
+
+Returns a boolean indicating whether the option is stored in the object.
+
+=cut
+
+sub has {
+    my ($self, $key) = @_;
+    return exists $self->{options}{$key};
+}
+
+=item $bo->parse_features($option, $use_feature)
+
+Parse the $option values, as a set of known features to enable or disable,
+as specified in the $use_feature hash reference.
+
+Each feature is prefixed with a 'B<+>' or a 'B<->' character as a marker
+to enable or disable it. The special feature "B<all>" can be used to act
+on all known features.
+
+Unknown or malformed features will emit warnings.
+
+=cut
+
+sub parse_features {
+    my ($self, $option, $use_feature) = @_;
+
+    foreach my $feature (split(/,/, $self->get($option) // '')) {
+        $feature = lc $feature;
+        if ($feature =~ s/^([+-])//) {
+            my $value = ($1 eq '+') ? 1 : 0;
+            if ($feature eq 'all') {
+                $use_feature->{$_} = $value foreach keys %{$use_feature};
+            } else {
+                if (exists $use_feature->{$feature}) {
+                    $use_feature->{$feature} = $value;
+                } else {
+                    warning(g_('unknown %s feature in %s variable: %s'),
+                            $option, $self->{envvar}, $feature);
+                }
+            }
+        } else {
+            warning(g_('incorrect value in %s option of %s variable: %s'),
+                    $option, $self->{envvar}, $feature);
+        }
+    }
+}
+
+=item $string = $bo->output($fh)
+
+Return a string representation of the build options suitable to be
+assigned to an environment variable. Can optionally output that string to
+the given filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $o = $self->{options};
+    my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
+    print { $fh } $res if defined $fh;
+    return $res;
+}
+
+=item $bo->export([$var])
+
+Export the build options to the given environment variable. If omitted,
+the environment variable defined at creation time is assumed. The value
+set to the variable is also returned.
+
+=cut
+
+sub export {
+    my ($self, $var) = @_;
+    $var //= $self->{envvar};
+    my $content = $self->output();
+    Dpkg::BuildEnv::set($var, $content);
+    return $content;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.18.19)
+
+New method: $bo->parse_features().
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+Enable to use another environment variable instead of DEB_BUILD_OPTIONS.
+Thus add support for the "envvar" option at creation time.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildProfiles.pm b/scripts/Dpkg/BuildProfiles.pm
new file mode 100644
index 0000000..df3ec48
--- /dev/null
+++ b/scripts/Dpkg/BuildProfiles.pm
@@ -0,0 +1,146 @@
+# Copyright © 2013 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/>.
+
+package Dpkg::BuildProfiles;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+our @EXPORT_OK = qw(
+    get_build_profiles
+    set_build_profiles
+    parse_build_profiles
+    evaluate_restriction_formula
+);
+
+use Exporter qw(import);
+use List::Util qw(any);
+
+use Dpkg::BuildEnv;
+
+my $cache_profiles;
+my @build_profiles;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildProfiles - handle build profiles
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildProfiles module provides functions to handle the build
+profiles.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @profiles = get_build_profiles()
+
+Get an array with the currently active build profiles, taken from
+the environment variable B<DEB_BUILD_PROFILES>.
+
+=cut
+
+sub get_build_profiles {
+    return @build_profiles if $cache_profiles;
+
+    if (Dpkg::BuildEnv::has('DEB_BUILD_PROFILES')) {
+        @build_profiles = split ' ', Dpkg::BuildEnv::get('DEB_BUILD_PROFILES');
+    }
+    $cache_profiles = 1;
+
+    return @build_profiles;
+}
+
+=item set_build_profiles(@profiles)
+
+Set C<@profiles> as the current active build profiles, by setting
+the environment variable B<DEB_BUILD_PROFILES>.
+
+=cut
+
+sub set_build_profiles {
+    my (@profiles) = @_;
+
+    $cache_profiles = 1;
+    @build_profiles = @profiles;
+    Dpkg::BuildEnv::set('DEB_BUILD_PROFILES', join ' ', @profiles);
+}
+
+=item @profiles = parse_build_profiles($string)
+
+Parses a build profiles specification, into an array of array references.
+
+=cut
+
+sub parse_build_profiles {
+    my $string = shift;
+
+    $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
+
+    return map { [ split ' ' ] } split /\s*>\s+<\s*/, $string;
+}
+
+=item evaluate_restriction_formula(\@formula, \@profiles)
+
+Evaluate whether a restriction formula of the form "<foo bar> <baz>", given as
+a nested array, is true or false, given the array of enabled build profiles.
+
+=cut
+
+sub evaluate_restriction_formula {
+    my ($formula, $profiles) = @_;
+
+    # Restriction formulas are in disjunctive normal form:
+    # (foo AND bar) OR (blub AND bla)
+    foreach my $restrlist (@{$formula}) {
+        my $seen_profile = 1;
+
+        foreach my $restriction (@$restrlist) {
+            next if $restriction !~ m/^(!)?(.+)/;
+
+            my $negated = defined $1 && $1 eq '!';
+            my $profile = $2;
+            my $found = any { $_ eq $profile } @{$profiles};
+
+            # If a negative set profile is encountered, stop processing.
+            # If a positive unset profile is encountered, stop processing.
+            if ($found == $negated) {
+                $seen_profile = 0;
+                last;
+            }
+        }
+
+        # This conjunction evaluated to true so we don't have to evaluate
+        # the others.
+        return 1 if $seen_profile;
+    }
+    return 0;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.17.17)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildTypes.pm b/scripts/Dpkg/BuildTypes.pm
new file mode 100644
index 0000000..9f20d0d
--- /dev/null
+++ b/scripts/Dpkg/BuildTypes.pm
@@ -0,0 +1,284 @@
+# Copyright © 2007 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2010, 2013-2016 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/>.
+
+package Dpkg::BuildTypes;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+our @EXPORT = qw(
+    BUILD_DEFAULT
+    BUILD_SOURCE
+    BUILD_ARCH_DEP
+    BUILD_ARCH_INDEP
+    BUILD_BINARY
+    BUILD_FULL
+    build_has_any
+    build_has_all
+    build_has_none
+    build_is
+    set_build_type
+    set_build_type_from_options
+    set_build_type_from_targets
+    get_build_options_from_type
+);
+
+use Exporter qw(import);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildTypes - track build types
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildTypes module is used by various tools to track and decide
+what artifacts need to be built.
+
+The build types are bit constants that are exported by default. Multiple
+types can be ORed.
+
+=head1 CONSTANTS
+
+=over 4
+
+=item BUILD_DEFAULT
+
+This build is the default.
+
+=item BUILD_SOURCE
+
+This build includes source artifacts.
+
+=item BUILD_ARCH_DEP
+
+This build includes architecture dependent binary artifacts.
+
+=item BUILD_ARCH_INDEP
+
+This build includes architecture independent binary artifacts.
+
+=item BUILD_BINARY
+
+This build includes binary artifacts.
+
+=item BUILD_FULL
+
+This build includes source and binary artifacts.
+
+=cut
+
+# Simple types.
+use constant {
+    BUILD_DEFAULT      => 1,
+    BUILD_SOURCE       => 2,
+    BUILD_ARCH_DEP     => 4,
+    BUILD_ARCH_INDEP   => 8,
+};
+
+# Composed types.
+use constant BUILD_BINARY => BUILD_ARCH_DEP | BUILD_ARCH_INDEP;
+use constant BUILD_FULL   => BUILD_BINARY | BUILD_SOURCE;
+
+my $current_type = BUILD_FULL | BUILD_DEFAULT;
+my $current_option = undef;
+
+my @build_types = qw(full source binary any all);
+my %build_types = (
+    full => BUILD_FULL,
+    source => BUILD_SOURCE,
+    binary => BUILD_BINARY,
+    any => BUILD_ARCH_DEP,
+    all => BUILD_ARCH_INDEP,
+);
+my %build_targets = (
+    'clean' => BUILD_SOURCE,
+    'build' => BUILD_BINARY,
+    'build-arch' => BUILD_ARCH_DEP,
+    'build-indep' => BUILD_ARCH_INDEP,
+    'binary' => BUILD_BINARY,
+    'binary-arch' => BUILD_ARCH_DEP,
+    'binary-indep' => BUILD_ARCH_INDEP,
+);
+
+=back
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item build_has_any($bits)
+
+Return a boolean indicating whether the current build type has any of the
+specified $bits.
+
+=cut
+
+sub build_has_any
+{
+    my ($bits) = @_;
+
+    return $current_type & $bits;
+}
+
+=item build_has_all($bits)
+
+Return a boolean indicating whether the current build type has all the
+specified $bits.
+
+=cut
+
+sub build_has_all
+{
+    my ($bits) = @_;
+
+    return ($current_type & $bits) == $bits;
+}
+
+=item build_has_none($bits)
+
+Return a boolean indicating whether the current build type has none of the
+specified $bits.
+
+=cut
+
+sub build_has_none
+{
+    my ($bits) = @_;
+
+    return !($current_type & $bits);
+}
+
+=item build_is($bits)
+
+Return a boolean indicating whether the current build type is the specified
+set of $bits.
+
+=cut
+
+sub build_is
+{
+    my ($bits) = @_;
+
+    return $current_type == $bits;
+}
+
+=item set_build_type($build_type, $build_option, %opts)
+
+Set the current build type to $build_type, which was specified via the
+$build_option command-line option.
+
+The function will check and abort on incompatible build type assignments,
+this behavior can be disabled by using the boolean option "nocheck".
+
+=cut
+
+sub set_build_type
+{
+    my ($build_type, $build_option, %opts) = @_;
+
+    usageerr(g_('cannot combine %s and %s'), $current_option, $build_option)
+        if not $opts{nocheck} and
+           build_has_none(BUILD_DEFAULT) and $current_type != $build_type;
+
+    $current_type = $build_type;
+    $current_option = $build_option;
+}
+
+=item set_build_type_from_options($build_types, $build_option, %opts)
+
+Set the current build type from a list of comma-separated build type
+components.
+
+The function will check and abort on incompatible build type assignments,
+this behavior can be disabled by using the boolean option "nocheck".
+
+=cut
+
+sub set_build_type_from_options
+{
+    my ($build_parts, $build_option, %opts) = @_;
+
+    my $build_type = 0;
+    foreach my $type (split /,/, $build_parts) {
+        usageerr(g_('unknown build type %s'), $type)
+            unless exists $build_types{$type};
+        $build_type |= $build_types{$type};
+    }
+
+    set_build_type($build_type, $build_option, %opts);
+}
+
+=item set_build_type_from_targets($build_targets, $build_option, %opts)
+
+Set the current build type from a list of comma-separated build target
+components.
+
+The function will check and abort on incompatible build type assignments,
+this behavior can be disabled by using the boolean option "nocheck".
+
+=cut
+
+sub set_build_type_from_targets
+{
+    my ($build_targets, $build_option, %opts) = @_;
+
+    my $build_type = 0;
+    foreach my $target (split /,/, $build_targets) {
+        $build_type |= $build_targets{$target} // BUILD_BINARY;
+    }
+
+    set_build_type($build_type, $build_option, %opts);
+}
+
+=item get_build_options_from_type()
+
+Get the current build type as a set of comma-separated string options.
+
+=cut
+
+sub get_build_options_from_type
+{
+    my $local_type = $current_type;
+
+    my @parts;
+    foreach my $type (@build_types) {
+        my $part_bits = $build_types{$type};
+        if (($local_type & $part_bits) == $part_bits) {
+            push @parts, $type;
+            $local_type &= ~$part_bits;
+        }
+    }
+
+    return join ',', @parts;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
new file mode 100644
index 0000000..ffa7fc2
--- /dev/null
+++ b/scripts/Dpkg/Changelog.pm
@@ -0,0 +1,775 @@
+# Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
+# Copyright © 2009       Raphaël Hertzog <hertzog@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/>.
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog - base class to implement a changelog parser
+
+=head1 DESCRIPTION
+
+Dpkg::Changelog is a class representing a changelog file
+as an array of changelog entries (Dpkg::Changelog::Entry).
+By deriving this class and implementing its parse method, you
+add the ability to fill this object with changelog entries.
+
+=cut
+
+package Dpkg::Changelog;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.00';
+
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(:DEFAULT report REPORT_WARN);
+use Dpkg::Control;
+use Dpkg::Control::Changelog;
+use Dpkg::Control::Fields;
+use Dpkg::Index;
+use Dpkg::Version;
+use Dpkg::Vendor qw(run_vendor_hook);
+
+use parent qw(Dpkg::Interface::Storable);
+
+use overload
+    '@{}' => sub { return $_[0]->{data} };
+
+=head1 METHODS
+
+=over 4
+
+=item $c = Dpkg::Changelog->new(%options)
+
+Creates a new changelog object.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	verbose => 1,
+	parse_errors => []
+    };
+    bless $self, $class;
+    $self->set_options(%opts);
+    return $self;
+}
+
+=item $c->set_options(%opts)
+
+Change the value of some options. "verbose" (defaults to 1) defines
+whether parse errors are displayed as warnings by default. "reportfile"
+is a string to use instead of the name of the file parsed, in particular
+in error messages. "range" defines the range of entries that we want to
+parse, the parser will stop as soon as it has parsed enough data to
+satisfy $c->get_range($opts{range}).
+
+=cut
+
+sub set_options {
+    my ($self, %opts) = @_;
+    $self->{$_} = $opts{$_} foreach keys %opts;
+}
+
+=item $count = $c->parse($fh, $description)
+
+Read the filehandle and parse a changelog in it. The data in the object is
+reset before parsing new data.
+
+Returns the number of changelog entries that have been parsed with success.
+
+This method needs to be implemented by one of the specialized changelog
+format subclasses.
+
+=item $count = $c->load($filename)
+
+Parse $filename contents for a changelog.
+
+Returns the number of changelog entries that have been parsed with success.
+
+=item $c->reset_parse_errors()
+
+Can be used to delete all information about errors occurred during
+previous L<parse> runs.
+
+=cut
+
+sub reset_parse_errors {
+    my $self = shift;
+    $self->{parse_errors} = [];
+}
+
+=item $c->parse_error($file, $line_nr, $error, [$line])
+
+Record a new parse error in $file at line $line_nr. The error message is
+specified with $error and a copy of the line can be recorded in $line.
+
+=cut
+
+sub parse_error {
+    my ($self, $file, $line_nr, $error, $line) = @_;
+
+    push @{$self->{parse_errors}}, [ $file, $line_nr, $error, $line ];
+
+    if ($self->{verbose}) {
+	if ($line) {
+	    warning("%20s(l$line_nr): $error\nLINE: $line", $file);
+	} else {
+	    warning("%20s(l$line_nr): $error", $file);
+	}
+    }
+}
+
+=item $c->get_parse_errors()
+
+Returns all error messages from the last L<parse> run.
+If called in scalar context returns a human readable
+string representation. If called in list context returns
+an array of arrays. Each of these arrays contains
+
+=over 4
+
+=item 1.
+
+a string describing the origin of the data (a filename usually). If the
+reportfile configuration option was given, its value will be used instead.
+
+=item 2.
+
+the line number where the error occurred
+
+=item 3.
+
+an error description
+
+=item 4.
+
+the original line
+
+=back
+
+=cut
+
+sub get_parse_errors {
+    my $self = shift;
+
+    if (wantarray) {
+	return @{$self->{parse_errors}};
+    } else {
+	my $res = '';
+	foreach my $e (@{$self->{parse_errors}}) {
+	    if ($e->[3]) {
+		$res .= report(REPORT_WARN, g_("%s(l%s): %s\nLINE: %s"), @$e);
+	    } else {
+		$res .= report(REPORT_WARN, g_('%s(l%s): %s'), @$e);
+	    }
+	}
+	return $res;
+    }
+}
+
+=item $c->set_unparsed_tail($tail)
+
+Add a string representing unparsed lines after the changelog entries.
+Use undef as $tail to remove the unparsed lines currently set.
+
+=item $c->get_unparsed_tail()
+
+Return a string representing the unparsed lines after the changelog
+entries. Returns undef if there's no such thing.
+
+=cut
+
+sub set_unparsed_tail {
+    my ($self, $tail) = @_;
+    $self->{unparsed_tail} = $tail;
+}
+
+sub get_unparsed_tail {
+    my $self = shift;
+    return $self->{unparsed_tail};
+}
+
+=item @{$c}
+
+Returns all the Dpkg::Changelog::Entry objects contained in this changelog
+in the order in which they have been parsed.
+
+=item $c->get_range($range)
+
+Returns an array (if called in list context) or a reference to an array of
+Dpkg::Changelog::Entry objects which each represent one entry of the
+changelog. $range is a hash reference describing the range of entries
+to return. See section L<"RANGE SELECTION">.
+
+=cut
+
+sub _sanitize_range {
+    my ($self, $r) = @_;
+    my $data = $self->{data};
+
+    if (defined($r->{offset}) and not defined($r->{count})) {
+	warning(g_("'offset' without 'count' has no effect")) if $self->{verbose};
+	delete $r->{offset};
+    }
+
+    ## no critic (ControlStructures::ProhibitUntilBlocks)
+    if ((defined($r->{count}) || defined($r->{offset})) &&
+        (defined($r->{from}) || defined($r->{since}) ||
+	 defined($r->{to}) || defined($r->{until})))
+    {
+	warning(g_("you can't combine 'count' or 'offset' with any other " .
+		   'range option')) if $self->{verbose};
+	delete $r->{from};
+	delete $r->{since};
+	delete $r->{to};
+	delete $r->{until};
+    }
+    if (defined($r->{from}) && defined($r->{since})) {
+	warning(g_("you can only specify one of 'from' and 'since', using " .
+		   "'since'")) if $self->{verbose};
+	delete $r->{from};
+    }
+    if (defined($r->{to}) && defined($r->{until})) {
+	warning(g_("you can only specify one of 'to' and 'until', using " .
+		   "'until'")) if $self->{verbose};
+	delete $r->{to};
+    }
+
+    # Handle non-existing versions
+    my (%versions, @versions);
+    foreach my $entry (@{$data}) {
+        my $version = $entry->get_version();
+        next unless defined $version;
+        $versions{$version->as_string()} = 1;
+        push @versions, $version->as_string();
+    }
+    if ((defined($r->{since}) and not exists $versions{$r->{since}})) {
+        warning(g_("'%s' option specifies non-existing version '%s'"), 'since', $r->{since});
+        warning(g_('use newest entry that is earlier than the one specified'));
+        foreach my $v (@versions) {
+            if (version_compare_relation($v, REL_LT, $r->{since})) {
+                $r->{since} = $v;
+                last;
+            }
+        }
+        if (not exists $versions{$r->{since}}) {
+            # No version was earlier, include all
+            warning(g_('none found, starting from the oldest entry'));
+            delete $r->{since};
+            $r->{from} = $versions[-1];
+        }
+    }
+    if ((defined($r->{from}) and not exists $versions{$r->{from}})) {
+        warning(g_("'%s' option specifies non-existing version '%s'"), 'from', $r->{from});
+        warning(g_('use oldest entry that is later than the one specified'));
+        my $oldest;
+        foreach my $v (@versions) {
+            if (version_compare_relation($v, REL_GT, $r->{from})) {
+                $oldest = $v;
+            }
+        }
+        if (defined($oldest)) {
+            $r->{from} = $oldest;
+        } else {
+            warning(g_("no such entry found, ignoring '%s' parameter '%s'"), 'from', $r->{from});
+            delete $r->{from}; # No version was oldest
+        }
+    }
+    if (defined($r->{until}) and not exists $versions{$r->{until}}) {
+        warning(g_("'%s' option specifies non-existing version '%s'"), 'until', $r->{until});
+        warning(g_('use oldest entry that is later than the one specified'));
+        my $oldest;
+        foreach my $v (@versions) {
+            if (version_compare_relation($v, REL_GT, $r->{until})) {
+                $oldest = $v;
+            }
+        }
+        if (defined($oldest)) {
+            $r->{until} = $oldest;
+        } else {
+            warning(g_("no such entry found, ignoring '%s' parameter '%s'"), 'until', $r->{until});
+            delete $r->{until}; # No version was oldest
+        }
+    }
+    if (defined($r->{to}) and not exists $versions{$r->{to}}) {
+        warning(g_("'%s' option specifies non-existing version '%s'"), 'to', $r->{to});
+        warning(g_('use newest entry that is earlier than the one specified'));
+        foreach my $v (@versions) {
+            if (version_compare_relation($v, REL_LT, $r->{to})) {
+                $r->{to} = $v;
+                last;
+            }
+        }
+        if (not exists $versions{$r->{to}}) {
+            # No version was earlier
+            warning(g_("no such entry found, ignoring '%s' parameter '%s'"), 'to', $r->{to});
+            delete $r->{to};
+        }
+    }
+
+    if (defined($r->{since}) and $data->[0]->get_version() eq $r->{since}) {
+	warning(g_("'since' option specifies most recent version '%s', ignoring"), $r->{since});
+	delete $r->{since};
+    }
+    if (defined($r->{until}) and $data->[-1]->get_version() eq $r->{until}) {
+	warning(g_("'until' option specifies oldest version '%s', ignoring"), $r->{until});
+	delete $r->{until};
+    }
+    ## use critic
+}
+
+sub get_range {
+    my ($self, $range) = @_;
+    $range //= {};
+    my $res = $self->_data_range($range);
+    return unless defined $res;
+    if (wantarray) {
+        return reverse @{$res} if $range->{reverse};
+        return @{$res};
+    } else {
+	return $res;
+    }
+}
+
+sub _is_full_range {
+    my ($self, $range) = @_;
+
+    return 1 if $range->{all};
+
+    # If no range delimiter is specified, we want everything.
+    foreach my $delim (qw(since until from to count offset)) {
+        return 0 if exists $range->{$delim};
+    }
+
+    return 1;
+}
+
+sub _data_range {
+    my ($self, $range) = @_;
+
+    my $data = $self->{data} or return;
+
+    return [ @$data ] if $self->_is_full_range($range);
+
+    $self->_sanitize_range($range);
+
+    my ($start, $end);
+    if (defined($range->{count})) {
+	my $offset = $range->{offset} // 0;
+	my $count = $range->{count};
+	# Convert count/offset in start/end
+	if ($offset > 0) {
+	    $offset -= ($count < 0);
+	} elsif ($offset < 0) {
+	    $offset = $#$data + ($count > 0) + $offset;
+	} else {
+	    $offset = $#$data if $count < 0;
+	}
+	$start = $end = $offset;
+	$start += $count+1 if $count < 0;
+	$end += $count-1 if $count > 0;
+	# Check limits
+	$start = 0 if $start < 0;
+	return if $start > $#$data;
+	$end = $#$data if $end > $#$data;
+	return if $end < 0;
+	$end = $start if $end < $start;
+	return [ @{$data}[$start .. $end] ];
+    }
+
+    ## no critic (ControlStructures::ProhibitUntilBlocks)
+    my @result;
+    my $include = 1;
+    $include = 0 if defined($range->{to}) or defined($range->{until});
+    foreach my $entry (@{$data}) {
+	my $v = $entry->get_version();
+	$include = 1 if defined($range->{to}) and $v eq $range->{to};
+	last if defined($range->{since}) and $v eq $range->{since};
+
+	push @result, $entry if $include;
+
+	$include = 1 if defined($range->{until}) and $v eq $range->{until};
+	last if defined($range->{from}) and $v eq $range->{from};
+    }
+    ## use critic
+
+    return \@result if scalar(@result);
+    return;
+}
+
+=item $c->abort_early()
+
+Returns true if enough data have been parsed to be able to return all
+entries selected by the range set at creation (or with set_options).
+
+=cut
+
+sub abort_early {
+    my $self = shift;
+
+    my $data = $self->{data} or return;
+    my $r = $self->{range} or return;
+    my $count = $r->{count} // 0;
+    my $offset = $r->{offset} // 0;
+
+    return if $self->_is_full_range($r);
+    return if $offset < 0 or $count < 0;
+    if (defined($r->{count})) {
+	if ($offset > 0) {
+	    $offset -= ($count < 0);
+	}
+	my $start = my $end = $offset;
+	$end += $count-1 if $count > 0;
+	return ($start < @$data and $end < @$data);
+    }
+
+    return unless defined($r->{since}) or defined($r->{from});
+    foreach my $entry (@{$data}) {
+	my $v = $entry->get_version();
+	return 1 if defined($r->{since}) and $v eq $r->{since};
+	return 1 if defined($r->{from}) and $v eq $r->{from};
+    }
+
+    return;
+}
+
+=item $str = $c->output()
+
+=item "$c"
+
+Returns a string representation of the changelog (it's a concatenation of
+the string representation of the individual changelog entries).
+
+=item $c->output($fh)
+
+Output the changelog to the given filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    foreach my $entry (@{$self}) {
+	my $text = $entry->output();
+	print { $fh } $text if defined $fh;
+	$str .= $text if defined wantarray;
+    }
+    my $text = $self->get_unparsed_tail();
+    if (defined $text) {
+	print { $fh } $text if defined $fh;
+	$str .= $text if defined wantarray;
+    }
+    return $str;
+}
+
+=item $c->save($filename)
+
+Save the changelog in the given file.
+
+=cut
+
+our ( @URGENCIES, %URGENCIES );
+BEGIN {
+    @URGENCIES = qw(
+        low
+        medium
+        high
+        critical
+        emergency
+    );
+    my $i = 1;
+    %URGENCIES = map { $_ => $i++ } @URGENCIES;
+}
+
+sub _format_dpkg {
+    my ($self, $range) = @_;
+
+    my @data = $self->get_range($range) or return;
+    my $src = shift @data;
+
+    my $f = Dpkg::Control::Changelog->new();
+    $f->{Urgency} = $src->get_urgency() || 'unknown';
+    $f->{Source} = $src->get_source() || 'unknown';
+    $f->{Version} = $src->get_version() // 'unknown';
+    $f->{Distribution} = join(' ', $src->get_distributions());
+    $f->{Maintainer} = $src->get_maintainer() // '';
+    $f->{Date} = $src->get_timestamp() // '';
+    $f->{Timestamp} = $src->get_timepiece && $src->get_timepiece->epoch // '';
+    $f->{Changes} = $src->get_dpkg_changes();
+
+    # handle optional fields
+    my $opts = $src->get_optional_fields();
+    my %closes;
+    foreach (keys %$opts) {
+	if (/^Urgency$/i) { # Already dealt
+	} elsif (/^Closes$/i) {
+	    $closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes}));
+	} else {
+	    field_transfer_single($opts, $f);
+	}
+    }
+
+    foreach my $bin (@data) {
+	my $oldurg = $f->{Urgency} // '';
+	my $oldurgn = $URGENCIES{$f->{Urgency}} // -1;
+	my $newurg = $bin->get_urgency() // '';
+	my $newurgn = $URGENCIES{$newurg} // -1;
+	$f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
+	$f->{Changes} .= "\n" . $bin->get_dpkg_changes();
+
+	# handle optional fields
+	$opts = $bin->get_optional_fields();
+	foreach (keys %$opts) {
+	    if (/^Closes$/i) {
+		$closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes}));
+	    } elsif (not exists $f->{$_}) { # Don't overwrite an existing field
+		field_transfer_single($opts, $f);
+	    }
+	}
+    }
+
+    if (scalar keys %closes) {
+	$f->{Closes} = join ' ', sort { $a <=> $b } keys %closes;
+    }
+    run_vendor_hook('post-process-changelog-entry', $f);
+
+    return $f;
+}
+
+sub _format_rfc822 {
+    my ($self, $range) = @_;
+
+    my @data = $self->get_range($range) or return;
+    my @ctrl;
+
+    foreach my $entry (@data) {
+	my $f = Dpkg::Control::Changelog->new();
+	$f->{Urgency} = $entry->get_urgency() || 'unknown';
+	$f->{Source} = $entry->get_source() || 'unknown';
+	$f->{Version} = $entry->get_version() // 'unknown';
+	$f->{Distribution} = join(' ', $entry->get_distributions());
+	$f->{Maintainer} = $entry->get_maintainer() // '';
+	$f->{Date} = $entry->get_timestamp() // '';
+	$f->{Timestamp} = $entry->get_timepiece && $entry->get_timepiece->epoch // '';
+	$f->{Changes} = $entry->get_dpkg_changes();
+
+	# handle optional fields
+	my $opts = $entry->get_optional_fields();
+	foreach (keys %$opts) {
+	    field_transfer_single($opts, $f) unless exists $f->{$_};
+	}
+
+        run_vendor_hook('post-process-changelog-entry', $f);
+
+        push @ctrl, $f;
+    }
+
+    return @ctrl;
+}
+
+=item $control = $c->format_range($format, $range)
+
+Formats the changelog into Dpkg::Control::Changelog objects representing the
+entries selected by the optional range specifier (see L<"RANGE SELECTION">
+for details). In scalar context returns a Dpkg::Index object containing the
+selected entries, in list context returns an array of Dpkg::Control::Changelog
+objects.
+
+With format B<dpkg> the returned Dpkg::Control::Changelog object is coalesced
+from the entries in the changelog that are part of the range requested,
+with the fields described below, but considering that "selected entry"
+means the first entry of the selected range.
+
+With format B<rfc822> each returned Dpkg::Control::Changelog objects
+represents one entry in the changelog that is part of the range requested,
+with the fields described below, but considering that "selected entry"
+means for each entry.
+
+The different formats return undef if no entries are matched. The following
+fields are contained in the object(s) returned:
+
+=over 4
+
+=item Source
+
+package name (selected entry)
+
+=item Version
+
+packages' version (selected entry)
+
+=item Distribution
+
+target distribution (selected entry)
+
+=item Urgency
+
+urgency (highest of all entries in range)
+
+=item Maintainer
+
+person that created the (selected) entry
+
+=item Date
+
+date of the (selected) entry
+
+=item Timestamp
+
+date of the (selected) entry as a timestamp in seconds since the epoch
+
+=item Closes
+
+bugs closed by the (selected) entry/entries, sorted by bug number
+
+=item Changes
+
+content of the (selected) entry/entries
+
+=back
+
+=cut
+
+sub format_range {
+    my ($self, $format, $range) = @_;
+
+    my @ctrl;
+
+    if ($format eq 'dpkg') {
+        @ctrl = $self->_format_dpkg($range);
+    } elsif ($format eq 'rfc822') {
+        @ctrl = $self->_format_rfc822($range);
+    } else {
+        croak "unknown changelog output format $format";
+    }
+
+    if (wantarray) {
+        return @ctrl;
+    } else {
+        my $index = Dpkg::Index->new(type => CTRL_CHANGELOG);
+
+        foreach my $f (@ctrl) {
+            $index->add($f);
+        }
+
+        return $index;
+    }
+}
+
+=back
+
+=head1 RANGE SELECTION
+
+A range selection is described by a hash reference where
+the allowed keys and values are described below.
+
+The following options take a version number as value.
+
+=over 4
+
+=item since
+
+Causes changelog information from all versions strictly
+later than B<version> to be used.
+
+=item until
+
+Causes changelog information from all versions strictly
+earlier than B<version> to be used.
+
+=item from
+
+Similar to C<since> but also includes the information for the
+specified B<version> itself.
+
+=item to
+
+Similar to C<until> but also includes the information for the
+specified B<version> itself.
+
+=back
+
+The following options don't take version numbers as values:
+
+=over 4
+
+=item all
+
+If set to a true value, all entries of the changelog are returned,
+this overrides all other options.
+
+=item count
+
+Expects a signed integer as value. Returns C<value> entries from the
+top of the changelog if set to a positive integer, and C<abs(value)>
+entries from the tail if set to a negative integer.
+
+=item offset
+
+Expects a signed integer as value. Changes the starting point for
+C<count>, either counted from the top (positive integer) or from
+the tail (negative integer). C<offset> has no effect if C<count>
+wasn't given as well.
+
+=back
+
+Some examples for the above options. Imagine an example changelog with
+entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1.
+
+  Range                        Included entries
+  -----                        ----------------
+  since => '2.0'               3.1, 3.0, 2.2
+  until => '2.0'               1.3, 1.2
+  from  => '2.0'               3.1, 3.0, 2.2, 2.1, 2.0
+  to    => '2.0'               2.0, 1.3, 1.2
+  count =>  2                  3.1, 3.0
+  count => -2                  1.3, 1.2
+  count =>  3, offset => 2     2.2, 2.1, 2.0
+  count =>  2, offset => -3    2.0, 1.3
+  count => -2, offset => 3     3.0, 2.2
+  count => -2, offset => -3    2.2, 2.1
+
+Any combination of one option of C<since> and C<from> and one of
+C<until> and C<to> returns the intersection of the two results
+with only one of the options specified.
+
+=head1 CHANGES
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove methods: $c->dpkg(), $c->rfc822().
+
+=head2 Version 1.01 (dpkg 1.18.8)
+
+New method: $c->format_range().
+
+Deprecated methods: $c->dpkg(), $c->rfc822().
+
+New field Timestamp in output formats.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+1;
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
new file mode 100644
index 0000000..44f0be0
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Debian.pm
@@ -0,0 +1,271 @@
+# Copyright © 1996 Ian Jackson
+# Copyright © 2005 Frank Lichtenheld <frank@lichtenheld.de>
+# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2017 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/>.
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog::Debian - parse Debian changelogs
+
+=head1 DESCRIPTION
+
+This class represents a Debian changelog file as an array of changelog
+entries (Dpkg::Changelog::Entry::Debian).
+It implements the generic interface Dpkg::Changelog.
+Only methods specific to this implementation are described below,
+the rest are inherited.
+
+Dpkg::Changelog::Debian parses Debian changelogs as described in
+deb-changelog(5).
+
+The parser tries to ignore most cruft like # or /* */ style comments,
+RCS keywords, Vim modelines, Emacs local variables and stuff from
+older changelogs with other formats at the end of the file.
+NOTE: most of these are ignored silently currently, there is no
+parser error issued for them. This should become configurable in the
+future.
+
+=cut
+
+package Dpkg::Changelog::Debian;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Gettext;
+use Dpkg::File;
+use Dpkg::Changelog qw(:util);
+use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer);
+
+use parent qw(Dpkg::Changelog);
+
+use constant {
+    FIRST_HEADING => g_('first heading'),
+    NEXT_OR_EOF => g_('next heading or end of file'),
+    START_CHANGES => g_('start of change data'),
+    CHANGES_OR_TRAILER => g_('more change data or trailer'),
+};
+
+my $ancient_delimiter_re = qr{
+    ^
+    (?: # Ancient GNU style changelog entry with expanded date
+      (?:
+        \w+\s+                          # Day of week (abbreviated)
+        \w+\s+                          # Month name (abbreviated)
+        \d{1,2}                         # Day of month
+        \Q \E
+        \d{1,2}:\d{1,2}:\d{1,2}\s+      # Time
+        [\w\s]*                         # Timezone
+        \d{4}                           # Year
+      )
+      \s+
+      (?:.*)                            # Maintainer name
+      \s+
+      [<\(]
+        (?:.*)                          # Maintainer email
+      [\)>]
+    | # Old GNU style changelog entry with expanded date
+      (?:
+        \w+\s+                          # Day of week (abbreviated)
+        \w+\s+                          # Month name (abbreviated)
+        \d{1,2},?\s*                    # Day of month
+        \d{4}                           # Year
+      )
+      \s+
+      (?:.*)                            # Maintainer name
+      \s+
+      [<\(]
+        (?:.*)                          # Maintainer email
+      [\)>]
+    | # Ancient changelog header w/o key=value options
+      (?:\w[-+0-9a-z.]*)                # Package name
+      \Q \E
+      \(
+        (?:[^\(\) \t]+)                 # Package version
+      \)
+      \;?
+    | # Ancient changelog header
+      (?:[\w.+-]+)                      # Package name
+      [- ]
+      (?:\S+)                           # Package version
+      \ Debian
+      \ (?:\S+)                         # Package revision
+    |
+      Changes\ from\ version\ (?:.*)\ to\ (?:.*):
+    |
+      Changes\ for\ [\w.+-]+-[\w.+-]+:?\s*$
+    |
+      Old\ Changelog:\s*$
+    |
+      (?:\d+:)?
+      \w[\w.+~-]*:?
+      \s*$
+    )
+}xi;
+
+=head1 METHODS
+
+=over 4
+
+=item $count = $c->parse($fh, $description)
+
+Read the filehandle and parse a Debian changelog in it, to store the entries
+as an array of Dpkg::Changelog::Entry::Debian objects.
+Any previous entries in the object are reset before parsing new data.
+
+Returns the number of changelog entries that have been parsed with success.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $file) = @_;
+    $file = $self->{reportfile} if exists $self->{reportfile};
+
+    $self->reset_parse_errors;
+
+    $self->{data} = [];
+    $self->set_unparsed_tail(undef);
+
+    my $expect = FIRST_HEADING;
+    my $entry = Dpkg::Changelog::Entry::Debian->new();
+    my @blanklines = ();
+    # To make version unique, for example for using as id.
+    my $unknowncounter = 1;
+    local $_;
+
+    while (<$fh>) {
+	chomp;
+	if (match_header($_)) {
+	    unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
+		$self->parse_error($file, $.,
+		    sprintf(g_('found start of entry where expected %s'),
+		    $expect), "$_");
+	    }
+	    unless ($entry->is_empty) {
+		push @{$self->{data}}, $entry;
+		$entry = Dpkg::Changelog::Entry::Debian->new();
+		last if $self->abort_early();
+	    }
+	    $entry->set_part('header', $_);
+	    foreach my $error ($entry->parse_header()) {
+		$self->parse_error($file, $., $error, $_);
+	    }
+            $expect = START_CHANGES;
+	    @blanklines = ();
+	} elsif (m/^(?:;;\s*)?Local variables:/io) {
+            # Save any trailing Emacs variables at end of file.
+            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
+            last;
+	} elsif (m/^vim:/io) {
+            # Save any trailing Vim modelines at end of file.
+            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
+            last;
+	} elsif (m/^\$\w+:.*\$/o) {
+	    next; # skip stuff that look like a RCS keyword
+	} elsif (m/^\# /o) {
+	    next; # skip comments, even that's not supported
+	} elsif (m{^/\*.*\*/}o) {
+	    next; # more comments
+	} elsif (m/$ancient_delimiter_re/) {
+	    # save entries on old changelog format verbatim
+	    # we assume the rest of the file will be in old format once we
+	    # hit it for the first time
+	    $self->set_unparsed_tail("$_\n" . file_slurp($fh));
+	} elsif (m/^\S/) {
+	    $self->parse_error($file, $., g_('badly formatted heading line'), "$_");
+	} elsif (match_trailer($_)) {
+	    unless ($expect eq CHANGES_OR_TRAILER) {
+		$self->parse_error($file, $.,
+		    sprintf(g_('found trailer where expected %s'), $expect), "$_");
+	    }
+	    $entry->set_part('trailer', $_);
+	    $entry->extend_part('blank_after_changes', [ @blanklines ]);
+	    @blanklines = ();
+	    foreach my $error ($entry->parse_trailer()) {
+		$self->parse_error($file, $., $error, $_);
+	    }
+	    $expect = NEXT_OR_EOF;
+	} elsif (m/^ \-\-/) {
+	    $self->parse_error($file, $., g_('badly formatted trailer line'), "$_");
+	} elsif (m/^\s{2,}(?:\S)/) {
+	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
+		$self->parse_error($file, $., sprintf(g_('found change data' .
+		    ' where expected %s'), $expect), "$_");
+		if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
+		    # lets assume we have missed the actual header line
+		    push @{$self->{data}}, $entry;
+		    $entry = Dpkg::Changelog::Entry::Debian->new();
+		    $entry->set_part('header', 'unknown (unknown' . ($unknowncounter++) . ') unknown; urgency=unknown');
+		}
+	    }
+	    # Keep raw changes
+	    $entry->extend_part('changes', [ @blanklines, $_ ]);
+	    @blanklines = ();
+	    $expect = CHANGES_OR_TRAILER;
+	} elsif (!m/\S/) {
+	    if ($expect eq START_CHANGES) {
+		$entry->extend_part('blank_after_header', $_);
+		next;
+	    } elsif ($expect eq NEXT_OR_EOF) {
+		$entry->extend_part('blank_after_trailer', $_);
+		next;
+	    } elsif ($expect ne CHANGES_OR_TRAILER) {
+		$self->parse_error($file, $.,
+		    sprintf(g_('found blank line where expected %s'), $expect));
+	    }
+	    push @blanklines, $_;
+	} else {
+	    $self->parse_error($file, $., g_('unrecognized line'), "$_");
+	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
+		# lets assume change data if we expected it
+		$entry->extend_part('changes', [ @blanklines, $_]);
+		@blanklines = ();
+		$expect = CHANGES_OR_TRAILER;
+	    }
+	}
+    }
+
+    unless ($expect eq NEXT_OR_EOF) {
+        $self->parse_error($file, $.,
+                           sprintf(g_('found end of file where expected %s'),
+                                   $expect));
+    }
+    unless ($entry->is_empty) {
+	push @{$self->{data}}, $entry;
+    }
+
+    return scalar @{$self->{data}};
+}
+
+1;
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=head1 SEE ALSO
+
+Dpkg::Changelog
+
+=cut
diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
new file mode 100644
index 0000000..79b741d
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Entry.pm
@@ -0,0 +1,324 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Changelog::Entry;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Changelog;
+
+use overload
+    '""' => \&output,
+    'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" },
+    fallback => 1;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog::Entry - represents a changelog entry
+
+=head1 DESCRIPTION
+
+This class represents a changelog entry. It is composed
+of a set of lines with specific purpose: a header line, changes lines, a
+trailer line. Blank lines can be between those kind of lines.
+
+=head1 METHODS
+
+=over 4
+
+=item $entry = Dpkg::Changelog::Entry->new()
+
+Creates a new object. It doesn't represent a real changelog entry
+until one has been successfully parsed or built from scratch.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+
+    my $self = {
+	header => undef,
+	changes => [],
+	trailer => undef,
+	blank_after_header => [],
+	blank_after_changes => [],
+	blank_after_trailer => [],
+    };
+    bless $self, $class;
+    return $self;
+}
+
+=item $str = $entry->output()
+
+=item "$entry"
+
+Get a string representation of the changelog entry.
+
+=item $entry->output($fh)
+
+Print the string representation of the changelog entry to a
+filehandle.
+
+=cut
+
+sub _format_output_block {
+    my $lines = shift;
+    return join('', map { $_ . "\n" } @{$lines});
+}
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    $str .= $self->{header} . "\n" if defined($self->{header});
+    $str .= _format_output_block($self->{blank_after_header});
+    $str .= _format_output_block($self->{changes});
+    $str .= _format_output_block($self->{blank_after_changes});
+    $str .= $self->{trailer} . "\n" if defined($self->{trailer});
+    $str .= _format_output_block($self->{blank_after_trailer});
+    print { $fh } $str if defined $fh;
+    return $str;
+}
+
+=item $entry->get_part($part)
+
+Return either a string (for a single line) or an array ref (for multiple
+lines) corresponding to the requested part. $part can be
+"header, "changes", "trailer", "blank_after_header",
+"blank_after_changes", "blank_after_trailer".
+
+=cut
+
+sub get_part {
+    my ($self, $part) = @_;
+    croak "invalid part of changelog entry: $part" unless exists $self->{$part};
+    return $self->{$part};
+}
+
+=item $entry->set_part($part, $value)
+
+Set the value of the corresponding part. $value can be a string
+or an array ref.
+
+=cut
+
+sub set_part {
+    my ($self, $part, $value) = @_;
+    croak "invalid part of changelog entry: $part" unless exists $self->{$part};
+    if (ref($self->{$part})) {
+	if (ref($value)) {
+	    $self->{$part} = $value;
+	} else {
+	    $self->{$part} = [ $value ];
+	}
+    } else {
+	$self->{$part} = $value;
+    }
+}
+
+=item $entry->extend_part($part, $value)
+
+Concatenate $value at the end of the part. If the part is already a
+multi-line value, $value is added as a new line otherwise it's
+concatenated at the end of the current line.
+
+=cut
+
+sub extend_part {
+    my ($self, $part, $value, @rest) = @_;
+    croak "invalid part of changelog entry: $part" unless exists $self->{$part};
+    if (ref($self->{$part})) {
+	if (ref($value)) {
+	    push @{$self->{$part}}, @$value;
+	} else {
+	    push @{$self->{$part}}, $value;
+	}
+    } else {
+	if (defined($self->{$part})) {
+	    if (ref($value)) {
+		$self->{$part} = [ $self->{$part}, @$value ];
+	    } else {
+		$self->{$part} .= $value;
+	    }
+	} else {
+	    $self->{$part} = $value;
+	}
+    }
+}
+
+=item $is_empty = $entry->is_empty()
+
+Returns 1 if the changelog entry doesn't contain anything at all.
+Returns 0 as soon as it contains something in any of its non-blank
+parts.
+
+=cut
+
+sub is_empty {
+    my $self = shift;
+    return !(defined($self->{header}) || defined($self->{trailer}) ||
+	     scalar(@{$self->{changes}}));
+}
+
+=item $entry->normalize()
+
+Normalize the content. Strip whitespaces at end of lines, use a single
+empty line to separate each part.
+
+=cut
+
+sub normalize {
+    my $self = shift;
+    if (defined($self->{header})) {
+	$self->{header} =~ s/\s+$//g;
+	$self->{blank_after_header} = [''];
+    } else {
+	$self->{blank_after_header} = [];
+    }
+    if (scalar(@{$self->{changes}})) {
+	s/\s+$//g foreach @{$self->{changes}};
+	$self->{blank_after_changes} = [''];
+    } else {
+	$self->{blank_after_changes} = [];
+    }
+    if (defined($self->{trailer})) {
+	$self->{trailer} =~ s/\s+$//g;
+	$self->{blank_after_trailer} = [''];
+    } else {
+	$self->{blank_after_trailer} = [];
+    }
+}
+
+=item $src = $entry->get_source()
+
+Return the name of the source package associated to the changelog entry.
+
+=cut
+
+sub get_source {
+    return;
+}
+
+=item $ver = $entry->get_version()
+
+Return the version associated to the changelog entry.
+
+=cut
+
+sub get_version {
+    return;
+}
+
+=item @dists = $entry->get_distributions()
+
+Return a list of target distributions for this version.
+
+=cut
+
+sub get_distributions {
+    return;
+}
+
+=item $fields = $entry->get_optional_fields()
+
+Return a set of optional fields exposed by the changelog entry.
+It always returns a Dpkg::Control object (possibly empty though).
+
+=cut
+
+sub get_optional_fields {
+    return Dpkg::Control::Changelog->new();
+}
+
+=item $urgency = $entry->get_urgency()
+
+Return the urgency of the associated upload.
+
+=cut
+
+sub get_urgency {
+    return;
+}
+
+=item $maint = $entry->get_maintainer()
+
+Return the string identifying the person who signed this changelog entry.
+
+=cut
+
+sub get_maintainer {
+    return;
+}
+
+=item $time = $entry->get_timestamp()
+
+Return the timestamp of the changelog entry.
+
+=cut
+
+sub get_timestamp {
+    return;
+}
+
+=item $time = $entry->get_timepiece()
+
+Return the timestamp of the changelog entry as a Time::Piece object.
+
+This function might return undef if there was no timestamp.
+
+=cut
+
+sub get_timepiece {
+    return;
+}
+
+=item $str = $entry->get_dpkg_changes()
+
+Returns a string that is suitable for usage in a C<Changes> field
+in the output format of C<dpkg-parsechangelog>.
+
+=cut
+
+sub get_dpkg_changes {
+    my $self = shift;
+    my $header = $self->get_part('header') // '';
+    $header =~ s/\s+$//;
+    return "\n$header\n\n" . join("\n", @{$self->get_part('changes')});
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.18.8)
+
+New method: $entry->get_timepiece().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Changelog/Entry/Debian.pm b/scripts/Dpkg/Changelog/Entry/Debian.pm
new file mode 100644
index 0000000..fee5be8
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Entry/Debian.pm
@@ -0,0 +1,462 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2013 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/>.
+
+package Dpkg::Changelog::Entry::Debian;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.00';
+our @EXPORT_OK = qw(
+    match_header
+    match_trailer
+    find_closes
+);
+
+use Exporter qw(import);
+use Time::Piece;
+
+use Dpkg::Gettext;
+use Dpkg::Control::Fields;
+use Dpkg::Control::Changelog;
+use Dpkg::Changelog::Entry;
+use Dpkg::Version;
+
+use parent qw(Dpkg::Changelog::Entry);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog::Entry::Debian - represents a Debian changelog entry
+
+=head1 DESCRIPTION
+
+This class represents a Debian changelog entry.
+It implements the generic interface Dpkg::Changelog::Entry.
+Only functions specific to this implementation are described below,
+the rest are inherited.
+
+=cut
+
+my $name_chars = qr/[-+0-9a-z.]/i;
+
+# The matched content is the source package name ($1), the version ($2),
+# the target distributions ($3) and the options on the rest of the line ($4).
+my $regex_header = qr{
+    ^
+    (\w$name_chars*)                    # Package name
+    \ \(([^\(\) \t]+)\)                 # Package version
+    ((?:\s+$name_chars+)+)              # Target distribution
+    \;                                  # Separator
+    (.*?)                               # Key=Value options
+    \s*$                                # Trailing space
+}xi;
+
+# The matched content is the maintainer name ($1), its email ($2),
+# some blanks ($3) and the timestamp ($4), which is decomposed into
+# day of week ($6), date-time ($7) and this into month name ($8).
+my $regex_trailer = qr<
+    ^
+    \ \-\-                              # Trailer marker
+    \ (.*)                              # Maintainer name
+    \ \<(.*)\>                          # Maintainer email
+    (\ \ ?)                             # Blanks
+    (
+      ((\w+)\,\s*)?                     # Day of week (abbreviated)
+      (
+        \d{1,2}\s+                      # Day of month
+        (\w+)\s+                        # Month name (abbreviated)
+        \d{4}\s+                        # Year
+        \d{1,2}:\d\d:\d\d\s+[-+]\d{4}   # ISO 8601 date
+      )
+    )
+    \s*$                                # Trailing space
+>xo;
+
+my %week_day = map { $_ => 1 } qw(Mon Tue Wed Thu Fri Sat Sun);
+my @month_abbrev = qw(
+    Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
+);
+my %month_abbrev = map { $_ => 1 } @month_abbrev;
+my @month_name = qw(
+    January February March April May June July
+    August September October November December
+);
+my %month_name = map { $month_name[$_] => $month_abbrev[$_] } 0 .. 11;
+
+=head1 METHODS
+
+=over 4
+
+=item @items = $entry->get_change_items()
+
+Return a list of change items. Each item contains at least one line.
+A change line starting with an asterisk denotes the start of a new item.
+Any change line like "C<[ Raphaël Hertzog ]>" is treated like an item of its
+own even if it starts a set of items attributed to this person (the
+following line necessarily starts a new item).
+
+=cut
+
+sub get_change_items {
+    my $self = shift;
+    my (@items, @blanks, $item);
+    foreach my $line (@{$self->get_part('changes')}) {
+	if ($line =~ /^\s*\*/) {
+	    push @items, $item if defined $item;
+	    $item = "$line\n";
+	} elsif ($line =~ /^\s*\[\s[^\]]+\s\]\s*$/) {
+	    push @items, $item if defined $item;
+	    push @items, "$line\n";
+	    $item = undef;
+	    @blanks = ();
+	} elsif ($line =~ /^\s*$/) {
+	    push @blanks, "$line\n";
+	} else {
+	    if (defined $item) {
+		$item .= "@blanks$line\n";
+	    } else {
+		$item = "$line\n";
+	    }
+	    @blanks = ();
+	}
+    }
+    push @items, $item if defined $item;
+    return @items;
+}
+
+=item @errors = $entry->parse_header()
+
+=item @errors = $entry->parse_trailer()
+
+Return a list of errors. Each item in the list is an error message
+describing the problem. If the empty list is returned, no errors
+have been found.
+
+=cut
+
+sub parse_header {
+    my $self = shift;
+    my @errors;
+    if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+	$self->{header_source} = $1;
+
+	my $version = Dpkg::Version->new($2);
+	my ($ok, $msg) = version_check($version);
+	if ($ok) {
+	    $self->{header_version} = $version;
+	} else {
+	    push @errors, sprintf(g_("version '%s' is invalid: %s"), $version, $msg);
+	}
+
+	@{$self->{header_dists}} = split ' ', $3;
+
+	my $options = $4;
+	$options =~ s/^\s+//;
+	my $f = Dpkg::Control::Changelog->new();
+	foreach my $opt (split(/\s*,\s*/, $options)) {
+	    unless ($opt =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i) {
+		push @errors, sprintf(g_("bad key-value after ';': '%s'"), $opt);
+		next;
+	    }
+	    my ($k, $v) = (field_capitalize($1), $2);
+	    if (exists $f->{$k}) {
+		push @errors, sprintf(g_('repeated key-value %s'), $k);
+	    } else {
+		$f->{$k} = $v;
+	    }
+	    if ($k eq 'Urgency') {
+		push @errors, sprintf(g_('badly formatted urgency value: %s'), $v)
+		    unless ($v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i);
+	    } elsif ($k eq 'Binary-Only') {
+		push @errors, sprintf(g_('bad binary-only value: %s'), $v)
+		    unless ($v eq 'yes');
+	    } elsif ($k =~ m/^X[BCS]+-/i) {
+	    } else {
+		push @errors, sprintf(g_('unknown key-value %s'), $k);
+	    }
+	}
+	$self->{header_fields} = $f;
+    } else {
+	push @errors, g_("the header doesn't match the expected regex");
+    }
+    return @errors;
+}
+
+sub parse_trailer {
+    my $self = shift;
+    my @errors;
+    if (defined($self->{trailer}) and $self->{trailer} =~ $regex_trailer) {
+	$self->{trailer_maintainer} = "$1 <$2>";
+
+	if ($3 ne '  ') {
+	    push @errors, g_('badly formatted trailer line');
+	}
+
+	# Validate the week day. Date::Parse used to ignore it, but Time::Piece
+	# is much more strict and it does not gracefully handle bogus values.
+	if (defined $5 and not exists $week_day{$6}) {
+	    push @errors, sprintf(g_('ignoring invalid week day \'%s\''), $6);
+	}
+
+	# Ignore the week day ('%a, '), as we have validated it above.
+	local $ENV{LC_ALL} = 'C';
+	eval {
+	    my $tp = Time::Piece->strptime($7, '%d %b %Y %T %z');
+	    $self->{trailer_timepiece} = $tp;
+	} or do {
+	    # Validate the month. Date::Parse used to accept both abbreviated
+	    # and full months, but Time::Piece strptime() implementation only
+	    # matches the abbreviated one with %b, which is what we want anyway.
+	    if (not exists $month_abbrev{$8}) {
+	        # We have to nest the conditionals because May is the same in
+	        # full and abbreviated forms!
+	        if (exists $month_name{$8}) {
+	            push @errors, sprintf(g_('uses full \'%s\' instead of abbreviated month name \'%s\''),
+	                                  $8, $month_name{$8});
+	        } else {
+	            push @errors, sprintf(g_('invalid abbreviated month name \'%s\''), $8);
+	        }
+	    }
+	    push @errors, sprintf(g_("cannot parse non-conformant date '%s'"), $7);
+	};
+	$self->{trailer_timestamp_date} = $4;
+    } else {
+	push @errors, g_("the trailer doesn't match the expected regex");
+    }
+    return @errors;
+}
+
+=item $entry->normalize()
+
+Normalize the content. Strip whitespaces at end of lines, use a single
+empty line to separate each part.
+
+=cut
+
+sub normalize {
+    my $self = shift;
+    $self->SUPER::normalize();
+    #XXX: recreate header/trailer
+}
+
+=item $src = $entry->get_source()
+
+Return the name of the source package associated to the changelog entry.
+
+=cut
+
+sub get_source {
+    my $self = shift;
+
+    return $self->{header_source};
+}
+
+=item $ver = $entry->get_version()
+
+Return the version associated to the changelog entry.
+
+=cut
+
+sub get_version {
+    my $self = shift;
+
+    return $self->{header_version};
+}
+
+=item @dists = $entry->get_distributions()
+
+Return a list of target distributions for this version.
+
+=cut
+
+sub get_distributions {
+    my $self = shift;
+
+    if (defined $self->{header_dists}) {
+        return @{$self->{header_dists}} if wantarray;
+        return $self->{header_dists}[0];
+    }
+    return;
+}
+
+=item $fields = $entry->get_optional_fields()
+
+Return a set of optional fields exposed by the changelog entry.
+It always returns a Dpkg::Control object (possibly empty though).
+
+=cut
+
+sub get_optional_fields {
+    my $self = shift;
+    my $f;
+
+    if (defined $self->{header_fields}) {
+        $f = $self->{header_fields};
+    } else {
+        $f = Dpkg::Control::Changelog->new();
+    }
+
+    my @closes = find_closes(join("\n", @{$self->{changes}}));
+    if (@closes) {
+	$f->{Closes} = join(' ', @closes);
+    }
+
+    return $f;
+}
+
+=item $urgency = $entry->get_urgency()
+
+Return the urgency of the associated upload.
+
+=cut
+
+sub get_urgency {
+    my $self = shift;
+    my $f = $self->get_optional_fields();
+    if (exists $f->{Urgency}) {
+	$f->{Urgency} =~ s/\s.*$//;
+	return lc($f->{Urgency});
+    }
+    return;
+}
+
+=item $maint = $entry->get_maintainer()
+
+Return the string identifying the person who signed this changelog entry.
+
+=cut
+
+sub get_maintainer {
+    my $self = shift;
+
+    return $self->{trailer_maintainer};
+}
+
+=item $time = $entry->get_timestamp()
+
+Return the timestamp of the changelog entry.
+
+=cut
+
+sub get_timestamp {
+    my $self = shift;
+
+    return $self->{trailer_timestamp_date};
+}
+
+=item $time = $entry->get_timepiece()
+
+Return the timestamp of the changelog entry as a Time::Piece object.
+
+This function might return undef if there was no timestamp.
+
+=cut
+
+sub get_timepiece {
+    my $self = shift;
+
+    return $self->{trailer_timepiece};
+}
+
+=back
+
+=head1 UTILITY FUNCTIONS
+
+=over 4
+
+=item $bool = match_header($line)
+
+Checks if the line matches a valid changelog header line.
+
+=cut
+
+sub match_header {
+    my $line = shift;
+
+    return $line =~ /$regex_header/;
+}
+
+=item $bool = match_trailer($line)
+
+Checks if the line matches a valid changelog trailing line.
+
+=cut
+
+sub match_trailer {
+    my $line = shift;
+
+    return $line =~ /$regex_trailer/;
+}
+
+=item @closed_bugs = find_closes($changes)
+
+Takes one string as argument and finds "Closes: #123456, #654321" statements
+as supported by the Debian Archive software in it. Returns all closed bug
+numbers in an array.
+
+=cut
+
+sub find_closes {
+    my $changes = shift;
+    my %closes;
+
+    while ($changes && ($changes =~ m{
+               closes:\s*
+               (?:bug)?\#?\s?\d+
+               (?:,\s*(?:bug)?\#?\s?\d+)*
+           }pigx)) {
+        $closes{$_} = 1 foreach (${^MATCH} =~ /\#?\s?(\d+)/g);
+    }
+
+    my @closes = sort { $a <=> $b } keys %closes;
+    return @closes;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove methods: $entry->check_header(), $entry->check_trailer().
+
+Hide variables: $regex_header, $regex_trailer.
+
+=head2 Version 1.03 (dpkg 1.18.8)
+
+New methods: $entry->get_timepiece().
+
+=head2 Version 1.02 (dpkg 1.18.5)
+
+New methods: $entry->parse_header(), $entry->parse_trailer().
+
+Deprecated methods: $entry->check_header(), $entry->check_trailer().
+
+=head2 Version 1.01 (dpkg 1.17.2)
+
+New functions: match_header(), match_trailer()
+
+Deprecated variables: $regex_header, $regex_trailer
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm
new file mode 100644
index 0000000..ec9e9ad
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Parse.pm
@@ -0,0 +1,197 @@
+# Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
+# Copyright © 2009       Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2010, 2012-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/>.
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog::Parse - generic changelog parser for dpkg-parsechangelog
+
+=head1 DESCRIPTION
+
+This module provides a set of functions which reproduce all the features
+of dpkg-parsechangelog.
+
+=cut
+
+package Dpkg::Changelog::Parse;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.01';
+our @EXPORT = qw(
+    changelog_parse
+);
+
+use Exporter qw(import);
+use List::Util qw(none);
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Changelog;
+
+sub _changelog_detect_format {
+    my $file = shift;
+    my $format = 'debian';
+
+    # Extract the format from the changelog file if possible
+    if ($file ne '-') {
+        local $_;
+
+        open my $format_fh, '<', $file
+            or syserr(g_('cannot open file %s'), $file);
+        if (-s $format_fh > 4096) {
+            seek $format_fh, -4096, 2
+                or syserr(g_('cannot seek into file %s'), $file);
+        }
+        while (<$format_fh>) {
+            $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
+        }
+        close $format_fh;
+    }
+
+    return $format;
+}
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $fields = changelog_parse(%opt)
+
+This function will parse a changelog. In list context, it returns as many
+Dpkg::Control objects as the parser did create. In scalar context, it will
+return only the first one. If the parser did not return any data, it will
+return an empty list in list context or undef on scalar context. If the
+parser failed, it will die. Any parse errors will be printed as warnings
+on standard error, but this can be disabled by passing $opt{verbose} to 0.
+
+The changelog file that is parsed is F<debian/changelog> by default but it
+can be overridden with $opt{file}. The changelog name used in output messages
+can be specified with $opt{label}, otherwise it will default to $opt{file}.
+The default output format is "dpkg" but it can be overridden with $opt{format}.
+
+The parsing itself is done by a parser module (searched in the standard
+perl library directories. That module is named according to the format that
+it is able to parse, with the name capitalized. By default it is either
+Dpkg::Changelog::Debian (from the "debian" format) or the format name looked
+up in the 40 last lines of the changelog itself (extracted with this perl
+regular expression "\schangelog-format:\s+([0-9a-z]+)\W"). But it can be
+overridden with $opt{changelogformat}.
+
+If $opt{compression} is false, the file will be loaded without compression
+support, otherwise by default compression support is disabled if the file
+is the default.
+
+All the other keys in %opt are forwarded to the parser module constructor.
+
+=cut
+
+sub changelog_parse {
+    my (%options) = @_;
+
+    $options{verbose} //= 1;
+    $options{file} //= 'debian/changelog';
+    $options{label} //= $options{file};
+    $options{changelogformat} //= _changelog_detect_format($options{file});
+    $options{format} //= 'dpkg';
+    $options{compression} //= $options{file} ne 'debian/changelog';
+
+    my @range_opts = qw(since until from to offset count reverse all);
+    $options{all} = 1 if exists $options{all};
+    if (none { defined $options{$_} } @range_opts) {
+        $options{count} = 1;
+    }
+    my $range;
+    foreach my $opt (@range_opts) {
+        $range->{$opt} = $options{$opt} if exists $options{$opt};
+    }
+
+    # Find the right changelog parser.
+    my $format = ucfirst lc $options{changelogformat};
+    my $changes;
+    eval qq{
+        pop \@INC if \$INC[-1] eq '.';
+        require Dpkg::Changelog::$format;
+        \$changes = Dpkg::Changelog::$format->new();
+    };
+    error(g_('changelog format %s is unknown: %s'), $format, $@) if $@;
+    error(g_('changelog format %s is not a Dpkg::Changelog class'), $format)
+        unless $changes->isa('Dpkg::Changelog');
+    $changes->set_options(reportfile => $options{label},
+                          verbose => $options{verbose},
+                          range => $range);
+
+    # Load and parse the changelog.
+    $changes->load($options{file}, compression => $options{compression})
+        or error(g_('fatal error occurred while parsing %s'), $options{file});
+
+    # Get the output into several Dpkg::Control objects.
+    my @res;
+    if ($options{format} eq 'dpkg') {
+        push @res, $changes->format_range('dpkg', $range);
+    } elsif ($options{format} eq 'rfc822') {
+        push @res, $changes->format_range('rfc822', $range);
+    } else {
+        error(g_('unknown output format %s'), $options{format});
+    }
+
+    if (wantarray) {
+        return @res;
+    } else {
+        return $res[0] if @res;
+        return;
+    }
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.01 (dpkg 1.20.6)
+
+New option: 'verbose' in changelog_parse().
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove functions: changelog_parse_debian(), changelog_parse_plugin().
+
+Remove warnings: For options 'forceplugin', 'libdir'.
+
+=head2 Version 1.03 (dpkg 1.19.0)
+
+New option: 'compression' in changelog_parse().
+
+=head2 Version 1.02 (dpkg 1.18.8)
+
+Deprecated functions: changelog_parse_debian(), changelog_parse_plugin().
+
+Obsolete options: forceplugin, libdir.
+
+=head2 Version 1.01 (dpkg 1.18.2)
+
+New functions: changelog_parse_debian(), changelog_parse_plugin().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm
new file mode 100644
index 0000000..4744447
--- /dev/null
+++ b/scripts/Dpkg/Checksums.pm
@@ -0,0 +1,430 @@
+# Copyright © 2008 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2008, 2012-2015 Guillem Jover <guillem@debian.org>
+# Copyright © 2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Checksums;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.04';
+our @EXPORT = qw(
+    checksums_is_supported
+    checksums_get_list
+    checksums_get_property
+);
+
+use Exporter qw(import);
+use Digest;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Checksums - generate and manipulate file checksums
+
+=head1 DESCRIPTION
+
+This module provides a class that can generate and manipulate
+various file checksums as well as some methods to query information
+about supported checksums.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=cut
+
+my $CHECKSUMS = {
+    md5 => {
+	name => 'MD5',
+	regex => qr/[0-9a-f]{32}/,
+	strong => 0,
+    },
+    sha1 => {
+	name => 'SHA-1',
+	regex => qr/[0-9a-f]{40}/,
+	strong => 0,
+    },
+    sha256 => {
+	name => 'SHA-256',
+	regex => qr/[0-9a-f]{64}/,
+	strong => 1,
+    },
+};
+
+=item @list = checksums_get_list()
+
+Returns the list of supported checksums algorithms.
+
+=cut
+
+sub checksums_get_list() {
+    my @list = sort keys %{$CHECKSUMS};
+    return @list;
+}
+
+=item $bool = checksums_is_supported($alg)
+
+Returns a boolean indicating whether the given checksum algorithm is
+supported. The checksum algorithm is case-insensitive.
+
+=cut
+
+sub checksums_is_supported($) {
+    my $alg = shift;
+    return exists $CHECKSUMS->{lc($alg)};
+}
+
+=item $value = checksums_get_property($alg, $property)
+
+Returns the requested property of the checksum algorithm. Returns undef if
+either the property or the checksum algorithm doesn't exist. Valid
+properties currently include "name" (returns the name of the digest
+algorithm), "regex" for the regular expression describing the common
+string representation of the checksum, and "strong" for a boolean describing
+whether the checksum algorithm is considered cryptographically strong.
+
+=cut
+
+sub checksums_get_property($$) {
+    my ($alg, $property) = @_;
+
+    return unless checksums_is_supported($alg);
+    return $CHECKSUMS->{lc($alg)}{$property};
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $ck = Dpkg::Checksums->new()
+
+Create a new Dpkg::Checksums object. This object is able to store
+the checksums of several files to later export them or verify them.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {};
+    bless $self, $class;
+    $self->reset();
+
+    return $self;
+}
+
+=item $ck->reset()
+
+Forget about all checksums stored. The object is again in the same state
+as if it was newly created.
+
+=cut
+
+sub reset {
+    my $self = shift;
+
+    $self->{files} = [];
+    $self->{checksums} = {};
+    $self->{size} = {};
+}
+
+=item $ck->add_from_file($filename, %opts)
+
+Add or verify checksums information for the file $filename. The file must
+exists for the call to succeed. If you don't want the given filename to
+appear when you later export the checksums you might want to set the "key"
+option with the public name that you want to use. Also if you don't want
+to generate all the checksums, you can pass an array reference of the
+wanted checksums in the "checksums" option.
+
+It the object already contains checksums information associated the
+filename (or key), it will error out if the newly computed information
+does not match what's stored, and the caller did not request that it be
+updated with the boolean "update" option.
+
+=cut
+
+sub add_from_file {
+    my ($self, $file, %opts) = @_;
+    my $key = exists $opts{key} ? $opts{key} : $file;
+    my @alg;
+    if (exists $opts{checksums}) {
+	push @alg, map { lc } @{$opts{checksums}};
+    } else {
+	push @alg, checksums_get_list();
+    }
+
+    push @{$self->{files}}, $key unless exists $self->{size}{$key};
+    (my @s = stat($file)) or syserr(g_('cannot fstat file %s'), $file);
+    if (not $opts{update} and exists $self->{size}{$key} and
+        $self->{size}{$key} != $s[7]) {
+	error(g_('file %s has size %u instead of expected %u'),
+	      $file, $s[7], $self->{size}{$key});
+    }
+    $self->{size}{$key} = $s[7];
+
+    foreach my $alg (@alg) {
+        my $digest = Digest->new($CHECKSUMS->{$alg}{name});
+        open my $fh, '<', $file or syserr(g_('cannot open file %s'), $file);
+        $digest->addfile($fh);
+        close $fh;
+
+        my $newsum = $digest->hexdigest;
+        if (not $opts{update} and exists $self->{checksums}{$key}{$alg} and
+            $self->{checksums}{$key}{$alg} ne $newsum) {
+            error(g_('file %s has checksum %s instead of expected %s (algorithm %s)'),
+                  $file, $newsum, $self->{checksums}{$key}{$alg}, $alg);
+        }
+        $self->{checksums}{$key}{$alg} = $newsum;
+    }
+}
+
+=item $ck->add_from_string($alg, $value, %opts)
+
+Add checksums of type $alg that are stored in the $value variable.
+$value can be multi-lines, each line should be a space separated list
+of checksum, file size and filename. Leading or trailing spaces are
+not allowed.
+
+It the object already contains checksums information associated to the
+filenames, it will error out if the newly read information does not match
+what's stored, and the caller did not request that it be updated with
+the boolean "update" option.
+
+=cut
+
+sub add_from_string {
+    my ($self, $alg, $fieldtext, %opts) = @_;
+    $alg = lc($alg);
+    my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/;
+    my $regex = checksums_get_property($alg, 'regex');
+    my $checksums = $self->{checksums};
+
+    for my $checksum (split /\n */, $fieldtext) {
+	next if $checksum eq '';
+	unless ($checksum =~ m/^($regex)\s+(\d+)\s+($rx_fname)$/) {
+	    error(g_('invalid line in %s checksums string: %s'),
+		  $alg, $checksum);
+	}
+	my ($sum, $size, $file) = ($1, $2, $3);
+	if (not $opts{update} and exists($checksums->{$file}{$alg})
+	    and $checksums->{$file}{$alg} ne $sum) {
+	    error(g_("conflicting checksums '%s' and '%s' for file '%s'"),
+		  $checksums->{$file}{$alg}, $sum, $file);
+	}
+	if (not $opts{update} and exists $self->{size}{$file}
+	    and $self->{size}{$file} != $size) {
+	    error(g_("conflicting file sizes '%u' and '%u' for file '%s'"),
+		  $self->{size}{$file}, $size, $file);
+	}
+	push @{$self->{files}}, $file unless exists $self->{size}{$file};
+	$checksums->{$file}{$alg} = $sum;
+	$self->{size}{$file} = $size;
+    }
+}
+
+=item $ck->add_from_control($control, %opts)
+
+Read checksums from Checksums-* fields stored in the Dpkg::Control object
+$control. It uses $self->add_from_string() on the field values to do the
+actual work.
+
+If the option "use_files_for_md5" evaluates to true, then the "Files"
+field is used in place of the "Checksums-Md5" field. By default the option
+is false.
+
+=cut
+
+sub add_from_control {
+    my ($self, $control, %opts) = @_;
+    $opts{use_files_for_md5} //= 0;
+    foreach my $alg (checksums_get_list()) {
+	my $key = "Checksums-$alg";
+	$key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5');
+	if (exists $control->{$key}) {
+	    $self->add_from_string($alg, $control->{$key}, %opts);
+	}
+    }
+}
+
+=item @files = $ck->get_files()
+
+Return the list of files whose checksums are stored in the object.
+
+=cut
+
+sub get_files {
+    my $self = shift;
+    return @{$self->{files}};
+}
+
+=item $bool = $ck->has_file($file)
+
+Return true if we have checksums for the given file. Returns false
+otherwise.
+
+=cut
+
+sub has_file {
+    my ($self, $file) = @_;
+    return exists $self->{size}{$file};
+}
+
+=item $ck->remove_file($file)
+
+Remove all checksums of the given file.
+
+=cut
+
+sub remove_file {
+    my ($self, $file) = @_;
+    return unless $self->has_file($file);
+    delete $self->{checksums}{$file};
+    delete $self->{size}{$file};
+    @{$self->{files}} = grep { $_ ne $file } $self->get_files();
+}
+
+=item $checksum = $ck->get_checksum($file, $alg)
+
+Return the checksum of type $alg for the requested $file. This will not
+compute the checksum but only return the checksum stored in the object, if
+any.
+
+If $alg is not defined, it returns a reference to a hash: keys are
+the checksum algorithms and values are the checksums themselves. The
+hash returned must not be modified, it's internal to the object.
+
+=cut
+
+sub get_checksum {
+    my ($self, $file, $alg) = @_;
+    $alg = lc($alg) if defined $alg;
+    if (exists $self->{checksums}{$file}) {
+	return $self->{checksums}{$file} unless defined $alg;
+	return $self->{checksums}{$file}{$alg};
+    }
+    return;
+}
+
+=item $size = $ck->get_size($file)
+
+Return the size of the requested file if it's available in the object.
+
+=cut
+
+sub get_size {
+    my ($self, $file) = @_;
+    return $self->{size}{$file};
+}
+
+=item $bool = $ck->has_strong_checksums($file)
+
+Return a boolean on whether the file has a strong checksum.
+
+=cut
+
+sub has_strong_checksums {
+    my ($self, $file) = @_;
+
+    foreach my $alg (checksums_get_list()) {
+        return 1 if defined $self->get_checksum($file, $alg) and
+                    checksums_get_property($alg, 'strong');
+    }
+
+    return 0;
+}
+
+=item $ck->export_to_string($alg, %opts)
+
+Return a multi-line string containing the checksums of type $alg. The
+string can be stored as-is in a Checksum-* field of a Dpkg::Control
+object.
+
+=cut
+
+sub export_to_string {
+    my ($self, $alg, %opts) = @_;
+    my $res = '';
+    foreach my $file ($self->get_files()) {
+	my $sum = $self->get_checksum($file, $alg);
+	my $size = $self->get_size($file);
+	next unless defined $sum and defined $size;
+	$res .= "\n$sum $size $file";
+    }
+    return $res;
+}
+
+=item $ck->export_to_control($control, %opts)
+
+Export the checksums in the Checksums-* fields of the Dpkg::Control
+$control object.
+
+=cut
+
+sub export_to_control {
+    my ($self, $control, %opts) = @_;
+    $opts{use_files_for_md5} //= 0;
+    foreach my $alg (checksums_get_list()) {
+	my $key = "Checksums-$alg";
+	$key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5');
+	$control->{$key} = $self->export_to_string($alg, %opts);
+    }
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.04 (dpkg 1.20.0)
+
+Remove warning: For obsolete property 'program'.
+
+=head2 Version 1.03 (dpkg 1.18.5)
+
+New property: Add new 'strong' property.
+
+New member: $ck->has_strong_checksums().
+
+=head2 Version 1.02 (dpkg 1.18.0)
+
+Obsolete property: Getting the 'program' checksum property will warn and
+return undef, the Digest module is used internally now.
+
+New property: Add new 'name' property with the name of the Digest algorithm
+to use.
+
+=head2 Version 1.01 (dpkg 1.17.6)
+
+New argument: Accept an options argument in $ck->export_to_string().
+
+New option: Accept new option 'update' in $ck->add_from_file() and
+$ck->add_from_control().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm
new file mode 100644
index 0000000..189be8b
--- /dev/null
+++ b/scripts/Dpkg/Compression.pm
@@ -0,0 +1,448 @@
+# Copyright © 2007-2022 Guillem Jover <guillem@debian.org>
+# Copyright © 2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Compression;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.01';
+our @EXPORT = qw(
+    compression_is_supported
+    compression_get_list
+    compression_get_property
+    compression_guess_from_filename
+    compression_get_file_extension_regex
+    compression_get_file_extension
+    compression_get_default
+    compression_set_default
+    compression_get_default_level
+    compression_set_default_level
+    compression_get_level
+    compression_set_level
+    compression_is_valid_level
+    compression_get_threads
+    compression_set_threads
+    compression_get_cmdline_compress
+    compression_get_cmdline_decompress
+);
+
+use Exporter qw(import);
+use Config;
+use List::Util qw(any);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression - simple database of available compression methods
+
+=head1 DESCRIPTION
+
+This modules provides a few public functions and a public regex to
+interact with the set of supported compression methods.
+
+=cut
+
+my %COMP = (
+    gzip => {
+	file_ext => 'gz',
+	comp_prog => [ 'gzip', '-n' ],
+	decomp_prog => [ 'gunzip' ],
+	default_level => 9,
+    },
+    bzip2 => {
+	file_ext => 'bz2',
+	comp_prog => [ 'bzip2' ],
+	decomp_prog => [ 'bunzip2' ],
+	default_level => 9,
+    },
+    lzma => {
+	file_ext => 'lzma',
+	comp_prog => [ 'xz', '--format=lzma' ],
+	decomp_prog => [ 'unxz', '--format=lzma' ],
+	default_level => 6,
+    },
+    xz => {
+	file_ext => 'xz',
+	comp_prog => [ 'xz' ],
+	decomp_prog => [ 'unxz' ],
+	default_level => 6,
+    },
+);
+
+# The gzip --rsyncable option is not universally supported, so we need to
+# conditionally use it. Ideally we would invoke 'gzip --help' and check
+# whether the option is supported, but that would imply forking and executing
+# that process for any module that ends up loading this one, which is not
+# acceptable performance-wise. Instead we will approximate it by osname, which
+# is not ideal, but better than nothing.
+#
+# Requires GNU gzip >= 1.7 for the --rsyncable option. On AIX GNU gzip is
+# too old. On the BSDs they use their own implementation based on zlib,
+# which does not currently support the --rsyncable option.
+if (any { $Config{osname} eq $_ } qw(linux gnu solaris)) {
+    push @{$COMP{gzip}{comp_prog}}, '--rsyncable';
+}
+
+my $default_compression = 'xz';
+my $default_compression_level = undef;
+my $default_compression_threads = 0;
+
+my $regex = join '|', map { $_->{file_ext} } values %COMP;
+my $compression_re_file_ext = qr/(?:$regex)/;
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @list = compression_get_list()
+
+Returns a list of supported compression methods (sorted alphabetically).
+
+=cut
+
+sub compression_get_list {
+    my @list = sort keys %COMP;
+    return @list;
+}
+
+=item compression_is_supported($comp)
+
+Returns a boolean indicating whether the give compression method is
+known and supported.
+
+=cut
+
+sub compression_is_supported {
+    my $comp = shift;
+
+    return exists $COMP{$comp};
+}
+
+=item compression_get_property($comp, $property)
+
+Returns the requested property of the compression method. Returns undef if
+either the property or the compression method doesn't exist. Valid
+properties currently include "file_ext" for the file extension,
+"default_level" for the default compression level,
+"comp_prog" for the name of the compression program and "decomp_prog" for
+the name of the decompression program.
+
+This function is deprecated, please switch to one of the new specialized
+getters instead.
+
+=cut
+
+sub compression_get_property {
+    my ($comp, $property) = @_;
+
+    #warnings::warnif('deprecated',
+    #    'Dpkg::Compression::compression_get_property() is deprecated, ' .
+    #    'use one of the specialized getters instead');
+    return unless compression_is_supported($comp);
+    return $COMP{$comp}{$property} if exists $COMP{$comp}{$property};
+    return;
+}
+
+=item compression_guess_from_filename($filename)
+
+Returns the compression method that is likely used on the indicated
+filename based on its file extension.
+
+=cut
+
+sub compression_guess_from_filename {
+    my $filename = shift;
+    foreach my $comp (compression_get_list()) {
+        my $ext = $COMP{$comp}{file_ext};
+        if ($filename =~ /^(.*)\.\Q$ext\E$/) {
+	    return $comp;
+        }
+    }
+    return;
+}
+
+=item $regex = compression_get_file_extension_regex()
+
+Returns a regex that matches a file extension of a file compressed with
+one of the supported compression methods.
+
+=cut
+
+sub compression_get_file_extension_regex {
+    return $compression_re_file_ext;
+}
+
+=item $ext = compression_get_file_extension($comp)
+
+Return the file extension for the compressor $comp.
+
+=cut
+
+sub compression_get_file_extension {
+    my $comp = shift;
+
+    error(g_('%s is not a supported compression'), $comp)
+        unless compression_is_supported($comp);
+
+    return $COMP{$comp}{file_ext};
+}
+
+=item $comp = compression_get_default()
+
+Return the default compression method. It is "xz" unless
+C<compression_set_default> has been used to change it.
+
+=cut
+
+sub compression_get_default {
+    return $default_compression;
+}
+
+=item compression_set_default($comp)
+
+Change the default compression method. Errors out if the
+given compression method is not supported.
+
+=cut
+
+sub compression_set_default {
+    my $method = shift;
+    error(g_('%s is not a supported compression'), $method)
+        unless compression_is_supported($method);
+    $default_compression = $method;
+}
+
+=item $level = compression_get_default_level()
+
+Return the global default compression level used when compressing data if
+it has been set, otherwise the default level for the default compressor.
+
+It's "9" for "gzip" and "bzip2", "6" for "xz" and "lzma", unless
+C<compression_set_default_level> has been used to change it.
+
+=cut
+
+sub compression_get_default_level {
+    if (defined $default_compression_level) {
+        return $default_compression_level;
+    } else {
+        return $COMP{$default_compression}{default_level};
+    }
+}
+
+=item compression_set_default_level($level)
+
+Change the global default compression level. Passing undef as the level will
+reset it to the global default compressor specific default, otherwise errors
+out if the level is not valid (see C<compression_is_valid_level>).
+
+=cut
+
+sub compression_set_default_level {
+    my $level = shift;
+    error(g_('%s is not a compression level'), $level)
+        if defined($level) and not compression_is_valid_level($level);
+    $default_compression_level = $level;
+}
+
+=item $level = compression_get_level($comp)
+
+Return the compression level used when compressing data with a specific
+compressor. The value returned is the specific compression level if it has
+been set, otherwise the global default compression level if it has been set,
+falling back to the specific default compression level.
+
+=cut
+
+sub compression_get_level {
+    my $comp = shift;
+
+    error(g_('%s is not a supported compression'), $comp)
+        unless compression_is_supported($comp);
+
+    return $COMP{$comp}{level} //
+           $default_compression_level //
+           $COMP{$comp}{default_level};
+}
+
+=item compression_set_level($comp, $level)
+
+Change the compression level for a specific compressor. Passing undef as
+the level will reset it to the specific default compressor level, otherwise
+errors out if the level is not valid (see C<compression_is_valid_level>).
+
+=cut
+
+sub compression_set_level {
+    my ($comp, $level) = @_;
+
+    error(g_('%s is not a supported compression'), $comp)
+        unless compression_is_supported($comp);
+    error(g_('%s is not a compression level'), $level)
+        if defined $level && ! compression_is_valid_level($level);
+
+    $COMP{$comp}{level} = $level;
+}
+
+=item compression_is_valid_level($level)
+
+Returns a boolean indicating whether $level is a valid compression level
+(it must be either a number between 1 and 9 or "fast" or "best")
+
+=cut
+
+sub compression_is_valid_level {
+    my $level = shift;
+    return $level =~ /^([1-9]|fast|best)$/;
+}
+
+=item $threads = compression_get_threads()
+
+Return the number of threads to use for compression and decompression.
+
+=cut
+
+sub compression_get_threads {
+    return $default_compression_threads;
+}
+
+=item compression_set_threads($threads)
+
+Change the threads to use for compression and decompression. Passing C<undef>
+or B<0> requests to use automatic mode, based on the current CPU cores on
+the system.
+
+=cut
+
+sub compression_set_threads {
+    my $threads = shift;
+
+    error(g_('compression threads %s is not a number'), $threads)
+        if defined $threads && $threads !~ m/^\d+$/;
+    $default_compression_threads = $threads;
+}
+
+=item @exec = compression_get_cmdline_compress($comp)
+
+Returns a list ready to be passed to C<exec>, its first element is the
+program name for compression and the following elements are parameters
+for the program.
+
+When executed the program will act as a filter between its standard input
+and its standard output.
+
+=cut
+
+sub compression_get_cmdline_compress {
+    my $comp = shift;
+
+    error(g_('%s is not a supported compression'), $comp)
+        unless compression_is_supported($comp);
+
+    my @prog = @{$COMP{$comp}{comp_prog}};
+    my $level = compression_get_level($comp);
+    if ($level =~ m/^[1-9]$/) {
+        push @prog, "-$level";
+    } else {
+        push @prog, "--$level";
+    }
+    my $threads = compression_get_threads();
+    if ($comp eq 'xz') {
+        # Do not generate warnings when adjusting memory usage, nor
+        # exit with non-zero due to those not emitted warnings.
+        push @prog, qw(--quiet --no-warn);
+
+        # Do not let xz fallback to single-threaded mode, to avoid
+        # non-reproducible output.
+        push @prog, '--no-adjust';
+
+        # The xz -T1 option selects a single-threaded mode which generates
+        # different output than in multi-threaded mode. To avoid the
+        # non-reproducible output we pass -T+1 (supported with xz >= 5.4.0)
+        # to request multi-threaded mode with a single thread.
+        push @prog, $threads == 1 ? '-T+1' : "-T$threads";
+    }
+    return @prog;
+}
+
+=item @exec = compression_get_cmdline_decompress($comp)
+
+Returns a list ready to be passed to C<exec>, its first element is the
+program name for decompression and the following elements are parameters
+for the program.
+
+When executed the program will act as a filter between its standard input
+and its standard output.
+
+=cut
+
+sub compression_get_cmdline_decompress {
+    my $comp = shift;
+
+    error(g_('%s is not a supported compression'), $comp)
+        unless compression_is_supported($comp);
+
+    my @prog = @{$COMP{$comp}{decomp_prog}};
+
+    my $threads = compression_get_threads();
+    if ($comp eq 'xz') {
+        push @prog, "-T$threads";
+    }
+
+    return @prog;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.01 (dpkg 1.21.14)
+
+New functions: compression_get_file_extension(), compression_get_level(),
+compression_set_level(), compression_get_cmdline_compress(),
+compression_get_cmdline_decompress(), compression_get_threads() and
+compression_set_threads().
+
+Deprecated functions: compression_get_property().
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Hide variables: $default_compression, $default_compression_level
+and $compression_re_file_ext.
+
+=head2 Version 1.02 (dpkg 1.17.2)
+
+New function: compression_get_file_extension_regex()
+
+Deprecated variables: $default_compression, $default_compression_level
+and $compression_re_file_ext
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+Default compression level is not global any more, it is per compressor type.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm
new file mode 100644
index 0000000..5b3fd1c
--- /dev/null
+++ b/scripts/Dpkg/Compression/FileHandle.pm
@@ -0,0 +1,473 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2014 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/>.
+
+package Dpkg::Compression::FileHandle;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+
+use Carp;
+
+use Dpkg::Compression;
+use Dpkg::Compression::Process;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(IO::File Tie::Handle);
+
+# Useful reference to understand some kludges required to
+# have the class behave like a filehandle
+# http://blog.woobling.org/2009/10/are-filehandles-objects.html
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression::FileHandle - class dealing transparently with file compression
+
+=head1 SYNOPSIS
+
+    use Dpkg::Compression::FileHandle;
+
+    my ($fh, @lines);
+
+    $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
+    print $fh "Something\n";
+    close $fh;
+
+    $fh = Dpkg::Compression::FileHandle->new();
+    open($fh, '>', 'sample.bz2');
+    print $fh "Something\n";
+    close $fh;
+
+    $fh = Dpkg::Compression::FileHandle->new();
+    $fh->open('sample.xz', 'w');
+    $fh->print("Something\n");
+    $fh->close();
+
+    $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
+    @lines = <$fh>;
+    close $fh;
+
+    $fh = Dpkg::Compression::FileHandle->new();
+    open($fh, '<', 'sample.bz2');
+    @lines = <$fh>;
+    close $fh;
+
+    $fh = Dpkg::Compression::FileHandle->new();
+    $fh->open('sample.xz', 'r');
+    @lines = $fh->getlines();
+    $fh->close();
+
+=head1 DESCRIPTION
+
+Dpkg::Compression::FileHandle is a class that can be used
+like any filehandle and that deals transparently with compressed
+files. By default, the compression scheme is guessed from the filename
+but you can override this behaviour with the method C<set_compression>.
+
+If you don't open the file explicitly, it will be auto-opened on the
+first read or write operation based on the filename set at creation time
+(or later with the C<set_filename> method).
+
+Once a file has been opened, the filehandle must be closed before being
+able to open another file.
+
+=head1 STANDARD FUNCTIONS
+
+The standard functions acting on filehandles should accept a
+Dpkg::Compression::FileHandle object transparently including
+C<open> (only when using the variant with 3 parameters), C<close>,
+C<binmode>, C<eof>, C<fileno>, C<getc>, C<print>, C<printf>, C<read>,
+C<sysread>, C<say>, C<write>, C<syswrite>, C<seek>, C<sysseek>, C<tell>.
+
+Note however that C<seek> and C<sysseek> will only work on uncompressed
+files as compressed files are really pipes to the compressor programs
+and you can't seek on a pipe.
+
+=head1 FileHandle METHODS
+
+The class inherits from IO::File so all methods that work on this
+class should work for Dpkg::Compression::FileHandle too. There
+may be exceptions though.
+
+=head1 PUBLIC METHODS
+
+=over 4
+
+=item $fh = Dpkg::Compression::FileHandle->new(%opts)
+
+Creates a new filehandle supporting on-the-fly compression/decompression.
+Supported options are "filename", "compression", "compression_level" (see
+respective set_* functions) and "add_comp_ext". If "add_comp_ext"
+evaluates to true, then the extension corresponding to the selected
+compression scheme is automatically added to the recorded filename. It's
+obviously incompatible with automatic detection of the compression method.
+
+=cut
+
+# Class methods
+sub new {
+    my ($this, %args) = @_;
+    my $class = ref($this) || $this;
+    my $self = IO::File->new();
+    # Tying is required to overload the open functions and to auto-open
+    # the file on first read/write operation
+    tie *$self, $class, $self; ## no critic (Miscellanea::ProhibitTies)
+    bless $self, $class;
+    # Initializations
+    *$self->{compression} = 'auto';
+    *$self->{compressor} = Dpkg::Compression::Process->new();
+    *$self->{add_comp_ext} = $args{add_compression_extension} ||
+        $args{add_comp_ext} || 0;
+    *$self->{allow_sigpipe} = 0;
+    if (exists $args{filename}) {
+	$self->set_filename($args{filename});
+    }
+    if (exists $args{compression}) {
+	$self->set_compression($args{compression});
+    }
+    if (exists $args{compression_level}) {
+	$self->set_compression_level($args{compression_level});
+    }
+    return $self;
+}
+
+=item $fh->ensure_open($mode, %opts)
+
+Ensure the file is opened in the requested mode ("r" for read and "w" for
+write). The options are passed down to the compressor's spawn() call, if one
+is used. Opens the file with the recorded filename if needed. If the file
+is already open but not in the requested mode, then it errors out.
+
+=cut
+
+sub ensure_open {
+    my ($self, $mode, %opts) = @_;
+    if (exists *$self->{mode}) {
+	return if *$self->{mode} eq $mode;
+	croak "ensure_open requested incompatible mode: $mode";
+    } else {
+	# Sanitize options.
+	delete $opts{from_pipe};
+	delete $opts{from_file};
+	delete $opts{to_pipe};
+	delete $opts{to_file};
+
+	if ($mode eq 'w') {
+	    $self->_open_for_write(%opts);
+	} elsif ($mode eq 'r') {
+	    $self->_open_for_read(%opts);
+	} else {
+	    croak "invalid mode in ensure_open: $mode";
+	}
+    }
+}
+
+##
+## METHODS FOR TIED HANDLE
+##
+sub TIEHANDLE {
+    my ($class, $self) = @_;
+    return $self;
+}
+
+sub WRITE {
+    my ($self, $scalar, $length, $offset) = @_;
+    $self->ensure_open('w');
+    return *$self->{file}->write($scalar, $length, $offset);
+}
+
+sub READ {
+    my ($self, $scalar, $length, $offset) = @_;
+    $self->ensure_open('r');
+    return *$self->{file}->read($scalar, $length, $offset);
+}
+
+sub READLINE {
+    my ($self) = shift;
+    $self->ensure_open('r');
+    return *$self->{file}->getlines() if wantarray;
+    return *$self->{file}->getline();
+}
+
+sub OPEN {
+    my ($self) = shift;
+    if (scalar(@_) == 2) {
+	my ($mode, $filename) = @_;
+	$self->set_filename($filename);
+	if ($mode eq '>') {
+	    $self->_open_for_write();
+	} elsif ($mode eq '<') {
+	    $self->_open_for_read();
+	} else {
+	    croak 'Dpkg::Compression::FileHandle does not support ' .
+	          "open() mode $mode";
+	}
+    } else {
+	croak 'Dpkg::Compression::FileHandle only supports open() ' .
+	      'with 3 parameters';
+    }
+    return 1; # Always works (otherwise errors out)
+}
+
+sub CLOSE {
+    my ($self) = shift;
+    my $ret = 1;
+    if (defined *$self->{file}) {
+	$ret = *$self->{file}->close(@_) if *$self->{file}->opened();
+    } else {
+	$ret = 0;
+    }
+    $self->_cleanup();
+    return $ret;
+}
+
+sub FILENO {
+    my ($self) = shift;
+    return *$self->{file}->fileno(@_) if defined *$self->{file};
+    return;
+}
+
+sub EOF {
+    # Since perl 5.12, an integer parameter is passed describing how the
+    # function got called, just ignore it.
+    my ($self, $param) = (shift, shift);
+    return *$self->{file}->eof(@_) if defined *$self->{file};
+    return 1;
+}
+
+sub SEEK {
+    my ($self) = shift;
+    return *$self->{file}->seek(@_) if defined *$self->{file};
+    return 0;
+}
+
+sub TELL {
+    my ($self) = shift;
+    return *$self->{file}->tell(@_) if defined *$self->{file};
+    return -1;
+}
+
+sub BINMODE {
+    my ($self) = shift;
+    return *$self->{file}->binmode(@_) if defined *$self->{file};
+    return;
+}
+
+##
+## NORMAL METHODS
+##
+
+=item $fh->set_compression($comp)
+
+Defines the compression method used. $comp should one of the methods supported by
+B<Dpkg::Compression> or "none" or "auto". "none" indicates that the file is
+uncompressed and "auto" indicates that the method must be guessed based
+on the filename extension used.
+
+=cut
+
+sub set_compression {
+    my ($self, $method) = @_;
+    if ($method ne 'none' and $method ne 'auto') {
+	*$self->{compressor}->set_compression($method);
+    }
+    *$self->{compression} = $method;
+}
+
+=item $fh->set_compression_level($level)
+
+Indicate the desired compression level. It should be a value accepted
+by the function C<compression_is_valid_level> of B<Dpkg::Compression>.
+
+=cut
+
+sub set_compression_level {
+    my ($self, $level) = @_;
+    *$self->{compressor}->set_compression_level($level);
+}
+
+=item $fh->set_filename($name, [$add_comp_ext])
+
+Use $name as filename when the file must be opened/created. If
+$add_comp_ext is passed, it indicates whether the default extension
+of the compression method must be automatically added to the filename
+(or not).
+
+=cut
+
+sub set_filename {
+    my ($self, $filename, $add_comp_ext) = @_;
+    *$self->{filename} = $filename;
+    # Automatically add compression extension to filename
+    if (defined($add_comp_ext)) {
+	*$self->{add_comp_ext} = $add_comp_ext;
+    }
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
+	warning('filename %s already has an extension of a compressed file ' .
+	        'and add_comp_ext is active', $filename);
+    }
+}
+
+=item $file = $fh->get_filename()
+
+Returns the filename that would be used when the filehandle must
+be opened (both in read and write mode). This function errors out
+if "add_comp_ext" is enabled while the compression method is set
+to "auto". The returned filename includes the extension of the compression
+method if "add_comp_ext" is enabled.
+
+=cut
+
+sub get_filename {
+    my $self = shift;
+    my $comp = *$self->{compression};
+    if (*$self->{add_comp_ext}) {
+	if ($comp eq 'auto') {
+	    croak 'automatic detection of compression is ' .
+	          'incompatible with add_comp_ext';
+	} elsif ($comp eq 'none') {
+	    return *$self->{filename};
+	} else {
+	    return *$self->{filename} . '.' .
+	           compression_get_file_extension($comp);
+	}
+    } else {
+	return *$self->{filename};
+    }
+}
+
+=item $ret = $fh->use_compression()
+
+Returns "0" if no compression is used and the compression method used
+otherwise. If the compression is set to "auto", the value returned
+depends on the extension of the filename obtained with the B<get_filename>
+method.
+
+=cut
+
+sub use_compression {
+    my $self = shift;
+    my $comp = *$self->{compression};
+    if ($comp eq 'none') {
+	return 0;
+    } elsif ($comp eq 'auto') {
+	$comp = compression_guess_from_filename($self->get_filename());
+	*$self->{compressor}->set_compression($comp) if $comp;
+    }
+    return $comp;
+}
+
+=item $real_fh = $fh->get_filehandle()
+
+Returns the real underlying filehandle. Useful if you want to pass it
+along in a derived class.
+
+=cut
+
+sub get_filehandle {
+    my $self = shift;
+    return *$self->{file} if exists *$self->{file};
+}
+
+## INTERNAL METHODS
+
+sub _open_for_write {
+    my ($self, %opts) = @_;
+    my $filehandle;
+
+    croak 'cannot reopen an already opened compressed file'
+        if exists *$self->{mode};
+
+    if ($self->use_compression()) {
+	*$self->{compressor}->compress(from_pipe => \$filehandle,
+            to_file => $self->get_filename(), %opts);
+    } else {
+	CORE::open($filehandle, '>', $self->get_filename)
+	    or syserr(g_('cannot write %s'), $self->get_filename());
+    }
+    *$self->{mode} = 'w';
+    *$self->{file} = $filehandle;
+}
+
+sub _open_for_read {
+    my ($self, %opts) = @_;
+    my $filehandle;
+
+    croak 'cannot reopen an already opened compressed file'
+        if exists *$self->{mode};
+
+    if ($self->use_compression()) {
+	*$self->{compressor}->uncompress(to_pipe => \$filehandle,
+		from_file => $self->get_filename(), %opts);
+        *$self->{allow_sigpipe} = 1;
+    } else {
+	CORE::open($filehandle, '<', $self->get_filename)
+	    or syserr(g_('cannot read %s'), $self->get_filename());
+    }
+    *$self->{mode} = 'r';
+    *$self->{file} = $filehandle;
+}
+
+sub _cleanup {
+    my $self = shift;
+    my $cmdline = *$self->{compressor}{cmdline} // '';
+    *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
+    if (*$self->{allow_sigpipe}) {
+        require POSIX;
+        unless (($? == 0) || (POSIX::WIFSIGNALED($?) &&
+                              (POSIX::WTERMSIG($?) == POSIX::SIGPIPE()))) {
+            subprocerr($cmdline);
+        }
+	*$self->{allow_sigpipe} = 0;
+    }
+    delete *$self->{mode};
+    delete *$self->{file};
+}
+
+=back
+
+=head1 DERIVED CLASSES
+
+If you want to create a class that inherits from
+Dpkg::Compression::FileHandle you must be aware that
+the object is a reference to a GLOB that is returned by Symbol::gensym()
+and as such it's not a HASH.
+
+You can store internal data in a hash but you have to use
+C<*$self->{...}> to access the associated hash like in the example below:
+
+    sub set_option {
+	my ($self, $value) = @_;
+	*$self->{option} = $value;
+    }
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.17.11)
+
+New argument: $fh->ensure_open() accepts an %opts argument.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+1;
diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm
new file mode 100644
index 0000000..3f08d48
--- /dev/null
+++ b/scripts/Dpkg/Compression/Process.pm
@@ -0,0 +1,208 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2022 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/>.
+
+package Dpkg::Compression::Process;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Carp;
+
+use Dpkg::Compression;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::IPC;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression::Process - run compression/decompression processes
+
+=head1 DESCRIPTION
+
+This module provides an object oriented interface to run and manage
+compression/decompression processes.
+
+=head1 METHODS
+
+=over 4
+
+=item $proc = Dpkg::Compression::Process->new(%opts)
+
+Create a new instance of the object. Supported options are "compression"
+and "compression_level" (see corresponding set_* functions).
+
+=cut
+
+sub new {
+    my ($this, %args) = @_;
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+    $self->set_compression($args{compression} || compression_get_default());
+    $self->set_compression_level($args{compression_level} ||
+        compression_get_default_level());
+    return $self;
+}
+
+=item $proc->set_compression($comp)
+
+Select the compression method to use. It errors out if the method is not
+supported according to C<compression_is_supported> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression {
+    my ($self, $method) = @_;
+    error(g_('%s is not a supported compression method'), $method)
+        unless compression_is_supported($method);
+    $self->{compression} = $method;
+}
+
+=item $proc->set_compression_level($level)
+
+Select the compression level to use. It errors out if the level is not
+valid according to C<compression_is_valid_level> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression_level {
+    my ($self, $level) = @_;
+
+    compression_set_level($self->{compression}, $level);
+}
+
+=item @exec = $proc->get_compress_cmdline()
+
+=item @exec = $proc->get_uncompress_cmdline()
+
+Returns a list ready to be passed to C<exec>, its first element is the
+program name (either for compression or decompression) and the following
+elements are parameters for the program.
+
+When executed the program acts as a filter between its standard input
+and its standard output.
+
+=cut
+
+sub get_compress_cmdline {
+    my $self = shift;
+
+    return compression_get_cmdline_compress($self->{compression});
+}
+
+sub get_uncompress_cmdline {
+    my $self = shift;
+
+    return compression_get_cmdline_decompress($self->{compression});
+}
+
+sub _check_opts {
+    my ($self, %opts) = @_;
+    # Check for proper cleaning before new start
+    error(g_('Dpkg::Compression::Process can only start one subprocess at a time'))
+        if $self->{pid};
+    # Check options
+    my $to = my $from = 0;
+    foreach my $thing (qw(file handle string pipe)) {
+        $to++ if $opts{"to_$thing"};
+        $from++ if $opts{"from_$thing"};
+    }
+    croak 'exactly one to_* parameter is needed' if $to != 1;
+    croak 'exactly one from_* parameter is needed' if $from != 1;
+    return %opts;
+}
+
+=item $proc->compress(%opts)
+
+Starts a compressor program. You must indicate where it will read its
+uncompressed data from and where it will write its compressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub compress {
+    my ($self, %opts) = @_;
+
+    $self->_check_opts(%opts);
+    my @prog = $self->get_compress_cmdline();
+    $opts{exec} = \@prog;
+    $self->{cmdline} = "@prog";
+    $self->{pid} = spawn(%opts);
+    delete $self->{pid} if $opts{to_string}; # wait_child already done
+}
+
+=item $proc->uncompress(%opts)
+
+Starts a decompressor program. You must indicate where it will read its
+compressed data from and where it will write its uncompressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub uncompress {
+    my ($self, %opts) = @_;
+
+    $self->_check_opts(%opts);
+    my @prog = $self->get_uncompress_cmdline();
+    $opts{exec} = \@prog;
+    $self->{cmdline} = "@prog";
+    $self->{pid} = spawn(%opts);
+    delete $self->{pid} if $opts{to_string}; # wait_child already done
+}
+
+=item $proc->wait_end_process(%opts)
+
+Call B<Dpkg::IPC::wait_child> to wait until the sub-process has exited
+and verify its return code. Any given option will be forwarded to
+the C<wait_child> function. Most notably you can use the "nocheck" option
+to verify the return code yourself instead of letting C<wait_child> do
+it for you.
+
+=cut
+
+sub wait_end_process {
+    my ($self, %opts) = @_;
+    $opts{cmdline} //= $self->{cmdline};
+    wait_child($self->{pid}, %opts) if $self->{pid};
+    delete $self->{pid};
+    delete $self->{cmdline};
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Conf.pm b/scripts/Dpkg/Conf.pm
new file mode 100644
index 0000000..028a293
--- /dev/null
+++ b/scripts/Dpkg/Conf.pm
@@ -0,0 +1,269 @@
+# Copyright © 2009-2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Conf;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.04';
+
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Interface::Storable);
+
+use overload
+    '@{}' => sub { return [ $_[0]->get_options() ] },
+    fallback => 1;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Conf - parse dpkg configuration files
+
+=head1 DESCRIPTION
+
+The Dpkg::Conf object can be used to read options from a configuration
+file. It can export an array that can then be parsed exactly like @ARGV.
+
+=head1 METHODS
+
+=over 4
+
+=item $conf = Dpkg::Conf->new(%opts)
+
+Create a new Dpkg::Conf object. Some options can be set through %opts:
+if allow_short evaluates to true (it defaults to false), then short
+options are allowed in the configuration file, they should be prepended
+with a single hyphen.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+	options => [],
+	allow_short => 0,
+    };
+    foreach my $opt (keys %opts) {
+	$self->{$opt} = $opts{$opt};
+    }
+    bless $self, $class;
+
+    return $self;
+}
+
+=item @$conf
+
+=item @options = $conf->get_options()
+
+Returns the list of options that can be parsed like @ARGV.
+
+=cut
+
+sub get_options {
+    my $self = shift;
+
+    return @{$self->{options}};
+}
+
+=item $conf->load($file)
+
+Read options from a file. Return the number of options parsed.
+
+=item $conf->load_system_config($file)
+
+Read options from a system configuration file.
+
+Return the number of options parsed.
+
+=cut
+
+sub load_system_config {
+    my ($self, $file) = @_;
+
+    return 0 unless -e "$Dpkg::CONFDIR/$file";
+    return $self->load("$Dpkg::CONFDIR/$file");
+}
+
+=item $conf->load_user_config($file)
+
+Read options from a user configuration file. It will try to use the XDG
+directory, either $XDG_CONFIG_HOME/dpkg/ or $HOME/.config/dpkg/.
+
+Return the number of options parsed.
+
+=cut
+
+sub load_user_config {
+    my ($self, $file) = @_;
+
+    my $confdir = $ENV{XDG_CONFIG_HOME};
+    $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
+
+    return 0 unless length $confdir;
+    return 0 unless -e "$confdir/dpkg/$file";
+    return $self->load("$confdir/dpkg/$file") if length $confdir;
+    return 0;
+}
+
+=item $conf->load_config($file)
+
+Read options from system and user configuration files.
+
+Return the number of options parsed.
+
+=cut
+
+sub load_config {
+    my ($self, $file) = @_;
+
+    my $nopts = 0;
+
+    $nopts += $self->load_system_config($file);
+    $nopts += $self->load_user_config($file);
+
+    return $nopts;
+}
+
+=item $conf->parse($fh)
+
+Parse options from a file handle. When called multiple times, the parsed
+options are accumulated.
+
+Return the number of options parsed.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+    my $count = 0;
+    local $_;
+
+    while (<$fh>) {
+	chomp;
+	s/^\s+//;             # Strip leading spaces
+	s/\s+$//;             # Strip trailing spaces
+	s/\s+=\s+/=/;         # Remove spaces around the first =
+	s/\s+/=/ unless m/=/; # First spaces becomes = if no =
+	# Skip empty lines and comments
+	next if /^#/ or length == 0;
+	if (/^-[^-]/ and not $self->{allow_short}) {
+	    warning(g_('short option not allowed in %s, line %d'), $desc, $.);
+	    next;
+	}
+	if (/^([^=]+)(?:=(.*))?$/) {
+	    my ($name, $value) = ($1, $2);
+	    $name = "--$name" unless $name =~ /^-/;
+	    if (defined $value) {
+		$value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/;
+		push @{$self->{options}}, "$name=$value";
+	    } else {
+		push @{$self->{options}}, $name;
+	    }
+	    $count++;
+	} else {
+	    warning(g_('invalid syntax for option in %s, line %d'), $desc, $.);
+	}
+    }
+    return $count;
+}
+
+=item $conf->filter(%opts)
+
+Filter the list of options, either removing or keeping all those that
+return true when $opts{remove}->($option) or $opts{keep}->($option) is called.
+
+=cut
+
+sub filter {
+    my ($self, %opts) = @_;
+    my $remove = $opts{remove} // sub { 0 };
+    my $keep = $opts{keep} // sub { 1 };
+
+    @{$self->{options}} = grep { not $remove->($_) and $keep->($_) }
+                               @{$self->{options}};
+}
+
+=item $string = $conf->output([$fh])
+
+Write the options in the given filehandle (if defined) and return a string
+representation of the content (that would be) written.
+
+=item "$conf"
+
+Return a string representation of the content.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $ret = '';
+    foreach my $opt ($self->get_options()) {
+	$opt =~ s/^--//;
+	$opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/;
+	$opt .= "\n";
+	print { $fh } $opt if defined $fh;
+	$ret .= $opt;
+    }
+    return $ret;
+}
+
+=item $conf->save($file)
+
+Save the options in a file.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.04 (dpkg 1.20.0)
+
+Remove croak: For 'format_argv' in $conf->filter().
+
+Remove methods: $conf->get(), $conf->set().
+
+=head2 Version 1.03 (dpkg 1.18.8)
+
+Obsolete option: 'format_argv' in $conf->filter().
+
+Obsolete methods: $conf->get(), $conf->set().
+
+New methods: $conf->load_system_config(), $conf->load_system_user(),
+$conf->load_config().
+
+=head2 Version 1.02 (dpkg 1.18.5)
+
+New option: Accept new option 'format_argv' in $conf->filter().
+
+New methods: $conf->get(), $conf->set().
+
+=head2 Version 1.01 (dpkg 1.15.8)
+
+New method: $conf->filter()
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control.pm b/scripts/Dpkg/Control.pm
new file mode 100644
index 0000000..7da5993
--- /dev/null
+++ b/scripts/Dpkg/Control.pm
@@ -0,0 +1,269 @@
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Control;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.03';
+our @EXPORT = qw(
+    CTRL_UNKNOWN
+    CTRL_INFO_SRC
+    CTRL_INFO_PKG
+    CTRL_INDEX_SRC
+    CTRL_INDEX_PKG
+    CTRL_REPO_RELEASE
+    CTRL_PKG_SRC
+    CTRL_PKG_DEB
+    CTRL_FILE_BUILDINFO
+    CTRL_FILE_CHANGES
+    CTRL_FILE_VENDOR
+    CTRL_FILE_STATUS
+    CTRL_CHANGELOG
+    CTRL_COPYRIGHT_HEADER
+    CTRL_COPYRIGHT_FILES
+    CTRL_COPYRIGHT_LICENSE
+    CTRL_TESTS
+);
+
+use Exporter qw(import);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Types;
+use Dpkg::Control::Hash;
+use Dpkg::Control::Fields;
+
+use parent qw(Dpkg::Control::Hash);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control - parse and manipulate official control-like information
+
+=head1 DESCRIPTION
+
+The Dpkg::Control object is a smart version of Dpkg::Control::Hash.
+It associates a type to the control information. That type can be
+used to know what fields are allowed and in what order they must be
+output.
+
+The types are constants that are exported by default. Here's the full
+list:
+
+=over 4
+
+=item CTRL_UNKNOWN
+
+This type is the default type, it indicates that the type of control
+information is not yet known.
+
+=item CTRL_INFO_SRC
+
+Corresponds to the first stanza in a F<debian/control> file in
+a Debian source package.
+
+=item CTRL_INFO_PKG
+
+Corresponds to subsequent stanza in a F<debian/control> file
+in a Debian source package.
+
+=item CTRL_REPO_RELEASE
+
+Corresponds to a F<Release> file in a repository.
+
+=item CTRL_INDEX_SRC
+
+Corresponds to a stanza in a F<Sources> file of a source package
+repository.
+
+=item CTRL_INDEX_PKG
+
+Corresponds to a stanza in a F<Packages> file of a binary package
+repository.
+
+=item CTRL_PKG_SRC
+
+Corresponds to a .dsc file of a Debian source package.
+
+=item CTRL_PKG_DEB
+
+Corresponds to the F<control> file generated by dpkg-gencontrol
+(F<DEBIAN/control>) and to the same file inside .deb packages.
+
+=item CTRL_FILE_BUILDINFO
+
+Corresponds to a .buildinfo file.
+
+=item CTRL_FILE_CHANGES
+
+Corresponds to a .changes file.
+
+=item CTRL_FILE_VENDOR
+
+Corresponds to a vendor file in $Dpkg::CONFDIR/origins/.
+
+=item CTRL_FILE_STATUS
+
+Corresponds to a stanza in dpkg's F<status> file ($Dpkg::ADMINDIR/status).
+
+=item CTRL_CHANGELOG
+
+Corresponds to the output of dpkg-parsechangelog.
+
+=item CTRL_COPYRIGHT_HEADER
+
+Corresponds to the header stanza in a F<debian/copyright> file in
+machine readable format.
+
+=item CTRL_COPYRIGHT_FILES
+
+Corresponds to a files stanza in a F<debian/copyright> file in
+machine readable format.
+
+=item CTRL_COPYRIGHT_LICENSE
+
+Corresponds to a license stanza in a F<debian/copyright> file in
+machine readable format.
+
+=item CTRL_TESTS
+
+Corresponds to a package tests control file in F<debian/tests/control>.
+
+=back
+
+=head1 METHODS
+
+All the methods of Dpkg::Control::Hash are available. Those listed below
+are either new or overridden with a different behaviour.
+
+=over 4
+
+=item $c = Dpkg::Control->new(%opts)
+
+If the "type" option is given, it's used to setup default values
+for other options. See set_options() for more details.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = Dpkg::Control::Hash->new();
+    bless $self, $class;
+    $self->set_options(%opts);
+
+    return $self;
+}
+
+=item $c->set_options(%opts)
+
+Changes the value of one or more options. If the "type" option is changed,
+it is used first to define default values for others options. The option
+"allow_pgp" is set to 1 for CTRL_PKG_SRC, CTRL_FILE_CHANGES and
+CTRL_REPO_RELEASE and to 0 otherwise. The option "drop_empty" is set to 0
+for CTRL_INFO_PKG and CTRL_INFO_SRC and to 1 otherwise. The option "name"
+is set to a textual description of the type of control information.
+
+The output order is also set to match the ordered list returned by
+Dpkg::Control::Fields::field_ordered_list($type).
+
+=cut
+
+sub set_options {
+    my ($self, %opts) = @_;
+    if (exists $opts{type}) {
+        my $t = $opts{type};
+        $$self->{allow_pgp} = ($t & (CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_REPO_RELEASE)) ? 1 : 0;
+        $$self->{drop_empty} = ($t & (CTRL_INFO_PKG | CTRL_INFO_SRC)) ?  0 : 1;
+        if ($t == CTRL_INFO_SRC) {
+            $$self->{name} = g_('general section of control info file');
+        } elsif ($t == CTRL_INFO_PKG) {
+            $$self->{name} = g_("package's section of control info file");
+        } elsif ($t == CTRL_CHANGELOG) {
+            $$self->{name} = g_('parsed version of changelog');
+        } elsif ($t == CTRL_COPYRIGHT_HEADER) {
+            $$self->{name} = g_('header stanza of copyright file');
+        } elsif ($t == CTRL_COPYRIGHT_FILES) {
+            $$self->{name} = g_('files stanza of copyright file');
+        } elsif ($t == CTRL_COPYRIGHT_HEADER) {
+            $$self->{name} = g_('license stanza of copyright file');
+        } elsif ($t == CTRL_TESTS) {
+            $$self->{name} = g_("package's tests control file");
+        } elsif ($t == CTRL_REPO_RELEASE) {
+            $$self->{name} = sprintf(g_("repository's %s file"), 'Release');
+        } elsif ($t == CTRL_INDEX_SRC) {
+            $$self->{name} = sprintf(g_("stanza in repository's %s file"), 'Sources');
+        } elsif ($t == CTRL_INDEX_PKG) {
+            $$self->{name} = sprintf(g_("stanza in repository's %s file"), 'Packages');
+        } elsif ($t == CTRL_PKG_SRC) {
+            $$self->{name} = sprintf(g_('%s file'), '.dsc');
+        } elsif ($t == CTRL_PKG_DEB) {
+            $$self->{name} = g_('control info of a .deb package');
+        } elsif ($t == CTRL_FILE_BUILDINFO) {
+            $$self->{name} = g_('build information file');
+        } elsif ($t == CTRL_FILE_CHANGES) {
+            $$self->{name} = sprintf(g_('%s file'), '.changes');
+        } elsif ($t == CTRL_FILE_VENDOR) {
+            $$self->{name} = g_('vendor file');
+        } elsif ($t == CTRL_FILE_STATUS) {
+            $$self->{name} = g_("stanza in dpkg's status file");
+        }
+        $self->set_output_order(field_ordered_list($opts{type}));
+    }
+
+    # Options set by the user override default values
+    $$self->{$_} = $opts{$_} foreach keys %opts;
+}
+
+=item $c->get_type()
+
+Returns the type of control information stored. See the type parameter
+set during new().
+
+=cut
+
+sub get_type {
+    my $self = shift;
+    return $$self->{type};
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.03 (dpkg 1.18.11)
+
+New type: CTRL_FILE_BUILDINFO.
+
+=head2 Version 1.02 (dpkg 1.18.8)
+
+New type: CTRL_TESTS.
+
+=head2 Version 1.01 (dpkg 1.18.5)
+
+New types: CTRL_REPO_RELEASE, CTRL_COPYRIGHT_HEADER, CTRL_COPYRIGHT_FILES,
+CTRL_COPYRIGHT_LICENSE.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Changelog.pm b/scripts/Dpkg/Control/Changelog.pm
new file mode 100644
index 0000000..9184ced
--- /dev/null
+++ b/scripts/Dpkg/Control/Changelog.pm
@@ -0,0 +1,65 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Control::Changelog;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Control;
+
+use parent qw(Dpkg::Control);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Changelog - represent info fields output by dpkg-parsechangelog
+
+=head1 DESCRIPTION
+
+This class derives directly from Dpkg::Control with the type
+CTRL_CHANGELOG.
+
+=head1 METHODS
+
+=over 4
+
+=item $c = Dpkg::Control::Changelog->new()
+
+Create a new empty set of changelog related fields.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = Dpkg::Control->new(type => CTRL_CHANGELOG, @_);
+    return bless $self, $class;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm
new file mode 100644
index 0000000..33beeec
--- /dev/null
+++ b/scripts/Dpkg/Control/Fields.pm
@@ -0,0 +1,69 @@
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Control::Fields;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+our @EXPORT = @Dpkg::Control::FieldsCore::EXPORT;
+
+use Carp;
+use Exporter qw(import);
+
+use Dpkg::Control::FieldsCore;
+use Dpkg::Vendor qw(run_vendor_hook);
+
+# Register vendor specifics fields
+foreach my $op (run_vendor_hook('register-custom-fields')) {
+    next if not (defined $op and ref $op); # Skip when not implemented by vendor
+    my $func = shift @$op;
+    if ($func eq 'register') {
+        my ($field, $allowed_type, @opts) = @{$op};
+        field_register($field, $allowed_type, @opts);
+    } elsif ($func eq 'insert_before') {
+        my ($type, $ref, @fields) = @{$op};
+        field_insert_before($type, $ref, @fields);
+    } elsif ($func eq 'insert_after') {
+        my ($type, $ref, @fields) = @{$op};
+        field_insert_after($type, $ref, @fields);
+    } else {
+        croak "vendor hook register-custom-fields sent bad data: @$op";
+    }
+}
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Fields - manage (list of official) control fields
+
+=head1 DESCRIPTION
+
+The module contains a list of vendor-neutral and vendor-specific fieldnames
+with associated meta-data explaining in which type of control information
+they are allowed. The vendor-neutral fieldnames and all functions are
+inherited from Dpkg::Control::FieldsCore.
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/FieldsCore.pm b/scripts/Dpkg/Control/FieldsCore.pm
new file mode 100644
index 0000000..77216c7
--- /dev/null
+++ b/scripts/Dpkg/Control/FieldsCore.pm
@@ -0,0 +1,1377 @@
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Control::FieldsCore;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+our @EXPORT = qw(
+    field_capitalize
+    field_is_official
+    field_is_allowed_in
+    field_transfer_single
+    field_transfer_all
+    field_parse_binary_source
+    field_list_src_dep
+    field_list_pkg_dep
+    field_get_dep_type
+    field_get_sep_type
+    field_ordered_list
+    field_register
+    field_insert_after
+    field_insert_before
+    FIELD_SEP_UNKNOWN
+    FIELD_SEP_SPACE
+    FIELD_SEP_COMMA
+    FIELD_SEP_LINE
+);
+
+use Exporter qw(import);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Types;
+
+use constant {
+    ALL_PKG => CTRL_INFO_PKG | CTRL_INDEX_PKG | CTRL_PKG_DEB | CTRL_FILE_STATUS,
+    ALL_SRC => CTRL_INFO_SRC | CTRL_INDEX_SRC | CTRL_PKG_SRC,
+    ALL_FILE_MANIFEST => CTRL_FILE_BUILDINFO | CTRL_FILE_CHANGES,
+    ALL_CHANGES => CTRL_FILE_CHANGES | CTRL_CHANGELOG,
+    ALL_COPYRIGHT => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES | CTRL_COPYRIGHT_LICENSE,
+};
+
+use constant {
+    FIELD_SEP_UNKNOWN => 0,
+    FIELD_SEP_SPACE => 1,
+    FIELD_SEP_COMMA => 2,
+    FIELD_SEP_LINE => 4,
+};
+
+# The canonical list of fields.
+
+# Note that fields used only in dpkg's available file are not listed.
+# Deprecated fields of dpkg's status file are also not listed.
+our %FIELDS = (
+    'acquire-by-hash' => {
+        name => 'Acquire-By-Hash',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'architecture' => {
+        name => 'Architecture',
+        allowed => (ALL_PKG | ALL_SRC | ALL_FILE_MANIFEST | CTRL_TESTS) & (~CTRL_INFO_SRC),
+        separator => FIELD_SEP_SPACE,
+    },
+    'architectures' => {
+        name => 'Architectures',
+        allowed => CTRL_REPO_RELEASE,
+        separator => FIELD_SEP_SPACE,
+    },
+    'auto-built-package' => {
+        name => 'Auto-Built-Package',
+        allowed => ALL_PKG & ~CTRL_INFO_PKG,
+        separator => FIELD_SEP_SPACE,
+    },
+    'binary' => {
+        name => 'Binary',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | ALL_FILE_MANIFEST,
+        # XXX: This field values are separated either by space or comma
+        # depending on the context.
+        separator => FIELD_SEP_SPACE | FIELD_SEP_COMMA,
+    },
+    'binary-only' => {
+        name => 'Binary-Only',
+        allowed => ALL_CHANGES,
+    },
+    'binary-only-changes' => {
+        name => 'Binary-Only-Changes',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'breaks' => {
+        name => 'Breaks',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 7,
+    },
+    'bugs' => {
+        name => 'Bugs',
+        allowed => (ALL_PKG | CTRL_INFO_SRC | CTRL_FILE_VENDOR) & (~CTRL_INFO_PKG),
+    },
+    'build-architecture' => {
+        name => 'Build-Architecture',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'build-conflicts' => {
+        name => 'Build-Conflicts',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 4,
+    },
+    'build-conflicts-arch' => {
+        name => 'Build-Conflicts-Arch',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 5,
+    },
+    'build-conflicts-indep' => {
+        name => 'Build-Conflicts-Indep',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 6,
+    },
+    'build-date' => {
+        name => 'Build-Date',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'build-depends' => {
+        name => 'Build-Depends',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 1,
+    },
+    'build-depends-arch' => {
+        name => 'Build-Depends-Arch',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 2,
+    },
+    'build-depends-indep' => {
+        name => 'Build-Depends-Indep',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 3,
+    },
+    'build-essential' => {
+        name => 'Build-Essential',
+        allowed => ALL_PKG,
+    },
+    'build-kernel-version' => {
+        name => 'Build-Kernel-Version',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'build-origin' => {
+        name => 'Build-Origin',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'build-path' => {
+        name => 'Build-Path',
+        allowed => CTRL_FILE_BUILDINFO,
+    },
+    'build-profiles' => {
+        name => 'Build-Profiles',
+        allowed => CTRL_INFO_PKG,
+        separator => FIELD_SEP_SPACE,
+    },
+    'build-tainted-by' => {
+        name => 'Build-Tainted-By',
+        allowed => CTRL_FILE_BUILDINFO,
+        separator => FIELD_SEP_SPACE,
+    },
+    'built-for-profiles' => {
+        name => 'Built-For-Profiles',
+        allowed => ALL_PKG | CTRL_FILE_CHANGES,
+        separator => FIELD_SEP_SPACE,
+    },
+    'built-using' => {
+        name => 'Built-Using',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 10,
+    },
+    'butautomaticupgrades' => {
+        name => 'ButAutomaticUpgrades',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'changed-by' => {
+        name => 'Changed-By',
+        allowed => CTRL_FILE_CHANGES,
+    },
+    'changelogs' => {
+        name => 'Changelogs',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'changes' => {
+        name => 'Changes',
+        allowed => ALL_CHANGES,
+    },
+    'checksums-md5' => {
+        name => 'Checksums-Md5',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | ALL_FILE_MANIFEST,
+    },
+    'checksums-sha1' => {
+        name => 'Checksums-Sha1',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | ALL_FILE_MANIFEST,
+    },
+    'checksums-sha256' => {
+        name => 'Checksums-Sha256',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | ALL_FILE_MANIFEST,
+    },
+    'classes' => {
+        name => 'Classes',
+        allowed => CTRL_TESTS,
+        separator => FIELD_SEP_COMMA,
+    },
+    'closes' => {
+        name => 'Closes',
+        allowed => ALL_CHANGES,
+        separator => FIELD_SEP_SPACE,
+    },
+    'codename' => {
+        name => 'Codename',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'comment' => {
+        name => 'Comment',
+        allowed => ALL_COPYRIGHT,
+    },
+    'components' => {
+        name => 'Components',
+        allowed => CTRL_REPO_RELEASE,
+        separator => FIELD_SEP_SPACE,
+    },
+    'conffiles' => {
+        name => 'Conffiles',
+        allowed => CTRL_FILE_STATUS,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'config-version' => {
+        name => 'Config-Version',
+        allowed => CTRL_FILE_STATUS,
+    },
+    'conflicts' => {
+        name => 'Conflicts',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 6,
+    },
+    'copyright' => {
+        name => 'Copyright',
+        allowed => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES,
+    },
+    'date' => {
+        name => 'Date',
+        allowed => ALL_CHANGES | CTRL_REPO_RELEASE,
+    },
+    'depends' => {
+        name => 'Depends',
+        allowed => ALL_PKG | CTRL_TESTS,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 2,
+    },
+    'description' => {
+        name => 'Description',
+        allowed => ALL_SRC | ALL_PKG | CTRL_FILE_CHANGES | CTRL_REPO_RELEASE,
+    },
+    'disclaimer' => {
+        name => 'Disclaimer',
+        allowed => CTRL_COPYRIGHT_HEADER,
+    },
+    'directory' => {
+        name => 'Directory',
+        allowed => CTRL_INDEX_SRC,
+    },
+    'distribution' => {
+        name => 'Distribution',
+        allowed => ALL_CHANGES,
+    },
+    'enhances' => {
+        name => 'Enhances',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 5,
+    },
+    'environment' => {
+        name => 'Environment',
+        allowed => CTRL_FILE_BUILDINFO,
+        separator => FIELD_SEP_LINE,
+    },
+    'essential' => {
+        name => 'Essential',
+        allowed => ALL_PKG,
+    },
+    'features' => {
+        name => 'Features',
+        allowed => CTRL_TESTS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'filename' => {
+        name => 'Filename',
+        allowed => CTRL_INDEX_PKG,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'files' => {
+        name => 'Files',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | CTRL_FILE_CHANGES | CTRL_COPYRIGHT_FILES,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'format' => {
+        name => 'Format',
+        allowed => CTRL_PKG_SRC | CTRL_INDEX_SRC | ALL_FILE_MANIFEST | CTRL_COPYRIGHT_HEADER,
+    },
+    'homepage' => {
+        name => 'Homepage',
+        allowed => ALL_SRC | ALL_PKG,
+    },
+    'installed-build-depends' => {
+        name => 'Installed-Build-Depends',
+        allowed => CTRL_FILE_BUILDINFO,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 12,
+    },
+    'installed-size' => {
+        name => 'Installed-Size',
+        allowed => ALL_PKG & ~CTRL_INFO_PKG,
+    },
+    'installer-menu-item' => {
+        name => 'Installer-Menu-Item',
+        allowed => ALL_PKG,
+    },
+    'kernel-version' => {
+        name => 'Kernel-Version',
+        allowed => ALL_PKG,
+    },
+    'label' => {
+        name => 'Label',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'license' => {
+        name => 'License',
+        allowed => ALL_COPYRIGHT,
+    },
+    'origin' => {
+        name => 'Origin',
+        allowed => (ALL_PKG | ALL_SRC | CTRL_REPO_RELEASE) & (~CTRL_INFO_PKG),
+    },
+    'maintainer' => {
+        name => 'Maintainer',
+        allowed => CTRL_PKG_DEB | CTRL_INDEX_PKG | CTRL_FILE_STATUS | ALL_SRC  | ALL_CHANGES,
+    },
+    'md5sum' => {
+        # XXX: Wrong capitalization due to historical reasons.
+        name => 'MD5sum',
+        allowed => CTRL_INDEX_PKG | CTRL_REPO_RELEASE,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'multi-arch' => {
+        name => 'Multi-Arch',
+        allowed => ALL_PKG,
+    },
+    'no-support-for-architecture-all' => {
+        name => 'No-Support-for-Architecture-all',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'notautomatic' => {
+        name => 'NotAutomatic',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'package' => {
+        name => 'Package',
+        allowed => ALL_PKG | CTRL_INDEX_SRC,
+    },
+    'package-list' => {
+        name => 'Package-List',
+        allowed => ALL_SRC & ~CTRL_INFO_SRC,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'package-type' => {
+        name => 'Package-Type',
+        allowed => ALL_PKG,
+    },
+    'parent' => {
+        name => 'Parent',
+        allowed => CTRL_FILE_VENDOR,
+    },
+    'pre-depends' => {
+        name => 'Pre-Depends',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 1,
+    },
+    'priority' => {
+        name => 'Priority',
+        allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG,
+    },
+    'protected' => {
+        name => 'Protected',
+        allowed => ALL_PKG,
+    },
+    'provides' => {
+        name => 'Provides',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 9,
+    },
+    'recommends' => {
+        name => 'Recommends',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 3,
+    },
+    'replaces' => {
+        name => 'Replaces',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 8,
+    },
+    'restrictions' => {
+        name => 'Restrictions',
+        allowed => CTRL_TESTS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'rules-requires-root' => {
+        name => 'Rules-Requires-Root',
+        allowed => CTRL_INFO_SRC,
+        separator => FIELD_SEP_SPACE,
+    },
+    'section' => {
+        name => 'Section',
+        allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG,
+    },
+    'sha1' => {
+        # XXX: Wrong capitalization due to historical reasons.
+        name => 'SHA1',
+        allowed => CTRL_INDEX_PKG | CTRL_REPO_RELEASE,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'sha256' => {
+        # XXX: Wrong capitalization due to historical reasons.
+        name => 'SHA256',
+        allowed => CTRL_INDEX_PKG | CTRL_REPO_RELEASE,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'size' => {
+        name => 'Size',
+        allowed => CTRL_INDEX_PKG,
+        separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
+    },
+    'source' => {
+        name => 'Source',
+        allowed => (ALL_PKG | ALL_SRC | ALL_CHANGES | CTRL_COPYRIGHT_HEADER | CTRL_FILE_BUILDINFO) &
+                   (~(CTRL_INDEX_SRC | CTRL_INFO_PKG)),
+    },
+    'standards-version' => {
+        name => 'Standards-Version',
+        allowed => ALL_SRC,
+    },
+    'static-built-using' => {
+        name => 'Static-Built-Using',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'union',
+        dep_order => 11,
+    },
+    'status' => {
+        name => 'Status',
+        allowed => CTRL_FILE_STATUS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'subarchitecture' => {
+        name => 'Subarchitecture',
+        allowed => ALL_PKG,
+    },
+    'suite' => {
+        name => 'Suite',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'suggests' => {
+        name => 'Suggests',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+        dependency => 'normal',
+        dep_order => 4,
+    },
+    'tag' => {
+        name => 'Tag',
+        allowed => ALL_PKG,
+        separator => FIELD_SEP_COMMA,
+    },
+    'task' => {
+        name => 'Task',
+        allowed => ALL_PKG,
+    },
+    'test-command' => {
+        name => 'Test-Command',
+        allowed => CTRL_TESTS,
+    },
+    'tests' => {
+        name => 'Tests',
+        allowed => CTRL_TESTS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'tests-directory' => {
+        name => 'Tests-Directory',
+        allowed => CTRL_TESTS,
+    },
+    'testsuite' => {
+        name => 'Testsuite',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+    },
+    'testsuite-triggers' => {
+        name => 'Testsuite-Triggers',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+    },
+    'timestamp' => {
+        name => 'Timestamp',
+        allowed => CTRL_CHANGELOG,
+    },
+    'triggers-awaited' => {
+        name => 'Triggers-Awaited',
+        allowed => CTRL_FILE_STATUS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'triggers-pending' => {
+        name => 'Triggers-Pending',
+        allowed => CTRL_FILE_STATUS,
+        separator => FIELD_SEP_SPACE,
+    },
+    'uploaders' => {
+        name => 'Uploaders',
+        allowed => ALL_SRC,
+        separator => FIELD_SEP_COMMA,
+    },
+    'upstream-name' => {
+        name => 'Upstream-Name',
+        allowed => CTRL_COPYRIGHT_HEADER,
+    },
+    'upstream-contact' => {
+        name => 'Upstream-Contact',
+        allowed => CTRL_COPYRIGHT_HEADER,
+    },
+    'urgency' => {
+        name => 'Urgency',
+        allowed => ALL_CHANGES,
+    },
+    'valid-until' => {
+        name => 'Valid-Until',
+        allowed => CTRL_REPO_RELEASE,
+    },
+    'vcs-browser' => {
+        name => 'Vcs-Browser',
+        allowed => ALL_SRC,
+    },
+    'vcs-arch' => {
+        name => 'Vcs-Arch',
+        allowed => ALL_SRC,
+    },
+    'vcs-bzr' => {
+        name => 'Vcs-Bzr',
+        allowed => ALL_SRC,
+    },
+    'vcs-cvs' => {
+        name => 'Vcs-Cvs',
+        allowed => ALL_SRC,
+    },
+    'vcs-darcs' => {
+        name => 'Vcs-Darcs',
+        allowed => ALL_SRC,
+    },
+    'vcs-git' => {
+        name => 'Vcs-Git',
+        allowed => ALL_SRC,
+    },
+    'vcs-hg' => {
+        name => 'Vcs-Hg',
+        allowed => ALL_SRC,
+    },
+    'vcs-mtn' => {
+        name => 'Vcs-Mtn',
+        allowed => ALL_SRC,
+    },
+    'vcs-svn' => {
+        name => 'Vcs-Svn',
+        allowed => ALL_SRC,
+    },
+    'vendor' => {
+        name => 'Vendor',
+        allowed => CTRL_FILE_VENDOR,
+    },
+    'vendor-url' => {
+        name => 'Vendor-Url',
+        allowed => CTRL_FILE_VENDOR,
+    },
+    'version' => {
+        name => 'Version',
+        allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_BUILDINFO | ALL_CHANGES | CTRL_REPO_RELEASE) &
+                    (~(CTRL_INFO_SRC | CTRL_INFO_PKG)),
+    },
+);
+
+my @src_vcs_fields = qw(
+    vcs-browser
+    vcs-arch
+    vcs-bzr
+    vcs-cvs
+    vcs-darcs
+    vcs-git
+    vcs-hg
+    vcs-mtn
+    vcs-svn
+);
+
+my @src_dep_fields = qw(
+    build-depends
+    build-depends-arch
+    build-depends-indep
+    build-conflicts
+    build-conflicts-arch
+    build-conflicts-indep
+);
+my @bin_dep_fields = qw(
+    pre-depends
+    depends
+    recommends
+    suggests
+    enhances
+    conflicts
+    breaks
+    replaces
+    provides
+    built-using
+    static-built-using
+);
+
+my @src_test_fields = qw(
+    testsuite
+    testsuite-triggers
+);
+
+my @src_checksums_fields = qw(
+    checksums-md5
+    checksums-sha1
+    checksums-sha256
+);
+my @bin_checksums_fields = qw(
+    md5sum
+    sha1
+    sha256
+);
+
+our %FIELD_ORDER = (
+    CTRL_INFO_SRC() => [
+        qw(
+            source
+            section
+            priority
+            maintainer
+            uploaders
+            origin
+            bugs
+        ),
+        @src_vcs_fields,
+        qw(
+            homepage
+            standards-version
+            rules-requires-root
+        ),
+        @src_dep_fields,
+        @src_test_fields,
+        qw(
+            description
+        ),
+    ],
+    CTRL_INFO_PKG() => [
+        qw(
+            package
+            package-type
+            section
+            priority
+            architecture
+            subarchitecture
+            multi-arch
+            essential
+            protected
+            build-essential
+            build-profiles
+            built-for-profiles
+            kernel-version
+        ),
+        @bin_dep_fields,
+        qw(
+            homepage
+            installer-menu-item
+            task
+            tag
+            description
+        ),
+    ],
+    CTRL_PKG_SRC() => [
+        qw(
+            format
+            source
+            binary
+            architecture
+            version
+            origin
+            maintainer
+            uploaders
+            homepage
+            description
+            standards-version
+        ),
+        @src_vcs_fields,
+        @src_test_fields,
+        @src_dep_fields,
+        qw(
+            package-list
+        ),
+        @src_checksums_fields,
+        qw(
+            files
+        ),
+    ],
+    CTRL_PKG_DEB() => [
+        qw(
+            package
+            package-type
+            source
+            version
+            kernel-version
+            built-for-profiles
+            auto-built-package
+            architecture
+            subarchitecture
+            installer-menu-item
+            build-essential
+            essential
+            protected
+            origin
+            bugs
+            maintainer
+            installed-size
+        ),
+        @bin_dep_fields,
+        qw(
+            section
+            priority
+            multi-arch
+            homepage
+            description
+            tag
+            task
+        ),
+    ],
+    CTRL_INDEX_SRC() => [
+        qw(
+            format
+            package
+            binary
+            architecture
+            version
+            priority
+            section
+            origin
+            maintainer
+            uploaders
+            homepage
+            description
+            standards-version
+        ),
+        @src_vcs_fields,
+        @src_test_fields,
+        @src_dep_fields,
+        qw(
+            package-list
+            directory
+        ),
+        @src_checksums_fields,
+        qw(
+            files
+        ),
+    ],
+    CTRL_INDEX_PKG() => [
+        qw(
+            package
+            package-type
+            source
+            version
+            kernel-version
+            built-for-profiles
+            auto-built-package
+            architecture
+            subarchitecture
+            installer-menu-item
+            build-essential
+            essential
+            protected
+            origin
+            bugs
+            maintainer
+            installed-size
+        ),
+        @bin_dep_fields,
+        qw(
+            filename
+            size
+        ),
+        @bin_checksums_fields,
+        qw(
+            section
+            priority
+            multi-arch
+            homepage
+            description
+            tag
+            task
+        ),
+    ],
+    CTRL_REPO_RELEASE() => [
+        qw(
+            origin
+            label
+            suite
+            version
+            codename
+            changelogs
+            date
+            valid-until
+            notautomatic
+            butautomaticupgrades
+            acquire-by-hash
+            no-support-for-architecture-all
+            architectures
+            components
+            description
+        ),
+        @bin_checksums_fields
+    ],
+    CTRL_CHANGELOG() => [
+        qw(
+            source
+            binary-only
+            version
+            distribution
+            urgency
+            maintainer
+            timestamp
+            date
+            closes
+            changes
+        ),
+    ],
+    CTRL_COPYRIGHT_HEADER() => [
+        qw(
+            format
+            upstream-name
+            upstream-contact
+            source
+            disclaimer
+            comment
+            license
+            copyright
+        ),
+    ],
+    CTRL_COPYRIGHT_FILES() => [
+        qw(
+            files
+            copyright
+            license
+            comment
+        ),
+    ],
+    CTRL_COPYRIGHT_LICENSE() => [
+        qw(
+            license
+            comment
+        ),
+    ],
+    CTRL_FILE_BUILDINFO() => [
+        qw(
+            format
+            source
+            binary
+            architecture
+            version
+            binary-only-changes
+        ),
+        @src_checksums_fields,
+        qw(
+            build-origin
+            build-architecture
+            build-kernel-version
+            build-date
+            build-path
+            build-tainted-by
+            installed-build-depends
+            environment
+        ),
+    ],
+    CTRL_FILE_CHANGES() => [
+        qw(
+            format
+            date
+            source
+            binary
+            binary-only
+            built-for-profiles
+            architecture
+            version
+            distribution
+            urgency
+            maintainer
+            changed-by
+            description
+            closes
+            changes
+        ),
+        @src_checksums_fields,
+        qw(
+            files
+        ),
+    ],
+    CTRL_FILE_VENDOR() => [
+        qw(
+            vendor
+            vendor-url
+            bugs
+            parent
+        ),
+    ],
+    CTRL_FILE_STATUS() => [
+        # Same as fieldinfos in lib/dpkg/parse.c
+        qw(
+            package
+            essential
+            protected
+            status
+            priority
+            section
+            installed-size
+            origin
+            maintainer
+            bugs
+            architecture
+            multi-arch
+            source
+            version
+            config-version
+            replaces
+            provides
+            depends
+            pre-depends
+            recommends
+            suggests
+            breaks
+            conflicts
+            enhances
+            conffiles
+            description
+            triggers-pending
+            triggers-awaited
+        ),
+        # These are allowed here, but not tracked by lib/dpkg/parse.c.
+        qw(
+            auto-built-package
+            build-essential
+            built-for-profiles
+            built-using
+            static-built-using
+            homepage
+            installer-menu-item
+            kernel-version
+            package-type
+            subarchitecture
+            tag
+            task
+        ),
+    ],
+    CTRL_TESTS() => [
+        qw(
+            test-command
+            tests
+            tests-directory
+            architecture
+            restrictions
+            features
+            classes
+            depends
+        ),
+    ],
+);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::FieldsCore - manage (list of official) control fields
+
+=head1 DESCRIPTION
+
+The modules contains a list of fieldnames with associated meta-data explaining
+in which type of control information they are allowed. The types are the
+CTRL_* constants exported by Dpkg::Control.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $f = field_capitalize($field_name)
+
+Returns the field name properly capitalized. All characters are lowercase,
+except the first of each word (words are separated by a hyphen in field names).
+
+=cut
+
+sub field_capitalize($) {
+    my $field = lc(shift);
+
+    # Use known fields first.
+    return $FIELDS{$field}{name} if exists $FIELDS{$field};
+
+    # Generic case
+    return join '-', map { ucfirst } split /-/, $field;
+}
+
+=item $bool = field_is_official($fname)
+
+Returns true if the field is official and known.
+
+=cut
+
+sub field_is_official($) {
+    my $field = lc shift;
+
+    return exists $FIELDS{$field};
+}
+
+=item $bool = field_is_allowed_in($fname, @types)
+
+Returns true (1) if the field $fname is allowed in all the types listed in
+the list. Note that you can use type sets instead of individual types (ex:
+CTRL_FILE_CHANGES | CTRL_CHANGELOG).
+
+field_allowed_in(A|B, C) returns true only if the field is allowed in C
+and either A or B.
+
+Undef is returned for non-official fields.
+
+=cut
+
+sub field_is_allowed_in($@) {
+    my ($field, @types) = @_;
+    $field = lc $field;
+
+    return unless exists $FIELDS{$field};
+
+    return 0 if not scalar(@types);
+    foreach my $type (@types) {
+        next if $type == CTRL_UNKNOWN; # Always allowed
+        return 0 unless $FIELDS{$field}{allowed} & $type;
+    }
+    return 1;
+}
+
+=item $new_field = field_transfer_single($from, $to, $field)
+
+If appropriate, copy the value of the field named $field taken from the
+$from Dpkg::Control object to the $to Dpkg::Control object.
+
+Official fields are copied only if the field is allowed in both types of
+objects. Custom fields are treated in a specific manner. When the target
+is not among CTRL_PKG_SRC, CTRL_PKG_DEB or CTRL_FILE_CHANGES, then they
+are always copied as is (the X- prefix is kept). Otherwise they are not
+copied except if the target object matches the target destination encoded
+in the field name. The initial X denoting custom fields can be followed by
+one or more letters among "S" (Source: corresponds to CTRL_PKG_SRC), "B"
+(Binary: corresponds to CTRL_PKG_DEB) or "C" (Changes: corresponds to
+CTRL_FILE_CHANGES).
+
+Returns undef if nothing has been copied or the name of the new field
+added to $to otherwise.
+
+=cut
+
+sub field_transfer_single($$;$) {
+    my ($from, $to, $field) = @_;
+    $field //= $_;
+    my ($from_type, $to_type) = ($from->get_type(), $to->get_type());
+    $field = field_capitalize($field);
+
+    if (field_is_allowed_in($field, $from_type, $to_type)) {
+        $to->{$field} = $from->{$field};
+        return $field;
+    } elsif ($field =~ /^X([SBC]*)-/i) {
+        my $dest = $1;
+        if (($dest =~ /B/i and $to_type == CTRL_PKG_DEB) or
+            ($dest =~ /S/i and $to_type == CTRL_PKG_SRC) or
+            ($dest =~ /C/i and $to_type == CTRL_FILE_CHANGES))
+        {
+            my $new = $field;
+            $new =~ s/^X([SBC]*)-//i;
+            $to->{$new} = $from->{$field};
+            return $new;
+        } elsif ($to_type != CTRL_PKG_DEB and
+		 $to_type != CTRL_PKG_SRC and
+		 $to_type != CTRL_FILE_CHANGES)
+	{
+	    $to->{$field} = $from->{$field};
+	    return $field;
+	}
+    } elsif (not field_is_allowed_in($field, $from_type)) {
+        warning(g_("unknown information field '%s' in input data in %s"),
+                $field, $from->get_option('name') || g_('control information'));
+    }
+    return;
+}
+
+=item @field_list = field_transfer_all($from, $to)
+
+Transfer all appropriate fields from $from to $to. Calls
+field_transfer_single() on all fields available in $from.
+
+Returns the list of fields that have been added to $to.
+
+=cut
+
+sub field_transfer_all($$) {
+    my ($from, $to) = @_;
+    my (@res, $res);
+    foreach my $k (keys %$from) {
+        $res = field_transfer_single($from, $to, $k);
+        push @res, $res if $res and defined wantarray;
+    }
+    return @res;
+}
+
+=item @field_list = field_ordered_list($type)
+
+Returns an ordered list of fields for a given type of control information.
+This list can be used to output the fields in a predictable order.
+The list might be empty for types where the order does not matter much.
+
+=cut
+
+sub field_ordered_list($) {
+    my $type = shift;
+
+    if (exists $FIELD_ORDER{$type}) {
+        return map { $FIELDS{$_}{name} } @{$FIELD_ORDER{$type}};
+    }
+    return ();
+}
+
+=item ($source, $version) = field_parse_binary_source($ctrl)
+
+Parse the B<Source> field in a binary package control stanza. The field
+contains the source package name where it was built from, and optionally
+a space and the source version enclosed in parenthesis if it is different
+from the binary version.
+
+Returns a list with the $source name, and the source $version, or undef
+or an empty list when $ctrl does not contain a binary package control stanza.
+Neither $source nor $version are validated, but that can be done with
+Dpkg::Package::pkg_name_is_illegal() and Dpkg::Version::version_check().
+
+=cut
+
+sub field_parse_binary_source($) {
+    my $ctrl = shift;
+    my $ctrl_type = $ctrl->get_type();
+
+    if ($ctrl_type != CTRL_INDEX_PKG and
+        $ctrl_type != CTRL_PKG_DEB and
+        $ctrl_type != CTRL_FILE_CHANGES and
+        $ctrl_type != CTRL_FILE_BUILDINFO and
+        $ctrl_type != CTRL_FILE_STATUS) {
+        return;
+    }
+
+    my ($source, $version);
+
+    # For .changes and .buildinfo the Source field always exists,
+    # and there is no Package field.
+    if (exists $ctrl->{'Source'}) {
+        $source = $ctrl->{'Source'};
+        if ($source =~ m/^([^ ]+) +\(([^)]*)\)$/) {
+            $source = $1;
+            $version = $2;
+        } else {
+            $version = $ctrl->{'Version'};
+        }
+    } else {
+        $source = $ctrl->{'Package'};
+        $version = $ctrl->{'Version'};
+    }
+
+    return ($source, $version);
+}
+
+=item @field_list = field_list_src_dep()
+
+List of fields that contains dependencies-like information in a source
+Debian package.
+
+=cut
+
+sub field_list_src_dep() {
+    my @list = map {
+        $FIELDS{$_}{name}
+    } sort {
+        $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order}
+    } grep {
+        field_is_allowed_in($_, CTRL_PKG_SRC) and
+        exists $FIELDS{$_}{dependency}
+    } keys %FIELDS;
+    return @list;
+}
+
+=item @field_list = field_list_pkg_dep()
+
+List of fields that contains dependencies-like information in a binary
+Debian package. The fields that express real dependencies are sorted from
+the stronger to the weaker.
+
+=cut
+
+sub field_list_pkg_dep() {
+    my @list = map {
+        $FIELDS{$_}{name}
+    } sort {
+        $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order}
+    } grep {
+        field_is_allowed_in($_, CTRL_PKG_DEB) and
+        exists $FIELDS{$_}{dependency}
+    } keys %FIELDS;
+    return @list;
+}
+
+=item $dep_type = field_get_dep_type($field)
+
+Return the type of the dependency expressed by the given field. Can
+either be "normal" for a real dependency field (Pre-Depends, Depends, ...)
+or "union" for other relation fields sharing the same syntax (Conflicts,
+Breaks, ...). Returns undef for fields which are not dependencies.
+
+=cut
+
+sub field_get_dep_type($) {
+    my $field = lc shift;
+
+    return unless exists $FIELDS{$field};
+    return $FIELDS{$field}{dependency} if exists $FIELDS{$field}{dependency};
+    return;
+}
+
+=item $sep_type = field_get_sep_type($field)
+
+Return the type of the field value separator. Can be one of FIELD_SEP_UNKNOWN,
+FIELD_SEP_SPACE, FIELD_SEP_COMMA or FIELD_SEP_LINE.
+
+=cut
+
+sub field_get_sep_type($) {
+    my $field = lc shift;
+
+    return $FIELDS{$field}{separator} if exists $FIELDS{$field}{separator};
+    return FIELD_SEP_UNKNOWN;
+}
+
+=item field_register($field, $allowed_types, %opts)
+
+Register a new field as being allowed in control information of specified
+types. %opts is optional.
+
+=cut
+
+sub field_register($$;@) {
+    my ($field, $types, %opts) = @_;
+
+    $field = lc $field;
+    $FIELDS{$field} = {
+        name => field_capitalize($field),
+        allowed => $types,
+        %opts
+    };
+
+    return;
+}
+
+=item $bool = field_insert_after($type, $ref, @fields)
+
+Place field after another one ($ref) in output of control information of
+type $type.
+
+Return true if the field was inserted, otherwise false.
+
+=cut
+
+sub field_insert_after($$@) {
+    my ($type, $field, @fields) = @_;
+
+    return 0 if not exists $FIELD_ORDER{$type};
+
+    ($field, @fields) = map { lc } ($field, @fields);
+    @{$FIELD_ORDER{$type}} = map {
+        ($_ eq $field) ? ($_, @fields) : $_
+    } @{$FIELD_ORDER{$type}};
+
+    return 1;
+}
+
+=item $bool = field_insert_before($type, $ref, @fields)
+
+Place field before another one ($ref) in output of control information of
+type $type.
+
+Return true if the field was inserted, otherwise false.
+
+=cut
+
+sub field_insert_before($$@) {
+    my ($type, $field, @fields) = @_;
+
+    return 0 if not exists $FIELD_ORDER{$type};
+
+    ($field, @fields) = map { lc } ($field, @fields);
+    @{$FIELD_ORDER{$type}} = map {
+        ($_ eq $field) ? (@fields, $_) : $_
+    } @{$FIELD_ORDER{$type}};
+
+    return 1;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.21.0)
+
+New function: field_parse_binary_source().
+
+=head2 Version 1.00 (dpkg 1.17.0)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Hash.pm b/scripts/Dpkg/Control/Hash.pm
new file mode 100644
index 0000000..8b7f54f
--- /dev/null
+++ b/scripts/Dpkg/Control/Hash.pm
@@ -0,0 +1,48 @@
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Control::Hash;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Fields; # Force execution of vendor hook.
+
+use parent qw(Dpkg::Control::HashCore);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Hash - parse and manipulate a stanza of deb822 fields
+
+=head1 DESCRIPTION
+
+This module is just like Dpkg::Control::HashCore, with vendor-specific
+field knowledge.
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/HashCore.pm b/scripts/Dpkg/Control/HashCore.pm
new file mode 100644
index 0000000..0bdb812
--- /dev/null
+++ b/scripts/Dpkg/Control/HashCore.pm
@@ -0,0 +1,589 @@
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2009, 2012-2019, 2021 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/>.
+
+package Dpkg::Control::HashCore;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::FieldsCore;
+
+# This module cannot use Dpkg::Control::Fields, because that one makes use
+# of Dpkg::Vendor which at the same time uses this module, which would turn
+# into a compilation error. We can use Dpkg::Control::FieldsCore instead.
+
+use parent qw(Dpkg::Interface::Storable);
+
+use overload
+    '%{}' => sub { ${$_[0]}->{fields} },
+    'eq' => sub { "$_[0]" eq "$_[1]" };
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::HashCore - parse and manipulate a stanza of deb822 fields
+
+=head1 DESCRIPTION
+
+The Dpkg::Control::Hash class is a hash-like representation of a set of
+RFC822-like fields. The fields names are case insensitive and are always
+capitalized the same when output (see field_capitalize function in
+Dpkg::Control::Fields).
+The order in which fields have been set is remembered and is used
+to be able to dump back the same content. The output order can also be
+overridden if needed.
+
+You can store arbitrary values in the hash, they will always be properly
+escaped in the output to conform to the syntax of control files. This is
+relevant mainly for multilines values: while the first line is always output
+unchanged directly after the field name, supplementary lines are
+modified. Empty lines and lines containing only dots are prefixed with
+" ." (space + dot) while other lines are prefixed with a single space.
+
+During parsing, trailing spaces are stripped on all lines while leading
+spaces are stripped only on the first line of each field.
+
+=head1 METHODS
+
+=over 4
+
+=item $c = Dpkg::Control::Hash->new(%opts)
+
+Creates a new object with the indicated options. Supported options
+are:
+
+=over 8
+
+=item allow_pgp
+
+Configures the parser to accept OpenPGP signatures around the control
+information. Value can be 0 (default) or 1.
+
+=item allow_duplicate
+
+Configures the parser to allow duplicate fields in the control
+information.
+The last value overrides any previous values.
+Value can be 0 (default) or 1.
+
+=item keep_duplicate
+
+Configure the parser to keep values for duplicate fields found in the control
+information (when B<allow_duplicate> is enabled), as array references.
+Value can be 0 (default) or 1.
+
+=item drop_empty
+
+Defines if empty fields are dropped during the output. Value can be 0
+(default) or 1.
+
+=item name
+
+The user friendly name of the information stored in the object. It might
+be used in some error messages or warnings. A default name might be set
+depending on the type.
+
+=item is_pgp_signed
+
+Set by the parser (starting in dpkg 1.17.0) if it finds an OpenPGP
+signature around the control information. Value can be 0 (default)
+or 1, and undef when the option is not supported by the code (in
+versions older than dpkg 1.17.0).
+
+=back
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    # Object is a scalar reference and not a hash ref to avoid
+    # infinite recursion due to overloading hash-dereferencing
+    my $self = \{
+        in_order => [],
+        out_order => [],
+        is_pgp_signed => 0,
+        allow_pgp => 0,
+        allow_duplicate => 0,
+        keep_duplicate => 0,
+        drop_empty => 0,
+    };
+    bless $self, $class;
+
+    $$self->{fields} = Dpkg::Control::HashCore::Tie->new($self);
+
+    # Options set by the user override default values
+    $$self->{$_} = $opts{$_} foreach keys %opts;
+
+    return $self;
+}
+
+# There is naturally a circular reference between the tied hash and its
+# containing object. Happily, the extra layer of scalar reference can
+# be used to detect the destruction of the object and break the loop so
+# that everything gets garbage-collected.
+
+sub DESTROY {
+    my $self = shift;
+    delete $$self->{fields};
+}
+
+=item $c->set_options($option, %opts)
+
+Changes the value of one or more options.
+
+=cut
+
+sub set_options {
+    my ($self, %opts) = @_;
+    $$self->{$_} = $opts{$_} foreach keys %opts;
+}
+
+=item $value = $c->get_option($option)
+
+Returns the value of the corresponding option.
+
+=cut
+
+sub get_option {
+    my ($self, $k) = @_;
+    return $$self->{$k};
+}
+
+=item $c->parse_error($file, $fmt, ...)
+
+Prints an error message and dies on syntax parse errors.
+
+=cut
+
+sub parse_error {
+    my ($self, $file, $msg) = (shift, shift, shift);
+
+    $msg = sprintf($msg, @_) if (@_);
+    error(g_('syntax error in %s at line %d: %s'), $file, $., $msg);
+}
+
+=item $c->parse($fh, $description)
+
+Parse a control file from the given filehandle. Exits in case of errors.
+$description is used to describe the filehandle, ideally it's a filename
+or a description of where the data comes from. It's used in error
+messages. When called multiple times, the parsed fields are accumulated.
+
+Returns true if some fields have been parsed.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+
+    my $paraborder = 1;
+    my $parabody = 0;
+    my $cf; # Current field
+    my $expect_pgp_sig = 0;
+    local $_;
+
+    while (<$fh>) {
+        # In the common case there will be just a trailing \n character,
+        # so using chomp here which is very fast will avoid the latter
+        # s/// doing anything, which gives usa significant speed up.
+	chomp;
+        my $armor = $_;
+        s/\s+$//;
+
+        next if length == 0 and $paraborder;
+
+        my $lead = substr $_, 0, 1;
+        next if $lead eq '#';
+	$paraborder = 0;
+
+        my ($name, $value) = split /\s*:\s*/, $_, 2;
+        if (defined $name and $name =~ m/^\S+?$/) {
+	    $parabody = 1;
+            if ($lead eq '-') {
+		$self->parse_error($desc, g_('field cannot start with a hyphen'));
+	    }
+	    if (exists $self->{$name}) {
+		unless ($$self->{allow_duplicate}) {
+		    $self->parse_error($desc, g_('duplicate field %s found'), $name);
+		}
+                if ($$self->{keep_duplicate}) {
+                    if (ref $self->{$name} ne 'ARRAY') {
+                        # Switch value into an array.
+                        $self->{$name} = [ $self->{$name}, $value ];
+                    } else {
+                        # Append the value.
+                        push @{$self->{$name}}, $value;
+                    }
+                } else {
+                    # Overwrite with last value.
+                    $self->{$name} = $value;
+                }
+            } else {
+                $self->{$name} = $value;
+            }
+	    $cf = $name;
+	} elsif (m/^\s(\s*\S.*)$/) {
+	    my $line = $1;
+	    unless (defined($cf)) {
+		$self->parse_error($desc, g_('continued value line not in field'));
+            }
+	    if ($line =~ /^\.+$/) {
+		$line = substr $line, 1;
+	    }
+	    $self->{$cf} .= "\n$line";
+        } elsif (length == 0 ||
+                 ($expect_pgp_sig && $armor =~ m/^-----BEGIN PGP SIGNATURE-----[\r\t ]*$/)) {
+	    if ($expect_pgp_sig) {
+		# Skip empty lines
+		$_ = <$fh> while defined && m/^\s*$/;
+		unless (length) {
+		    $self->parse_error($desc, g_('expected OpenPGP signature, ' .
+		                                 'found end of file after blank line'));
+		}
+		chomp;
+		unless (m/^-----BEGIN PGP SIGNATURE-----[\r\t ]*$/) {
+		    $self->parse_error($desc, g_('expected OpenPGP signature, ' .
+		                                 "found something else '%s'"), $_);
+                }
+		# Skip OpenPGP signature
+		while (<$fh>) {
+		    chomp;
+		    last if m/^-----END PGP SIGNATURE-----[\r\t ]*$/;
+		}
+		unless (defined) {
+		    $self->parse_error($desc, g_('unfinished OpenPGP signature'));
+                }
+		# This does not mean the signature is correct, that needs to
+		# be verified by an OpenPGP backend.
+		$$self->{is_pgp_signed} = 1;
+	    }
+            # Finished parsing one stanza.
+            last;
+        } elsif ($armor =~ m/^-----BEGIN PGP SIGNED MESSAGE-----[\r\t ]*$/) {
+            $expect_pgp_sig = 1;
+            if ($$self->{allow_pgp} and not $parabody) {
+                # Skip OpenPGP headers
+                while (<$fh>) {
+                    last if m/^\s*$/;
+                }
+            } else {
+                $self->parse_error($desc, g_('OpenPGP signature not allowed here'));
+            }
+	} else {
+	    $self->parse_error($desc,
+	                       g_('line with unknown format (not field-colon-value)'));
+	}
+    }
+
+    if ($expect_pgp_sig and not $$self->{is_pgp_signed}) {
+	$self->parse_error($desc, g_('unfinished OpenPGP signature'));
+    }
+
+    return defined($cf);
+}
+
+=item $c->load($file)
+
+Parse the content of $file. Exits in case of errors. Returns true if some
+fields have been parsed.
+
+=item $c->find_custom_field($name)
+
+Scan the fields and look for a user specific field whose name matches the
+following regex: /X[SBC]*-$name/i. Return the name of the field found or
+undef if nothing has been found.
+
+=cut
+
+sub find_custom_field {
+    my ($self, $name) = @_;
+    foreach my $key (keys %$self) {
+        return $key if $key =~ /^X[SBC]*-\Q$name\E$/i;
+    }
+    return;
+}
+
+=item $c->get_custom_field($name)
+
+Identify a user field and retrieve its value.
+
+=cut
+
+sub get_custom_field {
+    my ($self, $name) = @_;
+    my $key = $self->find_custom_field($name);
+    return $self->{$key} if defined $key;
+    return;
+}
+
+=item $str = $c->output()
+
+=item "$c"
+
+Get a string representation of the control information. The fields
+are sorted in the order in which they have been read or set except
+if the order has been overridden with set_output_order().
+
+=item $c->output($fh)
+
+Print the string representation of the control information to a
+filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    my @keys;
+    if (@{$$self->{out_order}}) {
+        my $i = 1;
+        my $imp = {};
+        $imp->{$_} = $i++ foreach @{$$self->{out_order}};
+        @keys = sort {
+            if (defined $imp->{$a} && defined $imp->{$b}) {
+                $imp->{$a} <=> $imp->{$b};
+            } elsif (defined($imp->{$a})) {
+                -1;
+            } elsif (defined($imp->{$b})) {
+                1;
+            } else {
+                $a cmp $b;
+            }
+        } keys %$self;
+    } else {
+        @keys = @{$$self->{in_order}};
+    }
+
+    foreach my $key (@keys) {
+	if (exists $self->{$key}) {
+	    my $value = $self->{$key};
+            # Skip whitespace-only fields
+            next if $$self->{drop_empty} and $value !~ m/\S/;
+	    # Escape data to follow control file syntax
+	    my ($first_line, @lines) = split /\n/, $value;
+
+	    my $kv = "$key:";
+	    $kv .= ' ' . $first_line if length $first_line;
+	    $kv .= "\n";
+	    foreach (@lines) {
+		s/\s+$//;
+		if (length == 0 or /^\.+$/) {
+		    $kv .= " .$_\n";
+		} else {
+		    $kv .= " $_\n";
+		}
+	    }
+	    # Print it out
+            if ($fh) {
+	        print { $fh } $kv
+	            or syserr(g_('write error on control data'));
+            }
+	    $str .= $kv if defined wantarray;
+	}
+    }
+    return $str;
+}
+
+=item $c->save($filename)
+
+Write the string representation of the control information to a file.
+
+=item $c->set_output_order(@fields)
+
+Define the order in which fields will be displayed in the output() method.
+
+=cut
+
+sub set_output_order {
+    my ($self, @fields) = @_;
+
+    $$self->{out_order} = [@fields];
+}
+
+=item $c->apply_substvars($substvars)
+
+Update all fields by replacing the variables references with
+the corresponding value stored in the Dpkg::Substvars object.
+
+=cut
+
+sub apply_substvars {
+    my ($self, $substvars, %opts) = @_;
+
+    # Add substvars to refer to other fields
+    $substvars->set_field_substvars($self, 'F');
+
+    foreach my $f (keys %$self) {
+        my $v = $substvars->substvars($self->{$f}, %opts);
+	if ($v ne $self->{$f}) {
+	    my $sep;
+
+	    $sep = field_get_sep_type($f);
+
+	    # If we replaced stuff, ensure we're not breaking
+	    # a dependency field by introducing empty lines, or multiple
+	    # commas
+
+	    if ($sep & (FIELD_SEP_COMMA | FIELD_SEP_LINE)) {
+	        # Drop empty/whitespace-only lines
+	        $v =~ s/\n[ \t]*(\n|$)/$1/;
+	    }
+
+	    if ($sep & FIELD_SEP_COMMA) {
+	        $v =~ s/,[\s,]*,/,/g;
+	        $v =~ s/^\s*,\s*//;
+	        $v =~ s/\s*,\s*$//;
+	    }
+	}
+        # Replace ${} with $, which is otherwise an invalid substitution, but
+        # this then makes it possible to use ${} as an escape sequence such
+        # as ${}{VARIABLE}.
+        $v =~ s/\$\{\}/\$/g;
+
+        $self->{$f} = $v;
+    }
+}
+
+package Dpkg::Control::HashCore::Tie;
+
+# This class is used to tie a hash. It implements hash-like functions by
+# normalizing the name of fields received in keys (using
+# Dpkg::Control::Fields::field_capitalize). It also stores the order in
+# which fields have been added in order to be able to dump them in the
+# same order. But the order information is stored in a parent object of
+# type Dpkg::Control.
+
+use strict;
+use warnings;
+
+use Dpkg::Control::FieldsCore;
+
+use Carp;
+use Tie::Hash;
+use parent -norequire, qw(Tie::ExtraHash);
+
+# $self->[0] is the real hash
+# $self->[1] is a reference to the hash contained by the parent object.
+# This reference bypasses the top-level scalar reference of a
+# Dpkg::Control::Hash, hence ensuring that reference gets DESTROYed
+# properly.
+
+# Dpkg::Control::Hash->new($parent)
+#
+# Return a reference to a tied hash implementing storage of simple
+# "field: value" mapping as used in many Debian-specific files.
+
+sub new {
+    my $class = shift;
+    my $hash = {};
+    tie %{$hash}, $class, @_; ## no critic (Miscellanea::ProhibitTies)
+    return $hash;
+}
+
+sub TIEHASH  {
+    my ($class, $parent) = @_;
+    croak 'parent object must be Dpkg::Control::Hash'
+        if not $parent->isa('Dpkg::Control::HashCore') and
+           not $parent->isa('Dpkg::Control::Hash');
+    return bless [ {}, $$parent ], $class;
+}
+
+sub FETCH {
+    my ($self, $key) = @_;
+    $key = lc($key);
+    return $self->[0]->{$key} if exists $self->[0]->{$key};
+    return;
+}
+
+sub STORE {
+    my ($self, $key, $value) = @_;
+    $key = lc($key);
+    if (not exists $self->[0]->{$key}) {
+        push @{$self->[1]->{in_order}}, field_capitalize($key);
+    }
+    $self->[0]->{$key} = $value;
+}
+
+sub EXISTS {
+    my ($self, $key) = @_;
+    $key = lc($key);
+    return exists $self->[0]->{$key};
+}
+
+sub DELETE {
+    my ($self, $key) = @_;
+    my $parent = $self->[1];
+    my $in_order = $parent->{in_order};
+    $key = lc($key);
+    if (exists $self->[0]->{$key}) {
+	delete $self->[0]->{$key};
+	@{$in_order} = grep { lc ne $key } @{$in_order};
+	return 1;
+    } else {
+	return 0;
+    }
+}
+
+sub FIRSTKEY {
+    my $self = shift;
+    my $parent = $self->[1];
+    foreach my $key (@{$parent->{in_order}}) {
+	return $key if exists $self->[0]->{lc $key};
+    }
+}
+
+sub NEXTKEY {
+    my ($self, $last) = @_;
+    my $parent = $self->[1];
+    my $found = 0;
+    foreach my $key (@{$parent->{in_order}}) {
+	if ($found) {
+	    return $key if exists $self->[0]->{lc $key};
+	} else {
+	    $found = 1 if $key eq $last;
+	}
+    }
+    return;
+}
+
+1;
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.21.0)
+
+New option: "keep_duplicate" in new().
+
+=head2 Version 1.01 (dpkg 1.17.2)
+
+New method: $c->parse_error().
+
+=head2 Version 1.00 (dpkg 1.17.0)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Info.pm b/scripts/Dpkg/Control/Info.pm
new file mode 100644
index 0000000..e4bc85e
--- /dev/null
+++ b/scripts/Dpkg/Control/Info.pm
@@ -0,0 +1,227 @@
+# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2009, 2012-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/>.
+
+package Dpkg::Control::Info;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+
+use Dpkg::Control;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+use parent qw(Dpkg::Interface::Storable);
+
+use overload
+    '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] };
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Info - parse files like debian/control
+
+=head1 DESCRIPTION
+
+It provides a class to access data of files that follow the same
+syntax as F<debian/control>.
+
+=head1 METHODS
+
+=over 4
+
+=item $c = Dpkg::Control::Info->new(%opts)
+
+Create a new Dpkg::Control::Info object. Loads the file from the filename
+option, if no option is specified filename defaults to F<debian/control>.
+If a scalar is passed instead, it will be used as the filename. If filename
+is "-", it parses the standard input. If filename is undef no loading will
+be performed.
+
+=cut
+
+sub new {
+    my ($this, @args) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	source => undef,
+	packages => [],
+    };
+    bless $self, $class;
+
+    my %opts;
+    if (scalar @args == 0) {
+        $opts{filename} = 'debian/control';
+    } elsif (scalar @args == 1) {
+        $opts{filename} = $args[0];
+    } else {
+        %opts = @args;
+    }
+
+    $self->load($opts{filename}) if $opts{filename};
+
+    return $self;
+}
+
+=item $c->reset()
+
+Resets what got read.
+
+=cut
+
+sub reset {
+    my $self = shift;
+    $self->{source} = undef;
+    $self->{packages} = [];
+}
+
+=item $c->parse($fh, $description)
+
+Parse a control file from the given filehandle. Exits in case of errors.
+$description is used to describe the filehandle, ideally it's a filename
+or a description of where the data comes from. It is used in error messages.
+The data in the object is reset before parsing new control files.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+    $self->reset();
+    my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
+    return if not $cdata->parse($fh, $desc);
+    $self->{source} = $cdata;
+    unless (exists $cdata->{Source}) {
+        $cdata->parse_error($desc, g_("first stanza lacks a '%s' field"),
+                            'Source');
+    }
+    while (1) {
+	$cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
+        last if not $cdata->parse($fh, $desc);
+	push @{$self->{packages}}, $cdata;
+	unless (exists $cdata->{Package}) {
+	    $cdata->parse_error($desc, g_("stanza lacks the '%s' field"),
+	                        'Package');
+	}
+	unless (exists $cdata->{Architecture}) {
+	    $cdata->parse_error($desc, g_("stanza lacks the '%s' field"),
+	                        'Architecture');
+	}
+    }
+}
+
+=item $c->load($file)
+
+Load the content of $file. Exits in case of errors. If file is "-", it
+loads from the standard input.
+
+=item $c->[0]
+
+=item $c->get_source()
+
+Returns a Dpkg::Control object containing the fields concerning the
+source package.
+
+=cut
+
+sub get_source {
+    my $self = shift;
+    return $self->{source};
+}
+
+=item $c->get_pkg_by_idx($idx)
+
+Returns a Dpkg::Control object containing the fields concerning the binary
+package numbered $idx (starting at 1).
+
+=cut
+
+sub get_pkg_by_idx {
+    my ($self, $idx) = @_;
+    return $self->{packages}[--$idx];
+}
+
+=item $c->get_pkg_by_name($name)
+
+Returns a Dpkg::Control object containing the fields concerning the binary
+package named $name.
+
+=cut
+
+sub get_pkg_by_name {
+    my ($self, $name) = @_;
+    foreach my $pkg (@{$self->{packages}}) {
+	return $pkg if ($pkg->{Package} eq $name);
+    }
+    return;
+}
+
+
+=item $c->get_packages()
+
+Returns a list containing the Dpkg::Control objects for all binary packages.
+
+=cut
+
+sub get_packages {
+    my $self = shift;
+    return @{$self->{packages}};
+}
+
+=item $str = $c->output([$fh])
+
+Return the content info into a string. If $fh is specified print it into
+the filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str;
+    $str .= $self->{source}->output($fh);
+    foreach my $pkg (@{$self->{packages}}) {
+	print { $fh } "\n" if defined $fh;
+	$str .= "\n" . $pkg->output($fh);
+    }
+    return $str;
+}
+
+=item "$c"
+
+Return a string representation of the content.
+
+=item @{$c}
+
+Return a list of Dpkg::Control objects, the first one is corresponding to
+source information and the following ones are the binary packages
+information.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.18.0)
+
+New argument: The $c->new() constructor accepts an %opts argument.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Tests.pm b/scripts/Dpkg/Control/Tests.pm
new file mode 100644
index 0000000..3c8d1c0
--- /dev/null
+++ b/scripts/Dpkg/Control/Tests.pm
@@ -0,0 +1,83 @@
+# Copyright © 2016 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/>.
+
+package Dpkg::Control::Tests;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Control;
+use Dpkg::Control::Tests::Entry;
+use Dpkg::Index;
+
+use parent qw(Dpkg::Index);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Tests - parse files like debian/tests/control
+
+=head1 DESCRIPTION
+
+It provides a class to access data of files that follow the same
+syntax as F<debian/tests/control>.
+
+=head1 METHODS
+
+All the methods of Dpkg::Index are available. Those listed below are either
+new or overridden with a different behavior.
+
+=over 4
+
+=item $c = Dpkg::Control::Tests->new(%opts)
+
+Create a new Dpkg::Control::Tests object, which inherits from Dpkg::Index.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = Dpkg::Index->new(type => CTRL_TESTS, %opts);
+
+    return bless $self, $class;
+}
+
+=item $item = $tests->new_item()
+
+Creates a new item.
+
+=cut
+
+sub new_item {
+    my $self = shift;
+
+    return Dpkg::Control::Tests::Entry->new();
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.18.8)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Tests/Entry.pm b/scripts/Dpkg/Control/Tests/Entry.pm
new file mode 100644
index 0000000..cbcd7e8
--- /dev/null
+++ b/scripts/Dpkg/Control/Tests/Entry.pm
@@ -0,0 +1,94 @@
+# Copyright © 2016 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/>.
+
+package Dpkg::Control::Tests::Entry;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control;
+
+use parent qw(Dpkg::Control);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Tests::Entry - represents a test suite entry
+
+=head1 DESCRIPTION
+
+This class represents a test suite entry.
+
+=head1 METHODS
+
+All the methods of Dpkg::Control are available. Those listed below are either
+new or overridden with a different behavior.
+
+=over 4
+
+=item $entry = Dpkg::Control::Tests::Entry->new()
+
+Creates a new object. It does not represent a real control test entry
+until one has been successfully parsed or built from scratch.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = Dpkg::Control->new(type => CTRL_TESTS, %opts);
+    bless $self, $class;
+    return $self;
+}
+
+=item $entry->parse($fh, $desc)
+
+Parse a control test entry from a filehandle. When called multiple times,
+the parsed fields are accumulated.
+
+Returns true if parsing was a success.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+
+    return if not $self->SUPER::parse($fh, $desc);
+
+    if (not exists $self->{'Tests'} and not exists $self->{'Test-Command'}) {
+        $self->parse_error($desc, g_('stanza lacks either %s or %s fields'),
+                           'Tests', 'Test-Command');
+    }
+
+    return 1;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.18.8)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Types.pm b/scripts/Dpkg/Control/Types.pm
new file mode 100644
index 0000000..8dd1aa1
--- /dev/null
+++ b/scripts/Dpkg/Control/Types.pm
@@ -0,0 +1,102 @@
+# 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/>.
+
+package Dpkg::Control::Types;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    CTRL_UNKNOWN
+    CTRL_INFO_SRC
+    CTRL_INFO_PKG
+    CTRL_REPO_RELEASE
+    CTRL_INDEX_SRC
+    CTRL_INDEX_PKG
+    CTRL_PKG_SRC
+    CTRL_PKG_DEB
+    CTRL_FILE_BUILDINFO
+    CTRL_FILE_CHANGES
+    CTRL_FILE_VENDOR
+    CTRL_FILE_STATUS
+    CTRL_CHANGELOG
+    CTRL_COPYRIGHT_HEADER
+    CTRL_COPYRIGHT_FILES
+    CTRL_COPYRIGHT_LICENSE
+    CTRL_TESTS
+);
+
+use Exporter qw(import);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Control::Types - export CTRL_* constants
+
+=head1 DESCRIPTION
+
+You should not use this module directly. Instead you more likely
+want to use Dpkg::Control which also re-exports the same constants.
+
+This module has been introduced solely to avoid a dependency loop
+between Dpkg::Control and Dpkg::Control::Fields.
+
+=cut
+
+use constant {
+    CTRL_UNKNOWN => 0,
+    # First control stanza in debian/control.
+    CTRL_INFO_SRC => 1 << 0,
+    # Subsequent control stanza in debian/control.
+    CTRL_INFO_PKG => 1 << 1,
+    # Entry in repository's Sources files.
+    CTRL_INDEX_SRC => 1 << 2,
+    # Entry in repository's Packages files.
+    CTRL_INDEX_PKG => 1 << 3,
+    # .dsc file of source package.
+    CTRL_PKG_SRC => 1 << 4,
+    # DEBIAN/control in binary packages.
+    CTRL_PKG_DEB => 1 << 5,
+    # .changes file.
+    CTRL_FILE_CHANGES => 1 << 6,
+    # File in $Dpkg::CONFDIR/origins.
+    CTRL_FILE_VENDOR => 1 << 7,
+    # $Dpkg::ADMINDIR/status.
+    CTRL_FILE_STATUS => 1 << 8,
+    # Output of dpkg-parsechangelog.
+    CTRL_CHANGELOG => 1 << 9,
+    # Repository's (In)Release file.
+    CTRL_REPO_RELEASE => 1 << 10,
+    # Header control stanza in debian/copyright.
+    CTRL_COPYRIGHT_HEADER => 1 << 11,
+    # Files control stanza in debian/copyright.
+    CTRL_COPYRIGHT_FILES => 1 << 12,
+    # License control stanza in debian/copyright.
+    CTRL_COPYRIGHT_LICENSE => 1 << 13,
+    # Package test suite control file in debian/tests/control.
+    CTRL_TESTS => 1 << 14,
+    # .buildinfo file
+    CTRL_FILE_BUILDINFO => 1 << 15,
+};
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps.pm b/scripts/Dpkg/Deps.pm
new file mode 100644
index 0000000..5afa384
--- /dev/null
+++ b/scripts/Dpkg/Deps.pm
@@ -0,0 +1,490 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009,2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps - parse and manipulate dependencies of Debian packages
+
+=head1 DESCRIPTION
+
+The Dpkg::Deps module provides classes implementing various types of
+dependencies.
+
+The most important function is deps_parse(), it turns a dependency line in
+a set of Dpkg::Deps::{Simple,AND,OR,Union} objects depending on the case.
+
+=head1 FUNCTIONS
+
+All the deps_* functions are exported by default.
+
+=over 4
+
+=cut
+
+use strict;
+use warnings;
+use feature qw(current_sub);
+
+our $VERSION = '1.07';
+our @EXPORT = qw(
+    deps_concat
+    deps_parse
+    deps_eval_implication
+    deps_iterate
+    deps_compare
+);
+
+use Carp;
+use Exporter qw(import);
+
+use Dpkg::Version;
+use Dpkg::Arch qw(get_host_arch get_build_arch debarch_to_debtuple);
+use Dpkg::BuildProfiles qw(get_build_profiles);
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Deps::Simple;
+use Dpkg::Deps::Union;
+use Dpkg::Deps::AND;
+use Dpkg::Deps::OR;
+use Dpkg::Deps::KnownFacts;
+
+=item deps_eval_implication($rel_p, $v_p, $rel_q, $v_q)
+
+($rel_p, $v_p) and ($rel_q, $v_q) express two dependencies as (relation,
+version). The relation variable can have the following values that are
+exported by Dpkg::Version: REL_EQ, REL_LT, REL_LE, REL_GT, REL_GT.
+
+This functions returns 1 if the "p" dependency implies the "q"
+dependency. It returns 0 if the "p" dependency implies that "q" is
+not satisfied. It returns undef when there's no implication.
+
+The $v_p and $v_q parameter should be Dpkg::Version objects.
+
+=cut
+
+sub deps_eval_implication {
+    my ($rel_p, $v_p, $rel_q, $v_q) = @_;
+
+    # If versions are not valid, we can't decide of any implication
+    return unless defined($v_p) and $v_p->is_valid();
+    return unless defined($v_q) and $v_q->is_valid();
+
+    # q wants an exact version, so p must provide that exact version.  p
+    # disproves q if q's version is outside the range enforced by p.
+    if ($rel_q eq REL_EQ) {
+        if ($rel_p eq REL_LT) {
+            return ($v_p <= $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_LE) {
+            return ($v_p < $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_GT) {
+            return ($v_p >= $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_GE) {
+            return ($v_p > $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_EQ) {
+            return ($v_p == $v_q);
+        }
+    }
+
+    # A greater than clause may disprove a less than clause. An equal
+    # cause might as well.  Otherwise, if
+    # p's clause is <<, <=, or =, the version must be <= q's to imply q.
+    if ($rel_q eq REL_LE) {
+        if ($rel_p eq REL_GT) {
+            return ($v_p >= $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_GE) {
+            return ($v_p > $v_q) ? 0 : undef;
+	} elsif ($rel_p eq REL_EQ) {
+            return ($v_p <= $v_q) ? 1 : 0;
+        } else { # <<, <=
+            return ($v_p <= $v_q) ? 1 : undef;
+        }
+    }
+
+    # Similar, but << is stronger than <= so p's version must be << q's
+    # version if the p relation is <= or =.
+    if ($rel_q eq REL_LT) {
+        if ($rel_p eq REL_GT or $rel_p eq REL_GE) {
+            return ($v_p >= $v_p) ? 0 : undef;
+        } elsif ($rel_p eq REL_LT) {
+            return ($v_p <= $v_q) ? 1 : undef;
+	} elsif ($rel_p eq REL_EQ) {
+            return ($v_p < $v_q) ? 1 : 0;
+        } else { # <<, <=
+            return ($v_p < $v_q) ? 1 : undef;
+        }
+    }
+
+    # Same logic as above, only inverted.
+    if ($rel_q eq REL_GE) {
+        if ($rel_p eq REL_LT) {
+            return ($v_p <= $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_LE) {
+            return ($v_p < $v_q) ? 0 : undef;
+	} elsif ($rel_p eq REL_EQ) {
+            return ($v_p >= $v_q) ? 1 : 0;
+        } else { # >>, >=
+            return ($v_p >= $v_q) ? 1 : undef;
+        }
+    }
+    if ($rel_q eq REL_GT) {
+        if ($rel_p eq REL_LT or $rel_p eq REL_LE) {
+            return ($v_p <= $v_q) ? 0 : undef;
+        } elsif ($rel_p eq REL_GT) {
+            return ($v_p >= $v_q) ? 1 : undef;
+	} elsif ($rel_p eq REL_EQ) {
+            return ($v_p > $v_q) ? 1 : 0;
+        } else {
+            return ($v_p > $v_q) ? 1 : undef;
+        }
+    }
+
+    return;
+}
+
+=item $dep = deps_concat(@dep_list)
+
+This function concatenates multiple dependency lines into a single line,
+joining them with ", " if appropriate, and always returning a valid string.
+
+=cut
+
+sub deps_concat {
+    my (@dep_list) = @_;
+
+    return join ', ', grep { defined } @dep_list;
+}
+
+=item $dep = deps_parse($line, %options)
+
+This function parses the dependency line and returns an object, either a
+Dpkg::Deps::AND or a Dpkg::Deps::Union. Various options can alter the
+behaviour of that function.
+
+=over 4
+
+=item use_arch (defaults to 1)
+
+Take into account the architecture restriction part of the dependencies.
+Set to 0 to completely ignore that information.
+
+=item host_arch (defaults to the current architecture)
+
+Define the host architecture. By default it uses
+Dpkg::Arch::get_host_arch() to identify the proper architecture.
+
+=item build_arch (defaults to the current architecture)
+
+Define the build architecture. By default it uses
+Dpkg::Arch::get_build_arch() to identify the proper architecture.
+
+=item reduce_arch (defaults to 0)
+
+If set to 1, ignore dependencies that do not concern the current host
+architecture. This implicitly strips off the architecture restriction
+list so that the resulting dependencies are directly applicable to the
+current architecture.
+
+=item use_profiles (defaults to 1)
+
+Take into account the profile restriction part of the dependencies. Set
+to 0 to completely ignore that information.
+
+=item build_profiles (defaults to no profile)
+
+Define the active build profiles. By default no profile is defined.
+
+=item reduce_profiles (defaults to 0)
+
+If set to 1, ignore dependencies that do not concern the current build
+profile. This implicitly strips off the profile restriction formula so
+that the resulting dependencies are directly applicable to the current
+profiles.
+
+=item reduce_restrictions (defaults to 0)
+
+If set to 1, ignore dependencies that do not concern the current set of
+restrictions. This implicitly strips off any architecture restriction list
+or restriction formula so that the resulting dependencies are directly
+applicable to the current restriction.
+This currently implies C<reduce_arch> and C<reduce_profiles>, and overrides
+them if set.
+
+=item union (defaults to 0)
+
+If set to 1, returns a Dpkg::Deps::Union instead of a Dpkg::Deps::AND. Use
+this when parsing non-dependency fields like Conflicts.
+
+=item virtual (defaults to 0)
+
+If set to 1, allow only virtual package version relations, that is none,
+or "=".
+This should be set whenever working with Provides fields.
+
+=item build_dep (defaults to 0)
+
+If set to 1, allow build-dep only arch qualifiers, that is ":native".
+This should be set whenever working with build-deps.
+
+=item tests_dep (defaults to 0)
+
+If set to 1, allow tests-specific package names in dependencies, that is
+"@" and "@builddeps@" (since dpkg 1.18.7). This should be set whenever
+working with dependency fields from F<debian/tests/control>.
+
+=back
+
+=cut
+
+sub deps_parse {
+    my ($dep_line, %options) = @_;
+
+    # Validate arguments.
+    croak "invalid host_arch $options{host_arch}"
+        if defined $options{host_arch} and not defined debarch_to_debtuple($options{host_arch});
+    croak "invalid build_arch $options{build_arch}"
+        if defined $options{build_arch} and not defined debarch_to_debtuple($options{build_arch});
+
+    $options{use_arch} //= 1;
+    $options{reduce_arch} //= 0;
+    $options{use_profiles} //= 1;
+    $options{reduce_profiles} //= 0;
+    $options{reduce_restrictions} //= 0;
+    $options{union} //= 0;
+    $options{virtual} //= 0;
+    $options{build_dep} //= 0;
+    $options{tests_dep} //= 0;
+
+    if ($options{reduce_restrictions}) {
+        $options{reduce_arch} = 1;
+        $options{reduce_profiles} = 1;
+    }
+    if ($options{reduce_arch}) {
+        $options{host_arch} //= get_host_arch();
+        $options{build_arch} //= get_build_arch();
+    }
+    if ($options{reduce_profiles}) {
+        $options{build_profiles} //= [ get_build_profiles() ];
+    }
+
+    # Options for Dpkg::Deps::Simple.
+    my %deps_options = (
+        host_arch => $options{host_arch},
+        build_arch => $options{build_arch},
+        build_dep => $options{build_dep},
+        tests_dep => $options{tests_dep},
+    );
+
+    # Merge in a single-line
+    $dep_line =~ s/\s*[\r\n]\s*/ /g;
+    # Strip trailing/leading spaces
+    $dep_line =~ s/^\s+//;
+    $dep_line =~ s/\s+$//;
+
+    my @dep_list;
+    foreach my $dep_and (split(/\s*,\s*/m, $dep_line)) {
+        my @or_list = ();
+        foreach my $dep_or (split(/\s*\|\s*/m, $dep_and)) {
+	    my $dep_simple = Dpkg::Deps::Simple->new($dep_or, %deps_options);
+	    if (not defined $dep_simple->{package}) {
+		warning(g_("can't parse dependency %s"), $dep_or);
+		return;
+	    }
+            if ($options{virtual} && defined $dep_simple->{relation} &&
+                $dep_simple->{relation} ne '=') {
+                warning(g_('virtual dependency contains invalid relation: %s'),
+                        $dep_simple->output);
+                return;
+            }
+	    $dep_simple->{arches} = undef if not $options{use_arch};
+            if ($options{reduce_arch}) {
+		$dep_simple->reduce_arch($options{host_arch});
+		next if not $dep_simple->arch_is_concerned($options{host_arch});
+	    }
+	    $dep_simple->{restrictions} = undef if not $options{use_profiles};
+	    if ($options{reduce_profiles}) {
+		$dep_simple->reduce_profiles($options{build_profiles});
+		next if not $dep_simple->profile_is_concerned($options{build_profiles});
+	    }
+	    push @or_list, $dep_simple;
+        }
+	next if not @or_list;
+	if (scalar @or_list == 1) {
+	    push @dep_list, $or_list[0];
+	} else {
+	    my $dep_or = Dpkg::Deps::OR->new();
+	    $dep_or->add($_) foreach (@or_list);
+	    push @dep_list, $dep_or;
+	}
+    }
+    my $dep_and;
+    if ($options{union}) {
+	$dep_and = Dpkg::Deps::Union->new();
+    } else {
+	$dep_and = Dpkg::Deps::AND->new();
+    }
+    foreach my $dep (@dep_list) {
+        if ($options{union} and not $dep->isa('Dpkg::Deps::Simple')) {
+            warning(g_('an union dependency can only contain simple dependencies'));
+            return;
+        }
+        $dep_and->add($dep);
+    }
+    return $dep_and;
+}
+
+=item $bool = deps_iterate($deps, $callback_func)
+
+This function visits all elements of the dependency object, calling the
+callback function for each element.
+
+The callback function is expected to return true when everything is fine,
+or false if something went wrong, in which case the iteration will stop.
+
+Return the same value as the callback function.
+
+=cut
+
+sub deps_iterate {
+    my ($deps, $callback_func) = @_;
+
+    my $visitor_func = sub {
+        foreach my $dep (@_) {
+            return unless defined $dep;
+
+            if ($dep->isa('Dpkg::Deps::Simple')) {
+                return unless $callback_func->($dep);
+            } else {
+                return unless __SUB__->($dep->get_deps());
+            }
+        }
+        return 1;
+    };
+
+    return $visitor_func->($deps);
+}
+
+=item deps_compare($a, $b)
+
+Implements a comparison operator between two dependency objects.
+This function is mainly used to implement the sort() method.
+
+=back
+
+=cut
+
+my %relation_ordering = (
+	undef => 0,
+	REL_GE() => 1,
+	REL_GT() => 2,
+	REL_EQ() => 3,
+	REL_LT() => 4,
+	REL_LE() => 5,
+);
+
+sub deps_compare {
+    my ($aref, $bref) = @_;
+
+    my (@as, @bs);
+    deps_iterate($aref, sub { push @as, @_ });
+    deps_iterate($bref, sub { push @bs, @_ });
+
+    while (1) {
+        my ($a, $b) = (shift @as, shift @bs);
+        my $aundef = not defined $a or $a->is_empty();
+        my $bundef = not defined $b or $b->is_empty();
+
+        return  0 if $aundef and $bundef;
+        return -1 if $aundef;
+        return  1 if $bundef;
+
+        my $ar = $a->{relation} // 'undef';
+        my $br = $b->{relation} // 'undef';
+        my $av = $a->{version} // '';
+        my $bv = $b->{version} // '';
+
+        my $res = (($a->{package} cmp $b->{package}) ||
+                   ($relation_ordering{$ar} <=> $relation_ordering{$br}) ||
+                   ($av cmp $bv));
+        return $res if $res != 0;
+    }
+}
+
+=head1 CLASSES - Dpkg::Deps::*
+
+There are several kind of dependencies. A Dpkg::Deps::Simple dependency
+represents a single dependency statement (it relates to one package only).
+Dpkg::Deps::Multiple dependencies are built on top of this class
+and combine several dependencies in different manners. Dpkg::Deps::AND
+represents the logical "AND" between dependencies while Dpkg::Deps::OR
+represents the logical "OR". Dpkg::Deps::Multiple objects can contain
+Dpkg::Deps::Simple object as well as other Dpkg::Deps::Multiple objects.
+
+In practice, the code is only meant to handle the realistic cases which,
+given Debian's dependencies structure, imply those restrictions: AND can
+contain Simple or OR objects, OR can only contain Simple objects.
+
+Dpkg::Deps::KnownFacts is a special class that is used while evaluating
+dependencies and while trying to simplify them. It represents a set of
+installed packages along with the virtual packages that they might
+provide.
+
+=head1 CHANGES
+
+=head2 Version 1.07 (dpkg 1.20.0)
+
+New option: Add virtual option to Dpkg::Deps::deps_parse().
+
+=head2 Version 1.06 (dpkg 1.18.7; module version bumped on dpkg 1.18.24)
+
+New option: Add tests_dep option to Dpkg::Deps::deps_parse().
+
+=head2 Version 1.05 (dpkg 1.17.14)
+
+New function: Dpkg::Deps::deps_iterate().
+
+=head2 Version 1.04 (dpkg 1.17.10)
+
+New options: Add use_profiles, build_profiles, reduce_profiles and
+reduce_restrictions to Dpkg::Deps::deps_parse().
+
+=head2 Version 1.03 (dpkg 1.17.0)
+
+New option: Add build_arch option to Dpkg::Deps::deps_parse().
+
+=head2 Version 1.02 (dpkg 1.17.0)
+
+New function: Dpkg::Deps::deps_concat()
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+<Used to document changes to Dpkg::Deps::* modules before they were split.>
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/AND.pm b/scripts/Dpkg/Deps/AND.pm
new file mode 100644
index 0000000..7b403c2
--- /dev/null
+++ b/scripts/Dpkg/Deps/AND.pm
@@ -0,0 +1,182 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::AND;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::AND - list of AND dependencies
+
+=head1 DESCRIPTION
+
+This class represents a list of dependencies that must be met at the same
+time. It inherits from Dpkg::Deps::Multiple.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use parent qw(Dpkg::Deps::Multiple);
+
+=head1 METHODS
+
+=over 4
+
+=item $dep->output([$fh])
+
+The output method uses ", " to join the list of sub-dependencies.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+
+    my $res = join(', ', map {
+        $_->output()
+    } grep {
+        not $_->is_empty()
+    } $self->get_deps());
+
+    if (defined $fh) {
+        print { $fh } $res;
+    }
+    return $res;
+}
+
+=item $dep->implies($other_dep)
+
+Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
+NOT($other_dep). Returns undef when there's no implication. $dep and
+$other_dep do not need to be of the same type.
+
+=cut
+
+sub implies {
+    my ($self, $o) = @_;
+
+    # If any individual member can imply $o or NOT $o, we're fine
+    foreach my $dep ($self->get_deps()) {
+        my $implication = $dep->implies($o);
+        return 1 if defined $implication and $implication == 1;
+        return 0 if defined $implication and $implication == 0;
+    }
+
+    # If o is an AND, we might have an implication, if we find an
+    # implication within us for each predicate in o
+    if ($o->isa('Dpkg::Deps::AND')) {
+        my $subset = 1;
+        foreach my $odep ($o->get_deps()) {
+            my $found = 0;
+            foreach my $dep ($self->get_deps()) {
+                $found = 1 if $dep->implies($odep);
+            }
+            $subset = 0 if not $found;
+        }
+        return 1 if $subset;
+    }
+    return;
+}
+
+=item $dep->get_evaluation($facts)
+
+Evaluates the dependency given a list of installed packages and a list of
+virtual packages provided. These lists are part of the Dpkg::Deps::KnownFacts
+object given as parameters.
+
+Returns 1 when it's true, 0 when it's false, undef when some information
+is lacking to conclude.
+
+=cut
+
+sub get_evaluation {
+    my ($self, $facts) = @_;
+
+    # Return 1 only if all members evaluates to true
+    # Return 0 if at least one member evaluates to false
+    # Return undef otherwise
+    my $result = 1;
+    foreach my $dep ($self->get_deps()) {
+        my $eval = $dep->get_evaluation($facts);
+        if (not defined $eval) {
+            $result = undef;
+        } elsif ($eval == 0) {
+            $result = 0;
+            last;
+        } elsif ($eval == 1) {
+            # Still possible
+        }
+    }
+    return $result;
+}
+
+=item $dep->simplify_deps($facts, @assumed_deps)
+
+Simplifies the dependency as much as possible given the list of facts (see
+object Dpkg::Deps::KnownFacts) and a list of other dependencies that are
+known to be true.
+
+=cut
+
+sub simplify_deps {
+    my ($self, $facts, @knowndeps) = @_;
+    my @new;
+
+WHILELOOP:
+    while (@{$self->{list}}) {
+        my $dep = shift @{$self->{list}};
+        my $eval = $dep->get_evaluation($facts);
+        next if defined $eval and $eval == 1;
+        foreach my $odep (@knowndeps, @new) {
+            next WHILELOOP if $odep->implies($dep);
+        }
+        # When a dependency is implied by another dependency that
+        # follows, then invert them
+        # "a | b, c, a"  becomes "a, c" and not "c, a"
+        my $i = 0;
+        foreach my $odep (@{$self->{list}}) {
+            if (defined $odep and $odep->implies($dep)) {
+                splice @{$self->{list}}, $i, 1;
+                unshift @{$self->{list}}, $odep;
+                next WHILELOOP;
+            }
+            $i++;
+        }
+        push @new, $dep;
+    }
+    $self->{list} = [ @new ];
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/KnownFacts.pm b/scripts/Dpkg/Deps/KnownFacts.pm
new file mode 100644
index 0000000..ef8655f
--- /dev/null
+++ b/scripts/Dpkg/Deps/KnownFacts.pm
@@ -0,0 +1,218 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::KnownFacts;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::KnownFacts - list of installed real and virtual packages
+
+=head1 DESCRIPTION
+
+This class represents a list of installed packages and a list of virtual
+packages provided (by the set of installed packages).
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '2.00';
+
+use Dpkg::Version;
+
+=head1 METHODS
+
+=over 4
+
+=item $facts = Dpkg::Deps::KnownFacts->new();
+
+Creates a new object.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = {
+        pkg => {},
+        virtualpkg => {},
+    };
+
+    bless $self, $class;
+    return $self;
+}
+
+=item $facts->add_installed_package($package, $version, $arch, $multiarch)
+
+Records that the given version of the package is installed. If
+$version/$arch is undefined we know that the package is installed but we
+don't know which version/architecture it is. $multiarch is the Multi-Arch
+field of the package. If $multiarch is undef, it will be equivalent to
+"Multi-Arch: no".
+
+Note that $multiarch is only used if $arch is provided.
+
+=cut
+
+sub add_installed_package {
+    my ($self, $pkg, $ver, $arch, $multiarch) = @_;
+    my $p = {
+        package => $pkg,
+        version => $ver,
+        architecture => $arch,
+        multiarch => $multiarch // 'no',
+    };
+
+    $self->{pkg}{"$pkg:$arch"} = $p if defined $arch;
+    push @{$self->{pkg}{$pkg}}, $p;
+}
+
+=item $facts->add_provided_package($virtual, $relation, $version, $by)
+
+Records that the "$by" package provides the $virtual package. $relation
+and $version correspond to the associated relation given in the Provides
+field (if present).
+
+=cut
+
+sub add_provided_package {
+    my ($self, $pkg, $rel, $ver, $by) = @_;
+    my $v = {
+        package => $pkg,
+        relation => $rel,
+        version => $ver,
+        provider => $by,
+    };
+
+    $self->{virtualpkg}{$pkg} //= [];
+    push @{$self->{virtualpkg}{$pkg}}, $v;
+}
+
+##
+## The functions below are private to Dpkg::Deps::KnownFacts.
+##
+
+sub _find_package {
+    my ($self, $dep, $lackinfos) = @_;
+    my ($pkg, $archqual) = ($dep->{package}, $dep->{archqual});
+
+    return if not exists $self->{pkg}{$pkg};
+
+    my $host_arch = $dep->{host_arch} // Dpkg::Arch::get_host_arch();
+    my $build_arch = $dep->{build_arch} // Dpkg::Arch::get_build_arch();
+
+    foreach my $p (@{$self->{pkg}{$pkg}}) {
+        my $a = $p->{architecture};
+        my $ma = $p->{multiarch};
+
+        if (not defined $a) {
+            $$lackinfos = 1;
+            next;
+        }
+        if (not defined $archqual) {
+            return $p if $ma eq 'foreign';
+            return $p if $a eq $host_arch or $a eq 'all';
+        } elsif ($archqual eq 'any') {
+            return $p if $ma eq 'allowed';
+        } elsif ($archqual eq 'native') {
+            return if $ma eq 'foreign';
+            return $p if $a eq $build_arch or $a eq 'all';
+        } else {
+            return $p if $a eq $archqual;
+        }
+    }
+    return;
+}
+
+sub _find_virtual_packages {
+    my ($self, $pkg) = @_;
+
+    return () if not exists $self->{virtualpkg}{$pkg};
+    return @{$self->{virtualpkg}{$pkg}};
+}
+
+=item $facts->evaluate_simple_dep()
+
+This method is private and should not be used except from within Dpkg::Deps.
+
+=cut
+
+sub evaluate_simple_dep {
+    my ($self, $dep) = @_;
+    my ($lackinfos, $pkg) = (0, $dep->{package});
+
+    my $p = $self->_find_package($dep, \$lackinfos);
+    if ($p) {
+        if (defined $dep->{relation}) {
+            if (defined $p->{version}) {
+                return 1 if version_compare_relation($p->{version},
+                                                     $dep->{relation},
+                                                     $dep->{version});
+            } else {
+                $lackinfos = 1;
+            }
+        } else {
+            return 1;
+        }
+    }
+    foreach my $virtpkg ($self->_find_virtual_packages($pkg)) {
+        next if defined $virtpkg->{relation} and
+                $virtpkg->{relation} ne REL_EQ;
+
+        if (defined $dep->{relation}) {
+            next if not defined $virtpkg->{version};
+            return 1 if version_compare_relation($virtpkg->{version},
+                                                 $dep->{relation},
+                                                 $dep->{version});
+        } else {
+            return 1;
+        }
+    }
+    return if $lackinfos;
+    return 0;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove method: $facts->check_package().
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+New option: Dpkg::Deps::KnownFacts->add_installed_package() now accepts 2
+supplementary parameters ($arch and $multiarch).
+
+Deprecated method: Dpkg::Deps::KnownFacts->check_package() is obsolete,
+it should not have been part of the public API.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/Multiple.pm b/scripts/Dpkg/Deps/Multiple.pm
new file mode 100644
index 0000000..da12f51
--- /dev/null
+++ b/scripts/Dpkg/Deps/Multiple.pm
@@ -0,0 +1,250 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::Multiple;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::Multiple - base module to represent multiple dependencies
+
+=head1 DESCRIPTION
+
+The Dpkg::Deps::Multiple module provides objects implementing various types
+of dependencies. It is the base class for Dpkg::Deps::{AND,OR,Union}.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+
+use Carp;
+
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Interface::Storable);
+
+=head1 METHODS
+
+=over 4
+
+=item $dep = Dpkg::Deps::Multiple->new(%opts);
+
+Creates a new object.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = { list => [ @_ ] };
+
+    bless $self, $class;
+    return $self;
+}
+
+=item $dep->reset()
+
+Clears any dependency information stored in $dep so that $dep->is_empty()
+returns true.
+
+=cut
+
+sub reset {
+    my $self = shift;
+
+    $self->{list} = [];
+}
+
+=item $dep->add(@deps)
+
+Adds new dependency objects at the end of the list.
+
+=cut
+
+sub add {
+    my $self = shift;
+
+    push @{$self->{list}}, @_;
+}
+
+=item $dep->get_deps()
+
+Returns a list of sub-dependencies.
+
+=cut
+
+sub get_deps {
+    my $self = shift;
+
+    return grep { not $_->is_empty() } @{$self->{list}};
+}
+
+=item $dep->sort()
+
+Sorts alphabetically the internal list of dependencies.
+
+=cut
+
+sub sort {
+    my $self = shift;
+
+    my @res = ();
+    @res = sort { Dpkg::Deps::deps_compare($a, $b) } @{$self->{list}};
+    $self->{list} = [ @res ];
+}
+
+=item $dep->arch_is_concerned($arch)
+
+Returns true if at least one of the sub-dependencies apply to this
+architecture.
+
+=cut
+
+sub arch_is_concerned {
+    my ($self, $host_arch) = @_;
+
+    my $res = 0;
+    foreach my $dep (@{$self->{list}}) {
+        $res = 1 if $dep->arch_is_concerned($host_arch);
+    }
+    return $res;
+}
+
+=item $dep->reduce_arch($arch)
+
+Simplifies the dependencies to contain only information relevant to the
+given architecture. The non-relevant sub-dependencies are simply removed.
+
+This trims off the architecture restriction list of Dpkg::Deps::Simple
+objects.
+
+=cut
+
+sub reduce_arch {
+    my ($self, $host_arch) = @_;
+
+    my @new;
+    foreach my $dep (@{$self->{list}}) {
+        $dep->reduce_arch($host_arch);
+        push @new, $dep if $dep->arch_is_concerned($host_arch);
+    }
+    $self->{list} = [ @new ];
+}
+
+=item $dep->has_arch_restriction()
+
+Returns the list of package names that have such a restriction.
+
+=cut
+
+sub has_arch_restriction {
+    my $self = shift;
+
+    my @res;
+    foreach my $dep (@{$self->{list}}) {
+        push @res, $dep->has_arch_restriction();
+    }
+    return @res;
+}
+
+=item $dep->profile_is_concerned()
+
+Returns true if at least one of the sub-dependencies apply to this profile.
+
+=cut
+
+sub profile_is_concerned {
+    my ($self, $build_profiles) = @_;
+
+    my $res = 0;
+    foreach my $dep (@{$self->{list}}) {
+        $res = 1 if $dep->profile_is_concerned($build_profiles);
+    }
+    return $res;
+}
+
+=item $dep->reduce_profiles()
+
+Simplifies the dependencies to contain only information relevant to the
+given profile. The non-relevant sub-dependencies are simply removed.
+
+This trims off the profile restriction list of Dpkg::Deps::Simple objects.
+
+=cut
+
+sub reduce_profiles {
+    my ($self, $build_profiles) = @_;
+
+    my @new;
+    foreach my $dep (@{$self->{list}}) {
+        $dep->reduce_profiles($build_profiles);
+        push @new, $dep if $dep->profile_is_concerned($build_profiles);
+    }
+    $self->{list} = [ @new ];
+}
+
+=item $dep->is_empty()
+
+Returns true if the dependency is empty and doesn't contain any useful
+information. This is true when a (descendant of) Dpkg::Deps::Multiple
+contains an empty list of dependencies.
+
+=cut
+
+sub is_empty {
+    my $self = shift;
+
+    return scalar @{$self->{list}} == 0;
+}
+
+=item $dep->merge_union($other_dep)
+
+This method is not meaningful for this object, and will always croak.
+
+=cut
+
+sub merge_union {
+    croak 'method merge_union() is only valid for Dpkg::Deps::Simple';
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.17.10)
+
+New methods: Add $dep->profile_is_concerned() and $dep->reduce_profiles().
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+New method: Add $dep->reset().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/OR.pm b/scripts/Dpkg/Deps/OR.pm
new file mode 100644
index 0000000..4ce5c98
--- /dev/null
+++ b/scripts/Dpkg/Deps/OR.pm
@@ -0,0 +1,174 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::OR;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::OR - list of OR dependencies
+
+=head1 DESCRIPTION
+
+This class represents a list of dependencies of which only one must be met
+for the dependency to be true. It inherits from Dpkg::Deps::Multiple.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use parent qw(Dpkg::Deps::Multiple);
+
+=head1 METHODS
+
+=over 4
+
+=item $dep->output([$fh])
+
+The output method uses " | " to join the list of sub-dependencies.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+
+    my $res = join(' | ', map {
+        $_->output()
+    } grep {
+        not $_->is_empty()
+    } $self->get_deps());
+
+    if (defined $fh) {
+        print { $fh } $res;
+    }
+    return $res;
+}
+
+=item $dep->implies($other_dep)
+
+Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
+NOT($other_dep). Returns undef when there's no implication. $dep and
+$other_dep do not need to be of the same type.
+
+=cut
+
+sub implies {
+    my ($self, $o) = @_;
+
+    # Special case for AND with a single member, replace it by its member
+    if ($o->isa('Dpkg::Deps::AND')) {
+        my @subdeps = $o->get_deps();
+        if (scalar(@subdeps) == 1) {
+            $o = $subdeps[0];
+        }
+    }
+
+    # In general, an OR dependency can't imply anything except if each
+    # of its member implies a member in the other OR dependency
+    if ($o->isa('Dpkg::Deps::OR')) {
+        my $subset = 1;
+        foreach my $dep ($self->get_deps()) {
+            my $found = 0;
+            foreach my $odep ($o->get_deps()) {
+                $found = 1 if $dep->implies($odep);
+            }
+            $subset = 0 if not $found;
+        }
+        return 1 if $subset;
+    }
+    return;
+}
+
+=item $dep->get_evaluation($facts)
+
+Evaluates the dependency given a list of installed packages and a list of
+virtual packages provided. These lists are part of the Dpkg::Deps::KnownFacts
+object given as parameters.
+
+Returns 1 when it's true, 0 when it's false, undef when some information
+is lacking to conclude.
+
+=cut
+
+sub get_evaluation {
+    my ($self, $facts) = @_;
+
+    # Returns false if all members evaluates to 0
+    # Returns true if at least one member evaluates to true
+    # Returns undef otherwise
+    my $result = 0;
+    foreach my $dep ($self->get_deps()) {
+        my $eval = $dep->get_evaluation($facts);
+        if (not defined $eval) {
+            $result = undef;
+        } elsif ($eval == 1) {
+            $result = 1;
+            last;
+        } elsif ($eval == 0) {
+            # Still possible to have a false evaluation
+        }
+    }
+    return $result;
+}
+
+=item $dep->simplify_deps($facts, @assumed_deps)
+
+Simplifies the dependency as much as possible given the list of facts (see
+object Dpkg::Deps::KnownFacts) and a list of other dependencies that are
+known to be true.
+
+=cut
+
+sub simplify_deps {
+    my ($self, $facts) = @_;
+    my @new;
+
+WHILELOOP:
+    while (@{$self->{list}}) {
+        my $dep = shift @{$self->{list}};
+        my $eval = $dep->get_evaluation($facts);
+        if (defined $eval and $eval == 1) {
+            $self->{list} = [];
+            return;
+        }
+        foreach my $odep (@new, @{$self->{list}}) {
+            next WHILELOOP if $odep->implies($dep);
+        }
+        push @new, $dep;
+    }
+    $self->{list} = [ @new ];
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/Simple.pm b/scripts/Dpkg/Deps/Simple.pm
new file mode 100644
index 0000000..e6ed550
--- /dev/null
+++ b/scripts/Dpkg/Deps/Simple.pm
@@ -0,0 +1,668 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::Simple;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::Simple - represents a single dependency statement
+
+=head1 DESCRIPTION
+
+This class represents a single dependency statement.
+It has several interesting properties:
+
+=over 4
+
+=item package
+
+The package name (can be undef if the dependency has not been initialized
+or if the simplification of the dependency lead to its removal).
+
+=item relation
+
+The relational operator: "=", "<<", "<=", ">=" or ">>". It can be
+undefined if the dependency had no version restriction. In that case the
+following field is also undefined.
+
+=item version
+
+The version.
+
+=item arches
+
+The list of architectures where this dependency is applicable. It is
+undefined when there's no restriction, otherwise it is an
+array ref. It can contain an exclusion list, in that case each
+architecture is prefixed with an exclamation mark.
+
+=item archqual
+
+The arch qualifier of the dependency (can be undef if there is none).
+In the dependency "python:any (>= 2.6)", the arch qualifier is "any".
+
+=item restrictions
+
+The restrictions formula for this dependency. It is undefined when there
+is no restriction formula. Otherwise it is an array ref.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+
+use Carp;
+
+use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse);
+use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula);
+use Dpkg::Version;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+use parent qw(Dpkg::Interface::Storable);
+
+=item $dep = Dpkg::Deps::Simple->new([$dep[, %opts]]);
+
+Creates a new object. Some options can be set through %opts:
+
+=over
+
+=item host_arch
+
+Sets the host architecture.
+
+=item build_arch
+
+Sets the build architecture.
+
+=item build_dep
+
+Specifies whether the parser should consider it a build dependency.
+Defaults to 0.
+
+=item tests_dep
+
+Specifies whether the parser should consider it a tests dependency.
+Defaults to 0.
+
+=back
+
+=cut
+
+sub new {
+    my ($this, $arg, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = {};
+
+    bless $self, $class;
+    $self->reset();
+    $self->{host_arch} = $opts{host_arch};
+    $self->{build_arch} = $opts{build_arch};
+    $self->{build_dep} = $opts{build_dep} // 0;
+    $self->{tests_dep} = $opts{tests_dep} // 0;
+    $self->parse_string($arg) if defined $arg;
+    return $self;
+}
+
+=item $dep->reset()
+
+Clears any dependency information stored in $dep so that $dep->is_empty()
+returns true.
+
+=cut
+
+sub reset {
+    my $self = shift;
+
+    $self->{package} = undef;
+    $self->{relation} = undef;
+    $self->{version} = undef;
+    $self->{arches} = undef;
+    $self->{archqual} = undef;
+    $self->{restrictions} = undef;
+}
+
+=item $dep->parse_string($dep_string)
+
+Parses the dependency string and modifies internal properties to match the
+parsed dependency.
+
+=cut
+
+sub parse_string {
+    my ($self, $dep) = @_;
+
+    my $pkgname_re;
+    if ($self->{tests_dep}) {
+        $pkgname_re = qr/[\@a-zA-Z0-9][\@a-zA-Z0-9+.-]*/;
+    } else {
+        $pkgname_re = qr/[a-zA-Z0-9][a-zA-Z0-9+.-]*/;
+    }
+
+    return if not $dep =~
+           m{^\s*                           # skip leading whitespace
+              ($pkgname_re)                 # package name
+              (?:                           # start of optional part
+                :                           # colon for architecture
+                ([a-zA-Z0-9][a-zA-Z0-9-]*)  # architecture name
+              )?                            # end of optional part
+              (?:                           # start of optional part
+                \s* \(                      # open parenthesis for version part
+                \s* (<<|<=|=|>=|>>|[<>])    # relation part
+                \s* ([^\)\s]+)              # do not attempt to parse version
+                \s* \)                      # closing parenthesis
+              )?                            # end of optional part
+              (?:                           # start of optional architecture
+                \s* \[                      # open bracket for architecture
+                \s* ([^\]]+)                # don't parse architectures now
+                \s* \]                      # closing bracket
+              )?                            # end of optional architecture
+              (
+                (?:                         # start of optional restriction
+                \s* <                       # open bracket for restriction
+                \s* [^>]+                   # do not parse restrictions now
+                \s* >                       # closing bracket
+                )+
+              )?                            # end of optional restriction
+              \s*$                          # trailing spaces at end
+            }x;
+    if (defined $2) {
+        return if $2 eq 'native' and not $self->{build_dep};
+        $self->{archqual} = $2;
+    }
+    $self->{package} = $1;
+    $self->{relation} = version_normalize_relation($3) if defined $3;
+    if (defined $4) {
+        $self->{version} = Dpkg::Version->new($4);
+    }
+    if (defined $5) {
+        $self->{arches} = [ debarch_list_parse($5) ];
+    }
+    if (defined $6) {
+        $self->{restrictions} = [ parse_build_profiles($6) ];
+    }
+}
+
+=item $dep->parse($fh, $desc)
+
+Parse a dependency line from a filehandle.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+
+    my $line = <$fh>;
+    chomp $line;
+    return $self->parse_string($line);
+}
+
+=item $dep->load($filename)
+
+Parse a dependency line from $filename.
+
+=item $dep->output([$fh])
+
+=item "$dep"
+
+Returns a string representing the dependency. If $fh is set, it prints
+the string to the filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+
+    my $res = $self->{package};
+    if (defined $self->{archqual}) {
+        $res .= ':' . $self->{archqual};
+    }
+    if (defined $self->{relation}) {
+        $res .= ' (' . $self->{relation} . ' ' . $self->{version} .  ')';
+    }
+    if (defined $self->{arches}) {
+        $res .= ' [' . join(' ', @{$self->{arches}}) . ']';
+    }
+    if (defined $self->{restrictions}) {
+        for my $restrlist (@{$self->{restrictions}}) {
+            $res .= ' <' . join(' ', @{$restrlist}) . '>';
+        }
+    }
+    if (defined $fh) {
+        print { $fh } $res;
+    }
+    return $res;
+}
+
+=item $dep->save($filename)
+
+Save the dependency into the given $filename.
+
+=cut
+
+# _arch_is_superset(\@p, \@q)
+#
+# Returns true if the arch list @p is a superset of arch list @q.
+# The arguments can also be undef in case there's no explicit architecture
+# restriction.
+sub _arch_is_superset {
+    my ($p, $q) = @_;
+    my $p_arch_neg = defined $p and $p->[0] =~ /^!/;
+    my $q_arch_neg = defined $q and $q->[0] =~ /^!/;
+
+    if (not defined $p) {
+        # If "p" has no arches, it is a superset of q and we should fall through
+        # to the version check.
+        return 1;
+    } elsif (not defined $q) {
+        # If q has no arches, it is a superset of p and there are no useful
+        # implications.
+        return 0;
+    } elsif (not $p_arch_neg and not $q_arch_neg) {
+        # Both have arches.  If neither are negated, we know nothing useful
+        # unless q is a subset of p.
+
+        my %p_arches = map { $_ => 1 } @{$p};
+        my $subset = 1;
+        for my $arch (@{$q}) {
+            $subset = 0 unless $p_arches{$arch};
+        }
+        return 0 unless $subset;
+    } elsif ($p_arch_neg and $q_arch_neg) {
+        # If both are negated, we know nothing useful unless p is a subset of
+        # q (and therefore has fewer things excluded, and therefore is more
+        # general).
+
+        my %q_arches = map { $_ => 1 } @{$q};
+        my $subset = 1;
+        for my $arch (@{$p}) {
+            $subset = 0 unless $q_arches{$arch};
+        }
+        return 0 unless $subset;
+    } elsif (not $p_arch_neg and $q_arch_neg) {
+        # If q is negated and p isn't, we'd need to know the full list of
+        # arches to know if there's any relationship, so bail.
+        return 0;
+    } elsif ($p_arch_neg and not $q_arch_neg) {
+        # If p is negated and q isn't, q is a subset of p if none of the
+        # negated arches in p are present in q.
+
+        my %q_arches = map { $_ => 1 } @{$q};
+        my $subset = 1;
+        for my $arch (@{$p}) {
+            $subset = 0 if $q_arches{substr($arch, 1)};
+        }
+        return 0 unless $subset;
+    }
+    return 1;
+}
+
+# _arch_qualifier_implies($p, $q)
+#
+# Returns true if the arch qualifier $p and $q are compatible with the
+# implication $p -> $q, false otherwise. $p/$q can be undef/"any"/"native"
+# or an architecture string.
+#
+# Because we are handling dependencies in isolation, and the full context
+# of the implications are only known when doing dependency resolution at
+# run-time, we can only assert that they are implied if they are equal.
+#
+# For example dependencies with different arch-qualifiers cannot be simplified
+# as these depend on the state of Multi-Arch field in the package depended on.
+sub _arch_qualifier_implies {
+    my ($p, $q) = @_;
+
+    return $p eq $q if defined $p and defined $q;
+    return 1 if not defined $p and not defined $q;
+    return 0;
+}
+
+# _restrictions_imply($p, $q)
+#
+# Returns true if the restrictions $p and $q are compatible with the
+# implication $p -> $q, false otherwise.
+# NOTE: We don't try to be very clever here, so we may conservatively
+# return false when there is an implication.
+sub _restrictions_imply {
+    my ($p, $q) = @_;
+
+    if (not defined $p) {
+       return 1;
+    } elsif (not defined $q) {
+       return 0;
+    } else {
+       # Check whether set difference is empty.
+       my %restr;
+
+       for my $restrlist (@{$q}) {
+           my $reststr = join ' ', sort @{$restrlist};
+           $restr{$reststr} = 1;
+       }
+       for my $restrlist (@{$p}) {
+           my $reststr = join ' ', sort @{$restrlist};
+           delete $restr{$reststr};
+       }
+
+       return keys %restr == 0;
+    }
+}
+
+=item $dep->implies($other_dep)
+
+Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
+NOT($other_dep). Returns undef when there is no implication. $dep and
+$other_dep do not need to be of the same type.
+
+=cut
+
+sub implies {
+    my ($self, $o) = @_;
+
+    if ($o->isa('Dpkg::Deps::Simple')) {
+        # An implication is only possible on the same package
+        return if $self->{package} ne $o->{package};
+
+        # Our architecture set must be a superset of the architectures for
+        # o, otherwise we can't conclude anything.
+        return unless _arch_is_superset($self->{arches}, $o->{arches});
+
+        # The arch qualifier must not forbid an implication
+        return unless _arch_qualifier_implies($self->{archqual},
+                                              $o->{archqual});
+
+        # Our restrictions must imply the restrictions for o
+        return unless _restrictions_imply($self->{restrictions},
+                                          $o->{restrictions});
+
+        # If o has no version clause, then our dependency is stronger
+        return 1 if not defined $o->{relation};
+        # If o has a version clause, we must also have one, otherwise there
+        # can't be an implication
+        return if not defined $self->{relation};
+
+        return Dpkg::Deps::deps_eval_implication($self->{relation},
+                $self->{version}, $o->{relation}, $o->{version});
+    } elsif ($o->isa('Dpkg::Deps::AND')) {
+        # TRUE: Need to imply all individual elements
+        # FALSE: Need to NOT imply at least one individual element
+        my $res = 1;
+        foreach my $dep ($o->get_deps()) {
+            my $implication = $self->implies($dep);
+            unless (defined $implication and $implication == 1) {
+                $res = $implication;
+                last if defined $res;
+            }
+        }
+        return $res;
+    } elsif ($o->isa('Dpkg::Deps::OR')) {
+        # TRUE: Need to imply at least one individual element
+        # FALSE: Need to not apply all individual elements
+        # UNDEF: The rest
+        my $res = undef;
+        foreach my $dep ($o->get_deps()) {
+            my $implication = $self->implies($dep);
+            if (defined $implication) {
+                if (not defined $res) {
+                    $res = $implication;
+                } else {
+                    if ($implication) {
+                        $res = 1;
+                    } else {
+                        $res = 0;
+                    }
+                }
+                last if defined $res and $res == 1;
+            }
+        }
+        return $res;
+    } else {
+        croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
+              ref($o);
+    }
+}
+
+=item $dep->get_deps()
+
+Returns a list of sub-dependencies, which for this object it means it
+returns itself.
+
+=cut
+
+sub get_deps {
+    my $self = shift;
+
+    return $self;
+}
+
+=item $dep->sort()
+
+This method is a no-op for this object.
+
+=cut
+
+sub sort {
+    # Nothing to sort
+}
+
+=item $dep->arch_is_concerned($arch)
+
+Returns true if the dependency applies to the indicated architecture.
+
+=cut
+
+sub arch_is_concerned {
+    my ($self, $host_arch) = @_;
+
+    return 0 if not defined $self->{package}; # Empty dep
+    return 1 if not defined $self->{arches};  # Dep without arch spec
+
+    return debarch_is_concerned($host_arch, @{$self->{arches}});
+}
+
+=item $dep->reduce_arch($arch)
+
+Simplifies the dependency to contain only information relevant to the given
+architecture. This object can be left empty after this operation. This trims
+off the architecture restriction list of these objects.
+
+=cut
+
+sub reduce_arch {
+    my ($self, $host_arch) = @_;
+
+    if (not $self->arch_is_concerned($host_arch)) {
+        $self->reset();
+    } else {
+        $self->{arches} = undef;
+    }
+}
+
+=item $dep->has_arch_restriction()
+
+Returns the package name if the dependency applies only to a subset of
+architectures.
+
+=cut
+
+sub has_arch_restriction {
+    my $self = shift;
+
+    if (defined $self->{arches}) {
+        return $self->{package};
+    } else {
+        return ();
+    }
+}
+
+=item $dep->profile_is_concerned()
+
+Returns true if the dependency applies to the indicated profile.
+
+=cut
+
+sub profile_is_concerned {
+    my ($self, $build_profiles) = @_;
+
+    return 0 if not defined $self->{package}; # Empty dep
+    return 1 if not defined $self->{restrictions}; # Dep without restrictions
+    return evaluate_restriction_formula($self->{restrictions}, $build_profiles);
+}
+
+=item $dep->reduce_profiles()
+
+Simplifies the dependency to contain only information relevant to the given
+profile. This object can be left empty after this operation. This trims off
+the profile restriction list of this object.
+
+=cut
+
+sub reduce_profiles {
+    my ($self, $build_profiles) = @_;
+
+    if (not $self->profile_is_concerned($build_profiles)) {
+        $self->reset();
+    } else {
+        $self->{restrictions} = undef;
+    }
+}
+
+=item $dep->get_evaluation($facts)
+
+Evaluates the dependency given a list of installed packages and a list of
+virtual packages provided. These lists are part of the Dpkg::Deps::KnownFacts
+object given as parameters.
+
+Returns 1 when it's true, 0 when it's false, undef when some information
+is lacking to conclude.
+
+=cut
+
+sub get_evaluation {
+    my ($self, $facts) = @_;
+
+    return if not defined $self->{package};
+    return $facts->evaluate_simple_dep($self);
+}
+
+=item $dep->simplify_deps($facts, @assumed_deps)
+
+Simplifies the dependency as much as possible given the list of facts (see
+class Dpkg::Deps::KnownFacts) and a list of other dependencies that are
+known to be true.
+
+=cut
+
+sub simplify_deps {
+    my ($self, $facts) = @_;
+
+    my $eval = $self->get_evaluation($facts);
+    $self->reset() if defined $eval and $eval == 1;
+}
+
+=item $dep->is_empty()
+
+Returns true if the dependency is empty and doesn't contain any useful
+information. This is true when the object has not yet been initialized.
+
+=cut
+
+sub is_empty {
+    my $self = shift;
+
+    return not defined $self->{package};
+}
+
+=item $dep->merge_union($other_dep)
+
+Returns true if $dep could be modified to represent the union of both
+dependencies. Otherwise returns false.
+
+=cut
+
+sub merge_union {
+    my ($self, $o) = @_;
+
+    return 0 if not $o->isa('Dpkg::Deps::Simple');
+    return 0 if $self->is_empty() or $o->is_empty();
+    return 0 if $self->{package} ne $o->{package};
+    return 0 if defined $self->{arches} or defined $o->{arches};
+
+    if (not defined $o->{relation} and defined $self->{relation}) {
+        # Union is the non-versioned dependency
+        $self->{relation} = undef;
+        $self->{version} = undef;
+        return 1;
+    }
+
+    my $implication = $self->implies($o);
+    my $rev_implication = $o->implies($self);
+    if (defined $implication) {
+        if ($implication) {
+            $self->{relation} = $o->{relation};
+            $self->{version} = $o->{version};
+            return 1;
+        } else {
+            return 0;
+        }
+    }
+    if (defined $rev_implication) {
+        if ($rev_implication) {
+            # Already merged...
+            return 1;
+        } else {
+            return 0;
+        }
+    }
+    return 0;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.17.10)
+
+New methods: Add $dep->profile_is_concerned() and $dep->reduce_profiles().
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+New method: Add $dep->reset().
+
+New property: recognizes the arch qualifier "any" and stores it in the
+"archqual" property when present.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Deps/Union.pm b/scripts/Dpkg/Deps/Union.pm
new file mode 100644
index 0000000..148e38e
--- /dev/null
+++ b/scripts/Dpkg/Deps/Union.pm
@@ -0,0 +1,119 @@
+# Copyright © 1998 Richard Braakman
+# Copyright © 1999 Darren Benham
+# Copyright © 2000 Sean 'Shaleh' Perry
+# Copyright © 2004 Frank Lichtenheld
+# Copyright © 2006 Russ Allbery
+# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you may 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 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/>.
+
+package Dpkg::Deps::Union;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Deps::Union - list of unrelated dependencies
+
+=head1 DESCRIPTION
+
+This class represents a list of relationships.
+It inherits from Dpkg::Deps::Multiple.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use parent qw(Dpkg::Deps::Multiple);
+
+=head1 METHODS
+
+=over 4
+
+=item $dep->output([$fh])
+
+The output method uses ", " to join the list of relationships.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+
+    my $res = join(', ', map {
+        $_->output()
+    } grep {
+        not $_->is_empty()
+    } $self->get_deps());
+
+    if (defined $fh) {
+        print { $fh } $res;
+    }
+    return $res;
+}
+
+=item $dep->implies($other_dep)
+
+=item $dep->get_evaluation($other_dep)
+
+These methods are not meaningful for this object and always return undef.
+
+=cut
+
+sub implies {
+    # Implication test is not useful on Union.
+    return;
+}
+
+sub get_evaluation {
+    # Evaluation is not useful on Union.
+    return;
+}
+
+=item $dep->simplify_deps($facts)
+
+The simplification is done to generate an union of all the relationships.
+It uses $simple_dep->merge_union($other_dep) to get its job done.
+
+=cut
+
+sub simplify_deps {
+    my ($self, $facts) = @_;
+    my @new;
+
+WHILELOOP:
+    while (@{$self->{list}}) {
+        my $odep = shift @{$self->{list}};
+        foreach my $dep (@new) {
+            next WHILELOOP if $dep->merge_union($odep);
+        }
+        push @new, $odep;
+    }
+    $self->{list} = [ @new ];
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Dist/Files.pm b/scripts/Dpkg/Dist/Files.pm
new file mode 100644
index 0000000..ac58b98
--- /dev/null
+++ b/scripts/Dpkg/Dist/Files.pm
@@ -0,0 +1,198 @@
+# Copyright © 2014-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/>.
+
+package Dpkg::Dist::Files;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use IO::Dir;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Interface::Storable);
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        options => [],
+        files => {},
+    };
+    foreach my $opt (keys %opts) {
+        $self->{$opt} = $opts{$opt};
+    }
+    bless $self, $class;
+
+    return $self;
+}
+
+sub reset {
+    my $self = shift;
+
+    $self->{files} = {};
+}
+
+sub parse_filename {
+    my ($self, $fn) = @_;
+
+    my $file;
+
+    if ($fn =~ m/^(([-+:.0-9a-z]+)_([^_]+)_([-\w]+)\.([a-z0-9.]+))$/) {
+        # Artifact using the common <name>_<version>_<arch>.<type> pattern.
+        $file->{filename} = $1;
+        $file->{package} = $2;
+        $file->{version} = $3;
+        $file->{arch} = $4;
+        $file->{package_type} = $5;
+    } elsif ($fn =~ m/^([-+:.,_0-9a-zA-Z~]+)$/) {
+        # Artifact with no common pattern, usually called byhand or raw, as
+        # they might require manual processing on the server side, or custom
+        # actions per file type.
+        $file->{filename} = $1;
+    } else {
+        $file = undef;
+    }
+
+    return $file;
+}
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+    my $count = 0;
+
+    local $_;
+    binmode $fh;
+
+    while (<$fh>) {
+        chomp;
+
+        my $file;
+
+        if (m/^(\S+) (\S+) (\S+)((?:\s+[0-9a-z-]+=\S+)*)$/) {
+            $file = $self->parse_filename($1);
+            error(g_('badly formed file name in files list file, line %d'), $.)
+                unless defined $file;
+            $file->{section} = $2;
+            $file->{priority} = $3;
+            my $attrs = $4;
+            $file->{attrs} = { map { split /=/ } split ' ', $attrs };
+        } else {
+            error(g_('badly formed line in files list file, line %d'), $.);
+        }
+
+        if (defined $self->{files}->{$file->{filename}}) {
+            warning(g_('duplicate files list entry for file %s (line %d)'),
+                    $file->{filename}, $.);
+        } else {
+            $count++;
+            $self->{files}->{$file->{filename}} = $file;
+        }
+    }
+
+    return $count;
+}
+
+sub load_dir {
+    my ($self, $dir) = @_;
+
+    my $count = 0;
+    my $dh = IO::Dir->new($dir) or syserr(g_('cannot open directory %s'), $dir);
+
+    while (defined(my $file = $dh->read)) {
+        my $pathname = "$dir/$file";
+        next unless -f $pathname;
+        $count += $self->load($pathname);
+    }
+
+    return $count;
+}
+
+sub get_files {
+    my $self = shift;
+
+    return map { $self->{files}->{$_} } sort keys %{$self->{files}};
+}
+
+sub get_file {
+    my ($self, $filename) = @_;
+
+    return $self->{files}->{$filename};
+}
+
+sub add_file {
+    my ($self, $filename, $section, $priority, %attrs) = @_;
+
+    my $file = $self->parse_filename($filename);
+    error(g_('invalid filename %s'), $filename) unless defined $file;
+    $file->{section} = $section;
+    $file->{priority} = $priority;
+    $file->{attrs} = \%attrs;
+
+    $self->{files}->{$filename} = $file;
+
+    return $file;
+}
+
+sub del_file {
+    my ($self, $filename) = @_;
+
+    delete $self->{files}->{$filename};
+}
+
+sub filter {
+    my ($self, %opts) = @_;
+    my $remove = $opts{remove} // sub { 0 };
+    my $keep = $opts{keep} // sub { 1 };
+
+    foreach my $filename (keys %{$self->{files}}) {
+        my $file = $self->{files}->{$filename};
+
+        if (not $keep->($file) or $remove->($file)) {
+            delete $self->{files}->{$filename};
+        }
+    }
+}
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+
+    binmode $fh if defined $fh;
+
+    foreach my $filename (sort keys %{$self->{files}}) {
+        my $file = $self->{files}->{$filename};
+        my $entry = "$filename $file->{section} $file->{priority}";
+
+        if (exists $file->{attrs}) {
+            foreach my $attr (sort keys %{$file->{attrs}}) {
+                $entry .= " $attr=$file->{attrs}->{$attr}";
+            }
+        }
+
+        $entry .= "\n";
+
+        print { $fh } $entry if defined $fh;
+        $str .= $entry;
+    }
+
+    return $str;
+}
+
+1;
diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm
new file mode 100644
index 0000000..81bc00d
--- /dev/null
+++ b/scripts/Dpkg/ErrorHandling.pm
@@ -0,0 +1,263 @@
+# 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/>.
+
+package Dpkg::ErrorHandling;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '0.02';
+our @EXPORT_OK = qw(
+    REPORT_PROGNAME
+    REPORT_COMMAND
+    REPORT_STATUS
+    REPORT_DEBUG
+    REPORT_INFO
+    REPORT_NOTICE
+    REPORT_WARN
+    REPORT_ERROR
+    report_pretty
+    report_color
+    report
+);
+our @EXPORT = qw(
+    report_options
+    debug
+    info
+    notice
+    warning
+    error
+    errormsg
+    syserr
+    printcmd
+    subprocerr
+    usageerr
+);
+
+use Exporter qw(import);
+
+use Dpkg ();
+use Dpkg::Gettext;
+
+my $quiet_warnings = 0;
+my $debug_level = 0;
+my $info_fh = \*STDOUT;
+
+sub setup_color
+{
+    my $mode = $ENV{'DPKG_COLORS'} // 'auto';
+    my $use_color;
+
+    if ($mode eq 'auto') {
+        ## no critic (InputOutput::ProhibitInteractiveTest)
+        $use_color = 1 if -t *STDOUT or -t *STDERR;
+    } elsif ($mode eq 'always') {
+        $use_color = 1;
+    } else {
+        $use_color = 0;
+    }
+
+    require Term::ANSIColor if $use_color;
+}
+
+use constant {
+    REPORT_PROGNAME => 1,
+    REPORT_COMMAND => 2,
+    REPORT_STATUS => 3,
+    REPORT_INFO => 4,
+    REPORT_NOTICE => 5,
+    REPORT_WARN => 6,
+    REPORT_ERROR => 7,
+    REPORT_DEBUG => 8,
+};
+
+my %report_mode = (
+    REPORT_PROGNAME() => {
+        color => 'bold',
+    },
+    REPORT_COMMAND() => {
+        color => 'bold magenta',
+    },
+    REPORT_STATUS() => {
+        color => 'clear',
+        # We do not translate this name because the untranslated output is
+        # part of the interface.
+        name => 'status',
+    },
+    REPORT_DEBUG() => {
+        color => 'clear',
+        # We do not translate this name because it is a developer interface
+        # and all debug messages are untranslated anyway.
+        name => 'debug',
+    },
+    REPORT_INFO() => {
+        color => 'green',
+        name => g_('info'),
+    },
+    REPORT_NOTICE() => {
+        color => 'yellow',
+        name => g_('notice'),
+    },
+    REPORT_WARN() => {
+        color => 'bold yellow',
+        name => g_('warning'),
+    },
+    REPORT_ERROR() => {
+        color => 'bold red',
+        name => g_('error'),
+    },
+);
+
+sub report_options
+{
+    my (%options) = @_;
+
+    if (exists $options{quiet_warnings}) {
+        $quiet_warnings = $options{quiet_warnings};
+    }
+    if (exists $options{debug_level}) {
+        $debug_level = $options{debug_level};
+    }
+    if (exists $options{info_fh}) {
+        $info_fh = $options{info_fh};
+    }
+}
+
+sub report_name
+{
+    my $type = shift;
+
+    return $report_mode{$type}{name} // '';
+}
+
+sub report_color
+{
+    my $type = shift;
+
+    return $report_mode{$type}{color} // 'clear';
+}
+
+sub report_pretty
+{
+    my ($msg, $color) = @_;
+
+    state $use_color = setup_color();
+
+    if ($use_color) {
+        return Term::ANSIColor::colored($msg, $color);
+    } else {
+        return $msg;
+    }
+}
+
+sub _progname_prefix
+{
+    return report_pretty("$Dpkg::PROGNAME: ", report_color(REPORT_PROGNAME));
+}
+
+sub _typename_prefix
+{
+    my $type = shift;
+
+    return report_pretty(report_name($type), report_color($type));
+}
+
+sub report(@)
+{
+    my ($type, $msg) = (shift, shift);
+
+    $msg = sprintf($msg, @_) if (@_);
+
+    my $progname = _progname_prefix();
+    my $typename = _typename_prefix($type);
+
+    return "$progname$typename: $msg\n";
+}
+
+sub debug
+{
+    my $level = shift;
+    print report(REPORT_DEBUG, @_) if $level <= $debug_level;
+}
+
+sub info($;@)
+{
+    print { $info_fh } report(REPORT_INFO, @_) if not $quiet_warnings;
+}
+
+sub notice
+{
+    warn report(REPORT_NOTICE, @_) if not $quiet_warnings;
+}
+
+sub warning($;@)
+{
+    warn report(REPORT_WARN, @_) if not $quiet_warnings;
+}
+
+sub syserr($;@)
+{
+    my $msg = shift;
+    die report(REPORT_ERROR, "$msg: $!", @_);
+}
+
+sub error($;@)
+{
+    die report(REPORT_ERROR, @_);
+}
+
+sub errormsg($;@)
+{
+    print { *STDERR } report(REPORT_ERROR, @_);
+}
+
+sub printcmd
+{
+    my (@cmd) = @_;
+
+    print { *STDERR } report_pretty(" @cmd\n", report_color(REPORT_COMMAND));
+}
+
+sub subprocerr(@)
+{
+    my ($p) = (shift);
+
+    $p = sprintf($p, @_) if (@_);
+
+    require POSIX;
+
+    if (POSIX::WIFEXITED($?)) {
+        my $ret = POSIX::WEXITSTATUS($?);
+        error(g_('%s subprocess returned exit status %d'), $p, $ret);
+    } elsif (POSIX::WIFSIGNALED($?)) {
+        my $sig = POSIX::WTERMSIG($?);
+        error(g_('%s subprocess was killed by signal %d'), $p, $sig);
+    } else {
+        error(g_('%s subprocess failed with unknown status code %d'), $p, $?);
+    }
+}
+
+sub usageerr(@)
+{
+    my ($msg) = (shift);
+
+    state $printforhelp = g_('Use --help for program usage information.');
+
+    $msg = sprintf($msg, @_) if (@_);
+    warn report(REPORT_ERROR, $msg);
+    warn "\n$printforhelp\n";
+    exit(2);
+}
+
+1;
diff --git a/scripts/Dpkg/Exit.pm b/scripts/Dpkg/Exit.pm
new file mode 100644
index 0000000..460b4ee
--- /dev/null
+++ b/scripts/Dpkg/Exit.pm
@@ -0,0 +1,132 @@
+# Copyright © 2002 Adam Heath <doogie@debian.org>
+# Copyright © 2012-2013 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/>.
+
+package Dpkg::Exit;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.00';
+our @EXPORT_OK = qw(
+    push_exit_handler
+    pop_exit_handler
+    run_exit_handlers
+);
+
+use Exporter qw(import);
+
+my @handlers = ();
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Exit - program exit handlers
+
+=head1 DESCRIPTION
+
+The Dpkg::Exit module provides support functions to run handlers on exit.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item push_exit_handler($func)
+
+Register a code reference into the exit function handlers stack.
+
+=cut
+
+sub push_exit_handler {
+    my ($func) = shift;
+
+    _setup_exit_handlers() if @handlers == 0;
+    push @handlers, $func;
+}
+
+=item pop_exit_handler()
+
+Pop the last registered exit handler from the handlers stack.
+
+=cut
+
+sub pop_exit_handler {
+    _reset_exit_handlers() if @handlers == 1;
+    pop @handlers;
+}
+
+=item run_exit_handlers()
+
+Run the registered exit handlers.
+
+=cut
+
+sub run_exit_handlers {
+    while (my $handler = pop @handlers) {
+        $handler->();
+    }
+    _reset_exit_handlers();
+}
+
+sub _exit_handler {
+    run_exit_handlers();
+    exit(127);
+}
+
+my @SIGNAMES = qw(INT HUP QUIT);
+my %SIGOLD;
+
+sub _setup_exit_handlers
+{
+    foreach my $signame (@SIGNAMES) {
+        $SIGOLD{$signame} = $SIG{$signame};
+        $SIG{$signame} = \&_exit_handler;
+    }
+}
+
+sub _reset_exit_handlers
+{
+    foreach my $signame (@SIGNAMES) {
+        $SIG{$signame} = $SIGOLD{$signame};
+    }
+}
+
+END {
+    local $?;
+    run_exit_handlers();
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Hide variable: @handlers.
+
+=head2 Version 1.01 (dpkg 1.17.2)
+
+New functions: push_exit_handler(), pop_exit_handler(), run_exit_handlers()
+
+Deprecated variable: @handlers
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/File.pm b/scripts/Dpkg/File.pm
new file mode 100644
index 0000000..dd3fd9f
--- /dev/null
+++ b/scripts/Dpkg/File.pm
@@ -0,0 +1,79 @@
+# Copyright © 2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012 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/>.
+
+package Dpkg::File;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    file_slurp
+    file_dump
+    file_touch
+);
+
+use Exporter qw(import);
+use Scalar::Util qw(openhandle);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+sub file_slurp {
+    my $file = shift;
+    my $fh;
+    my $doclose = 0;
+
+    if (openhandle($file)) {
+        $fh = $file;
+    } else {
+        open $fh, '<', $file or syserr(g_('cannot read %s'), $fh);
+        $doclose = 1;
+    }
+    local $/;
+    my $data = <$fh>;
+    close $fh if $doclose;
+
+    return $data;
+}
+
+sub file_dump {
+    my ($file, $data) = @_;
+    my $fh;
+    my $doclose = 0;
+
+    if (openhandle($file)) {
+        $fh = $file;
+    } else {
+        open $fh, '>', $file or syserr(g_('cannot create file %s'), $file);
+        $doclose = 1;
+    }
+    print { $fh } $data;
+    if ($doclose) {
+        close $fh or syserr(g_('cannot write %s'), $file);
+    }
+
+    return;
+}
+
+sub file_touch {
+    my $file = shift;
+
+    open my $fh, '>', $file or syserr(g_('cannot create file %s'), $file);
+    close $fh or syserr(g_('cannot write %s'), $file);
+}
+
+1;
diff --git a/scripts/Dpkg/Getopt.pm b/scripts/Dpkg/Getopt.pm
new file mode 100644
index 0000000..bebe9f8
--- /dev/null
+++ b/scripts/Dpkg/Getopt.pm
@@ -0,0 +1,48 @@
+# Copyright © 2014 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/>.
+
+package Dpkg::Getopt;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+our @EXPORT = qw(
+    normalize_options
+);
+
+use Exporter qw(import);
+
+sub normalize_options
+{
+    my (%opts) = @_;
+    my $norm = 1;
+    my @args;
+
+    @args = map {
+        if ($norm and m/^(-[A-Za-z])(.+)$/) {
+            ($1, $2)
+        } elsif ($norm and m/^(--[A-Za-z-]+)=(.*)$/) {
+            ($1, $2)
+        } else {
+            $norm = 0 if defined $opts{delim} and $_ eq $opts{delim};
+            $_;
+        }
+    } @{$opts{args}};
+
+    return @args;
+}
+
+1;
diff --git a/scripts/Dpkg/Gettext.pm b/scripts/Dpkg/Gettext.pm
new file mode 100644
index 0000000..bac8f57
--- /dev/null
+++ b/scripts/Dpkg/Gettext.pm
@@ -0,0 +1,235 @@
+# Copied from /usr/share/perl5/Debconf/Gettext.pm
+#
+# Copyright © 2000 Joey Hess <joeyh@debian.org>
+# Copyright © 2007-2022 Guillem Jover <guillem@debian.org>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+
+package Dpkg::Gettext;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '2.01';
+our @EXPORT = qw(
+    textdomain
+    gettext
+    ngettext
+    g_
+    P_
+    N_
+);
+
+use Exporter qw(import);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Gettext - convenience wrapper around Locale::gettext
+
+=head1 DESCRIPTION
+
+The Dpkg::Gettext module is a convenience wrapper over the Locale::gettext
+module, to guarantee we always have working gettext functions, and to add
+some commonly used aliases.
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item DPKG_NLS
+
+When set to 0, this environment variable will disable the National Language
+Support in all Dpkg modules.
+
+=back
+
+=head1 VARIABLES
+
+=over 4
+
+=item $Dpkg::Gettext::DEFAULT_TEXT_DOMAIN
+
+Specifies the default text domain name to be used with the short function
+aliases. This is intended to be used by the Dpkg modules, so that they
+can produce localized messages even when the calling program has set the
+current domain with textdomain(). If you would like to use the aliases
+for your own modules, you might want to set this variable to undef, or
+to another domain, but then the Dpkg modules will not produce localized
+messages.
+
+=back
+
+=cut
+
+our $DEFAULT_TEXT_DOMAIN = 'dpkg-dev';
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $domain = textdomain($new_domain)
+
+Compatibility textdomain() fallback when Locale::gettext is not available.
+
+If $new_domain is not undef, it will set the current domain to $new_domain.
+Returns the current domain, after possibly changing it.
+
+=item $trans = gettext($msgid)
+
+Compatibility gettext() fallback when Locale::gettext is not available.
+
+Returns $msgid.
+
+=item $trans = ngettext($msgid, $msgid_plural, $n)
+
+Compatibility ngettext() fallback when Locale::gettext is not available.
+
+Returns $msgid if $n is 1 or $msgid_plural otherwise.
+
+=item $trans = g_($msgid)
+
+Calls dgettext() on the $msgid and returns its translation for the current
+locale. If dgettext() is not available, simply returns $msgid.
+
+=item $trans = C_($msgctxt, $msgid)
+
+Calls dgettext() on the $msgid and returns its translation for the specific
+$msgctxt supplied. If dgettext() is not available, simply returns $msgid.
+
+=item $trans = P_($msgid, $msgid_plural, $n)
+
+Calls dngettext(), returning the correct translation for the plural form
+dependent on $n. If dngettext() is not available, returns $msgid if $n is 1
+or $msgid_plural otherwise.
+
+=cut
+
+use constant GETTEXT_CONTEXT_GLUE => "\004";
+
+BEGIN {
+    my $use_gettext = $ENV{DPKG_NLS} // 1;
+    if ($use_gettext) {
+        eval q{
+            pop @INC if $INC[-1] eq '.';
+            use Locale::gettext;
+        };
+        $use_gettext = not $@;
+    }
+    if (not $use_gettext) {
+        *g_ = sub {
+            return shift;
+        };
+        *textdomain = sub {
+            my $new_domain = shift;
+            state $domain = $DEFAULT_TEXT_DOMAIN;
+
+            $domain = $new_domain if defined $new_domain;
+
+            return $domain;
+        };
+        *gettext = sub {
+            my $msgid = shift;
+            return $msgid;
+        };
+        *ngettext = sub {
+            my ($msgid, $msgid_plural, $n) = @_;
+            if ($n == 1) {
+                return $msgid;
+            } else {
+                return $msgid_plural;
+            }
+        };
+        *C_ = sub {
+            my ($msgctxt, $msgid) = @_;
+            return $msgid;
+        };
+        *P_ = sub {
+            return ngettext(@_);
+        };
+    } else {
+        *g_ = sub {
+            return dgettext($DEFAULT_TEXT_DOMAIN, shift);
+        };
+        *C_ = sub {
+            my ($msgctxt, $msgid) = @_;
+            return dgettext($DEFAULT_TEXT_DOMAIN,
+                            $msgctxt . GETTEXT_CONTEXT_GLUE . $msgid);
+        };
+        *P_ = sub {
+            return dngettext($DEFAULT_TEXT_DOMAIN, @_);
+        };
+    }
+}
+
+=item $msgid = N_($msgid)
+
+A pseudo function that servers as a marker for automated extraction of
+messages, but does not call gettext(). The run-time translation is done
+at a different place in the code.
+
+=back
+
+=cut
+
+sub N_
+{
+    my $msgid = shift;
+    return $msgid;
+}
+
+=head1 CHANGES
+
+=head2 Version 2.01 (dpkg 1.21.10)
+
+New function: gettext().
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove function: _g().
+
+=head2 Version 1.03 (dpkg 1.19.0)
+
+New envvar: Add support for new B<DPKG_NLS> environment variable.
+
+=head2 Version 1.02 (dpkg 1.18.3)
+
+New function: N_().
+
+=head2 Version 1.01 (dpkg 1.18.0)
+
+Now the short aliases (g_ and P_) will call domain aware functions with
+$DEFAULT_TEXT_DOMAIN.
+
+New functions: g_(), C_().
+
+Deprecated function: _g().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/IPC.pm b/scripts/Dpkg/IPC.pm
new file mode 100644
index 0000000..2503642
--- /dev/null
+++ b/scripts/Dpkg/IPC.pm
@@ -0,0 +1,420 @@
+# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2008-2010, 2012-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/>.
+
+package Dpkg::IPC;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+our @EXPORT = qw(
+    spawn
+    wait_child
+);
+
+use Carp;
+use Exporter qw(import);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::IPC - helper functions for IPC
+
+=head1 DESCRIPTION
+
+Dpkg::IPC offers helper functions to allow you to execute
+other programs in an easy, yet flexible way, while hiding
+all the gory details of IPC (Inter-Process Communication)
+from you.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $pid = spawn(%opts)
+
+Creates a child process and executes another program in it.
+The arguments are interpreted as a hash of options, specifying
+how to handle the in and output of the program to execute.
+Returns the pid of the child process (unless the wait_child
+option was given).
+
+Any error will cause the function to exit with one of the
+Dpkg::ErrorHandling functions.
+
+Options:
+
+=over 4
+
+=item exec
+
+Can be either a scalar, i.e. the name of the program to be
+executed, or an array reference, i.e. the name of the program
+plus additional arguments. Note that the program will never be
+executed via the shell, so you can't specify additional arguments
+in the scalar string and you can't use any shell facilities like
+globbing.
+
+Mandatory Option.
+
+=item from_file, to_file, error_to_file
+
+Filename as scalar. Standard input/output/error of the
+child process will be redirected to the file specified.
+
+=item from_handle, to_handle, error_to_handle
+
+Filehandle. Standard input/output/error of the child process will be
+dup'ed from the handle.
+
+=item from_pipe, to_pipe, error_to_pipe
+
+Scalar reference or object based on IO::Handle. A pipe will be opened for
+each of the two options and either the reading (C<to_pipe> and
+C<error_to_pipe>) or the writing end (C<from_pipe>) will be returned in
+the referenced scalar. Standard input/output/error of the child process
+will be dup'ed to the other ends of the pipes.
+
+=item from_string, to_string, error_to_string
+
+Scalar reference. Standard input/output/error of the child
+process will be redirected to the string given as reference. Note
+that it wouldn't be strictly necessary to use a scalar reference
+for C<from_string>, as the string is not modified in any way. This was
+chosen only for reasons of symmetry with C<to_string> and
+C<error_to_string>. C<to_string> and C<error_to_string> imply the
+C<wait_child> option.
+
+=item wait_child
+
+Scalar. If containing a true value, wait_child() will be called before
+returning. The return value of spawn() will be a true value, not the pid.
+
+=item nocheck
+
+Scalar. Option of the wait_child() call.
+
+=item timeout
+
+Scalar. Option of the wait_child() call.
+
+=item chdir
+
+Scalar. The child process will chdir in the indicated directory before
+calling exec.
+
+=item env
+
+Hash reference. The child process will populate %ENV with the items of the
+hash before calling exec. This allows exporting environment variables.
+
+=item delete_env
+
+Array reference. The child process will remove all environment variables
+listed in the array before calling exec.
+
+=item sig
+
+Hash reference. The child process will populate %SIG with the items of the
+hash before calling exec. This allows setting signal dispositions.
+
+=item delete_sig
+
+Array reference. The child process will reset all signals listed in the
+array to their default dispositions before calling exec.
+
+=back
+
+=cut
+
+sub _check_opts {
+    my (%opts) = @_;
+
+    croak 'exec parameter is mandatory in spawn()'
+	unless $opts{exec};
+
+    my $to = my $error_to = my $from = 0;
+    foreach my $thing (qw(file handle string pipe)) {
+	$to++ if $opts{"to_$thing"};
+	$error_to++ if $opts{"error_to_$thing"};
+	$from++ if $opts{"from_$thing"};
+    }
+    croak 'not more than one of to_* parameters is allowed'
+	if $to > 1;
+    croak 'not more than one of error_to_* parameters is allowed'
+	if $error_to > 1;
+    croak 'not more than one of from_* parameters is allowed'
+	if $from > 1;
+
+    foreach my $param (qw(to_string error_to_string from_string)) {
+	if (exists $opts{$param} and
+	    (not ref $opts{$param} or ref $opts{$param} ne 'SCALAR')) {
+	    croak "parameter $param must be a scalar reference";
+	}
+    }
+
+    foreach my $param (qw(to_pipe error_to_pipe from_pipe)) {
+	if (exists $opts{$param} and
+	    (not ref $opts{$param} or (ref $opts{$param} ne 'SCALAR' and
+	     not $opts{$param}->isa('IO::Handle')))) {
+	    croak "parameter $param must be a scalar reference or " .
+	          'an IO::Handle object';
+	}
+    }
+
+    if (exists $opts{timeout} and defined($opts{timeout}) and
+        $opts{timeout} !~ /^\d+$/) {
+	croak 'parameter timeout must be an integer';
+    }
+
+    if (exists $opts{env} and ref($opts{env}) ne 'HASH') {
+	croak 'parameter env must be a hash reference';
+    }
+
+    if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') {
+	croak 'parameter delete_env must be an array reference';
+    }
+
+    if (exists $opts{sig} and ref($opts{sig}) ne 'HASH') {
+	croak 'parameter sig must be a hash reference';
+    }
+
+    if (exists $opts{delete_sig} and ref($opts{delete_sig}) ne 'ARRAY') {
+	croak 'parameter delete_sig must be an array reference';
+    }
+
+    return %opts;
+}
+
+sub spawn {
+    my (%opts) = @_;
+    my @prog;
+
+    _check_opts(%opts);
+    $opts{close_in_child} //= [];
+    if (ref($opts{exec}) =~ /ARRAY/) {
+	push @prog, @{$opts{exec}};
+    } elsif (not ref($opts{exec})) {
+	push @prog, $opts{exec};
+    } else {
+	croak 'invalid exec parameter in spawn()';
+    }
+    my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe);
+    if ($opts{to_string}) {
+	$opts{to_pipe} = \$to_string_pipe;
+	$opts{wait_child} = 1;
+    }
+    if ($opts{error_to_string}) {
+	$opts{error_to_pipe} = \$error_to_string_pipe;
+	$opts{wait_child} = 1;
+    }
+    if ($opts{from_string}) {
+	$opts{from_pipe} = \$from_string_pipe;
+    }
+    # Create pipes if needed
+    my ($input_pipe, $output_pipe, $error_pipe);
+    if ($opts{from_pipe}) {
+	pipe($opts{from_handle}, $input_pipe)
+	    or syserr(g_('pipe for %s'), "@prog");
+	${$opts{from_pipe}} = $input_pipe;
+	push @{$opts{close_in_child}}, $input_pipe;
+    }
+    if ($opts{to_pipe}) {
+	pipe($output_pipe, $opts{to_handle})
+	    or syserr(g_('pipe for %s'), "@prog");
+	${$opts{to_pipe}} = $output_pipe;
+	push @{$opts{close_in_child}}, $output_pipe;
+    }
+    if ($opts{error_to_pipe}) {
+	pipe($error_pipe, $opts{error_to_handle})
+	    or syserr(g_('pipe for %s'), "@prog");
+	${$opts{error_to_pipe}} = $error_pipe;
+	push @{$opts{close_in_child}}, $error_pipe;
+    }
+    # Fork and exec
+    my $pid = fork();
+    syserr(g_('cannot fork for %s'), "@prog") unless defined $pid;
+    if (not $pid) {
+	# Define environment variables
+	if ($opts{env}) {
+	    foreach (keys %{$opts{env}}) {
+		$ENV{$_} = $opts{env}{$_};
+	    }
+	}
+	if ($opts{delete_env}) {
+	    delete $ENV{$_} foreach (@{$opts{delete_env}});
+	}
+	# Define signal dispositions.
+	if ($opts{sig}) {
+	    foreach (keys %{$opts{sig}}) {
+		$SIG{$_} = $opts{sig}{$_};
+	    }
+	}
+	if ($opts{delete_sig}) {
+	    delete $SIG{$_} foreach (@{$opts{delete_sig}});
+	}
+	# Change the current directory
+	if ($opts{chdir}) {
+	    chdir($opts{chdir}) or syserr(g_('chdir to %s'), $opts{chdir});
+	}
+	# Redirect STDIN if needed
+	if ($opts{from_file}) {
+	    open(STDIN, '<', $opts{from_file})
+	        or syserr(g_('cannot open %s'), $opts{from_file});
+	} elsif ($opts{from_handle}) {
+	    open(STDIN, '<&', $opts{from_handle})
+		or syserr(g_('reopen stdin'));
+	    # has been duped, can be closed
+	    push @{$opts{close_in_child}}, $opts{from_handle};
+	}
+	# Redirect STDOUT if needed
+	if ($opts{to_file}) {
+	    open(STDOUT, '>', $opts{to_file})
+	        or syserr(g_('cannot write %s'), $opts{to_file});
+	} elsif ($opts{to_handle}) {
+	    open(STDOUT, '>&', $opts{to_handle})
+		or syserr(g_('reopen stdout'));
+	    # has been duped, can be closed
+	    push @{$opts{close_in_child}}, $opts{to_handle};
+	}
+	# Redirect STDERR if needed
+	if ($opts{error_to_file}) {
+	    open(STDERR, '>', $opts{error_to_file})
+	        or syserr(g_('cannot write %s'), $opts{error_to_file});
+	} elsif ($opts{error_to_handle}) {
+	    open(STDERR, '>&', $opts{error_to_handle})
+	        or syserr(g_('reopen stdout'));
+	    # has been duped, can be closed
+	    push @{$opts{close_in_child}}, $opts{error_to_handle};
+	}
+	# Close some inherited filehandles
+	close($_) foreach (@{$opts{close_in_child}});
+	# Execute the program
+	exec({ $prog[0] } @prog) or syserr(g_('unable to execute %s'), "@prog");
+    }
+    # Close handle that we can't use any more
+    close($opts{from_handle}) if exists $opts{from_handle};
+    close($opts{to_handle}) if exists $opts{to_handle};
+    close($opts{error_to_handle}) if exists $opts{error_to_handle};
+
+    if ($opts{from_string}) {
+	print { $from_string_pipe } ${$opts{from_string}};
+	close($from_string_pipe);
+    }
+    if ($opts{to_string}) {
+	local $/ = undef;
+	${$opts{to_string}} = readline($to_string_pipe);
+    }
+    if ($opts{error_to_string}) {
+	local $/ = undef;
+	${$opts{error_to_string}} = readline($error_to_string_pipe);
+    }
+    if ($opts{wait_child}) {
+	my $cmdline = "@prog";
+	if ($opts{env}) {
+	    foreach (keys %{$opts{env}}) {
+		$cmdline = "$_=\"" . $opts{env}{$_} . "\" $cmdline";
+	    }
+	}
+	wait_child($pid, nocheck => $opts{nocheck},
+                   timeout => $opts{timeout}, cmdline => $cmdline);
+	return 1;
+    }
+
+    return $pid;
+}
+
+
+=item wait_child($pid, %opts)
+
+Takes as first argument the pid of the process to wait for.
+Remaining arguments are taken as a hash of options. Returns
+nothing. Fails if the child has been ended by a signal or
+if it exited non-zero.
+
+Options:
+
+=over 4
+
+=item cmdline
+
+String to identify the child process in error messages.
+Defaults to "child process".
+
+=item nocheck
+
+If true do not check the return status of the child (and thus
+do not fail it has been killed or if it exited with a
+non-zero return code).
+
+=item timeout
+
+Set a maximum time to wait for the process, after that kill the process and
+fail with an error message.
+
+=back
+
+=cut
+
+sub wait_child {
+    my ($pid, %opts) = @_;
+    $opts{cmdline} //= g_('child process');
+    croak 'no PID set, cannot wait end of process' unless $pid;
+    eval {
+        local $SIG{ALRM} = sub { die "alarm\n" };
+        alarm($opts{timeout}) if defined($opts{timeout});
+        $pid == waitpid($pid, 0) or syserr(g_('wait for %s'), $opts{cmdline});
+        alarm(0) if defined($opts{timeout});
+    };
+    if ($@) {
+        die $@ unless $@ eq "alarm\n";
+        kill 'TERM', $pid;
+        error(P_("%s didn't complete in %d second",
+                 "%s didn't complete in %d seconds",
+                 $opts{timeout}),
+              $opts{cmdline}, $opts{timeout});
+    }
+    unless ($opts{nocheck}) {
+	subprocerr($opts{cmdline}) if $?;
+    }
+}
+
+1;
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.18.0)
+
+Change options: wait_child() now kills the process when reaching the 'timeout'.
+
+=head2 Version 1.01 (dpkg 1.17.11)
+
+New options: spawn() now accepts 'sig' and 'delete_sig'.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=head1 SEE ALSO
+
+Dpkg, Dpkg::ErrorHandling
diff --git a/scripts/Dpkg/Index.pm b/scripts/Dpkg/Index.pm
new file mode 100644
index 0000000..46027d0
--- /dev/null
+++ b/scripts/Dpkg/Index.pm
@@ -0,0 +1,457 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2017 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/>.
+
+package Dpkg::Index;
+
+use strict;
+use warnings;
+
+our $VERSION = '3.00';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control;
+
+use parent qw(Dpkg::Interface::Storable);
+
+use overload
+    '@{}' => sub { return $_[0]->{order} },
+    fallback => 1;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Index - generic index of control information
+
+=head1 DESCRIPTION
+
+This class represent a set of Dpkg::Control objects.
+
+=head1 METHODS
+
+=over 4
+
+=item $index = Dpkg::Index->new(%opts)
+
+Creates a new empty index. See set_options() for more details.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+	items => {},
+	order => [],
+	unique_tuple_key => 1,
+	get_key_func => sub { return $_[0]->{Package} },
+	type => CTRL_UNKNOWN,
+        item_opts => {},
+    };
+    bless $self, $class;
+    $self->set_options(%opts);
+    if (exists $opts{load}) {
+	$self->load($opts{load});
+    }
+
+    return $self;
+}
+
+=item $index->set_options(%opts)
+
+The "type" option is checked first to define default values for other
+options. Here are the relevant options: "get_key_func" is a function
+returning a key for the item passed in parameters, "unique_tuple_key" is
+a boolean requesting whether the default key should be the unique tuple
+(default to true), "item_opts" is a hash reference that will be passed to
+the item constructor in the new_item() method.
+The index can only contain one item with a given key.
+The "get_key_func" function used depends on the type:
+
+=over
+
+=item *
+
+for CTRL_INFO_SRC, it is the Source field;
+
+=item *
+
+for CTRL_INDEX_SRC and CTRL_PKG_SRC it is the Package and Version fields
+(concatenated with "_") when "unique_tuple_key" is true (the default), or
+otherwise the Package field;
+
+=item *
+
+for CTRL_INFO_PKG it is simply the Package field;
+
+=item *
+
+for CTRL_INDEX_PKG and CTRL_PKG_DEB it is the Package, Version and
+Architecture fields (concatenated with "_") when "unique_tuple_key" is
+true (the default) or otherwise the Package field;
+
+=item *
+
+for CTRL_CHANGELOG it is the Source and the Version fields (concatenated
+with an intermediary "_");
+
+=item *
+
+for CTRL_TESTS is an integer index (0-based) corresponding to the Tests or
+Test-Command field stanza;
+
+=item *
+
+for CTRL_FILE_CHANGES it is the Source, Version and Architecture fields
+(concatenated with "_");
+
+=item *
+
+for CTRL_FILE_VENDOR it is the Vendor field;
+
+=item *
+
+for CTRL_FILE_STATUS it is the Package and Architecture fields (concatenated
+with "_");
+
+=item *
+
+otherwise it is the Package field by default.
+
+=back
+
+=cut
+
+sub set_options {
+    my ($self, %opts) = @_;
+
+    # Default values based on type
+    if (exists $opts{type}) {
+        my $t = $opts{type};
+        if ($t == CTRL_INFO_PKG) {
+	    $self->{get_key_func} = sub { return $_[0]->{Package}; };
+        } elsif ($t == CTRL_INFO_SRC) {
+	    $self->{get_key_func} = sub { return $_[0]->{Source}; };
+        } elsif ($t == CTRL_CHANGELOG) {
+	    $self->{get_key_func} = sub {
+		return $_[0]->{Source} . '_' . $_[0]->{Version};
+	    };
+        } elsif ($t == CTRL_COPYRIGHT_HEADER) {
+            # This is a bit pointless, because the value will almost always
+            # be the same, but guarantees that we use a known field.
+            $self->{get_key_func} = sub { return $_[0]->{Format}; };
+        } elsif ($t == CTRL_COPYRIGHT_FILES) {
+            $self->{get_key_func} = sub { return $_[0]->{Files}; };
+        } elsif ($t == CTRL_COPYRIGHT_LICENSE) {
+            $self->{get_key_func} = sub { return $_[0]->{License}; };
+        } elsif ($t == CTRL_TESTS) {
+            $self->{get_key_func} = sub {
+                return scalar @{$self->{order}};
+            };
+        } elsif ($t == CTRL_INDEX_SRC or $t == CTRL_PKG_SRC) {
+            if ($opts{unique_tuple_key} // $self->{unique_tuple_key}) {
+                $self->{get_key_func} = sub {
+                    return $_[0]->{Package} . '_' . $_[0]->{Version};
+                };
+            } else {
+                $self->{get_key_func} = sub {
+                    return $_[0]->{Package};
+                };
+            }
+        } elsif ($t == CTRL_INDEX_PKG or $t == CTRL_PKG_DEB) {
+            if ($opts{unique_tuple_key} // $self->{unique_tuple_key}) {
+                $self->{get_key_func} = sub {
+                    return $_[0]->{Package} . '_' . $_[0]->{Version} . '_' .
+                           $_[0]->{Architecture};
+                };
+            } else {
+                $self->{get_key_func} = sub {
+                    return $_[0]->{Package};
+                };
+            }
+        } elsif ($t == CTRL_FILE_CHANGES) {
+	    $self->{get_key_func} = sub {
+		return $_[0]->{Source} . '_' . $_[0]->{Version} . '_' .
+		       $_[0]->{Architecture};
+	    };
+        } elsif ($t == CTRL_FILE_VENDOR) {
+	    $self->{get_key_func} = sub { return $_[0]->{Vendor}; };
+        } elsif ($t == CTRL_FILE_STATUS) {
+	    $self->{get_key_func} = sub {
+		return $_[0]->{Package} . '_' . $_[0]->{Architecture};
+	    };
+        }
+    }
+
+    # Options set by the user override default values
+    $self->{$_} = $opts{$_} foreach keys %opts;
+}
+
+=item $index->get_type()
+
+Returns the type of control information stored. See the type parameter
+set during new().
+
+=cut
+
+sub get_type {
+    my $self = shift;
+    return $self->{type};
+}
+
+=item $index->add($item, [$key])
+
+Add a new item in the index. If the $key parameter is omitted, the key
+will be generated with the get_key_func function (see set_options() for
+details).
+
+=cut
+
+sub add {
+    my ($self, $item, $key) = @_;
+
+    $key //= $self->{get_key_func}($item);
+    if (not exists $self->{items}{$key}) {
+	push @{$self->{order}}, $key;
+    }
+    $self->{items}{$key} = $item;
+}
+
+=item $index->parse($fh, $desc)
+
+Reads the filehandle and creates all items parsed. When called multiple
+times, the parsed stanzas are accumulated.
+
+Returns the number of items parsed.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+    my $item = $self->new_item();
+    my $i = 0;
+    while ($item->parse($fh, $desc)) {
+	$self->add($item);
+	$item = $self->new_item();
+	$i++;
+    }
+    return $i;
+}
+
+=item $index->load($file)
+
+Reads the file and creates all items parsed. Returns the number of items
+parsed. Handles compressed files transparently based on their extensions.
+
+=item $item = $index->new_item()
+
+Creates a new item. Mainly useful for derived objects that would want
+to override this method to return something else than a Dpkg::Control
+object.
+
+=cut
+
+sub new_item {
+    my $self = shift;
+    return Dpkg::Control->new(%{$self->{item_opts}}, type => $self->{type});
+}
+
+=item $item = $index->get_by_key($key)
+
+Returns the item identified by $key or undef.
+
+=cut
+
+sub get_by_key {
+    my ($self, $key) = @_;
+    return $self->{items}{$key} if exists $self->{items}{$key};
+    return;
+}
+
+=item @keys = $index->get_keys(%criteria)
+
+Returns the keys of items that matches all the criteria. The key of the
+%criteria hash is a field name and the value is either a regex that needs
+to match the field value, or a reference to a function that must return
+true and that receives the field value as single parameter, or a scalar
+that must be equal to the field value.
+
+=cut
+
+sub get_keys {
+    my ($self, %crit) = @_;
+    my @selected = @{$self->{order}};
+    foreach my $s_crit (keys %crit) { # search criteria
+	if (ref($crit{$s_crit}) eq 'Regexp') {
+	    @selected = grep {
+		exists $self->{items}{$_}{$s_crit} and
+		       $self->{items}{$_}{$s_crit} =~ $crit{$s_crit}
+	    } @selected;
+	} elsif (ref($crit{$s_crit}) eq 'CODE') {
+	    @selected = grep {
+		$crit{$s_crit}->($self->{items}{$_}{$s_crit});
+	    } @selected;
+	} else {
+	    @selected = grep {
+		exists $self->{items}{$_}{$s_crit} and
+		       $self->{items}{$_}{$s_crit} eq $crit{$s_crit}
+	    } @selected;
+	}
+    }
+    return @selected;
+}
+
+=item @items = $index->get(%criteria)
+
+Returns all the items that matches all the criteria.
+
+=cut
+
+sub get {
+    my ($self, %crit) = @_;
+    return map { $self->{items}{$_} } $self->get_keys(%crit);
+}
+
+=item $index->remove_by_key($key)
+
+Remove the item identified by the given key.
+
+=cut
+
+sub remove_by_key {
+    my ($self, $key) = @_;
+    @{$self->{order}} = grep { $_ ne $key } @{$self->{order}};
+    return delete $self->{items}{$key};
+}
+
+=item @items = $index->remove(%criteria)
+
+Returns and removes all the items that matches all the criteria.
+
+=cut
+
+sub remove {
+    my ($self, %crit) = @_;
+    my @keys = $self->get_keys(%crit);
+    my (%keys, @ret);
+    foreach my $key (@keys) {
+	$keys{$key} = 1;
+	push @ret, $self->{items}{$key} if defined wantarray;
+	delete $self->{items}{$key};
+    }
+    @{$self->{order}} = grep { not exists $keys{$_} } @{$self->{order}};
+    return @ret;
+}
+
+=item $index->merge($other_index, %opts)
+
+Merge the entries of the other index. While merging, the keys of the merged
+index are used, they are not re-computed (unless you have set the options
+"keep_keys" to "0"). It's your responsibility to ensure that they have been
+computed with the same function.
+
+=cut
+
+sub merge {
+    my ($self, $other, %opts) = @_;
+    $opts{keep_keys} //= 1;
+    foreach my $key ($other->get_keys()) {
+	$self->add($other->get_by_key($key), $opts{keep_keys} ? $key : undef);
+    }
+}
+
+=item $index->sort(\&sortfunc)
+
+Sort the index with the given sort function. If no function is given, an
+alphabetic sort is done based on the keys. The sort function receives the
+items themselves as parameters and not the keys.
+
+=cut
+
+sub sort {
+    my ($self, $func) = @_;
+    if (defined $func) {
+	@{$self->{order}} = sort {
+	    $func->($self->{items}{$a}, $self->{items}{$b})
+	} @{$self->{order}};
+    } else {
+	@{$self->{order}} = sort @{$self->{order}};
+    }
+}
+
+=item $str = $index->output([$fh])
+
+=item "$index"
+
+Get a string representation of the index. The L<Dpkg::Control> objects are
+output in the order which they have been read or added except if the order
+have been changed with sort().
+
+Print the string representation of the index to a filehandle if $fh has
+been passed.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    foreach my $key ($self->get_keys()) {
+	if (defined $fh) {
+	    print { $fh } $self->get_by_key($key) . "\n";
+	}
+	if (defined wantarray) {
+	    $str .= $self->get_by_key($key) . "\n";
+	}
+    }
+    return $str;
+}
+
+=item $index->save($file)
+
+Writes the content of the index in a file. Auto-compresses files
+based on their extensions.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 3.00 (dpkg 1.21.2)
+
+Change behavior: The CTRL_TESTS key now defaults to a stanza index.
+
+=head2 Version 2.01 (dpkg 1.20.6)
+
+New option: Add new "item_opts" option.
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Change behavior: The "unique_tuple_key" option now defaults to true.
+
+=head2 Version 1.01 (dpkg 1.19.0)
+
+New option: Add new "unique_tuple_key" option to $index->set_options() to set
+better default "get_key_func" options, which will become the default behavior
+in 1.20.x.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Interface/Storable.pm b/scripts/Dpkg/Interface/Storable.pm
new file mode 100644
index 0000000..5ac078a
--- /dev/null
+++ b/scripts/Dpkg/Interface/Storable.pm
@@ -0,0 +1,163 @@
+# Copyright © 2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Interface::Storable;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use overload
+    '""' => \&_stringify,
+    'fallback' => 1;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Interface::Storable - common methods related to object serialization
+
+=head1 DESCRIPTION
+
+Dpkg::Interface::Storable is only meant to be used as parent
+class for other classes. It provides common methods that are
+all implemented on top of two basic methods parse() and output().
+
+=head1 BASE METHODS
+
+Those methods must be provided by the class that wish to inherit
+from Dpkg::Interface::Storable so that the methods provided can work.
+
+=over 4
+
+=item $obj->parse($fh[, $desc])
+
+This methods initialize the object with the data stored in the
+filehandle. $desc is optional and is a textual description of
+the filehandle used in error messages.
+
+=item $string = $obj->output([$fh])
+
+This method returns a string representation of the object in $string
+and it writes the same string to $fh (if it's defined).
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item $obj->load($filename, %opts)
+
+Initialize the object with the data stored in the file. The file can be
+compressed, it will be decompressed on the fly by using a
+Dpkg::Compression::FileHandle object. If $opts{compression} is false the
+decompression support will be disabled. If $filename is "-", then the
+standard input is read (no compression is allowed in that case).
+
+=cut
+
+sub load {
+    my ($self, $file, %opts) = @_;
+    $opts{compression} //= 1;
+    unless ($self->can('parse')) {
+	croak ref($self) . ' cannot be loaded, it lacks the parse method';
+    }
+    my ($desc, $fh) = ($file, undef);
+    if ($file eq '-') {
+	$fh = \*STDIN;
+	$desc = g_('<standard input>');
+    } else {
+        if ($opts{compression}) {
+            require Dpkg::Compression::FileHandle;
+            $fh = Dpkg::Compression::FileHandle->new();
+        }
+	open($fh, '<', $file) or syserr(g_('cannot read %s'), $file);
+    }
+    my $res = $self->parse($fh, $desc, %opts);
+    if ($file ne '-') {
+	close($fh) or syserr(g_('cannot close %s'), $file);
+    }
+    return $res;
+}
+
+=item $obj->save($filename, %opts)
+
+Store the object in the file. If the filename ends with a known
+compression extension, it will be compressed on the fly by using a
+Dpkg::Compression::FileHandle object. If $opts{compression} is false the
+compression support will be disabled. If $filename is "-", then the
+standard output is used (data are written uncompressed in that case).
+
+=cut
+
+sub save {
+    my ($self, $file, %opts) = @_;
+    $opts{compression} //= 1;
+    unless ($self->can('output')) {
+	croak ref($self) . ' cannot be saved, it lacks the output method';
+    }
+    my $fh;
+    if ($file eq '-') {
+	$fh = \*STDOUT;
+    } else {
+        if ($opts{compression}) {
+            require Dpkg::Compression::FileHandle;
+            $fh = Dpkg::Compression::FileHandle->new();
+        }
+	open($fh, '>', $file) or syserr(g_('cannot write %s'), $file);
+    }
+    $self->output($fh, %opts);
+    if ($file ne '-') {
+	close($fh) or syserr(g_('cannot close %s'), $file);
+    }
+}
+
+=item "$obj"
+
+Return a string representation of the object.
+
+=cut
+
+sub _stringify {
+    my $self = shift;
+    unless ($self->can('output')) {
+	croak ref($self) . ' cannot be stringified, it lacks the output method';
+    }
+    return $self->output();
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.19.0)
+
+New options: The $obj->load() and $obj->save() methods support a new
+compression option.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Lock.pm b/scripts/Dpkg/Lock.pm
new file mode 100644
index 0000000..6344779
--- /dev/null
+++ b/scripts/Dpkg/Lock.pm
@@ -0,0 +1,61 @@
+# Copyright © 2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012 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/>.
+
+package Dpkg::Lock;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    file_lock
+);
+
+use Exporter qw(import);
+use Fcntl qw(:flock);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+sub file_lock($$) {
+    my ($fh, $filename) = @_;
+
+    # A strict dependency on libfile-fcntllock-perl being it an XS module,
+    # and dpkg-dev indirectly making use of it, makes building new perl
+    # package which bump the perl ABI impossible as these packages cannot
+    # be installed alongside.
+    eval q{
+        pop @INC if $INC[-1] eq '.';
+        use File::FcntlLock;
+    };
+    if ($@) {
+        # On Linux systems the flock() locks get converted to file-range
+        # locks on NFS mounts.
+        if ($^O ne 'linux') {
+            warning(g_('File::FcntlLock not available; using flock which is not NFS-safe'));
+        }
+        flock($fh, LOCK_EX)
+            or syserr(g_('failed to get a write lock on %s'), $filename);
+    } else {
+        eval q{
+            my $fs = File::FcntlLock->new(l_type => F_WRLCK);
+            $fs->lock($fh, F_SETLKW)
+                or syserr(g_('failed to get a write lock on %s'), $filename);
+        }
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP.pm b/scripts/Dpkg/OpenPGP.pm
new file mode 100644
index 0000000..2e12ea7
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP.pm
@@ -0,0 +1,155 @@
+# Copyright © 2017 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/>.
+
+package Dpkg::OpenPGP;
+
+use strict;
+use warnings;
+
+use List::Util qw(none);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::Path qw(find_command);
+
+our $VERSION = '0.01';
+
+my @BACKENDS = qw(
+    sop
+    sq
+    gpg
+);
+my %BACKEND = (
+    sop => 'SOP',
+    sq => 'Sequoia',
+    gpg => 'GnuPG',
+);
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {};
+    bless $self, $class;
+
+    my $backend = $opts{backend} // 'auto';
+    my %backend_opts = (
+        cmdv => $opts{cmdv} // 'auto',
+        cmd => $opts{cmd} // 'auto',
+    );
+
+    if ($backend eq 'auto') {
+        # Defaults for stateless full API auto-detection.
+        $opts{needs}{api} //= 'full';
+        $opts{needs}{keystore} //= 0;
+
+        if (none { $opts{needs}{api} eq $_ } qw(full verify)) {
+            error(g_('unknown OpenPGP api requested %s'), $opts{needs}{api});
+        }
+
+        $self->{backend} = $self->_auto_backend($opts{needs}, %backend_opts);
+    } elsif (exists $BACKEND{$backend}) {
+        $self->{backend} = $self->_load_backend($BACKEND{$backend}, %backend_opts);
+        if (! $self->{backend}) {
+            error(g_('cannot load OpenPGP backend %s'), $backend);
+        }
+    } else {
+        error(g_('unknown OpenPGP backend %s'), $backend);
+    }
+
+    return $self;
+}
+
+sub _load_backend {
+    my ($self, $backend, %opts) = @_;
+
+    my $module = "Dpkg::OpenPGP::Backend::$backend";
+    eval qq{
+        pop \@INC if \$INC[-1] eq '.';
+        require $module;
+    };
+    return if $@;
+
+    return $module->new(%opts);
+}
+
+sub _auto_backend {
+    my ($self, $needs, %opts) = @_;
+
+    foreach my $backend (@BACKENDS) {
+        my $module = $self->_load_backend($BACKEND{$backend}, %opts);
+
+        if ($needs->{api} eq 'verify') {
+            next if ! $module->has_verify_cmd();
+        } else {
+            next if ! $module->has_backend_cmd();
+        }
+        next if $needs->{keystore} && ! $module->has_keystore();
+
+        return $module;
+    }
+
+    # Otherwise load a dummy backend.
+    return Dpkg::OpenPGP::Backend->new();
+}
+
+sub can_use_secrets {
+    my ($self, $key) = @_;
+
+    return 0 unless $self->{backend}->has_backend_cmd();
+    return 0 if $key->type eq 'keyfile' && ! -f $key->handle;
+    return 0 if $key->type eq 'keystore' && ! -e $key->handle;
+    return 0 unless $self->{backend}->can_use_key($key);
+    return 1;
+}
+
+sub get_trusted_keyrings {
+    my $self = shift;
+
+    return $self->{backend}->get_trusted_keyrings();
+}
+
+sub armor {
+    my ($self, $type, $in, $out) = @_;
+
+    return $self->{backend}->armor($type, $in, $out);
+}
+
+sub dearmor {
+    my ($self, $type, $in, $out) = @_;
+
+    return $self->{backend}->dearmor($type, $in, $out);
+}
+
+sub inline_verify {
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return $self->{backend}->inline_verify($inlinesigned, $data, @certs);
+}
+
+sub verify {
+    my ($self, $data, $sig, @certs) = @_;
+
+    return $self->{backend}->verify($data, $sig, @certs);
+}
+
+sub inline_sign {
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return $self->{backend}->inline_sign($data, $inlinesigned, $key);
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend.pm b/scripts/Dpkg/OpenPGP/Backend.pm
new file mode 100644
index 0000000..48cfd22
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend.pm
@@ -0,0 +1,127 @@
+# Copyright © 2017, 2022 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/>.
+
+package Dpkg::OpenPGP::Backend;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use List::Util qw(first);
+
+use Dpkg::Path qw(find_command);
+use Dpkg::OpenPGP::ErrorCodes;
+
+sub DEFAULT_CMDV {
+    return [];
+}
+
+sub DEFAULT_CMDSTORE {
+    return [];
+}
+
+sub DEFAULT_CMD {
+    return [];
+}
+
+sub _detect_cmd {
+    my ($cmd, $default) = @_;
+
+    if (! defined $cmd || $cmd eq 'auto') {
+        return first { find_command($_) } @{$default};
+    } else {
+        return find_command($cmd);
+    }
+}
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        strict_verify => $opts{strict_verify} // 1,
+    };
+    bless $self, $class;
+
+    $self->{cmdv} = _detect_cmd($opts{cmdv}, $self->DEFAULT_CMDV());
+    $self->{cmdstore} = _detect_cmd($opts{cmdstore}, $self->DEFAULT_CMDSTORE());
+    $self->{cmd} = _detect_cmd($opts{cmd}, $self->DEFAULT_CMD());
+
+    return $self;
+}
+
+sub has_backend_cmd {
+    my $self = shift;
+
+    return defined $self->{cmd};
+}
+
+sub has_verify_cmd {
+    my $self = shift;
+
+    return defined $self->{cmd};
+}
+
+sub has_keystore {
+    my $self = shift;
+
+    return 0;
+}
+
+sub can_use_key {
+    my ($self, $key) = @_;
+
+    return $self->has_keystore() if $key->needs_keystore();
+    return 1;
+}
+
+sub get_trusted_keyrings {
+    my $self = shift;
+
+    return ();
+}
+
+sub armor {
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_UNSUPPORTED_SUBCMD;
+}
+
+sub dearmor {
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_UNSUPPORTED_SUBCMD;
+}
+
+sub inline_verify {
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return OPENPGP_UNSUPPORTED_SUBCMD;
+}
+
+sub verify {
+    my ($self, $data, $sig, @certs) = @_;
+
+    return OPENPGP_UNSUPPORTED_SUBCMD;
+}
+
+sub inline_sign {
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_UNSUPPORTED_SUBCMD;
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
new file mode 100644
index 0000000..7cc7bc7
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/GnuPG.pm
@@ -0,0 +1,301 @@
+# Copyright © 207, 2022 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/>.
+
+package Dpkg::OpenPGP::Backend::GnuPG;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use POSIX qw(:sys_wait_h);
+use File::Temp;
+use MIME::Base64;
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::File;
+use Dpkg::Path qw(find_command);
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+sub DEFAULT_CMDV {
+    return [ qw(gpgv) ];
+}
+
+sub DEFAULT_CMDSTORE {
+    return [ qw(gpg-agent) ];
+}
+
+sub DEFAULT_CMD {
+    return [ qw(gpg) ];
+}
+
+sub has_backend_cmd {
+    my $self = shift;
+
+    return defined $self->{cmd} && defined $self->{cmdstore};
+}
+
+sub has_keystore {
+    my $self = shift;
+
+    return 0 if not defined $self->{cmdstore};
+    return 1 if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) ||
+                ($ENV{HOME} && -e "$ENV{HOME}/.gnupg");
+    return 0;
+}
+
+sub can_use_key {
+    my ($self, $key) = @_;
+
+    # With gpg, a secret key always requires gpg-agent (the key store).
+    return $self->has_keystore();
+}
+
+sub has_verify_cmd {
+    my $self = shift;
+
+    return defined $self->{cmdv} || defined $self->{cmd};
+}
+
+sub get_trusted_keyrings {
+    my $self = shift;
+
+    my @keyrings;
+    if (length $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") {
+        push @keyrings, "$ENV{HOME}/.gnupg/trustedkeys.gpg";
+    }
+    return @keyrings;
+}
+
+# _pgp_* functions are strictly for applying or removing ASCII armor.
+# See <https://datatracker.ietf.org/doc/html/rfc4880#section-6> for more
+# details.
+#
+# Note that these _pgp_* functions are only necessary while relying on
+# gpgv, and gpgv itself does not verify multiple signatures correctly
+# (see https://bugs.debian.org/1010955).
+
+sub _pgp_dearmor_data {
+    my ($type, $data) = @_;
+
+    # Note that we ignore an incorrect or absent checksum, following the
+    # guidance of
+    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
+    my $armor_regex = qr{
+        -----BEGIN\ PGP\ \Q$type\E-----[\r\t ]*\n
+        (?:[^:]+:\ [^\n]*[\r\t ]*\n)*
+        [\r\t ]*\n
+        ([a-zA-Z0-9/+\n]+={0,2})[\r\t ]*\n
+        (?:=[a-zA-Z0-9/+]{4}[\r\t ]*\n)?
+        -----END\ PGP\ \Q$type\E-----
+    }xm;
+
+    if ($data =~ m/$armor_regex/) {
+        return decode_base64($1);
+    }
+    return;
+}
+
+sub _pgp_armor_checksum {
+    my ($data) = @_;
+
+    # From the upcoming revision to RFC 4880
+    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
+    #
+    # The resulting three-octet-wide value then gets base64-encoded into
+    # four base64 ASCII characters.
+
+    my $CRC24_INIT = 0xB704CE;
+    my $CRC24_GENERATOR = 0x864CFB;
+
+    my @bytes = unpack 'C*', $data;
+    my $crc = $CRC24_INIT;
+    for my $b (@bytes) {
+        $crc ^= ($b << 16);
+        for (1 .. 8) {
+            $crc <<= 1;
+            if ($crc & 0x1000000) {
+                # Clear bit 25 to avoid overflow.
+                $crc &= 0xffffff;
+                $crc ^= $CRC24_GENERATOR;
+            }
+        }
+    }
+    my $sum = pack 'CCC', ($crc >> 16) & 0xff, ($crc >> 8) & 0xff, $crc & 0xff;
+    return encode_base64($sum, q{});
+}
+
+sub _pgp_armor_data {
+    my ($type, $data) = @_;
+
+    my $out = encode_base64($data, q{}) =~ s/(.{1,64})/$1\n/gr;
+    chomp $out;
+    my $crc = _pgp_armor_checksum($data);
+    my $armor = <<~"ARMOR";
+        -----BEGIN PGP $type-----
+
+        $out
+        =$crc
+        -----END PGP $type-----
+        ARMOR
+    return $armor;
+}
+
+sub armor {
+    my ($self, $type, $in, $out) = @_;
+
+    my $raw_data = file_slurp($in);
+    my $data = _pgp_dearmor_data($type, $raw_data) // $raw_data;
+    my $armor = _pgp_armor_data($type, $data);
+    return OPENPGP_BAD_DATA unless defined $armor;
+    file_dump($out, $armor);
+
+    return OPENPGP_OK;
+}
+
+sub dearmor {
+    my ($self, $type, $in, $out) = @_;
+
+    my $armor = file_slurp($in);
+    my $data = _pgp_dearmor_data($type, $armor);
+    return OPENPGP_BAD_DATA unless defined $data;
+    file_dump($out, $data);
+
+    return OPENPGP_OK;
+}
+
+sub _gpg_exec
+{
+    my ($self, @exec) = @_;
+
+    my ($stdout, $stderr);
+    spawn(exec => \@exec, wait_child => 1, nocheck => 1, timeout => 10,
+          to_string => \$stdout, error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stdout$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("@exec");
+    }
+}
+
+sub _gpg_options_weak_digests {
+    my @gpg_weak_digests = map {
+        (qw(--weak-digest), $_)
+    } qw(SHA1 RIPEMD160);
+
+    return @gpg_weak_digests;
+}
+
+sub _gpg_verify {
+    my ($self, $signeddata, $sig, $data, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD if ! $self->has_verify_cmd();
+
+    my $gpg_home = File::Temp->newdir('dpkg-gpg-verify.XXXXXXXX', TMPDIR => 1);
+    my @cmd_opts = qw(--no-options --no-default-keyring --batch --quiet);
+    my @gpg_opts;
+    push @gpg_opts, _gpg_options_weak_digests();
+    push @gpg_opts, '--homedir', $gpg_home;
+    push @cmd_opts, @gpg_opts;
+
+    my @exec;
+    if ($self->{cmdv}) {
+        push @exec, $self->{cmdv};
+        push @exec, @gpg_opts;
+        # We need to touch the trustedkeys.gpg keyring, otherwise gpgv will
+        # emit an error about the trustedkeys.kbx file being of unknown type.
+        file_touch("$gpg_home/trustedkeys.gpg");
+    } else {
+        push @exec, $self->{cmd};
+        push @exec, @cmd_opts;
+    }
+    foreach my $cert (@certs) {
+        my $certring = File::Temp->new(UNLINK => 1, SUFFIX => '.pgp');
+        my $rc;
+        # XXX: The internal dearmor() does not handle concatenated ASCII Armor,
+        # but the old implementation handled such certificate keyrings, so to
+        # avoid regressing for now, we fallback to use the GnuPG dearmor.
+        if (defined $self->{cmd}) {
+            $rc = $self->_gpg_exec($self->{cmd}, @cmd_opts, '--yes',
+                                          '--output', $certring,
+                                          '--dearmor', $cert);
+        } else {
+            $rc = $self->dearmor('PUBLIC KEY BLOCK', $cert, $certring);
+        }
+        $certring = $cert if $rc;
+        push @exec, '--keyring', $certring;
+    }
+    push @exec, '--output', $data if defined $data;
+    if (! $self->{cmdv}) {
+        push @exec, '--verify';
+    }
+    push @exec, $sig if defined $sig;
+    push @exec, $signeddata;
+
+    my $rc = $self->_gpg_exec(@exec);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_verify {
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return $self->_gpg_verify($inlinesigned, undef, $data, @certs);
+}
+
+sub verify {
+    my ($self, $data, $sig, @certs) = @_;
+
+    return $self->_gpg_verify($data, $sig, undef, @certs);
+}
+
+sub inline_sign {
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_MISSING_CMD if ! $self->has_backend_cmd();
+
+    my @exec = ($self->{cmd});
+    push @exec, _gpg_options_weak_digests();
+    push @exec, qw(--utf8-strings --textmode --armor);
+    # Set conformance level.
+    push @exec, '--openpgp';
+    # Set secure algorithm preferences.
+    push @exec, '--personal-digest-preferences', 'SHA512 SHA384 SHA256 SHA224';
+    if ($key->type eq 'keyfile') {
+        # Promote the keyfile keyhandle to a keystore, this way we share the
+        # same gpg-agent and can get any password cached.
+        my $gpg_home = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
+
+        push @exec, '--homedir', $gpg_home;
+        $self->_gpg_exec(@exec, qw(--quiet --no-tty --batch --import), $key->handle);
+        $key->set('keystore', $gpg_home);
+    } elsif ($key->type eq 'keystore') {
+        push @exec, '--homedir', $key->handle;
+    } else {
+        push @exec, '--local-user', $key->handle;
+    }
+    push @exec, '--output', $inlinesigned;
+
+    my $rc = $self->_gpg_exec(@exec, '--clearsign', $data);
+    return OPENPGP_KEY_CANNOT_SIGN if $rc;
+    return OPENPGP_OK;
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend/SOP.pm b/scripts/Dpkg/OpenPGP/Backend/SOP.pm
new file mode 100644
index 0000000..1c5073b
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/SOP.pm
@@ -0,0 +1,108 @@
+# Copyright © 2021-2022 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/>.
+
+package Dpkg::OpenPGP::Backend::SOP;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use POSIX qw(:sys_wait_h);
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+# - Once "gosop" implements inline-verify and inline-sign, add as alternative.
+#   Ref: https://github.com/ProtonMail/gosop/issues/6
+# - Once "hop" implements the new SOP draft, add as alternative.
+#   Ref: https://salsa.debian.org/clint/hopenpgp-tools/-/issues/4
+# - Once the SOP MR !23 is finalized and merged, implement a way to select
+#   whether the SOP instance supports the expected draft.
+#   Ref: https://gitlab.com/dkg/openpgp-stateless-cli/-/merge_requests/23
+# - Once the SOP issue #42 is resolved we can perhaps remove the alternative
+#   dependencies and commands to check?
+#   Ref: https://gitlab.com/dkg/openpgp-stateless-cli/-/issues/42
+
+sub DEFAULT_CMD {
+    return [ qw(sqop pgpainless-cli) ];
+}
+
+sub _sop_exec
+{
+    my ($self, $io, @exec) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    $io->{out} //= '/dev/null';
+    my $stderr;
+    spawn(exec => [ $self->{cmd}, @exec ],
+          wait_child => 1, nocheck => 1, timeout => 10,
+          from_file => $io->{in}, to_file => $io->{out},
+          error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("$self->{cmd} @exec");
+    }
+}
+
+sub armor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    # We ignore the $type, and let "sop" handle this automatically.
+    return $self->_sop_exec({ in => $in, out => $out }, 'armor');
+}
+
+sub dearmor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    # We ignore the $type, and let "sop" handle this automatically.
+    return $self->_sop_exec({ in => $in, out => $out }, 'dearmor');
+}
+
+sub inline_verify
+{
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return $self->_sop_exec({ in => $inlinesigned, out => $data },
+                            'inline-verify', @certs);
+}
+
+sub verify
+{
+    my ($self, $data, $sig, @certs) = @_;
+
+    return $self->_sop_exec({ in => $data }, 'verify', $sig, @certs);
+}
+
+sub inline_sign
+{
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_NEEDS_KEYSTORE if $key->needs_keystore();
+
+    return $self->_sop_exec({ in => $data, out => $inlinesigned },
+                            qw(inline-sign --as clearsigned --), $key->handle);
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm b/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm
new file mode 100644
index 0000000..5313393
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/Backend/Sequoia.pm
@@ -0,0 +1,123 @@
+# Copyright © 2021-2022 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/>.
+
+package Dpkg::OpenPGP::Backend::Sequoia;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use POSIX qw(:sys_wait_h);
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::OpenPGP::ErrorCodes;
+
+use parent qw(Dpkg::OpenPGP::Backend);
+
+sub DEFAULT_CMD {
+    return [ qw(sq) ];
+}
+
+sub _sq_exec
+{
+    my ($self, @exec) = @_;
+
+    my ($stdout, $stderr);
+    spawn(exec => [ $self->{cmd}, @exec ],
+          wait_child => 1, nocheck => 1, timeout => 10,
+          to_string => \$stdout, error_to_string => \$stderr);
+    if (WIFEXITED($?)) {
+        my $status = WEXITSTATUS($?);
+        print { *STDERR } "$stdout$stderr" if $status;
+        return $status;
+    } else {
+        subprocerr("$self->{cmd} @exec");
+    }
+}
+
+sub armor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    # We ignore the $type, and let "sq" handle this automatically.
+    my $rc = $self->_sq_exec(qw(armor --output), $out, $in);
+    return OPENPGP_BAD_DATA if $rc;
+    return OPENPGP_OK;
+}
+
+sub dearmor
+{
+    my ($self, $type, $in, $out) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    # We ignore the $type, and let "sq" handle this automatically.
+    my $rc = $self->_sq_exec(qw(dearmor --output), $out, $in);
+    return OPENPGP_BAD_DATA if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_verify
+{
+    my ($self, $inlinesigned, $data, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    my @opts;
+    push @opts, map { ('--signer-cert', $_) } @certs;
+    push @opts, '--output', $data if defined $data;
+
+    my $rc = $self->_sq_exec(qw(verify), @opts, $inlinesigned);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub verify
+{
+    my ($self, $data, $sig, @certs) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+
+    my @opts;
+    push @opts, map { ('--signer-cert', $_) } @certs;
+    push @opts, '--detached', $sig;
+
+    my $rc = $self->_sq_exec(qw(verify), @opts, $data);
+    return OPENPGP_NO_SIG if $rc;
+    return OPENPGP_OK;
+}
+
+sub inline_sign
+{
+    my ($self, $data, $inlinesigned, $key) = @_;
+
+    return OPENPGP_MISSING_CMD unless $self->{cmd};
+    return OPENPGP_NEEDS_KEYSTORE if $key->needs_keystore();
+
+    my @opts;
+    push @opts, '--cleartext-signature';
+    push @opts, '--signer-key', $key->handle;
+    push @opts, '--output', $inlinesigned;
+
+    my $rc = $self->_sq_exec('sign', @opts, $data);
+    return OPENPGP_KEY_CANNOT_SIGN if $rc;
+    return OPENPGP_OK;
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/ErrorCodes.pm b/scripts/Dpkg/OpenPGP/ErrorCodes.pm
new file mode 100644
index 0000000..67bd39b
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/ErrorCodes.pm
@@ -0,0 +1,93 @@
+# Copyright © 2022 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/>.
+
+package Dpkg::OpenPGP::ErrorCodes;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    OPENPGP_OK
+    OPENPGP_NO_SIG
+    OPENPGP_MISSING_ARG
+    OPENPGP_UNSUPPORTED_OPTION
+    OPENPGP_BAD_DATA
+    OPENPGP_EXPECTED_TEXT
+    OPENPGP_OUTPUT_EXISTS
+    OPENPGP_MISSING_INPUT
+    OPENPGP_KEY_IS_PROTECTED
+    OPENPGP_UNSUPPORTED_SUBCMD
+    OPENPGP_KEY_CANNOT_SIGN
+
+    OPENPGP_MISSING_CMD
+    OPENPGP_NEEDS_KEYSTORE
+
+    openpgp_errorcode_to_string
+);
+
+use Exporter qw(import);
+
+use Dpkg::Gettext;
+
+# Error codes based on
+# https://ietf.org/archive/id/draft-dkg-openpgp-stateless-cli-04.html#section-6
+#
+# Local error codes use a negative number, as that should not conflict with
+# the SOP exit codes.
+
+use constant {
+    OPENPGP_OK => 0,
+    OPENPGP_NO_SIG => 3,
+    OPENPGP_MISSING_ARG => 19,
+    OPENPGP_UNSUPPORTED_OPTION => 37,
+    OPENPGP_BAD_DATA => 41,
+    OPENPGP_EXPECTED_TEXT => 53,
+    OPENPGP_OUTPUT_EXISTS => 59,
+    OPENPGP_MISSING_INPUT => 61,
+    OPENPGP_KEY_IS_PROTECTED => 67,
+    OPENPGP_UNSUPPORTED_SUBCMD => 69,
+    OPENPGP_KEY_CANNOT_SIGN => 79,
+
+    OPENPGP_MISSING_CMD => -1,
+    OPENPGP_NEEDS_KEYSTORE => -2,
+};
+
+my %code2error = (
+    OPENPGP_OK() => N_('success'),
+    OPENPGP_NO_SIG() => N_('no acceptable signature found'),
+    OPENPGP_MISSING_ARG() => N_('missing required argument'),
+    OPENPGP_UNSUPPORTED_OPTION() => N_('unsupported option'),
+    OPENPGP_BAD_DATA() => N_('invalid data type'),
+    OPENPGP_EXPECTED_TEXT() => N_('non-text input where text expected'),
+    OPENPGP_OUTPUT_EXISTS() => N_('output file already exists'),
+    OPENPGP_MISSING_INPUT() => N_('input file does not exist'),
+    OPENPGP_KEY_IS_PROTECTED() => N_('cannot unlock password-protected key'),
+    OPENPGP_UNSUPPORTED_SUBCMD() => N_('unsupported subcommand'),
+    OPENPGP_KEY_CANNOT_SIGN() => N_('key is not signature-capable'),
+
+    OPENPGP_MISSING_CMD() => N_('missing OpenPGP implementation'),
+    OPENPGP_NEEDS_KEYSTORE() => N_('specified key needs a keystore'),
+);
+
+sub openpgp_errorcode_to_string
+{
+    my $code = shift;
+
+    return gettext($code2error{$code}) if exists $code2error{$code};
+    return sprintf g_('error code %d'), $code;
+}
+
+1;
diff --git a/scripts/Dpkg/OpenPGP/KeyHandle.pm b/scripts/Dpkg/OpenPGP/KeyHandle.pm
new file mode 100644
index 0000000..89ae448
--- /dev/null
+++ b/scripts/Dpkg/OpenPGP/KeyHandle.pm
@@ -0,0 +1,103 @@
+# Copyright © 2022 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/>.
+
+package Dpkg::OpenPGP::KeyHandle;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Carp;
+use List::Util qw(any none);
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        type => $opts{type} // 'auto',
+        handle => $opts{handle},
+    };
+    bless $self, $class;
+
+    $self->_sanitize();
+
+    return $self;
+}
+
+my $keyid_regex = qr/^(?:0x)?([[:xdigit:]]+)$/;
+
+sub _sanitize {
+    my ($self) = shift;
+
+    my $type = $self->{type};
+    if ($type eq 'auto') {
+        if (-e $self->{handle}) {
+            $type = 'keyfile';
+        } else {
+            $type = 'autoid';
+        }
+    }
+
+    if ($type eq 'autoid') {
+        if ($self->{handle} =~ m/$keyid_regex/) {
+            $self->{handle} = $1;
+            $type = 'keyid';
+        } else {
+            $type = 'userid';
+        }
+        $self->{type} = $type;
+    } elsif ($type eq 'keyid') {
+        if ($self->{handle} =~ m/$keyid_regex/) {
+            $self->{handle} = $1;
+        }
+    }
+
+    if (none { $type eq $_ } qw(userid keyid keyfile keystore)) {
+        croak "unknown type parameter value $type";
+    }
+
+    return;
+}
+
+sub needs_keystore {
+    my $self = shift;
+
+    return any { $self->{type} eq $_ } qw(keyid userid);
+}
+
+sub set {
+    my ($self, $type, $handle) = @_;
+
+    $self->{type} = $type;
+    $self->{handle} = $handle;
+
+    $self->_sanitize();
+}
+
+sub type {
+    my $self = shift;
+
+    return $self->{type};
+}
+
+sub handle {
+    my $self = shift;
+
+    return $self->{handle};
+}
+
+1;
diff --git a/scripts/Dpkg/Package.pm b/scripts/Dpkg/Package.pm
new file mode 100644
index 0000000..e49c01b
--- /dev/null
+++ b/scripts/Dpkg/Package.pm
@@ -0,0 +1,47 @@
+# Copyright © 2006 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2007,2012 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/>.
+
+package Dpkg::Package;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    pkg_name_is_illegal
+);
+
+use Exporter qw(import);
+
+use Dpkg::Gettext;
+
+sub pkg_name_is_illegal($) {
+    my $name = shift // '';
+
+    if ($name eq '') {
+        return g_('may not be empty string');
+    }
+    if ($name =~ m/[^-+.0-9a-z]/op) {
+        return sprintf(g_("character '%s' not allowed"), ${^MATCH});
+    }
+    if ($name !~ m/^[0-9a-z]/o) {
+        return g_('must start with an alphanumeric character');
+    }
+
+    return;
+}
+
+1;
diff --git a/scripts/Dpkg/Path.pm b/scripts/Dpkg/Path.pm
new file mode 100644
index 0000000..e9dff5c
--- /dev/null
+++ b/scripts/Dpkg/Path.pm
@@ -0,0 +1,354 @@
+# Copyright © 2007-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2011 Linaro Limited
+#
+# 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/>.
+
+package Dpkg::Path;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.05';
+our @EXPORT_OK = qw(
+    canonpath
+    resolve_symlink
+    check_files_are_the_same
+    check_directory_traversal
+    find_command
+    find_build_file
+    get_control_path
+    get_pkg_root_dir
+    guess_pkg_root_dir
+    relative_to_pkg_root
+);
+
+use Exporter qw(import);
+use Errno qw(ENOENT);
+use File::Spec;
+use File::Find;
+use Cwd qw(realpath);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Arch qw(get_host_arch debarch_to_debtuple);
+use Dpkg::IPC;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Path - some common path handling functions
+
+=head1 DESCRIPTION
+
+It provides some functions to handle various path.
+
+=head1 FUNCTIONS
+
+=over 8
+
+=item get_pkg_root_dir($file)
+
+This function will scan upwards the hierarchy of directory to find out
+the directory which contains the "DEBIAN" sub-directory and it will return
+its path. This directory is the root directory of a package being built.
+
+If no DEBIAN subdirectory is found, it will return undef.
+
+=cut
+
+sub get_pkg_root_dir($) {
+    my $file = shift;
+    $file =~ s{/+$}{};
+    $file =~ s{/+[^/]+$}{} if not -d $file;
+    while ($file) {
+	return $file if -d "$file/DEBIAN";
+	last if $file !~ m{/};
+	$file =~ s{/+[^/]+$}{};
+    }
+    return;
+}
+
+=item relative_to_pkg_root($file)
+
+Returns the filename relative to get_pkg_root_dir($file).
+
+=cut
+
+sub relative_to_pkg_root($) {
+    my $file = shift;
+    my $pkg_root = get_pkg_root_dir($file);
+    if (defined $pkg_root) {
+	$pkg_root .= '/';
+	return $file if ($file =~ s/^\Q$pkg_root\E//);
+    }
+    return;
+}
+
+=item guess_pkg_root_dir($file)
+
+This function tries to guess the root directory of the package build tree.
+It will first use get_pkg_root_dir(), but it will fallback to a more
+imprecise check: namely it will use the parent directory that is a
+sub-directory of the debian directory.
+
+It can still return undef if a file outside of the debian sub-directory is
+provided.
+
+=cut
+
+sub guess_pkg_root_dir($) {
+    my $file = shift;
+    my $root = get_pkg_root_dir($file);
+    return $root if defined $root;
+
+    $file =~ s{/+$}{};
+    $file =~ s{/+[^/]+$}{} if not -d $file;
+    my $parent = $file;
+    while ($file) {
+	$parent =~ s{/+[^/]+$}{};
+	last if not -d $parent;
+	return $file if check_files_are_the_same('debian', $parent);
+	$file = $parent;
+	last if $file !~ m{/};
+    }
+    return;
+}
+
+=item check_files_are_the_same($file1, $file2, $resolve_symlink)
+
+This function verifies that both files are the same by checking that the device
+numbers and the inode numbers returned by stat()/lstat() are the same. If
+$resolve_symlink is true then stat() is used, otherwise lstat() is used.
+
+=cut
+
+sub check_files_are_the_same($$;$) {
+    my ($file1, $file2, $resolve_symlink) = @_;
+
+    return 1 if $file1 eq $file2;
+    return 0 if ((! -e $file1) || (! -e $file2));
+    my (@stat1, @stat2);
+    if ($resolve_symlink) {
+        @stat1 = stat($file1);
+        @stat2 = stat($file2);
+    } else {
+        @stat1 = lstat($file1);
+        @stat2 = lstat($file2);
+    }
+    my $result = ($stat1[0] == $stat2[0]) && ($stat1[1] == $stat2[1]);
+    return $result;
+}
+
+
+=item canonpath($file)
+
+This function returns a cleaned path. It simplifies double //, and remove
+/./ and /../ intelligently. For /../ it simplifies the path only if the
+previous element is not a symlink. Thus it should only be used on real
+filenames.
+
+=cut
+
+sub canonpath($) {
+    my $path = shift;
+    $path = File::Spec->canonpath($path);
+    my ($v, $dirs, $file) = File::Spec->splitpath($path);
+    my @dirs = File::Spec->splitdir($dirs);
+    my @new;
+    foreach my $d (@dirs) {
+	if ($d eq '..') {
+	    if (scalar(@new) > 0 and $new[-1] ne '..') {
+		next if $new[-1] eq ''; # Root directory has no parent
+		my $parent = File::Spec->catpath($v,
+			File::Spec->catdir(@new), '');
+		if (not -l $parent) {
+		    pop @new;
+		} else {
+		    push @new, $d;
+		}
+	    } else {
+		push @new, $d;
+	    }
+	} else {
+	    push @new, $d;
+	}
+    }
+    return File::Spec->catpath($v, File::Spec->catdir(@new), $file);
+}
+
+=item $newpath = resolve_symlink($symlink)
+
+Return the filename of the file pointed by the symlink. The new name is
+canonicalized by canonpath().
+
+=cut
+
+sub resolve_symlink($) {
+    my $symlink = shift;
+    my $content = readlink($symlink);
+    return unless defined $content;
+    if (File::Spec->file_name_is_absolute($content)) {
+	return canonpath($content);
+    } else {
+	my ($link_v, $link_d, $link_f) = File::Spec->splitpath($symlink);
+	my ($cont_v, $cont_d, $cont_f) = File::Spec->splitpath($content);
+	my $new = File::Spec->catpath($link_v, $link_d . '/' . $cont_d, $cont_f);
+	return canonpath($new);
+    }
+}
+
+=item check_directory_traversal($basedir, $dir)
+
+This function verifies that the directory $dir does not contain any symlink
+that goes beyond $basedir (which should be either equal or a parent of $dir).
+
+=cut
+
+sub check_directory_traversal {
+    my ($basedir, $dir) = @_;
+
+    my $canon_basedir = realpath($basedir);
+    # On Solaris /dev/null points to /devices/pseudo/mm@0:null.
+    my $canon_devnull = realpath('/dev/null');
+    my $check_symlinks = sub {
+        my $canon_pathname = realpath($_);
+        if (not defined $canon_pathname) {
+            return if $! == ENOENT;
+
+            syserr(g_("pathname '%s' cannot be canonicalized"), $_);
+        }
+        return if $canon_pathname eq $canon_devnull;
+        return if $canon_pathname eq $canon_basedir;
+        return if $canon_pathname =~ m{^\Q$canon_basedir/\E};
+
+        error(g_("pathname '%s' points outside source root (to '%s')"),
+              $_, $canon_pathname);
+    };
+
+    find({
+        wanted => $check_symlinks,
+        no_chdir => 1,
+        follow => 1,
+        follow_skip => 2,
+    }, $dir);
+
+    return;
+}
+
+=item $cmdpath = find_command($command)
+
+Return the path of the command if defined and available on an absolute or
+relative path or on the $PATH, undef otherwise.
+
+=cut
+
+sub find_command($) {
+    my $cmd = shift;
+
+    return if not $cmd;
+    if ($cmd =~ m{/}) {
+	return "$cmd" if -x "$cmd";
+    } else {
+	foreach my $dir (split(/:/, $ENV{PATH})) {
+	    return "$dir/$cmd" if -x "$dir/$cmd";
+	}
+    }
+    return;
+}
+
+=item $control_file = get_control_path($pkg, $filetype)
+
+Return the path of the control file of type $filetype for the given
+package.
+
+=item @control_files = get_control_path($pkg)
+
+Return the path of all available control files for the given package.
+
+=cut
+
+sub get_control_path($;$) {
+    my ($pkg, $filetype) = @_;
+    my $control_file;
+    my @exec = ('dpkg-query', '--control-path', $pkg);
+    push @exec, $filetype if defined $filetype;
+    spawn(exec => \@exec, wait_child => 1, to_string => \$control_file);
+    chomp($control_file);
+    if (defined $filetype) {
+	return if $control_file eq '';
+	return $control_file;
+    }
+    return () if $control_file eq '';
+    return split(/\n/, $control_file);
+}
+
+=item $file = find_build_file($basename)
+
+Selects the right variant of the given file: the arch-specific variant
+("$basename.$arch") has priority over the OS-specific variant
+("$basename.$os") which has priority over the default variant
+("$basename"). If none of the files exists, then it returns undef.
+
+=item @files = find_build_file($basename)
+
+Return the available variants of the given file. Returns an empty
+list if none of the files exists.
+
+=cut
+
+sub find_build_file($) {
+    my $base = shift;
+    my $host_arch = get_host_arch();
+    my ($abi, $libc, $host_os, $cpu) = debarch_to_debtuple($host_arch);
+    my @files;
+    foreach my $f ("$base.$host_arch", "$base.$host_os", "$base") {
+        push @files, $f if -f $f;
+    }
+    return @files if wantarray;
+    return $files[0] if scalar @files;
+    return;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.05 (dpkg 1.20.4)
+
+New function: check_directory_traversal().
+
+=head2 Version 1.04 (dpkg 1.17.11)
+
+Update semantics: find_command() now handles an empty or undef argument.
+
+=head2 Version 1.03 (dpkg 1.16.1)
+
+New function: find_build_file()
+
+=head2 Version 1.02 (dpkg 1.16.0)
+
+New function: get_control_path()
+
+=head2 Version 1.01 (dpkg 1.15.8)
+
+New function: find_command()
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Shlibs.pm b/scripts/Dpkg/Shlibs.pm
new file mode 100644
index 0000000..22fecc4
--- /dev/null
+++ b/scripts/Dpkg/Shlibs.pm
@@ -0,0 +1,184 @@
+# Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2007-2008, 2012-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/>.
+
+package Dpkg::Shlibs;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '0.03';
+our @EXPORT_OK = qw(
+    blank_library_paths
+    setup_library_paths
+    get_library_paths
+    add_library_dir
+    find_library
+);
+
+use Exporter qw(import);
+use List::Util qw(none);
+use File::Spec;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Shlibs::Objdump;
+use Dpkg::Path qw(resolve_symlink canonpath);
+use Dpkg::Arch qw(get_build_arch get_host_arch :mappers);
+
+use constant DEFAULT_LIBRARY_PATH =>
+    qw(/lib /usr/lib);
+# XXX: Deprecated multilib paths.
+use constant DEFAULT_MULTILIB_PATH =>
+    qw(/lib32 /usr/lib32 /lib64 /usr/lib64);
+
+# Library paths set by the user.
+my @custom_librarypaths;
+# Library paths from the system.
+my @system_librarypaths;
+my $librarypaths_init;
+
+sub parse_ldso_conf {
+    my $file = shift;
+    state %visited;
+    local $_;
+
+    open my $fh, '<', $file or syserr(g_('cannot open %s'), $file);
+    $visited{$file}++;
+    while (<$fh>) {
+	next if /^\s*$/;
+	chomp;
+	s{/+$}{};
+	if (/^include\s+(\S.*\S)\s*$/) {
+	    foreach my $include (glob($1)) {
+		parse_ldso_conf($include) if -e $include
+		    && !$visited{$include};
+	    }
+	} elsif (m{^\s*/}) {
+	    s/^\s+//;
+	    my $libdir = $_;
+	    if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) {
+		push @system_librarypaths, $libdir;
+	    }
+	}
+    }
+    close $fh;
+}
+
+sub blank_library_paths {
+    @custom_librarypaths = ();
+    @system_librarypaths = ();
+    $librarypaths_init = 1;
+}
+
+sub setup_library_paths {
+    @custom_librarypaths = ();
+    @system_librarypaths = ();
+
+    # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH.
+    if ($ENV{LD_LIBRARY_PATH}) {
+        require Cwd;
+        my $cwd = Cwd::getcwd;
+
+        foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) {
+            $path =~ s{/+$}{};
+
+            my $realpath = Cwd::realpath($path);
+            next unless defined $realpath;
+            if ($realpath =~ m/^\Q$cwd\E/) {
+                warning(g_('deprecated use of LD_LIBRARY_PATH with private ' .
+                           'library directory which interferes with ' .
+                           'cross-building, please use -l option instead'));
+            }
+
+            # XXX: This should be added to @custom_librarypaths, but as this
+            # is deprecated we do not care as the code will go away.
+            push @system_librarypaths, $path;
+        }
+    }
+
+    # Adjust set of directories to consider when we're in a situation of a
+    # cross-build or a build of a cross-compiler.
+    my $multiarch;
+
+    # Detect cross compiler builds.
+    if ($ENV{DEB_TARGET_GNU_TYPE} and
+        ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
+    {
+        $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE});
+    }
+    # Host for normal cross builds.
+    if (get_build_arch() ne get_host_arch()) {
+        $multiarch = debarch_to_multiarch(get_host_arch());
+    }
+    # Define list of directories containing crossbuilt libraries.
+    if ($multiarch) {
+        push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch";
+    }
+
+    push @system_librarypaths, DEFAULT_LIBRARY_PATH;
+
+    # Update library paths with ld.so config.
+    parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf';
+
+    push @system_librarypaths, DEFAULT_MULTILIB_PATH;
+
+    $librarypaths_init = 1;
+}
+
+sub add_library_dir {
+    my $dir = shift;
+
+    setup_library_paths() if not $librarypaths_init;
+
+    push @custom_librarypaths, $dir;
+}
+
+sub get_library_paths {
+    setup_library_paths() if not $librarypaths_init;
+
+    return (@custom_librarypaths, @system_librarypaths);
+}
+
+# find_library ($soname, \@rpath, $format, $root)
+sub find_library {
+    my ($lib, $rpath, $format, $root) = @_;
+
+    setup_library_paths() if not $librarypaths_init;
+
+    my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths);
+    my @libs;
+
+    $root //= '';
+    $root =~ s{/+$}{};
+    foreach my $dir (@librarypaths) {
+	my $checkdir = "$root$dir";
+	if (-e "$checkdir/$lib") {
+	    my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
+            if (not defined $libformat) {
+                warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib");
+            } elsif ($format eq $libformat) {
+		push @libs, canonpath("$checkdir/$lib");
+	    } else {
+		debug(1, "Skipping lib $checkdir/$lib, libabi=0x%s != objabi=0x%s",
+		      unpack('H*', $libformat), unpack('H*', $format));
+	    }
+	}
+    }
+    return @libs;
+}
+
+1;
diff --git a/scripts/Dpkg/Shlibs/Cppfilt.pm b/scripts/Dpkg/Shlibs/Cppfilt.pm
new file mode 100644
index 0000000..c2a4756
--- /dev/null
+++ b/scripts/Dpkg/Shlibs/Cppfilt.pm
@@ -0,0 +1,120 @@
+# Copyright © 2009-2010 Modestas Vainius <modax@debian.org>
+# Copyright © 2010, 2012-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/>.
+
+package Dpkg::Shlibs::Cppfilt;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT = qw(
+    cppfilt_demangle_cpp
+);
+our @EXPORT_OK = qw(
+    cppfilt_demangle
+);
+
+use Exporter qw(import);
+
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+
+# A hash of 'objects' referring to preforked c++filt processes for the distinct
+# demangling types.
+my %cppfilts;
+
+sub get_cppfilt {
+    my $type = shift || 'auto';
+
+    # Fork c++filt process for demangling $type unless it is forked already.
+    # Keeping c++filt running improves performance a lot.
+    my $filt;
+    if (exists $cppfilts{$type}) {
+	$filt = $cppfilts{$type};
+    } else {
+        $filt = {
+            from => undef,
+            to => undef,
+            last_symbol => '',
+            last_result => '',
+        };
+	$filt->{pid} = spawn(exec => [ 'c++filt', "--format=$type" ],
+	                     from_pipe => \$filt->{from},
+	                     to_pipe => \$filt->{to});
+	syserr(g_('unable to execute %s'), 'c++filt')
+	    unless defined $filt->{from};
+	$filt->{from}->autoflush(1);
+
+	$cppfilts{$type} = $filt;
+    }
+    return $filt;
+}
+
+# Demangle the given $symbol using demangler for the specified $type (defaults
+# to 'auto') . Extraneous characters trailing after a mangled name are kept
+# intact. If neither whole $symbol nor portion of it could be demangled, undef
+# is returned.
+sub cppfilt_demangle {
+    my ($symbol, $type) = @_;
+
+    # Start or get c++filt 'object' for the requested type.
+    my $filt = get_cppfilt($type);
+
+    # Remember the last result. Such a local optimization is cheap and useful
+    # when sequential pattern matching is performed.
+    if ($filt->{last_symbol} ne $symbol) {
+	# This write/read operation should not deadlock because c++filt flushes
+	# output buffer on LF or each invalid character.
+	print { $filt->{from} } $symbol, "\n";
+	my $demangled = readline($filt->{to});
+	chop $demangled;
+
+	# If the symbol was not demangled, return undef
+	$demangled = undef if $symbol eq $demangled;
+
+	# Remember the last result
+	$filt->{last_symbol} = $symbol;
+	$filt->{last_result} = $demangled;
+    }
+    return $filt->{last_result};
+}
+
+sub cppfilt_demangle_cpp {
+    my $symbol = shift;
+    return cppfilt_demangle($symbol, 'auto');
+}
+
+sub terminate_cppfilts {
+    foreach my $type (keys %cppfilts) {
+	next if not defined $cppfilts{$type}{pid};
+	close $cppfilts{$type}{from};
+	close $cppfilts{$type}{to};
+	wait_child($cppfilts{$type}{pid}, cmdline => 'c++filt',
+	                                  nocheck => 1,
+	                                  timeout => 5);
+	delete $cppfilts{$type};
+    }
+}
+
+# Close/terminate running c++filt process(es)
+END {
+    # Make sure exitcode is not changed (by wait_child)
+    my $exitcode = $?;
+    terminate_cppfilts();
+    $? = $exitcode;
+}
+
+1;
diff --git a/scripts/Dpkg/Shlibs/Objdump.pm b/scripts/Dpkg/Shlibs/Objdump.pm
new file mode 100644
index 0000000..c9af965
--- /dev/null
+++ b/scripts/Dpkg/Shlibs/Objdump.pm
@@ -0,0 +1,582 @@
+# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2007-2009,2012-2015,2017-2018 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/>.
+
+package Dpkg::Shlibs::Objdump;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '0.01';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = { objects => {} };
+    bless $self, $class;
+    return $self;
+}
+
+sub add_object {
+    my ($self, $obj) = @_;
+    my $id = $obj->get_id;
+    if ($id) {
+	$self->{objects}{$id} = $obj;
+    }
+    return $id;
+}
+
+sub analyze {
+    my ($self, $file) = @_;
+    my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
+
+    return $self->add_object($obj);
+}
+
+sub locate_symbol {
+    my ($self, $name) = @_;
+    foreach my $obj (values %{$self->{objects}}) {
+	my $sym = $obj->get_symbol($name);
+	if (defined($sym) && $sym->{defined}) {
+	    return $sym;
+	}
+    }
+    return;
+}
+
+sub get_object {
+    my ($self, $objid) = @_;
+    if ($self->has_object($objid)) {
+	return $self->{objects}{$objid};
+    }
+    return;
+}
+
+sub has_object {
+    my ($self, $objid) = @_;
+    return exists $self->{objects}{$objid};
+}
+
+use constant {
+    # ELF Class.
+    ELF_BITS_NONE           => 0,
+    ELF_BITS_32             => 1,
+    ELF_BITS_64             => 2,
+
+    # ELF Data encoding.
+    ELF_ORDER_NONE          => 0,
+    ELF_ORDER_2LSB          => 1,
+    ELF_ORDER_2MSB          => 2,
+
+    # ELF Machine.
+    EM_SPARC                => 2,
+    EM_MIPS                 => 8,
+    EM_SPARC64_OLD          => 11,
+    EM_SPARC32PLUS          => 18,
+    EM_PPC64                => 21,
+    EM_S390                 => 22,
+    EM_ARM                  => 40,
+    EM_ALPHA_OLD            => 41,
+    EM_SH                   => 42,
+    EM_SPARC64              => 43,
+    EM_IA64                 => 50,
+    EM_AVR                  => 83,
+    EM_M32R                 => 88,
+    EM_MN10300              => 89,
+    EM_MN10200              => 90,
+    EM_OR1K                 => 92,
+    EM_XTENSA               => 94,
+    EM_MICROBLAZE           => 189,
+    EM_ARCV2                => 195,
+    EM_LOONGARCH            => 258,
+    EM_AVR_OLD              => 0x1057,
+    EM_OR1K_OLD             => 0x8472,
+    EM_ALPHA                => 0x9026,
+    EM_M32R_CYGNUS          => 0x9041,
+    EM_S390_OLD             => 0xa390,
+    EM_XTENSA_OLD           => 0xabc7,
+    EM_MICROBLAZE_OLD       => 0xbaab,
+    EM_MN10300_CYGNUS       => 0xbeef,
+    EM_MN10200_CYGNUS       => 0xdead,
+
+    # ELF Version.
+    EV_NONE                 => 0,
+    EV_CURRENT              => 1,
+
+    # ELF Flags (might influence the ABI).
+    EF_ARM_ALIGN8           => 0x00000040,
+    EF_ARM_NEW_ABI          => 0x00000080,
+    EF_ARM_OLD_ABI          => 0x00000100,
+    EF_ARM_SOFT_FLOAT       => 0x00000200,
+    EF_ARM_HARD_FLOAT       => 0x00000400,
+    EF_ARM_EABI_MASK        => 0xff000000,
+
+    EF_IA64_ABI64           => 0x00000010,
+
+    EF_LOONGARCH_SOFT_FLOAT     => 0x00000001,
+    EF_LOONGARCH_SINGLE_FLOAT   => 0x00000002,
+    EF_LOONGARCH_DOUBLE_FLOAT   => 0x00000003,
+    EF_LOONGARCH_ABI_MASK       => 0x00000007,
+
+    EF_MIPS_ABI2            => 0x00000020,
+    EF_MIPS_32BIT           => 0x00000100,
+    EF_MIPS_FP64            => 0x00000200,
+    EF_MIPS_NAN2008         => 0x00000400,
+    EF_MIPS_ABI_MASK        => 0x0000f000,
+    EF_MIPS_ARCH_MASK       => 0xf0000000,
+
+    EF_PPC64_ABI64          => 0x00000003,
+
+    EF_SH_MACH_MASK         => 0x0000001f,
+};
+
+# These map alternative or old machine IDs to their canonical form.
+my %elf_mach_map = (
+    EM_ALPHA_OLD()          => EM_ALPHA,
+    EM_AVR_OLD()            => EM_AVR,
+    EM_M32R_CYGNUS()        => EM_M32R,
+    EM_MICROBLAZE_OLD()     => EM_MICROBLAZE,
+    EM_MN10200_CYGNUS()     => EM_MN10200,
+    EM_MN10300_CYGNUS()     => EM_MN10300,
+    EM_OR1K_OLD()           => EM_OR1K,
+    EM_S390_OLD()           => EM_S390,
+    EM_SPARC32PLUS()        => EM_SPARC,
+    EM_SPARC64_OLD()        => EM_SPARC64,
+    EM_XTENSA_OLD()         => EM_XTENSA,
+);
+
+# These masks will try to expose processor flags that are ABI incompatible,
+# and as such are part of defining the architecture ABI. If uncertain it is
+# always better to not mask a flag, because that preserves the historical
+# behavior, and we do not drop dependencies.
+my %elf_flags_mask = (
+    EM_IA64()               => EF_IA64_ABI64,
+    EM_LOONGARCH()          => EF_LOONGARCH_ABI_MASK,
+    EM_MIPS()               => EF_MIPS_ABI_MASK | EF_MIPS_ABI2,
+    EM_PPC64()              => EF_PPC64_ABI64,
+);
+
+sub get_format {
+    my ($file) = @_;
+    state %format;
+
+    return $format{$file} if exists $format{$file};
+
+    my $header;
+
+    open my $fh, '<', $file or syserr(g_('cannot read %s'), $file);
+    my $rc = read $fh, $header, 64;
+    if (not defined $rc) {
+        syserr(g_('cannot read %s'), $file);
+    } elsif ($rc != 64) {
+        return;
+    }
+    close $fh;
+
+    my %elf;
+
+    # Unpack the identifier field.
+    @elf{qw(magic bits endian vertype osabi verabi)} = unpack 'a4C5', $header;
+
+    return unless $elf{magic} eq "\x7fELF";
+    return unless $elf{vertype} == EV_CURRENT;
+
+    my ($elf_word, $elf_endian);
+    if ($elf{bits} == ELF_BITS_32) {
+        $elf_word = 'L';
+    } elsif ($elf{bits} == ELF_BITS_64) {
+        $elf_word = 'Q';
+    } else {
+        return;
+    }
+    if ($elf{endian} == ELF_ORDER_2LSB) {
+        $elf_endian = '<';
+    } elsif ($elf{endian} == ELF_ORDER_2MSB) {
+        $elf_endian = '>';
+    } else {
+        return;
+    }
+
+    # Unpack the endianness and size dependent fields.
+    my $tmpl = "x16(S2Lx[${elf_word}3]L)${elf_endian}";
+    @elf{qw(type mach version flags)} = unpack $tmpl, $header;
+
+    # Canonicalize the machine ID.
+    $elf{mach} = $elf_mach_map{$elf{mach}} // $elf{mach};
+
+    # Mask any processor flags that might not change the architecture ABI.
+    $elf{flags} &= $elf_flags_mask{$elf{mach}} // 0;
+
+    # Repack for easy comparison, as a big-endian byte stream, so that
+    # unpacking for output gives meaningful results.
+    $format{$file} = pack 'C2(SL)>', @elf{qw(bits endian mach flags)};
+
+    return $format{$file};
+}
+
+sub is_elf {
+    my $file = shift;
+    open(my $file_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
+    my ($header, $result) = ('', 0);
+    if (read($file_fh, $header, 4) == 4) {
+	$result = 1 if ($header =~ /^\177ELF$/);
+    }
+    close($file_fh);
+    return $result;
+}
+
+package Dpkg::Shlibs::Objdump::Object;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Path qw(find_command);
+use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch);
+
+sub new {
+    my $this = shift;
+    my $file = shift // '';
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+
+    $self->reset;
+    if ($file) {
+	$self->analyze($file);
+    }
+
+    return $self;
+}
+
+sub reset {
+    my $self = shift;
+
+    $self->{file} = '';
+    $self->{id} = '';
+    $self->{HASH} = '';
+    $self->{GNU_HASH} = '';
+    $self->{INTERP} = 0;
+    $self->{SONAME} = '';
+    $self->{NEEDED} = [];
+    $self->{RPATH} = [];
+    $self->{dynsyms} = {};
+    $self->{flags} = {};
+    $self->{dynrelocs} = {};
+
+    return $self;
+}
+
+sub _select_objdump {
+    # Decide which objdump to call
+    if (get_build_arch() ne get_host_arch()) {
+        my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump';
+        return $od if find_command($od);
+    }
+    return 'objdump';
+}
+
+sub analyze {
+    my ($self, $file) = @_;
+
+    $file ||= $self->{file};
+    return unless $file;
+
+    $self->reset;
+    $self->{file} = $file;
+
+    $self->{exec_abi} = Dpkg::Shlibs::Objdump::get_format($file);
+
+    if (not defined $self->{exec_abi}) {
+        warning(g_("unknown executable format in file '%s'"), $file);
+        return;
+    }
+
+    state $OBJDUMP = _select_objdump();
+    local $ENV{LC_ALL} = 'C';
+    open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file)
+        or syserr(g_('cannot fork for %s'), $OBJDUMP);
+    my $ret = $self->parse_objdump_output($objdump);
+    close($objdump);
+    return $ret;
+}
+
+sub parse_objdump_output {
+    my ($self, $fh) = @_;
+
+    my $section = 'none';
+    while (<$fh>) {
+	s/\s*$//;
+	next if length == 0;
+
+	if (/^DYNAMIC SYMBOL TABLE:/) {
+	    $section = 'dynsym';
+	    next;
+	} elsif (/^DYNAMIC RELOCATION RECORDS/) {
+	    $section = 'dynreloc';
+	    $_ = <$fh>; # Skip header
+	    next;
+	} elsif (/^Dynamic Section:/) {
+	    $section = 'dyninfo';
+	    next;
+	} elsif (/^Program Header:/) {
+	    $section = 'program';
+	    next;
+	} elsif (/^Version definitions:/) {
+	    $section = 'verdef';
+	    next;
+	} elsif (/^Version References:/) {
+	    $section = 'verref';
+	    next;
+	}
+
+	if ($section eq 'dynsym') {
+	    $self->parse_dynamic_symbol($_);
+	} elsif ($section eq 'dynreloc') {
+	    if (/^\S+\s+(\S+)\s+(.+)$/) {
+		$self->{dynrelocs}{$2} = $1;
+	    } else {
+		warning(g_("couldn't parse dynamic relocation record: %s"), $_);
+	    }
+	} elsif ($section eq 'dyninfo') {
+	    if (/^\s*NEEDED\s+(\S+)/) {
+		push @{$self->{NEEDED}}, $1;
+	    } elsif (/^\s*SONAME\s+(\S+)/) {
+		$self->{SONAME} = $1;
+	    } elsif (/^\s*HASH\s+(\S+)/) {
+		$self->{HASH} = $1;
+	    } elsif (/^\s*GNU_HASH\s+(\S+)/) {
+		$self->{GNU_HASH} = $1;
+	    } elsif (/^\s*RUNPATH\s+(\S+)/) {
+                # RUNPATH takes precedence over RPATH but is
+                # considered after LD_LIBRARY_PATH while RPATH
+                # is considered before (if RUNPATH is not set).
+                my $runpath = $1;
+                $self->{RPATH} = [ split /:/, $runpath ];
+	    } elsif (/^\s*RPATH\s+(\S+)/) {
+                my $rpath = $1;
+                unless (scalar(@{$self->{RPATH}})) {
+                    $self->{RPATH} = [ split /:/, $rpath ];
+                }
+	    }
+        } elsif ($section eq 'program') {
+            if (/^\s*INTERP\s+/) {
+                $self->{INTERP} = 1;
+            }
+	} elsif ($section eq 'none') {
+	    if (/^\s*.+:\s*file\s+format\s+(\S+)$/) {
+		$self->{format} = $1;
+	    } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:$/) {
+		# Parse 2 lines of "-f"
+		# architecture: i386, flags 0x00000112:
+		# EXEC_P, HAS_SYMS, D_PAGED
+		# start address 0x08049b50
+		$_ = <$fh>;
+		chomp;
+		$self->{flags}{$_} = 1 foreach (split(/,\s*/));
+	    }
+	}
+    }
+    # Update status of dynamic symbols given the relocations that have
+    # been parsed after the symbols...
+    $self->apply_relocations();
+
+    return $section ne 'none';
+}
+
+# Output format of objdump -w -T
+#
+# /lib/libc.so.6:     file format elf32-i386
+#
+# DYNAMIC SYMBOL TABLE:
+# 00056ef0 g    DF .text  000000db  GLIBC_2.2   getwchar
+# 00000000 g    DO *ABS*  00000000  GCC_3.0     GCC_3.0
+# 00069960  w   DF .text  0000001e  GLIBC_2.0   bcmp
+# 00000000  w   D  *UND*  00000000              _pthread_cleanup_pop_restore
+# 0000b788 g    DF .text  0000008e  Base        .protected xine_close
+# 0000b788 g    DF .text  0000008e              .hidden IA__g_free
+# |        ||||||| |      |         |           |
+# |        ||||||| |      |         Version str (.visibility) + Symbol name
+# |        ||||||| |      Alignment
+# |        ||||||| Section name (or *UND* for an undefined symbol)
+# |        ||||||F=Function,f=file,O=object
+# |        |||||d=debugging,D=dynamic
+# |        ||||I=Indirect
+# |        |||W=warning
+# |        ||C=constructor
+# |        |w=weak
+# |        g=global,l=local,!=both global/local
+# Size of the symbol
+#
+# GLIBC_2.2 is the version string associated to the symbol
+# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the
+# symbol exist
+
+my $vis_re = qr/(\.protected|\.hidden|\.internal|0x\S+)/;
+my $dynsym_re = qr<
+    ^
+    [0-9a-f]+                   # Symbol size
+    \ (.{7})                    # Flags
+    \s+(\S+)                    # Section name
+    \s+[0-9a-f]+                # Alignment
+    (?:\s+(\S+))?               # Version string
+    (?:\s+$vis_re)?             # Visibility
+    \s+(.+)                     # Symbol name
+>x;
+
+sub parse_dynamic_symbol {
+    my ($self, $line) = @_;
+    if ($line =~ $dynsym_re) {
+	my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5);
+
+	# Special case if version is missing but extra visibility
+	# attribute replaces it in the match
+	if (defined($ver) and $ver =~ /^$vis_re$/) {
+	    $vis = $ver;
+	    $ver = '';
+	}
+
+	# Cleanup visibility field
+	$vis =~ s/^\.// if defined($vis);
+
+	my $symbol = {
+		name => $name,
+		version => $ver // '',
+		section => $sect,
+		dynamic => substr($flags, 5, 1) eq 'D',
+		debug => substr($flags, 5, 1) eq 'd',
+		type => substr($flags, 6, 1),
+		weak => substr($flags, 1, 1) eq 'w',
+		local => substr($flags, 0, 1) eq 'l',
+		global => substr($flags, 0, 1) eq 'g',
+		visibility => $vis // '',
+		hidden => '',
+		defined => $sect ne '*UND*'
+	    };
+
+	# Handle hidden symbols
+	if (defined($ver) and $ver =~ /^\((.*)\)$/) {
+	    $ver = $1;
+	    $symbol->{version} = $1;
+	    $symbol->{hidden} = 1;
+	}
+
+	# Register symbol
+	$self->add_dynamic_symbol($symbol);
+    } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) {
+	# Same start but no version and no symbol ... just ignore
+    } elsif ($line =~ /^REG_G\d+\s+/) {
+	# Ignore some s390-specific output like
+	# REG_G6           g     R *UND*      0000000000000000              #scratch
+    } else {
+	warning(g_("couldn't parse dynamic symbol definition: %s"), $line);
+    }
+}
+
+sub apply_relocations {
+    my $self = shift;
+    foreach my $sym (values %{$self->{dynsyms}}) {
+	# We want to mark as undefined symbols those which are currently
+	# defined but that depend on a copy relocation
+	next if not $sym->{defined};
+
+        my @relocs;
+
+        # When objdump qualifies the symbol with a version it will use @ when
+        # the symbol is in an undefined section (which we discarded above, or
+        # @@ otherwise.
+        push @relocs, $sym->{name} . '@@' . $sym->{version} if $sym->{version};
+
+        # Symbols that are not versioned, or versioned but shown with objdump
+        # from binutils < 2.26, do not have a version appended.
+        push @relocs, $sym->{name};
+
+        foreach my $reloc (@relocs) {
+            next if not exists $self->{dynrelocs}{$reloc};
+            next if not $self->{dynrelocs}{$reloc} =~ /^R_.*_COPY$/;
+
+	    $sym->{defined} = 0;
+            last;
+	}
+    }
+}
+
+sub add_dynamic_symbol {
+    my ($self, $symbol) = @_;
+    $symbol->{objid} = $symbol->{soname} = $self->get_id();
+    $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME};
+    if ($symbol->{version}) {
+	$self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
+    } else {
+	$self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol;
+    }
+}
+
+sub get_id {
+    my $self = shift;
+    return $self->{SONAME} || $self->{file};
+}
+
+sub get_symbol {
+    my ($self, $name) = @_;
+    if (exists $self->{dynsyms}{$name}) {
+	return $self->{dynsyms}{$name};
+    }
+    if ($name !~ /@/) {
+        if (exists $self->{dynsyms}{$name . '@Base'}) {
+            return $self->{dynsyms}{$name . '@Base'};
+        }
+    }
+    return;
+}
+
+sub get_exported_dynamic_symbols {
+    my $self = shift;
+    return grep {
+        $_->{defined} && $_->{dynamic} && !$_->{local}
+    } values %{$self->{dynsyms}};
+}
+
+sub get_undefined_dynamic_symbols {
+    my $self = shift;
+    return grep {
+        (!$_->{defined}) && $_->{dynamic}
+    } values %{$self->{dynsyms}};
+}
+
+sub get_needed_libraries {
+    my $self = shift;
+    return @{$self->{NEEDED}};
+}
+
+sub is_executable {
+    my $self = shift;
+    return (exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P}) ||
+           (exists $self->{INTERP} && $self->{INTERP});
+}
+
+sub is_public_library {
+    my $self = shift;
+    return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC}
+	&& exists $self->{SONAME} && $self->{SONAME};
+}
+
+1;
diff --git a/scripts/Dpkg/Shlibs/Symbol.pm b/scripts/Dpkg/Shlibs/Symbol.pm
new file mode 100644
index 0000000..e6460ce
--- /dev/null
+++ b/scripts/Dpkg/Shlibs/Symbol.pm
@@ -0,0 +1,531 @@
+# Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2009-2010 Modestas Vainius <modax@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/>.
+
+package Dpkg::Shlibs::Symbol;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Storable ();
+use List::Util qw(any);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Arch qw(debarch_is_concerned debarch_to_abiattrs);
+use Dpkg::Version;
+use Dpkg::Shlibs::Cppfilt;
+
+# Supported alias types in the order of matching preference
+use constant ALIAS_TYPES => qw(
+    c++
+    symver
+);
+
+# Needed by the deprecated key, which is a correct use.
+no if $Dpkg::Version::VERSION ge '1.02',
+    warnings => qw(Dpkg::Version::semantic_change::overload::bool);
+
+sub new {
+    my ($this, %args) = @_;
+    my $class = ref($this) || $this;
+    my $self = bless {
+	symbol => undef,
+	symbol_templ => undef,
+	minver => undef,
+	dep_id => 0,
+	deprecated => 0,
+	tags => {},
+	tagorder => [],
+    }, $class;
+    $self->{$_} = $args{$_} foreach keys %args;
+    return $self;
+}
+
+# Deep clone
+sub clone {
+    my ($self, %args) = @_;
+    my $clone = Storable::dclone($self);
+    $clone->{$_} = $args{$_} foreach keys %args;
+    return $clone;
+}
+
+sub parse_tagspec {
+    my ($self, $tagspec) = @_;
+
+    if ($tagspec =~ /^\s*\((.*?)\)(.*)$/ && $1) {
+	# (tag1=t1 value|tag2|...|tagN=tNp)
+	# Symbols ()|= cannot appear in the tag names and values
+	my $tagspec = $1;
+	my $rest = ($2) ? $2 : '';
+	my @tags = split(/\|/, $tagspec);
+
+	# Parse each tag
+	for my $tag (@tags) {
+	    if ($tag =~ /^(.*)=(.*)$/) {
+		# Tag with value
+		$self->add_tag($1, $2);
+	    } else {
+		# Tag without value
+		$self->add_tag($tag, undef);
+	    }
+	}
+	return $rest;
+    }
+    return;
+}
+
+sub parse_symbolspec {
+    my ($self, $symbolspec, %opts) = @_;
+    my $symbol;
+    my $symbol_templ;
+    my $symbol_quoted;
+    my $rest;
+
+    if (defined($symbol = $self->parse_tagspec($symbolspec))) {
+	# (tag1=t1 value|tag2|...|tagN=tNp)"Foo::Bar::foobar()"@Base 1.0 1
+	# Symbols ()|= cannot appear in the tag names and values
+
+	# If the tag specification exists symbol name template might be quoted too
+	if ($symbol =~ /^(['"])/ && $symbol =~ /^($1)(.*?)$1(.*)$/) {
+	    $symbol_quoted = $1;
+	    $symbol_templ = $2;
+	    $symbol = $2;
+	    $rest = $3;
+	} else {
+	    if ($symbol =~ m/^(\S+)(.*)$/) {
+		$symbol_templ = $1;
+		$symbol = $1;
+		$rest = $2;
+	    }
+	}
+	error(g_('symbol name unspecified: %s'), $symbolspec) if (!$symbol);
+    } else {
+	# No tag specification. Symbol name is up to the first space
+	# foobarsymbol@Base 1.0 1
+	if ($symbolspec =~ m/^(\S+)(.*)$/) {
+	    $symbol = $1;
+	    $rest = $2;
+	} else {
+	    return 0;
+	}
+    }
+    $self->{symbol} = $symbol;
+    $self->{symbol_templ} = $symbol_templ;
+    $self->{symbol_quoted} = $symbol_quoted if ($symbol_quoted);
+
+    # Now parse "the rest" (minver and dep_id)
+    if ($rest =~ /^\s(\S+)(?:\s(\d+))?/) {
+	$self->{minver} = $1;
+	$self->{dep_id} = $2 // 0;
+    } elsif (defined $opts{default_minver}) {
+	$self->{minver} = $opts{default_minver};
+	$self->{dep_id} = 0;
+    } else {
+	return 0;
+    }
+    return 1;
+}
+
+# A hook for symbol initialization (typically processing of tags). The code
+# here may even change symbol name. Called from
+# Dpkg::Shlibs::SymbolFile::create_symbol().
+sub initialize {
+    my $self = shift;
+
+    # Look for tags marking symbol patterns. The pattern may match multiple
+    # real symbols.
+    my $type;
+    if ($self->has_tag('c++')) {
+	# Raw symbol name is always demangled to the same alias while demangled
+	# symbol name cannot be reliably converted back to raw symbol name.
+	# Therefore, we can use hash for mapping.
+	$type = 'alias-c++';
+    }
+
+    # Support old style wildcard syntax. That's basically a symver
+    # with an optional tag.
+    if ($self->get_symbolname() =~ /^\*@(.*)$/) {
+	$self->add_tag('symver') unless $self->has_tag('symver');
+	$self->add_tag('optional') unless $self->has_tag('optional');
+	$self->{symbol} = $1;
+    }
+
+    if ($self->has_tag('symver')) {
+	# Each symbol is matched against its version rather than full
+	# name@version string.
+	$type = (defined $type) ? 'generic' : 'alias-symver';
+        if ($self->get_symbolname() =~ /@/) {
+            warning(g_('symver tag with versioned symbol will not match: %s'),
+                    $self->get_symbolspec(1));
+        }
+	if ($self->get_symbolname() eq 'Base') {
+	    error(g_("you can't use symver tag to catch unversioned symbols: %s"),
+	          $self->get_symbolspec(1));
+	}
+    }
+
+    # As soon as regex is involved, we need to match each real
+    # symbol against each pattern (aka 'generic' pattern).
+    if ($self->has_tag('regex')) {
+	$type = 'generic';
+	# Pre-compile regular expression for better performance.
+	my $regex = $self->get_symbolname();
+	$self->{pattern}{regex} = qr/$regex/;
+    }
+    if (defined $type) {
+	$self->init_pattern($type);
+    }
+}
+
+sub get_symbolname {
+    my $self = shift;
+
+    return $self->{symbol};
+}
+
+sub get_symboltempl {
+    my $self = shift;
+
+    return $self->{symbol_templ} || $self->{symbol};
+}
+
+sub set_symbolname {
+    my ($self, $name, $templ, $quoted) = @_;
+
+    $name //= $self->{symbol};
+    if (!defined $templ && $name =~ /\s/) {
+	$templ = $name;
+    }
+    if (!defined $quoted && defined $templ && $templ =~ /\s/) {
+	$quoted = '"';
+    }
+    $self->{symbol} = $name;
+    $self->{symbol_templ} = $templ;
+    if ($quoted) {
+	$self->{symbol_quoted} = $quoted;
+    } else {
+	delete $self->{symbol_quoted};
+    }
+}
+
+sub has_tags {
+    my $self = shift;
+    return scalar (@{$self->{tagorder}});
+}
+
+sub add_tag {
+    my ($self, $tagname, $tagval) = @_;
+    if (exists $self->{tags}{$tagname}) {
+	$self->{tags}{$tagname} = $tagval;
+	return 0;
+    } else {
+	$self->{tags}{$tagname} = $tagval;
+	push @{$self->{tagorder}}, $tagname;
+    }
+    return 1;
+}
+
+sub delete_tag {
+    my ($self, $tagname) = @_;
+    if (exists $self->{tags}{$tagname}) {
+	delete $self->{tags}{$tagname};
+        $self->{tagorder} = [ grep { $_ ne $tagname } @{$self->{tagorder}} ];
+	return 1;
+    }
+    return 0;
+}
+
+sub has_tag {
+    my ($self, $tag) = @_;
+    return exists $self->{tags}{$tag};
+}
+
+sub get_tag_value {
+    my ($self, $tag) = @_;
+    return $self->{tags}{$tag};
+}
+
+# Checks if the symbol is equal to another one (by name and optionally,
+# tag sets, versioning info (minver and depid))
+sub equals {
+    my ($self, $other, %opts) = @_;
+    $opts{versioning} //= 1;
+    $opts{tags} //= 1;
+
+    return 0 if $self->{symbol} ne $other->{symbol};
+
+    if ($opts{versioning}) {
+	return 0 if $self->{minver} ne $other->{minver};
+	return 0 if $self->{dep_id} ne $other->{dep_id};
+    }
+
+    if ($opts{tags}) {
+	return 0 if scalar(@{$self->{tagorder}}) != scalar(@{$other->{tagorder}});
+
+	for my $i (0 .. scalar(@{$self->{tagorder}}) - 1) {
+	    my $tag = $self->{tagorder}->[$i];
+	    return 0 if $tag ne $other->{tagorder}->[$i];
+	    if (defined $self->{tags}{$tag} && defined $other->{tags}{$tag}) {
+		return 0 if $self->{tags}{$tag} ne $other->{tags}{$tag};
+	    } elsif (defined $self->{tags}{$tag} || defined $other->{tags}{$tag}) {
+		return 0;
+	    }
+	}
+    }
+
+    return 1;
+}
+
+
+sub is_optional {
+    my $self = shift;
+    return $self->has_tag('optional');
+}
+
+sub is_arch_specific {
+    my $self = shift;
+    return $self->has_tag('arch');
+}
+
+sub arch_is_concerned {
+    my ($self, $arch) = @_;
+    my $arches = $self->{tags}{arch};
+
+    return 0 if defined $arch && defined $arches &&
+                !debarch_is_concerned($arch, split /[\s,]+/, $arches);
+
+    my ($bits, $endian) = debarch_to_abiattrs($arch);
+    return 0 if defined $bits && defined $self->{tags}{'arch-bits'} &&
+                $bits ne $self->{tags}{'arch-bits'};
+    return 0 if defined $endian && defined $self->{tags}{'arch-endian'} &&
+                $endian ne $self->{tags}{'arch-endian'};
+
+    return 1;
+}
+
+# Get reference to the pattern the symbol matches (if any)
+sub get_pattern {
+    my $self = shift;
+
+    return $self->{matching_pattern};
+}
+
+### NOTE: subroutines below require (or initialize) $self to be a pattern ###
+
+# Initializes this symbol as a pattern of the specified type.
+sub init_pattern {
+    my ($self, $type) = @_;
+
+    $self->{pattern}{type} = $type;
+    # To be filled with references to symbols matching this pattern.
+    $self->{pattern}{matches} = [];
+}
+
+# Is this symbol a pattern or not?
+sub is_pattern {
+    my $self = shift;
+
+    return exists $self->{pattern};
+}
+
+# Get pattern type if this symbol is a pattern.
+sub get_pattern_type {
+    my $self = shift;
+
+    return $self->{pattern}{type} // '';
+}
+
+# Get (sub)type of the alias pattern. Returns empty string if current
+# pattern is not alias.
+sub get_alias_type {
+    my $self = shift;
+
+    return ($self->get_pattern_type() =~ /^alias-(.+)/ && $1) || '';
+}
+
+# Get a list of symbols matching this pattern if this symbol is a pattern
+sub get_pattern_matches {
+    my $self = shift;
+
+    return @{$self->{pattern}{matches}};
+}
+
+# Create a new symbol based on the pattern (i.e. $self)
+# and add it to the pattern matches list.
+sub create_pattern_match {
+    my $self = shift;
+    return unless $self->is_pattern();
+
+    # Leave out 'pattern' subfield while deep-cloning
+    my $pattern_stuff = $self->{pattern};
+    delete $self->{pattern};
+    my $newsym = $self->clone(@_);
+    $self->{pattern} = $pattern_stuff;
+
+    # Clean up symbol name related internal fields
+    $newsym->set_symbolname();
+
+    # Set newsym pattern reference, add to pattern matches list
+    $newsym->{matching_pattern} = $self;
+    push @{$self->{pattern}{matches}}, $newsym;
+    return $newsym;
+}
+
+### END of pattern subroutines ###
+
+# Given a raw symbol name the call returns its alias according to the rules of
+# the current pattern ($self). Returns undef if the supplied raw name is not
+# transformable to alias.
+sub convert_to_alias {
+    my ($self, $rawname, $type) = @_;
+    $type = $self->get_alias_type() unless $type;
+
+    if ($type) {
+	if ($type eq 'symver') {
+	    # In case of symver, alias is symbol version. Extract it from the
+	    # rawname.
+	    return "$1" if ($rawname =~ /\@([^@]+)$/);
+	} elsif ($rawname =~ /^_Z/ && $type eq 'c++') {
+	    return cppfilt_demangle_cpp($rawname);
+	}
+    }
+    return;
+}
+
+sub get_tagspec {
+    my $self = shift;
+    if ($self->has_tags()) {
+	my @tags;
+	for my $tagname (@{$self->{tagorder}}) {
+	    my $tagval = $self->{tags}{$tagname};
+	    if (defined $tagval) {
+		push @tags, $tagname . '='  . $tagval;
+	    } else {
+		push @tags, $tagname;
+	    }
+	}
+	return '(' . join('|', @tags) . ')';
+    }
+    return '';
+}
+
+sub get_symbolspec {
+    my $self = shift;
+    my $template_mode = shift;
+    my $spec = '';
+    $spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated};
+    $spec .= ' ';
+    if ($template_mode) {
+	if ($self->has_tags()) {
+	    $spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(),
+		$self->get_symboltempl(), $self->{symbol_quoted} // '');
+	} else {
+	    $spec .= $self->get_symboltempl();
+	}
+    } else {
+	$spec .= $self->get_symbolname();
+    }
+    $spec .= " $self->{minver}";
+    $spec .= " $self->{dep_id}" if $self->{dep_id};
+    return $spec;
+}
+
+# Sanitize the symbol when it is confirmed to be found in
+# the respective library.
+sub mark_found_in_library {
+    my ($self, $minver, $arch) = @_;
+
+    if ($self->{deprecated}) {
+	# Symbol reappeared somehow
+	$self->{deprecated} = 0;
+	$self->{minver} = $minver if (not $self->is_optional());
+    } else {
+	# We assume that the right dependency information is already
+	# there.
+	if (version_compare($minver, $self->{minver}) < 0) {
+	    $self->{minver} = $minver;
+	}
+    }
+    # Never remove arch tags from patterns
+    if (not $self->is_pattern()) {
+	if (not $self->arch_is_concerned($arch)) {
+	    # Remove arch tags because they are incorrect.
+	    $self->delete_tag('arch');
+	    $self->delete_tag('arch-bits');
+	    $self->delete_tag('arch-endian');
+	}
+    }
+}
+
+# Sanitize the symbol when it is confirmed to be NOT found in
+# the respective library.
+# Mark as deprecated those that are no more provided (only if the
+# minver is later than the version where the symbol was introduced)
+sub mark_not_found_in_library {
+    my ($self, $minver, $arch) = @_;
+
+    # Ignore symbols from foreign arch
+    return if not $self->arch_is_concerned($arch);
+
+    if ($self->{deprecated}) {
+	# Bump deprecated if the symbol is optional so that it
+	# keeps reappearing in the diff while it's missing
+	$self->{deprecated} = $minver if $self->is_optional();
+    } elsif (version_compare($minver, $self->{minver}) > 0) {
+	$self->{deprecated} = $minver;
+    }
+}
+
+# Checks if the symbol (or pattern) is legitimate as a real symbol for the
+# specified architecture.
+sub is_legitimate {
+    my ($self, $arch) = @_;
+    return ! $self->{deprecated} &&
+           $self->arch_is_concerned($arch);
+}
+
+# Determine whether a supplied raw symbol name matches against current ($self)
+# symbol or pattern.
+sub matches_rawname {
+    my ($self, $rawname) = @_;
+    my $target = $rawname;
+    my $ok = 1;
+    my $do_eq_match = 1;
+
+    if ($self->is_pattern()) {
+	# Process pattern tags in the order they were specified.
+	for my $tag (@{$self->{tagorder}}) {
+	    if (any { $tag eq $_ } ALIAS_TYPES) {
+		$ok = not not ($target = $self->convert_to_alias($target, $tag));
+	    } elsif ($tag eq 'regex') {
+		# Symbol name is a regex. Match it against the target
+		$do_eq_match = 0;
+		$ok = ($target =~ $self->{pattern}{regex});
+	    }
+	    last if not $ok;
+	}
+    }
+
+    # Equality match by default
+    if ($ok && $do_eq_match) {
+	$ok = $target eq $self->get_symbolname();
+    }
+    return $ok;
+}
+
+1;
diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm b/scripts/Dpkg/Shlibs/SymbolFile.pm
new file mode 100644
index 0000000..d492055
--- /dev/null
+++ b/scripts/Dpkg/Shlibs/SymbolFile.pm
@@ -0,0 +1,697 @@
+# Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2009-2010 Modestas Vainius <modax@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/>.
+
+package Dpkg::Shlibs::SymbolFile;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Version;
+use Dpkg::Control::Fields;
+use Dpkg::Shlibs::Symbol;
+use Dpkg::Arch qw(get_host_arch);
+
+use parent qw(Dpkg::Interface::Storable);
+
+# Needed by the deprecated key, which is a correct use.
+no if $Dpkg::Version::VERSION ge '1.02',
+    warnings => qw(Dpkg::Version::semantic_change::overload::bool);
+
+my %internal_symbol = (
+    __bss_end__ => 1,                   # arm
+    __bss_end => 1,                     # arm
+    _bss_end__ => 1,                    # arm
+    __bss_start => 1,                   # ALL
+    __bss_start__ => 1,                 # arm
+    __data_start => 1,                  # arm
+    __do_global_ctors_aux => 1,         # ia64
+    __do_global_dtors_aux => 1,         # ia64
+    __do_jv_register_classes => 1,      # ia64
+    _DYNAMIC => 1,                      # ALL
+    _edata => 1,                        # ALL
+    _end => 1,                          # ALL
+    __end__ => 1,                       # arm
+    __exidx_end => 1,                   # armel
+    __exidx_start => 1,                 # armel
+    _fbss => 1,                         # mips, mipsel
+    _fdata => 1,                        # mips, mipsel
+    _fini => 1,                         # ALL
+    _ftext => 1,                        # mips, mipsel
+    _GLOBAL_OFFSET_TABLE_ => 1,         # hppa, mips, mipsel
+    __gmon_start__ => 1,                # hppa
+    __gnu_local_gp => 1,                # mips, mipsel
+    _gp => 1,                           # mips, mipsel
+    _init => 1,                         # ALL
+    _PROCEDURE_LINKAGE_TABLE_ => 1,     # sparc, alpha
+    _SDA2_BASE_ => 1,                   # powerpc
+    _SDA_BASE_ => 1,                    # powerpc
+);
+
+for my $i (14 .. 31) {
+    # Many powerpc specific symbols
+    $internal_symbol{"_restfpr_$i"} = 1;
+    $internal_symbol{"_restfpr_$i\_x"} = 1;
+    $internal_symbol{"_restgpr_$i"} = 1;
+    $internal_symbol{"_restgpr_$i\_x"} = 1;
+    $internal_symbol{"_savefpr_$i"} = 1;
+    $internal_symbol{"_savegpr_$i"} = 1;
+}
+
+sub symbol_is_internal {
+    my ($symbol, $include_groups) = @_;
+
+    return 1 if exists $internal_symbol{$symbol};
+
+    # The ARM Embedded ABI spec states symbols under this namespace as
+    # possibly appearing in output objects.
+    return 1 if not ${$include_groups}{aeabi} and $symbol =~ /^__aeabi_/;
+
+    # The GNU implementation of the OpenMP spec, specifies symbols under
+    # this namespace as possibly appearing in output objects.
+    return 1 if not ${$include_groups}{gomp}
+                and $symbol =~ /^\.gomp_critical_user_/;
+
+    return 0;
+}
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = \%opts;
+    bless $self, $class;
+    $self->{arch} //= get_host_arch();
+    $self->clear();
+    if (exists $self->{file}) {
+	$self->load($self->{file}) if -e $self->{file};
+    }
+    return $self;
+}
+
+sub get_arch {
+    my $self = shift;
+    return $self->{arch};
+}
+
+sub clear {
+    my $self = shift;
+    $self->{objects} = {};
+}
+
+sub clear_except {
+    my ($self, @ids) = @_;
+
+    my %has = map { $_ => 1 } @ids;
+    foreach my $objid (keys %{$self->{objects}}) {
+	delete $self->{objects}{$objid} unless exists $has{$objid};
+    }
+}
+
+sub get_sonames {
+    my $self = shift;
+    return keys %{$self->{objects}};
+}
+
+sub get_symbols {
+    my ($self, $soname) = @_;
+    if (defined $soname) {
+	my $obj = $self->get_object($soname);
+	return (defined $obj) ? values %{$obj->{syms}} : ();
+    } else {
+	my @syms;
+	foreach my $soname ($self->get_sonames()) {
+	    push @syms, $self->get_symbols($soname);
+	}
+	return @syms;
+    }
+}
+
+sub get_patterns {
+    my ($self, $soname) = @_;
+    my @patterns;
+    if (defined $soname) {
+	my $obj = $self->get_object($soname);
+	foreach my $alias (values %{$obj->{patterns}{aliases}}) {
+	    push @patterns, values %$alias;
+	}
+	return (@patterns, @{$obj->{patterns}{generic}});
+    } else {
+	foreach my $soname ($self->get_sonames()) {
+	    push @patterns, $self->get_patterns($soname);
+	}
+	return @patterns;
+    }
+}
+
+# Create a symbol from the supplied string specification.
+sub create_symbol {
+    my ($self, $spec, %opts) = @_;
+    my $symbol = (exists $opts{base}) ? $opts{base} :
+	Dpkg::Shlibs::Symbol->new();
+
+    my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) :
+	$symbol->parse_symbolspec($spec);
+    if ($ret) {
+	$symbol->initialize(arch => $self->get_arch());
+	return $symbol;
+    }
+    return;
+}
+
+sub add_symbol {
+    my ($self, $symbol, $soname) = @_;
+    my $object = $self->get_object($soname);
+
+    if ($symbol->is_pattern()) {
+	if (my $alias_type = $symbol->get_alias_type()) {
+	    $object->{patterns}{aliases}{$alias_type} //= {};
+	    # Alias hash for matching.
+	    my $aliases = $object->{patterns}{aliases}{$alias_type};
+	    $aliases->{$symbol->get_symbolname()} = $symbol;
+	} else {
+	    # Otherwise assume this is a generic sequential pattern. This
+	    # should be always safe.
+	    push @{$object->{patterns}{generic}}, $symbol;
+	}
+	return 'pattern';
+    } else {
+	# invalidate the minimum version cache
+        $object->{minver_cache} = [];
+	$object->{syms}{$symbol->get_symbolname()} = $symbol;
+	return 'sym';
+    }
+}
+
+sub _new_symbol {
+    my $base = shift || 'Dpkg::Shlibs::Symbol';
+    return (ref $base) ? $base->clone(@_) : $base->new(@_);
+}
+
+# Option state is only used for recursive calls.
+sub parse {
+    my ($self, $fh, $file, %opts) = @_;
+    my $state = $opts{state} //= {};
+
+    if (exists $state->{seen}) {
+	return if exists $state->{seen}{$file}; # Avoid include loops
+    } else {
+	$self->{file} = $file;
+        $state->{seen} = {};
+    }
+    $state->{seen}{$file} = 1;
+
+    if (not ref $state->{obj_ref}) { # Init ref to name of current object/lib
+        ${$state->{obj_ref}} = undef;
+    }
+
+    while (<$fh>) {
+	chomp;
+
+	if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) {
+	    if (not defined ${$state->{obj_ref}}) {
+		error(g_('symbol information must be preceded by a header (file %s, line %s)'), $file, $.);
+	    }
+	    # Symbol specification
+	    my $deprecated = ($1) ? Dpkg::Version->new($1) : 0;
+	    my $sym = _new_symbol($state->{base_symbol}, deprecated => $deprecated);
+	    if ($self->create_symbol($2, base => $sym)) {
+		$self->add_symbol($sym, ${$state->{obj_ref}});
+	    } else {
+		warning(g_('failed to parse line in %s: %s'), $file, $_);
+	    }
+	} elsif (/^(\(.*\))?#include\s+"([^"]+)"/) {
+	    my $tagspec = $1;
+	    my $filename = $2;
+	    my $dir = $file;
+	    my $old_base_symbol = $state->{base_symbol};
+	    my $new_base_symbol;
+	    if (defined $tagspec) {
+		$new_base_symbol = _new_symbol($old_base_symbol);
+		$new_base_symbol->parse_tagspec($tagspec);
+	    }
+	    $state->{base_symbol} = $new_base_symbol;
+	    $dir =~ s{[^/]+$}{}; # Strip filename
+	    $self->load("$dir$filename", %opts);
+	    $state->{base_symbol} = $old_base_symbol;
+	} elsif (/^#|^$/) {
+	    # Skip possible comments and empty lines
+	} elsif (/^\|\s*(.*)$/) {
+	    # Alternative dependency template
+	    push @{$self->{objects}{${$state->{obj_ref}}}{deps}}, "$1";
+	} elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) {
+	    # Add meta-fields
+	    $self->{objects}{${$state->{obj_ref}}}{fields}{field_capitalize($1)} = $2;
+	} elsif (/^(\S+)\s+(.*)$/) {
+	    # New object and dependency template
+	    ${$state->{obj_ref}} = $1;
+	    if (exists $self->{objects}{${$state->{obj_ref}}}) {
+		# Update/override infos only
+		$self->{objects}{${$state->{obj_ref}}}{deps} = [ "$2" ];
+	    } else {
+		# Create a new object
+		$self->create_object(${$state->{obj_ref}}, "$2");
+	    }
+	} else {
+	    warning(g_('failed to parse a line in %s: %s'), $file, $_);
+	}
+    }
+    delete $state->{seen}{$file};
+}
+
+# Beware: we reuse the data structure of the provided symfile so make
+# sure to not modify them after having called this function
+sub merge_object_from_symfile {
+    my ($self, $src, $objid) = @_;
+    if (not $self->has_object($objid)) {
+        $self->{objects}{$objid} = $src->get_object($objid);
+    } else {
+        warning(g_('tried to merge the same object (%s) twice in a symfile'), $objid);
+    }
+}
+
+sub output {
+    my ($self, $fh, %opts) = @_;
+    $opts{template_mode} //= 0;
+    $opts{with_deprecated} //= 1;
+    $opts{with_pattern_matches} //= 0;
+    my $res = '';
+    foreach my $soname (sort $self->get_sonames()) {
+	my @deps = $self->get_dependencies($soname);
+	my $dep_first = shift @deps;
+	if (exists $opts{package} and not $opts{template_mode}) {
+	    $dep_first =~ s/#PACKAGE#/$opts{package}/g;
+	}
+	print { $fh } "$soname $dep_first\n" if defined $fh;
+	$res .= "$soname $dep_first\n" if defined wantarray;
+
+	foreach my $dep_next (@deps) {
+	    if (exists $opts{package} and not $opts{template_mode}) {
+	        $dep_next =~ s/#PACKAGE#/$opts{package}/g;
+	    }
+	    print { $fh } "| $dep_next\n" if defined $fh;
+	    $res .= "| $dep_next\n" if defined wantarray;
+	}
+	my $f = $self->{objects}{$soname}{fields};
+	foreach my $field (sort keys %{$f}) {
+	    my $value = $f->{$field};
+	    if (exists $opts{package} and not $opts{template_mode}) {
+	        $value =~ s/#PACKAGE#/$opts{package}/g;
+	    }
+	    print { $fh } "* $field: $value\n" if defined $fh;
+	    $res .= "* $field: $value\n" if defined wantarray;
+	}
+
+	my @symbols;
+	if ($opts{template_mode}) {
+	    # Exclude symbols matching a pattern, but include patterns themselves
+	    @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname);
+	    push @symbols, $self->get_patterns($soname);
+	} else {
+	    @symbols = $self->get_symbols($soname);
+	}
+	foreach my $sym (sort { $a->get_symboltempl() cmp
+	                        $b->get_symboltempl() } @symbols) {
+	    next if $sym->{deprecated} and not $opts{with_deprecated};
+	    # Do not dump symbols from foreign arch unless dumping a template.
+	    next if not $opts{template_mode} and
+	            not $sym->arch_is_concerned($self->get_arch());
+	    # Dump symbol specification. Dump symbol tags only in template mode.
+	    print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh;
+	    $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray;
+	    # Dump pattern matches as comments (if requested)
+	    if ($opts{with_pattern_matches} && $sym->is_pattern()) {
+		for my $match (sort { $a->get_symboltempl() cmp
+		                      $b->get_symboltempl() } $sym->get_pattern_matches())
+		{
+		    print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh;
+		    $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray;
+		}
+	    }
+	}
+    }
+    return $res;
+}
+
+# Tries to match a symbol name and/or version against the patterns defined.
+# Returns a pattern which matches (if any).
+sub find_matching_pattern {
+    my ($self, $refsym, $sonames, $inc_deprecated) = @_;
+    $inc_deprecated //= 0;
+    my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym;
+
+    my $pattern_ok = sub {
+	my $p = shift;
+	return defined $p && ($inc_deprecated || !$p->{deprecated}) &&
+	       $p->arch_is_concerned($self->get_arch());
+    };
+
+    foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
+	my $obj = $self->get_object($soname);
+	my ($type, $pattern);
+	next unless defined $obj;
+
+	my $all_aliases = $obj->{patterns}{aliases};
+	for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) {
+	    if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}})) {
+		my $aliases = $all_aliases->{$type};
+		my $converter = $aliases->{(keys %$aliases)[0]};
+		if (my $alias = $converter->convert_to_alias($name)) {
+		    if ($alias && exists $aliases->{$alias}) {
+			$pattern = $aliases->{$alias};
+			last if $pattern_ok->($pattern);
+			$pattern = undef; # otherwise not found yet
+		    }
+		}
+	    }
+	}
+
+	# Now try generic patterns and use the first that matches
+	if (not defined $pattern) {
+	    for my $p (@{$obj->{patterns}{generic}}) {
+		if ($pattern_ok->($p) && $p->matches_rawname($name)) {
+		    $pattern = $p;
+		    last;
+		}
+	    }
+	}
+	if (defined $pattern) {
+	    return (wantarray) ?
+		( symbol => $pattern, soname => $soname ) : $pattern;
+	}
+    }
+    return;
+}
+
+# merge_symbols($object, $minver)
+# Needs $Objdump->get_object($soname) as parameter
+# Do not merge symbols found in the list of (arch-specific) internal symbols.
+sub merge_symbols {
+    my ($self, $object, $minver) = @_;
+
+    my $soname = $object->{SONAME};
+    error(g_('cannot merge symbols from objects without SONAME'))
+        unless $soname;
+
+    my %include_groups = ();
+    my $groups = $self->get_field($soname, 'Allow-Internal-Symbol-Groups');
+    if (not defined $groups) {
+        $groups = $self->get_field($soname, 'Ignore-Blacklist-Groups');
+        if (defined $groups) {
+            warnings::warnif('deprecated',
+                'symbols file field "Ignore-Blacklist-Groups" is deprecated, ' .
+                'use "Allow-Internal-Symbol-Groups" instead');
+        }
+    }
+    if (defined $groups) {
+        $include_groups{$_} = 1 foreach (split ' ', $groups);
+    }
+
+    my %dynsyms;
+    foreach my $sym ($object->get_exported_dynamic_symbols()) {
+        my $name = $sym->{name} . '@' .
+                   ($sym->{version} ? $sym->{version} : 'Base');
+        my $symobj = $self->lookup_symbol($name, $soname);
+        if (symbol_is_internal($sym->{name}, \%include_groups)) {
+            next unless defined $symobj;
+
+            if ($symobj->has_tag('allow-internal')) {
+                # Allow the symbol.
+            } elsif ($symobj->has_tag('ignore-blacklist')) {
+                # Allow the symbol and warn.
+                warnings::warnif('deprecated',
+                    'symbol tag "ignore-blacklist" is deprecated, ' .
+                    'use "allow-internal" instead');
+            } else {
+                # Ignore the symbol.
+                next;
+            }
+        }
+        $dynsyms{$name} = $sym;
+    }
+
+    unless ($self->has_object($soname)) {
+	$self->create_object($soname, '');
+    }
+    # Scan all symbols provided by the objects
+    my $obj = $self->get_object($soname);
+    # invalidate the minimum version cache - it is not sufficient to
+    # invalidate in add_symbol, since we might change a minimum
+    # version for a particular symbol without adding it
+    $obj->{minver_cache} = [];
+    foreach my $name (keys %dynsyms) {
+        my $sym;
+	if ($sym = $self->lookup_symbol($name, $obj, 1)) {
+	    # If the symbol is already listed in the file
+	    $sym->mark_found_in_library($minver, $self->get_arch());
+	} else {
+	    # The exact symbol is not present in the file, but it might match a
+	    # pattern.
+	    my $pattern = $self->find_matching_pattern($name, $obj, 1);
+	    if (defined $pattern) {
+		$pattern->mark_found_in_library($minver, $self->get_arch());
+		$sym = $pattern->create_pattern_match(symbol => $name);
+	    } else {
+		# Symbol without any special info as no pattern matched
+		$sym = Dpkg::Shlibs::Symbol->new(symbol => $name,
+		                                 minver => $minver);
+	    }
+	    $self->add_symbol($sym, $obj);
+	}
+    }
+
+    # Process all symbols which could not be found in the library.
+    foreach my $sym ($self->get_symbols($soname)) {
+	if (not exists $dynsyms{$sym->get_symbolname()}) {
+	    $sym->mark_not_found_in_library($minver, $self->get_arch());
+	}
+    }
+
+    # Deprecate patterns which didn't match anything
+    for my $pattern (grep { $_->get_pattern_matches() == 0 }
+                          $self->get_patterns($soname)) {
+	$pattern->mark_not_found_in_library($minver, $self->get_arch());
+    }
+}
+
+sub is_empty {
+    my $self = shift;
+    return scalar(keys %{$self->{objects}}) ? 0 : 1;
+}
+
+sub has_object {
+    my ($self, $soname) = @_;
+    return exists $self->{objects}{$soname};
+}
+
+sub get_object {
+    my ($self, $soname) = @_;
+    return ref($soname) ? $soname : $self->{objects}{$soname};
+}
+
+sub create_object {
+    my ($self, $soname, @deps) = @_;
+    $self->{objects}{$soname} = {
+	syms => {},
+	fields => {},
+	patterns => {
+	    aliases => {},
+	    generic => [],
+	},
+	deps => [ @deps ],
+        minver_cache => []
+    };
+}
+
+sub get_dependency {
+    my ($self, $soname, $dep_id) = @_;
+    $dep_id //= 0;
+    return $self->get_object($soname)->{deps}[$dep_id];
+}
+
+sub get_smallest_version {
+    my ($self, $soname, $dep_id) = @_;
+    $dep_id //= 0;
+    my $so_object = $self->get_object($soname);
+    return $so_object->{minver_cache}[$dep_id]
+        if defined $so_object->{minver_cache}[$dep_id];
+    my $minver;
+    foreach my $sym ($self->get_symbols($so_object)) {
+        next if $dep_id != $sym->{dep_id};
+        $minver //= $sym->{minver};
+        if (version_compare($minver, $sym->{minver}) > 0) {
+            $minver = $sym->{minver};
+        }
+    }
+    $so_object->{minver_cache}[$dep_id] = $minver;
+    return $minver;
+}
+
+sub get_dependencies {
+    my ($self, $soname) = @_;
+    return @{$self->get_object($soname)->{deps}};
+}
+
+sub get_field {
+    my ($self, $soname, $name) = @_;
+    if (my $obj = $self->get_object($soname)) {
+	if (exists $obj->{fields}{$name}) {
+	    return $obj->{fields}{$name};
+	}
+    }
+    return;
+}
+
+# Tries to find a symbol like the $refsym and returns its descriptor.
+# $refsym may also be a symbol name.
+sub lookup_symbol {
+    my ($self, $refsym, $sonames, $inc_deprecated) = @_;
+    $inc_deprecated //= 0;
+    my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym;
+
+    foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
+	if (my $obj = $self->get_object($so)) {
+	    my $sym = $obj->{syms}{$name};
+	    if ($sym and ($inc_deprecated or not $sym->{deprecated}))
+	    {
+		return (wantarray) ?
+		    ( symbol => $sym, soname => $so ) : $sym;
+	    }
+	}
+    }
+    return;
+}
+
+# Tries to find a pattern like the $refpat and returns its descriptor.
+# $refpat may also be a pattern spec.
+sub lookup_pattern {
+    my ($self, $refpat, $sonames, $inc_deprecated) = @_;
+    $inc_deprecated //= 0;
+    # If $refsym is a string, we need to create a dummy ref symbol.
+    $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat);
+
+    if ($refpat && $refpat->is_pattern()) {
+	foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
+	    if (my $obj = $self->get_object($soname)) {
+		my $pat;
+		if (my $type = $refpat->get_alias_type()) {
+		    if (exists $obj->{patterns}{aliases}{$type}) {
+			$pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()};
+		    }
+		} elsif ($refpat->get_pattern_type() eq 'generic') {
+		    for my $p (@{$obj->{patterns}{generic}}) {
+			if (($inc_deprecated || !$p->{deprecated}) &&
+			    $p->equals($refpat, versioning => 0))
+			{
+			    $pat = $p;
+			    last;
+			}
+		    }
+		}
+		if ($pat && ($inc_deprecated || !$pat->{deprecated})) {
+		    return (wantarray) ?
+			(symbol => $pat, soname => $soname) : $pat;
+		}
+	    }
+	}
+    }
+    return;
+}
+
+# Get symbol object reference either by symbol name or by a reference object.
+sub get_symbol_object {
+    my ($self, $refsym, $soname) = @_;
+    my $sym = $self->lookup_symbol($refsym, $soname, 1);
+    if (! defined $sym) {
+	$sym = $self->lookup_pattern($refsym, $soname, 1);
+    }
+    return $sym;
+}
+
+sub get_new_symbols {
+    my ($self, $ref, %opts) = @_;
+    my $with_optional = (exists $opts{with_optional}) ?
+	$opts{with_optional} : 0;
+    my @res;
+    foreach my $soname ($self->get_sonames()) {
+	next if not $ref->has_object($soname);
+
+	# Scan raw symbols first.
+	foreach my $sym (grep { ($with_optional || ! $_->is_optional())
+	                        && $_->is_legitimate($self->get_arch()) }
+	                      $self->get_symbols($soname))
+	{
+	    my $refsym = $ref->lookup_symbol($sym, $soname, 1);
+	    my $isnew;
+	    if (defined $refsym) {
+		# If the symbol exists in the $ref symbol file, it might
+		# still be new if $refsym is not legitimate.
+		$isnew = not $refsym->is_legitimate($self->get_arch());
+	    } else {
+		# If the symbol does not exist in the $ref symbol file, it does
+		# not mean that it's new. It might still match a pattern in the
+		# symbol file. However, due to performance reasons, first check
+		# if the pattern that the symbol matches (if any) exists in the
+		# ref symbol file as well.
+		$isnew = not (
+		    ($sym->get_pattern() and $ref->lookup_pattern($sym->get_pattern(), $soname, 1)) or
+		    $ref->find_matching_pattern($sym, $soname, 1)
+		);
+	    }
+	    push @res, { symbol => $sym, soname => $soname } if $isnew;
+	}
+
+	# Now scan patterns
+	foreach my $p (grep { ($with_optional || ! $_->is_optional())
+	                      && $_->is_legitimate($self->get_arch()) }
+	                    $self->get_patterns($soname))
+	{
+	    my $refpat = $ref->lookup_pattern($p, $soname, 0);
+	    # If reference pattern was not found or it is not legitimate,
+	    # considering current one as new.
+	    if (not defined $refpat or
+	        not $refpat->is_legitimate($self->get_arch()))
+	    {
+		push @res, { symbol => $p , soname => $soname };
+	    }
+	}
+    }
+    return @res;
+}
+
+sub get_lost_symbols {
+    my ($self, $ref, %opts) = @_;
+    return $ref->get_new_symbols($self, %opts);
+}
+
+
+sub get_new_libs {
+    my ($self, $ref) = @_;
+    my @res;
+    foreach my $soname ($self->get_sonames()) {
+	push @res, $soname if not $ref->get_object($soname);
+    }
+    return @res;
+}
+
+sub get_lost_libs {
+    my ($self, $ref) = @_;
+    return $ref->get_new_libs($self);
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm
new file mode 100644
index 0000000..88e6700
--- /dev/null
+++ b/scripts/Dpkg/Source/Archive.pm
@@ -0,0 +1,240 @@
+# Copyright © 2008 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Source::Archive;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Carp;
+use Errno qw(ENOENT);
+use File::Temp qw(tempdir);
+use File::Basename qw(basename);
+use File::Spec;
+use File::Find;
+use Cwd;
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::Source::Functions qw(erasedir fixperms);
+
+use parent qw(Dpkg::Compression::FileHandle);
+
+sub create {
+    my ($self, %opts) = @_;
+    $opts{options} //= [];
+    my %spawn_opts;
+    # Possibly run tar from another directory
+    if ($opts{chdir}) {
+        $spawn_opts{chdir} = $opts{chdir};
+        *$self->{chdir} = $opts{chdir};
+    }
+    # Redirect input/output appropriately
+    $self->ensure_open('w');
+    $spawn_opts{to_handle} = $self->get_filehandle();
+    $spawn_opts{from_pipe} = \*$self->{tar_input};
+    # Try to use a deterministic mtime.
+    my $mtime = $opts{source_date} // $ENV{SOURCE_DATE_EPOCH} || time;
+    # Call tar creation process
+    $spawn_opts{delete_env} = [ 'TAR_OPTIONS' ];
+    $spawn_opts{exec} = [
+        $Dpkg::PROGTAR, '-cf', '-', '--format=gnu', '--sort=name',
+                        '--mtime', "\@$mtime", '--clamp-mtime', '--null',
+                        '--numeric-owner', '--owner=0', '--group=0',
+                        @{$opts{options}}, '-T', '-',
+    ];
+    *$self->{pid} = spawn(%spawn_opts);
+    *$self->{cwd} = getcwd();
+}
+
+sub _add_entry {
+    my ($self, $file) = @_;
+    my $cwd = *$self->{cwd};
+    croak 'call create() first' unless *$self->{tar_input};
+    $file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names
+    print({ *$self->{tar_input} } "$file\0")
+        or syserr(g_('write on tar input'));
+}
+
+sub add_file {
+    my ($self, $file) = @_;
+    my $testfile = $file;
+    if (*$self->{chdir}) {
+        $testfile = File::Spec->catfile(*$self->{chdir}, $file);
+    }
+    croak 'add_file() does not handle directories'
+        if not -l $testfile and -d _;
+    $self->_add_entry($file);
+}
+
+sub add_directory {
+    my ($self, $file) = @_;
+    my $testfile = $file;
+    if (*$self->{chdir}) {
+        $testfile = File::Spec->catdir(*$self->{chdir}, $file);
+    }
+    croak 'add_directory() only handles directories'
+        if -l $testfile or not -d _;
+    $self->_add_entry($file);
+}
+
+sub finish {
+    my $self = shift;
+
+    close(*$self->{tar_input}) or syserr(g_('close on tar input'));
+    wait_child(*$self->{pid}, cmdline => 'tar -cf -');
+    delete *$self->{pid};
+    delete *$self->{tar_input};
+    delete *$self->{cwd};
+    delete *$self->{chdir};
+    $self->close();
+}
+
+sub extract {
+    my ($self, $dest, %opts) = @_;
+    $opts{options} //= [];
+    $opts{in_place} //= 0;
+    $opts{no_fixperms} //= 0;
+    my %spawn_opts = (wait_child => 1);
+
+    # Prepare destination
+    my $template = basename($self->get_filename()) .  '.tmp-extract.XXXXX';
+    unless (-e $dest) {
+        # Kludge so that realpath works
+        mkdir($dest) or syserr(g_('cannot create directory %s'), $dest);
+    }
+    my $tmp = tempdir($template, DIR => Cwd::realpath("$dest/.."), CLEANUP => 1);
+    $spawn_opts{chdir} = $tmp;
+
+    # Prepare stuff that handles the input of tar
+    $self->ensure_open('r', delete_sig => [ 'PIPE' ]);
+    $spawn_opts{from_handle} = $self->get_filehandle();
+
+    # Call tar extraction process
+    $spawn_opts{delete_env} = [ 'TAR_OPTIONS' ];
+    $spawn_opts{exec} = [
+        $Dpkg::PROGTAR, '-xf', '-', '--no-same-permissions',
+                        '--no-same-owner', @{$opts{options}},
+    ];
+    spawn(%spawn_opts);
+    $self->close();
+
+    # Fix permissions on extracted files because tar insists on applying
+    # our umask _to the original permissions_ rather than mostly-ignoring
+    # the original permissions.
+    # We still need --no-same-permissions because otherwise tar might
+    # extract directory setgid (which we want inherited, not
+    # extracted); we need --no-same-owner because putting the owner
+    # back is tedious - in particular, correct group ownership would
+    # have to be calculated using mount options and other madness.
+    fixperms($tmp) unless $opts{no_fixperms};
+
+    # If we are extracting "in-place" do not remove the destination directory.
+    if ($opts{in_place}) {
+        my $canon_basedir = Cwd::realpath($dest);
+        # On Solaris /dev/null points to /devices/pseudo/mm@0:null.
+        my $canon_devnull = Cwd::realpath('/dev/null');
+        my $check_symlink = sub {
+            my $pathname = shift;
+            my $canon_pathname = Cwd::realpath($pathname);
+            if (not defined $canon_pathname) {
+                return if $! == ENOENT;
+
+                syserr(g_("pathname '%s' cannot be canonicalized"), $pathname);
+            }
+            return if $canon_pathname eq $canon_devnull;
+            return if $canon_pathname eq $canon_basedir;
+            return if $canon_pathname =~ m{^\Q$canon_basedir/\E};
+            warning(g_("pathname '%s' points outside source root (to '%s')"),
+                    $pathname, $canon_pathname);
+        };
+
+        my $move_in_place = sub {
+            my $relpath = File::Spec->abs2rel($File::Find::name, $tmp);
+            my $destpath = File::Spec->catfile($dest, $relpath);
+
+            my ($mode, $atime, $mtime);
+            lstat $File::Find::name
+                or syserr(g_('cannot get source pathname %s metadata'), $File::Find::name);
+            ((undef) x 2, $mode, (undef) x 5, $atime, $mtime) = lstat _;
+            my $src_is_dir = -d _;
+
+            my $dest_exists = 1;
+            if (not lstat $destpath) {
+                if ($! == ENOENT) {
+                    $dest_exists = 0;
+                } else {
+                    syserr(g_('cannot get target pathname %s metadata'), $destpath);
+                }
+            }
+            my $dest_is_dir = -d _;
+            if ($dest_exists) {
+                if ($dest_is_dir && $src_is_dir) {
+                    # Refresh the destination directory attributes with the
+                    # ones from the tarball.
+                    chmod $mode, $destpath
+                        or syserr(g_('cannot change directory %s mode'), $File::Find::name);
+                    utime $atime, $mtime, $destpath
+                        or syserr(g_('cannot change directory %s times'), $File::Find::name);
+
+                    # We should do nothing, and just walk further tree.
+                    return;
+                } elsif ($dest_is_dir) {
+                    rmdir $destpath
+                        or syserr(g_('cannot remove destination directory %s'), $destpath);
+                } else {
+                    $check_symlink->($destpath);
+                    unlink $destpath
+                        or syserr(g_('cannot remove destination file %s'), $destpath);
+                }
+            }
+            # If we are moving a directory, we do not need to walk it.
+            if ($src_is_dir) {
+                $File::Find::prune = 1;
+            }
+            rename $File::Find::name, $destpath
+                or syserr(g_('cannot move %s to %s'), $File::Find::name, $destpath);
+        };
+
+        find({
+            wanted => $move_in_place,
+            no_chdir => 1,
+            dangling_symlinks => 0,
+        }, $tmp);
+    } else {
+        # Rename extracted directory
+        opendir(my $dir_dh, $tmp) or syserr(g_('cannot opendir %s'), $tmp);
+        my @entries = grep { $_ ne '.' && $_ ne '..' } readdir($dir_dh);
+        closedir($dir_dh);
+
+        erasedir($dest);
+
+        if (scalar(@entries) == 1 && ! -l "$tmp/$entries[0]" && -d _) {
+            rename("$tmp/$entries[0]", $dest)
+                or syserr(g_('unable to rename %s to %s'),
+                          "$tmp/$entries[0]", $dest);
+        } else {
+            rename($tmp, $dest)
+                or syserr(g_('unable to rename %s to %s'), $tmp, $dest);
+        }
+    }
+    erasedir($tmp);
+}
+
+1;
diff --git a/scripts/Dpkg/Source/BinaryFiles.pm b/scripts/Dpkg/Source/BinaryFiles.pm
new file mode 100644
index 0000000..48c84c8
--- /dev/null
+++ b/scripts/Dpkg/Source/BinaryFiles.pm
@@ -0,0 +1,161 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-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/>.
+
+package Dpkg::Source::BinaryFiles;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Cwd;
+use File::Path qw(make_path);
+use File::Spec;
+use File::Find;
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Source::Functions qw(is_binary);
+
+sub new {
+    my ($this, $dir) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        dir => $dir,
+        allowed_binaries => {},
+        seen_binaries => {},
+        include_binaries_path =>
+            File::Spec->catfile($dir, 'debian', 'source', 'include-binaries'),
+    };
+    bless $self, $class;
+    $self->load_allowed_binaries();
+    return $self;
+}
+
+sub new_binary_found {
+    my ($self, $path) = @_;
+
+    $self->{seen_binaries}{$path} = 1;
+}
+
+sub load_allowed_binaries {
+    my $self = shift;
+    my $incbin_file = $self->{include_binaries_path};
+
+    if (-f $incbin_file) {
+        open my $incbin_fh, '<', $incbin_file
+            or syserr(g_('cannot read %s'), $incbin_file);
+        while (<$incbin_fh>) {
+            chomp;
+            s/^\s*//;
+            s/\s*$//;
+            next if /^#/ or length == 0;
+            $self->{allowed_binaries}{$_} = 1;
+        }
+        close $incbin_fh;
+    }
+}
+
+sub binary_is_allowed {
+    my ($self, $path) = @_;
+
+    return 1 if exists $self->{allowed_binaries}{$path};
+    return 0;
+}
+
+sub update_debian_source_include_binaries {
+    my $self = shift;
+
+    my @unknown_binaries = $self->get_unknown_binaries();
+    return unless scalar @unknown_binaries;
+
+    my $incbin_file = $self->{include_binaries_path};
+    make_path(File::Spec->catdir($self->{dir}, 'debian', 'source'));
+    open my $incbin_fh, '>>', $incbin_file
+        or syserr(g_('cannot write %s'), $incbin_file);
+    foreach my $binary (@unknown_binaries) {
+        print { $incbin_fh } "$binary\n";
+        info(g_('adding %s to %s'), $binary, 'debian/source/include-binaries');
+        $self->{allowed_binaries}{$binary} = 1;
+    }
+    close $incbin_fh;
+}
+
+sub get_unknown_binaries {
+    my $self = shift;
+
+    return grep { not $self->binary_is_allowed($_) } $self->get_seen_binaries();
+}
+
+sub get_seen_binaries {
+    my $self = shift;
+    my @seen = sort keys %{$self->{seen_binaries}};
+
+    return @seen;
+}
+
+sub detect_binary_files {
+    my ($self, %opts) = @_;
+
+    my $unwanted_binaries = 0;
+    my $check_binary = sub {
+        if (-f and is_binary($_)) {
+            my $fn = File::Spec->abs2rel($_, $self->{dir});
+            $self->new_binary_found($fn);
+            unless ($opts{include_binaries} or $self->binary_is_allowed($fn)) {
+                errormsg(g_('unwanted binary file: %s'), $fn);
+                $unwanted_binaries++;
+            }
+        }
+    };
+    my $exclude_glob = '{' .
+        join(',', map { s/,/\\,/rg } @{$opts{exclude_globs}}) .
+    '}';
+    my $filter_ignore = sub {
+        # Filter out files that are not going to be included in the debian
+        # tarball due to ignores.
+        my %exclude;
+        my $reldir = File::Spec->abs2rel($File::Find::dir, $self->{dir});
+        my $cwd = getcwd();
+        # Apply the pattern both from the top dir and from the inspected dir
+        chdir $self->{dir}
+            or syserr(g_("unable to chdir to '%s'"), $self->{dir});
+        $exclude{$_} = 1 foreach glob $exclude_glob;
+        chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
+        chdir $File::Find::dir
+            or syserr(g_("unable to chdir to '%s'"), $File::Find::dir);
+        $exclude{$_} = 1 foreach glob $exclude_glob;
+        chdir $cwd or syserr(g_("unable to chdir to '%s'"), $cwd);
+        my @result;
+        foreach my $fn (@_) {
+            unless (exists $exclude{$fn} or exists $exclude{"$reldir/$fn"}) {
+                push @result, $fn;
+            }
+        }
+        return @result;
+    };
+    find({ wanted => $check_binary, preprocess => $filter_ignore,
+           no_chdir => 1 }, File::Spec->catdir($self->{dir}, 'debian'));
+    error(P_('detected %d unwanted binary file (add it in ' .
+             'debian/source/include-binaries to allow its inclusion).',
+             'detected %d unwanted binary files (add them in ' .
+             'debian/source/include-binaries to allow their inclusion).',
+             $unwanted_binaries), $unwanted_binaries)
+        if $unwanted_binaries;
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Format.pm b/scripts/Dpkg/Source/Format.pm
new file mode 100644
index 0000000..41596a2
--- /dev/null
+++ b/scripts/Dpkg/Source/Format.pm
@@ -0,0 +1,191 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2018 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/>.
+
+package Dpkg::Source::Format;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Source::Format - manipulate debian/source/format files
+
+=head1 DESCRIPTION
+
+This module provides a class that can manipulate Debian source
+package F<debian/source/format> files.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Interface::Storable);
+
+=head1 METHODS
+
+=over 4
+
+=item $f = Dpkg::Source::Format->new(%opts)
+
+Creates a new object corresponding to a source package's
+F<debian/source/format> file. When the key B<filename> is set, it will
+be used to parse and set the format. Otherwise if the B<format> key is
+set it will be validated and used to set the format.
+
+=cut
+
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+        filename => undef,
+        major => undef,
+        minor => undef,
+        variant => undef,
+    };
+    bless $self, $class;
+
+    if (exists $opts{filename}) {
+        $self->load($opts{filename}, compression => 0);
+    } elsif ($opts{format}) {
+        $self->set($opts{format});
+    }
+    return $self;
+}
+
+=item $f->set_from_parts($major[, $minor[, $variant]])
+
+Sets the source format from its parts. The $major part is mandatory.
+The $minor and $variant parts are optional.
+
+B<Notice>: This function performs no validation.
+
+=cut
+
+sub set_from_parts {
+    my ($self, $major, $minor, $variant) = @_;
+
+    $self->{major} = $major;
+    $self->{minor} = $minor // 0;
+    $self->{variant} = $variant;
+}
+
+=item ($major, $minor, $variant) = $f->set($format)
+
+Sets (and validates) the source $format specified. Will return the parsed
+format parts as a list, the optional $minor and $variant parts might be
+undef.
+
+=cut
+
+sub set {
+    my ($self, $format) = @_;
+
+    if ($format =~ /^(\d+)(?:\.(\d+))?(?:\s+\(([a-z0-9]+)\))?$/) {
+        my ($major, $minor, $variant) = ($1, $2, $3);
+
+        $self->set_from_parts($major, $minor, $variant);
+
+        return ($major, $minor, $variant);
+    } else {
+        error(g_("source package format '%s' is invalid"), $format);
+    }
+}
+
+=item ($major, $minor, $variant) = $f->get()
+
+=item $format = $f->get()
+
+Gets the source format, either as properly formatted scalar, or as a list
+of its parts, where the optional $minor and $variant parts might be undef.
+
+=cut
+
+sub get {
+    my $self = shift;
+
+    if (wantarray) {
+        return ($self->{major}, $self->{minor}, $self->{variant});
+    } else {
+        my $format = "$self->{major}.$self->{minor}";
+        $format .= " ($self->{variant})" if defined $self->{variant};
+
+        return $format;
+    }
+}
+
+=item $count = $f->parse($fh, $desc)
+
+Parse the source format string from $fh, with filehandle description $desc.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $desc) = @_;
+
+    my $format = <$fh>;
+    chomp $format if defined $format;
+    error(g_('%s is empty'), $desc)
+        unless defined $format and length $format;
+
+    $self->set($format);
+
+    return 1;
+}
+
+=item $count = $f->load($filename)
+
+Parse $filename contents for a source package format string.
+
+=item $str = $f->output([$fh])
+
+=item "$f"
+
+Returns a string representing the source package format version.
+If $fh is set, it prints the string to the filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+
+    my $str = $self->get();
+
+    print { $fh } "$str\n" if defined $fh;
+
+    return $str;
+}
+
+=item $f->save($filename)
+
+Save the source package format into the given $filename.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.19.3)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Source/Functions.pm b/scripts/Dpkg/Source/Functions.pm
new file mode 100644
index 0000000..0576657
--- /dev/null
+++ b/scripts/Dpkg/Source/Functions.pm
@@ -0,0 +1,124 @@
+# Copyright © 2008-2010, 2012-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/>.
+
+package Dpkg::Source::Functions;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+our @EXPORT_OK = qw(
+    erasedir
+    fixperms
+    chmod_if_needed
+    fs_time
+    is_binary
+);
+
+use Exporter qw(import);
+use Errno qw(ENOENT);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::File;
+use Dpkg::IPC;
+
+sub erasedir {
+    my $dir = shift;
+    if (not lstat($dir)) {
+        return if $! == ENOENT;
+        syserr(g_('cannot stat directory %s (before removal)'), $dir);
+    }
+    system 'rm', '-rf', '--', $dir;
+    subprocerr("rm -rf $dir") if $?;
+    if (not stat($dir)) {
+        return if $! == ENOENT;
+        syserr(g_("unable to check for removal of directory '%s'"), $dir);
+    }
+    error(g_("rm -rf failed to remove '%s'"), $dir);
+}
+
+sub fixperms {
+    my $dir = shift;
+    my ($mode, $modes_set);
+    # Unfortunately tar insists on applying our umask _to the original
+    # permissions_ rather than mostly-ignoring the original
+    # permissions.  We fix it up with chmod -R (which saves us some
+    # work) but we have to construct a u+/- string which is a bit
+    # of a palaver.  (Numeric doesn't work because we need [ugo]+X
+    # and [ugo]=<stuff> doesn't work because that unsets sgid on dirs.)
+    $mode = 0777 & ~umask;
+    for my $i (0 .. 2) {
+        $modes_set .= ',' if $i;
+        $modes_set .= qw(u g o)[$i];
+        for my $j (0 .. 2) {
+            $modes_set .= $mode & (0400 >> ($i * 3 + $j)) ? '+' : '-';
+            $modes_set .= qw(r w X)[$j];
+        }
+    }
+    system('chmod', '-R', '--', $modes_set, $dir);
+    subprocerr("chmod -R -- $modes_set $dir") if $?;
+}
+
+# Only change the pathname permissions if they differ from the desired.
+#
+# To be able to build a source tree, a user needs write permissions on it,
+# but not necessarily ownership of those files.
+sub chmod_if_needed {
+    my ($newperms, $pathname) = @_;
+    my $oldperms = (stat $pathname)[2] & 07777;
+
+    return 1 if $oldperms == $newperms;
+    return chmod $newperms, $pathname;
+}
+
+# Touch the file and read the resulting mtime.
+#
+# If the file doesn't exist, create it, read the mtime and unlink it.
+#
+# Use this instead of time() when the timestamp is going to be
+# used to set file timestamps. This avoids confusion when an
+# NFS server and NFS client disagree about what time it is.
+sub fs_time($) {
+    my $file = shift;
+    my $is_temp = 0;
+    if (not -e $file) {
+        file_touch($file);
+	$is_temp = 1;
+    } else {
+	utime(undef, undef, $file) or
+	    syserr(g_('cannot change timestamp for %s'), $file);
+    }
+    stat($file) or syserr(g_('cannot read timestamp from %s'), $file);
+    my $mtime = (stat(_))[9];
+    unlink($file) if $is_temp;
+    return $mtime;
+}
+
+sub is_binary($) {
+    my $file = shift;
+
+    # Perform the same check as diff(1), look for a NUL character in the first
+    # 4 KiB of the file.
+    open my $fh, '<', $file
+        or syserr(g_('cannot open file %s for binary detection'), $file);
+    read $fh, my $buf, 4096, 0;
+    my $res = index $buf, "\0";
+    close $fh;
+
+    return $res >= 0;
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
new file mode 100644
index 0000000..412ea5d
--- /dev/null
+++ b/scripts/Dpkg/Source/Package.pm
@@ -0,0 +1,741 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2019 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/>.
+
+package Dpkg::Source::Package;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Source::Package - manipulate Debian source packages
+
+=head1 DESCRIPTION
+
+This module provides a class that can manipulate Debian source
+packages. While it supports both the extraction and the creation
+of source packages, the only API that is officially supported
+is the one that supports the extraction of the source package.
+
+=cut
+
+use strict;
+use warnings;
+
+our $VERSION = '2.02';
+our @EXPORT_OK = qw(
+    get_default_diff_ignore_regex
+    set_default_diff_ignore_regex
+    get_default_tar_ignore_pattern
+);
+
+use Exporter qw(import);
+use POSIX qw(:errno_h :sys_wait_h);
+use Carp;
+use File::Temp;
+use File::Copy qw(cp);
+use File::Basename;
+use File::Spec;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control;
+use Dpkg::Checksums;
+use Dpkg::Version;
+use Dpkg::Compression;
+use Dpkg::Path qw(check_files_are_the_same check_directory_traversal);
+use Dpkg::Vendor qw(run_vendor_hook);
+use Dpkg::Source::Format;
+use Dpkg::OpenPGP;
+use Dpkg::OpenPGP::ErrorCodes;
+
+my $diff_ignore_default_regex = '
+# Ignore general backup files
+(?:^|/).*~$|
+# Ignore emacs recovery files
+(?:^|/)\.#.*$|
+# Ignore vi swap files
+(?:^|/)\..*\.sw.$|
+# Ignore baz-style junk files or directories
+(?:^|/),,.*(?:$|/.*$)|
+# File-names that should be ignored (never directories)
+(?:^|/)(?:DEADJOE|\.arch-inventory|\.(?:bzr|cvs|hg|git|mtn-)ignore)$|
+# File or directory names that should be ignored
+(?:^|/)(?:CVS|RCS|\.deps|\{arch\}|\.arch-ids|\.svn|
+\.hg(?:tags|sigs)?|_darcs|\.git(?:attributes|modules|review)?|
+\.mailmap|\.shelf|_MTN|\.be|\.bzr(?:\.backup|tags)?)(?:$|/.*$)
+';
+# Take out comments and newlines
+$diff_ignore_default_regex =~ s/^#.*$//mg;
+$diff_ignore_default_regex =~ s/\n//sg;
+
+no warnings 'qw'; ## no critic (TestingAndDebugging::ProhibitNoWarnings)
+my @tar_ignore_default_pattern = qw(
+*.a
+*.la
+*.o
+*.so
+.*.sw?
+*/*~
+,,*
+.[#~]*
+.arch-ids
+.arch-inventory
+.be
+.bzr
+.bzr.backup
+.bzr.tags
+.bzrignore
+.cvsignore
+.deps
+.git
+.gitattributes
+.gitignore
+.gitmodules
+.gitreview
+.hg
+.hgignore
+.hgsigs
+.hgtags
+.mailmap
+.mtn-ignore
+.shelf
+.svn
+CVS
+DEADJOE
+RCS
+_MTN
+_darcs
+{arch}
+);
+## use critic
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $string = get_default_diff_ignore_regex()
+
+Returns the default diff ignore regex.
+
+=cut
+
+sub get_default_diff_ignore_regex {
+    return $diff_ignore_default_regex;
+}
+
+=item set_default_diff_ignore_regex($string)
+
+Set a regex as the new default diff ignore regex.
+
+=cut
+
+sub set_default_diff_ignore_regex {
+    my $regex = shift;
+
+    $diff_ignore_default_regex = $regex;
+}
+
+=item @array = get_default_tar_ignore_pattern()
+
+Returns the default tar ignore pattern, as an array.
+
+=cut
+
+sub get_default_tar_ignore_pattern {
+    return @tar_ignore_default_pattern;
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $p = Dpkg::Source::Package->new(%opts, options => {})
+
+Creates a new object corresponding to a source package. When the key
+B<filename> is set to a F<.dsc> file, it will be used to initialize the
+source package with its description. Otherwise if the B<format> key is
+set to a valid value, the object will be initialized for that format
+(since dpkg 1.19.3).
+
+The B<options> key is a hash ref which supports the following options:
+
+=over 8
+
+=item skip_debianization
+
+If set to 1, do not apply Debian changes on the extracted source package.
+
+=item skip_patches
+
+If set to 1, do not apply Debian-specific patches. This options is
+specific for source packages using format "2.0" and "3.0 (quilt)".
+
+=item require_valid_signature
+
+If set to 1, the check_signature() method will be stricter and will error
+out if the signature can't be verified.
+
+=item require_strong_checksums
+
+If set to 1, the check_checksums() method will be stricter and will error
+out if there is no strong checksum.
+
+=item copy_orig_tarballs
+
+If set to 1, the extraction will copy the upstream tarballs next the
+target directory. This is useful if you want to be able to rebuild the
+source package after its extraction.
+
+=back
+
+=cut
+
+# Class methods
+sub new {
+    my ($this, %args) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+        fields => Dpkg::Control->new(type => CTRL_PKG_SRC),
+        format => Dpkg::Source::Format->new(),
+        options => {},
+        checksums => Dpkg::Checksums->new(),
+        openpgp => Dpkg::OpenPGP->new(needs => { api => 'verify' }),
+    };
+    bless $self, $class;
+    if (exists $args{options}) {
+        $self->{options} = $args{options};
+    }
+    if (exists $args{filename}) {
+        $self->initialize($args{filename});
+        $self->init_options();
+    } elsif ($args{format}) {
+        $self->{fields}{Format} = $args{format};
+        $self->upgrade_object_type(0);
+        $self->init_options();
+    }
+
+    if ($self->{options}{require_valid_signature}) {
+        $self->{report_verify} = \&error;
+    } else {
+        $self->{report_verify} = \&warning;
+    }
+
+    return $self;
+}
+
+sub init_options {
+    my $self = shift;
+    # Use full ignore list by default
+    # note: this function is not called by V1 packages
+    $self->{options}{diff_ignore_regex} ||= $diff_ignore_default_regex;
+    $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$';
+    $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/files(?:\.new)?$';
+    if (defined $self->{options}{tar_ignore}) {
+        $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ]
+            unless @{$self->{options}{tar_ignore}};
+    } else {
+        $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ];
+    }
+    push @{$self->{options}{tar_ignore}},
+         'debian/source/local-options',
+         'debian/source/local-patch-header',
+         'debian/files',
+         'debian/files.new';
+    $self->{options}{copy_orig_tarballs} //= 0;
+
+    # Skip debianization while specific to some formats has an impact
+    # on code common to all formats
+    $self->{options}{skip_debianization} //= 0;
+    $self->{options}{skip_patches} //= 0;
+
+    # Set default validation checks.
+    $self->{options}{require_valid_signature} //= 0;
+    $self->{options}{require_strong_checksums} //= 0;
+
+    # Set default compressor for new formats.
+    $self->{options}{compression} //= 'xz';
+    $self->{options}{comp_level} //= compression_get_level($self->{options}{compression});
+    $self->{options}{comp_ext} //= compression_get_file_extension($self->{options}{compression});
+}
+
+sub initialize {
+    my ($self, $filename) = @_;
+    my ($fn, $dir) = fileparse($filename);
+    error(g_('%s is not the name of a file'), $filename) unless $fn;
+    $self->{basedir} = $dir || './';
+    $self->{filename} = $fn;
+
+    # Read the fields
+    my $fields = $self->{fields};
+    $fields->load($filename);
+    $self->{is_signed} = $fields->get_option('is_pgp_signed');
+
+    foreach my $f (qw(Source Version Files)) {
+        unless (defined($fields->{$f})) {
+            error(g_('missing critical source control field %s'), $f);
+        }
+    }
+
+    $self->{checksums}->add_from_control($fields, use_files_for_md5 => 1);
+
+    $self->upgrade_object_type(0);
+}
+
+sub upgrade_object_type {
+    my ($self, $update_format) = @_;
+    $update_format //= 1;
+
+    my $format = $self->{fields}{'Format'} // '1.0';
+    my ($major, $minor, $variant) = $self->{format}->set($format);
+
+    my $module = "Dpkg::Source::Package::V$major";
+    $module .= '::' . ucfirst $variant if defined $variant;
+    eval qq{
+        pop \@INC if \$INC[-1] eq '.';
+        require $module;
+        \$minor = \$${module}::CURRENT_MINOR_VERSION;
+    };
+    if ($@) {
+        error(g_("source package format '%s' is not supported: %s"),
+              $format, $@);
+    }
+    if ($update_format) {
+        $self->{format}->set_from_parts($major, $minor, $variant);
+        $self->{fields}{'Format'} = $self->{format}->get();
+    }
+
+    $module->prerequisites() if $module->can('prerequisites');
+    bless $self, $module;
+}
+
+=item $p->get_filename()
+
+Returns the filename of the DSC file.
+
+=cut
+
+sub get_filename {
+    my $self = shift;
+    return File::Spec->catfile($self->{basedir}, $self->{filename});
+}
+
+=item $p->get_files()
+
+Returns the list of files referenced by the source package. The filenames
+usually do not have any path information.
+
+=cut
+
+sub get_files {
+    my $self = shift;
+    return $self->{checksums}->get_files();
+}
+
+=item $p->check_checksums()
+
+Verify the checksums embedded in the DSC file. It requires the presence of
+the other files constituting the source package. If any inconsistency is
+discovered, it immediately errors out. It will make sure at least one strong
+checksum is present.
+
+If the object has been created with the "require_strong_checksums" option,
+then any problem will result in a fatal error.
+
+=cut
+
+sub check_checksums {
+    my $self = shift;
+    my $checksums = $self->{checksums};
+    my $warn_on_weak = 0;
+
+    # add_from_file verify the checksums if they are already existing
+    foreach my $file ($checksums->get_files()) {
+        if (not $checksums->has_strong_checksums($file)) {
+            if ($self->{options}{require_strong_checksums}) {
+                error(g_('source package uses only weak checksums'));
+            } else {
+                $warn_on_weak = 1;
+            }
+        }
+	my $pathname = File::Spec->catfile($self->{basedir}, $file);
+	$checksums->add_from_file($pathname, key => $file);
+    }
+
+    warning(g_('source package uses only weak checksums')) if $warn_on_weak;
+}
+
+sub get_basename {
+    my ($self, $with_revision) = @_;
+    my $f = $self->{fields};
+    unless (exists $f->{'Source'} and exists $f->{'Version'}) {
+        error(g_('%s and %s fields are required to compute the source basename'),
+              'Source', 'Version');
+    }
+    my $v = Dpkg::Version->new($f->{'Version'});
+    my $vs = $v->as_string(omit_epoch => 1, omit_revision => !$with_revision);
+    return $f->{'Source'} . '_' . $vs;
+}
+
+sub find_original_tarballs {
+    my ($self, %opts) = @_;
+    $opts{extension} //= compression_get_file_extension_regex();
+    $opts{include_main} //= 1;
+    $opts{include_supplementary} //= 1;
+    my $basename = $self->get_basename();
+    my @tar;
+    foreach my $dir ('.', $self->{basedir}, $self->{options}{origtardir}) {
+        next unless defined($dir) and -d $dir;
+        opendir(my $dir_dh, $dir) or syserr(g_('cannot opendir %s'), $dir);
+        push @tar, map { File::Spec->catfile($dir, $_) } grep {
+		($opts{include_main} and
+		 /^\Q$basename\E\.orig\.tar\.$opts{extension}$/) or
+		($opts{include_supplementary} and
+		 /^\Q$basename\E\.orig-[[:alnum:]-]+\.tar\.$opts{extension}$/)
+	    } readdir($dir_dh);
+        closedir($dir_dh);
+    }
+    return @tar;
+}
+
+=item $p->get_upstream_signing_key($dir)
+
+Get the filename for the upstream key.
+
+=cut
+
+sub get_upstream_signing_key {
+    my ($self, $dir) = @_;
+
+    return "$dir/debian/upstream/signing-key.asc";
+}
+
+=item $p->armor_original_tarball_signature($bin, $asc)
+
+Convert a signature from binary to ASCII armored form. If the signature file
+does not exist, it is a no-op. If the signature file is already ASCII armored
+then simply copy it, otherwise convert it from binary to ASCII armored form.
+
+=cut
+
+sub armor_original_tarball_signature {
+    my ($self, $bin, $asc) = @_;
+
+    if (-e $bin) {
+        return $self->{openpgp}->armor('SIGNATURE', $bin, $asc);
+    }
+
+    return;
+}
+
+=item $p->check_original_tarball_signature($dir, @asc)
+
+Verify the original upstream tarball signatures @asc using the upstream
+public keys. It requires the origin upstream tarballs, their signatures
+and the upstream signing key, as found in an unpacked source tree $dir.
+If any inconsistency is discovered, it immediately errors out.
+
+=cut
+
+sub check_original_tarball_signature {
+    my ($self, $dir, @asc) = @_;
+
+    my $upstream_key = $self->get_upstream_signing_key($dir);
+    if (not -e $upstream_key) {
+        warning(g_('upstream tarball signatures but no upstream signing key'));
+        return;
+    }
+
+    foreach my $asc (@asc) {
+        my $datafile = $asc =~ s/\.asc$//r;
+
+        info(g_('verifying %s'), $asc);
+        my $rc = $self->{openpgp}->verify($datafile, $asc, $upstream_key);
+        if ($rc) {
+            $self->{report_verify}->(g_('cannot verify upstream tarball signature for %s: %s'),
+                                     $datafile, openpgp_errorcode_to_string($rc));
+        }
+    }
+}
+
+=item $bool = $p->is_signed()
+
+Returns 1 if the DSC files contains an embedded OpenPGP signature.
+Otherwise returns 0.
+
+=cut
+
+sub is_signed {
+    my $self = shift;
+    return $self->{is_signed};
+}
+
+=item $p->check_signature()
+
+Implement the same OpenPGP signature check that dpkg-source does.
+In case of problems, it prints a warning or errors out.
+
+If the object has been created with the "require_valid_signature" option,
+then any problem will result in a fatal error.
+
+=cut
+
+sub check_signature {
+    my $self = shift;
+    my $dsc = $self->get_filename();
+    my @certs;
+
+    push @certs, $self->{openpgp}->get_trusted_keyrings();
+
+    foreach my $vendor_keyring (run_vendor_hook('package-keyrings')) {
+        if (-r $vendor_keyring) {
+            push @certs, $vendor_keyring;
+        }
+    }
+
+    my $rc = $self->{openpgp}->inline_verify($dsc, undef, @certs);
+    if ($rc) {
+        $self->{report_verify}->(g_('cannot verify inline signature for %s: %s'),
+                                 $dsc, openpgp_errorcode_to_string($rc));
+    }
+}
+
+sub describe_cmdline_options {
+    return;
+}
+
+sub parse_cmdline_options {
+    my ($self, @opts) = @_;
+    foreach my $option (@opts) {
+        if (not $self->parse_cmdline_option($option)) {
+            warning(g_('%s is not a valid option for %s'), $option, ref $self);
+        }
+    }
+}
+
+sub parse_cmdline_option {
+    return 0;
+}
+
+=item $p->extract($targetdir)
+
+Extracts the source package in the target directory $targetdir. Beware
+that if $targetdir already exists, it will be erased (as long as the
+no_overwrite_dir option is set).
+
+=cut
+
+sub extract {
+    my ($self, $newdirectory) = @_;
+
+    my ($ok, $error) = version_check($self->{fields}{'Version'});
+    if (not $ok) {
+        if ($self->{options}{ignore_bad_version}) {
+            warning($error);
+        } else {
+            error($error);
+        }
+    }
+
+    # Copy orig tarballs
+    if ($self->{options}{copy_orig_tarballs}) {
+        my $basename = $self->get_basename();
+        my ($dirname, $destdir) = fileparse($newdirectory);
+        $destdir ||= './';
+	my $ext = compression_get_file_extension_regex();
+        foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$ext$/ }
+                          $self->get_files())
+        {
+            my $src = File::Spec->catfile($self->{basedir}, $orig);
+            my $dst = File::Spec->catfile($destdir, $orig);
+            if (not check_files_are_the_same($src, $dst, 1)) {
+                cp($src, $dst)
+                    or syserr(g_('cannot copy %s to %s'), $src, $dst);
+            }
+        }
+    }
+
+    # Try extract
+    $self->do_extract($newdirectory);
+
+    # Check for directory traversals.
+    if (not $self->{options}{skip_debianization} and not $self->{no_check}) {
+        # We need to add a trailing slash to handle the debian directory
+        # possibly being a symlink.
+        check_directory_traversal($newdirectory, "$newdirectory/debian/");
+    }
+
+    # Store format if non-standard so that next build keeps the same format
+    if ($self->{fields}{'Format'} and
+        $self->{fields}{'Format'} ne '1.0' and
+        not $self->{options}{skip_debianization})
+    {
+        my $srcdir = File::Spec->catdir($newdirectory, 'debian', 'source');
+        my $format_file = File::Spec->catfile($srcdir, 'format');
+	unless (-e $format_file) {
+	    mkdir($srcdir) unless -e $srcdir;
+            $self->{format}->save($format_file);
+	}
+    }
+
+    # Make sure debian/rules is executable
+    my $rules = File::Spec->catfile($newdirectory, 'debian', 'rules');
+    my @s = lstat($rules);
+    if (not scalar(@s)) {
+        unless ($! == ENOENT) {
+            syserr(g_('cannot stat %s'), $rules);
+        }
+        warning(g_('%s does not exist'), $rules)
+            unless $self->{options}{skip_debianization};
+    } elsif (-f _) {
+        chmod($s[2] | 0111, $rules)
+            or syserr(g_('cannot make %s executable'), $rules);
+    } else {
+        warning(g_('%s is not a plain file'), $rules);
+    }
+}
+
+sub do_extract {
+    croak 'Dpkg::Source::Package does not know how to unpack a ' .
+          'source package; use one of the subclasses';
+}
+
+# Function used specifically during creation of a source package
+
+sub before_build {
+    my ($self, $dir) = @_;
+}
+
+sub build {
+    my $self = shift;
+
+    $self->do_build(@_);
+}
+
+sub after_build {
+    my ($self, $dir) = @_;
+}
+
+sub do_build {
+    croak 'Dpkg::Source::Package does not know how to build a ' .
+          'source package; use one of the subclasses';
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+    return (0, 'can_build() has not been overridden');
+}
+
+sub add_file {
+    my ($self, $filename) = @_;
+    my ($fn, $dir) = fileparse($filename);
+    if ($self->{checksums}->has_file($fn)) {
+        croak "tried to add file '$fn' twice";
+    }
+    $self->{checksums}->add_from_file($filename, key => $fn);
+    $self->{checksums}->export_to_control($self->{fields},
+					    use_files_for_md5 => 1);
+}
+
+sub commit {
+    my $self = shift;
+
+    $self->do_commit(@_);
+}
+
+sub do_commit {
+    my ($self, $dir) = @_;
+    info(g_("'%s' is not supported by the source format '%s'"),
+         'dpkg-source --commit', $self->{fields}{'Format'});
+}
+
+sub write_dsc {
+    my ($self, %opts) = @_;
+    my $fields = $self->{fields};
+
+    foreach my $f (keys %{$opts{override}}) {
+	$fields->{$f} = $opts{override}{$f};
+    }
+
+    unless ($opts{nocheck}) {
+        foreach my $f (qw(Source Version Architecture)) {
+            unless (defined($fields->{$f})) {
+                error(g_('missing information for critical output field %s'), $f);
+            }
+        }
+        foreach my $f (qw(Maintainer Standards-Version)) {
+            unless (defined($fields->{$f})) {
+                warning(g_('missing information for output field %s'), $f);
+            }
+        }
+    }
+
+    foreach my $f (keys %{$opts{remove}}) {
+	delete $fields->{$f};
+    }
+
+    my $filename = $opts{filename};
+    $filename //= $self->get_basename(1) . '.dsc';
+    open(my $dsc_fh, '>', $filename)
+        or syserr(g_('cannot write %s'), $filename);
+    $fields->apply_substvars($opts{substvars});
+    $fields->output($dsc_fh);
+    close($dsc_fh);
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.02 (dpkg 1.21.10)
+
+New method: armor_original_tarball_signature().
+
+=head2 Version 2.01 (dpkg 1.20.1)
+
+New method: get_upstream_signing_key().
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+New method: check_original_tarball_signature().
+
+Remove variable: $diff_ignore_default_regexp.
+
+Hide variable: @tar_ignore_default_pattern.
+
+=head2 Version 1.03 (dpkg 1.19.3)
+
+New option: format in new().
+
+=head2 Version 1.02 (dpkg 1.18.7)
+
+New option: require_strong_checksums in check_checksums().
+
+=head2 Version 1.01 (dpkg 1.17.2)
+
+New functions: get_default_diff_ignore_regex(), set_default_diff_ignore_regex(),
+get_default_tar_ignore_pattern()
+
+Deprecated variables: $diff_ignore_default_regexp, @tar_ignore_default_pattern
+
+=head2 Version 1.00 (dpkg 1.16.1)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm
new file mode 100644
index 0000000..96e2932
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V1.pm
@@ -0,0 +1,512 @@
+# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008, 2012-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/>.
+
+package Dpkg::Source::Package::V1;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Errno qw(ENOENT);
+use Cwd;
+use File::Basename;
+use File::Temp qw(tempfile);
+use File::Spec;
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Compression;
+use Dpkg::Source::Archive;
+use Dpkg::Source::Patch;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
+use Dpkg::Source::Functions qw(erasedir);
+use Dpkg::Source::Package::V3::Native;
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+sub init_options {
+    my $self = shift;
+
+    # Don't call $self->SUPER::init_options() on purpose, V1.0 has no
+    # ignore by default
+    if ($self->{options}{diff_ignore_regex}) {
+	$self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$';
+    } else {
+	$self->{options}{diff_ignore_regex} = '(?:^|/)debian/source/local-.*$';
+    }
+    $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/files(?:\.new)?$';
+    push @{$self->{options}{tar_ignore}},
+         'debian/source/local-options',
+         'debian/source/local-patch-header',
+         'debian/files',
+         'debian/files.new';
+    $self->{options}{sourcestyle} //= 'X';
+    $self->{options}{skip_debianization} //= 0;
+    $self->{options}{ignore_bad_version} //= 0;
+    $self->{options}{abort_on_upstream_changes} //= 0;
+
+    # Set default validation checks.
+    $self->{options}{require_valid_signature} //= 0;
+    $self->{options}{require_strong_checksums} //= 0;
+
+    # V1.0 only supports gzip compression.
+    $self->{options}{compression} //= 'gzip';
+    $self->{options}{comp_level} //= compression_get_level('gzip');
+    $self->{options}{comp_ext} //= compression_get_file_extension('gzip');
+}
+
+my @module_cmdline = (
+    {
+        name => '-sa',
+        help => N_('auto select original source'),
+        when => 'build',
+    }, {
+        name => '-sk',
+        help => N_('use packed original source (unpack and keep)'),
+        when => 'build',
+    }, {
+        name => '-sp',
+        help => N_('use packed original source (unpack and remove)'),
+        when => 'build',
+    }, {
+        name => '-su',
+        help => N_('use unpacked original source (pack and keep)'),
+        when => 'build',
+    }, {
+        name => '-sr',
+        help => N_('use unpacked original source (pack and remove)'),
+        when => 'build',
+    }, {
+        name => '-ss',
+        help => N_('trust packed and unpacked original sources are same'),
+        when => 'build',
+    }, {
+        name => '-sn',
+        help => N_('there is no diff, do main tarfile only'),
+        when => 'build',
+    }, {
+        name => '-sA, -sK, -sP, -sU, -sR',
+        help => N_('like -sa, -sk, -sp, -su, -sr but may overwrite'),
+        when => 'build',
+    }, {
+        name => '--abort-on-upstream-changes',
+        help => N_('abort if generated diff has upstream files changes'),
+        when => 'build',
+    }, {
+        name => '-sp',
+        help => N_('leave original source packed in current directory'),
+        when => 'extract',
+    }, {
+        name => '-su',
+        help => N_('do not copy original source to current directory'),
+        when => 'extract',
+    }, {
+        name => '-sn',
+        help => N_('unpack original source tree too'),
+        when => 'extract',
+    }, {
+        name => '--skip-debianization',
+        help => N_('do not apply debian diff to upstream sources'),
+        when => 'extract',
+    },
+);
+
+sub describe_cmdline_options {
+    return @module_cmdline;
+}
+
+sub parse_cmdline_option {
+    my ($self, $opt) = @_;
+    my $o = $self->{options};
+    if ($opt =~ m/^-s([akpursnAKPUR])$/) {
+        warning(g_('-s%s option overrides earlier -s%s option'), $1,
+                $o->{sourcestyle}) if $o->{sourcestyle} ne 'X';
+        $o->{sourcestyle} = $1;
+        $o->{copy_orig_tarballs} = 0 if $1 eq 'n'; # Extract option -sn
+        return 1;
+    } elsif ($opt eq '--skip-debianization') {
+        $o->{skip_debianization} = 1;
+        return 1;
+    } elsif ($opt eq '--ignore-bad-version') {
+        $o->{ignore_bad_version} = 1;
+        return 1;
+    } elsif ($opt eq '--abort-on-upstream-changes') {
+        $o->{abort_on_upstream_changes} = 1;
+        return 1;
+    }
+    return 0;
+}
+
+sub do_extract {
+    my ($self, $newdirectory) = @_;
+    my $sourcestyle = $self->{options}{sourcestyle};
+    my $fields = $self->{fields};
+
+    $sourcestyle =~ y/X/p/;
+    unless ($sourcestyle =~ m/[pun]/) {
+	usageerr(g_('source handling style -s%s not allowed with -x'),
+	         $sourcestyle);
+    }
+
+    my $basename = $self->get_basename();
+    my $basenamerev = $self->get_basename(1);
+
+    # V1.0 only supports gzip compression
+    my ($tarfile, $difffile);
+    my $tarsign;
+    foreach my $file ($self->get_files()) {
+	if ($file =~ /^(?:\Q$basename\E\.orig|\Q$basenamerev\E)\.tar\.gz$/) {
+            error(g_('multiple tarfiles in v1.0 source package')) if $tarfile;
+            $tarfile = $file;
+        } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.gz\.asc$/) {
+            $tarsign = $file;
+	} elsif ($file =~ /^\Q$basenamerev\E\.diff\.gz$/) {
+	    $difffile = $file;
+	} else {
+	    error(g_('unrecognized file for a %s source package: %s'),
+                  'v1.0', $file);
+	}
+    }
+
+    error(g_('no tarfile in Files field')) unless $tarfile;
+    my $native = $difffile ? 0 : 1;
+    if ($native and ($tarfile =~ /\.orig\.tar\.gz$/)) {
+        warning(g_('native package with .orig.tar'));
+        $native = 0; # V3::Native doesn't handle orig.tar
+    }
+
+    if ($native) {
+        Dpkg::Source::Package::V3::Native::do_extract($self, $newdirectory);
+    } else {
+        my $expectprefix = $newdirectory;
+        $expectprefix .= '.orig';
+
+        if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
+            error(g_('unpack target exists: %s'), $newdirectory);
+        } else {
+            erasedir($newdirectory);
+        }
+        if (-e $expectprefix) {
+            rename($expectprefix, "$newdirectory.tmp-keep")
+                or syserr(g_("unable to rename '%s' to '%s'"), $expectprefix,
+                          "$newdirectory.tmp-keep");
+        }
+
+        info(g_('unpacking %s'), $tarfile);
+        my $tar = Dpkg::Source::Archive->new(
+            filename => File::Spec->catfile($self->{basedir}, $tarfile),
+        );
+        $tar->extract($expectprefix);
+
+        if ($sourcestyle =~ /u/) {
+            # -su: keep .orig directory unpacked
+            if (-e "$newdirectory.tmp-keep") {
+                error(g_('unable to keep orig directory (already exists)'));
+            }
+            system('cp', '-ar', '--', $expectprefix, "$newdirectory.tmp-keep");
+            subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?;
+        }
+
+	rename($expectprefix, $newdirectory)
+	    or syserr(g_('failed to rename newly-extracted %s to %s'),
+	              $expectprefix, $newdirectory);
+
+	# rename the copied .orig directory
+	if (-e "$newdirectory.tmp-keep") {
+	    rename("$newdirectory.tmp-keep", $expectprefix)
+	        or syserr(g_('failed to rename saved %s to %s'),
+	                  "$newdirectory.tmp-keep", $expectprefix);
+        }
+    }
+
+    if ($difffile and not $self->{options}{skip_debianization}) {
+        my $patch = File::Spec->catfile($self->{basedir}, $difffile);
+	info(g_('applying %s'), $difffile);
+	my $patch_obj = Dpkg::Source::Patch->new(filename => $patch);
+	my $analysis = $patch_obj->apply($newdirectory, force_timestamp => 1);
+	my @files = grep { ! m{^\Q$newdirectory\E/debian/} }
+		    sort keys %{$analysis->{filepatched}};
+	info(g_('upstream files that have been modified: %s'),
+	     "\n " . join("\n ", @files)) if scalar @files;
+    }
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+
+    # As long as we can use gzip, we can do it as we have
+    # native packages as fallback
+    return (0, g_('only supports gzip compression'))
+        unless $self->{options}{compression} eq 'gzip';
+    return 1;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    my $sourcestyle = $self->{options}{sourcestyle};
+    my @argv = @{$self->{options}{ARGV}};
+    my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}};
+    my $diff_ignore_regex = $self->{options}{diff_ignore_regex};
+
+    if (scalar(@argv) > 1) {
+        usageerr(g_('-b takes at most a directory and an orig source ' .
+                    'argument (with v1.0 source package)'));
+    }
+
+    $sourcestyle =~ y/X/a/;
+    unless ($sourcestyle =~ m/[akpursnAKPUR]/) {
+        usageerr(g_('source handling style -s%s not allowed with -b'),
+                 $sourcestyle);
+    }
+
+    my $sourcepackage = $self->{fields}{'Source'};
+    my $basenamerev = $self->get_basename(1);
+    my $basename = $self->get_basename();
+    my $basedirname = $basename;
+    $basedirname =~ s/_/-/;
+
+    # Try to find a .orig tarball for the package
+    my $origdir = "$dir.orig";
+    my $origtargz = $self->get_basename() . '.orig.tar.gz';
+    if (-e $origtargz) {
+        unless (-f $origtargz) {
+            error(g_("packed orig '%s' exists but is not a plain file"), $origtargz);
+        }
+    } else {
+        $origtargz = undef;
+    }
+
+    if (@argv) {
+	# We have a second-argument <orig-dir> or <orig-targz>, check what it
+	# is to decide the mode to use
+        my $origarg = shift(@argv);
+        if (length($origarg)) {
+            stat($origarg)
+                or syserr(g_('cannot stat orig argument %s'), $origarg);
+            if (-d _) {
+                $origdir = File::Spec->catdir($origarg);
+
+                $sourcestyle =~ y/aA/rR/;
+                unless ($sourcestyle =~ m/[ursURS]/) {
+                    error(g_('orig argument is unpacked but source handling ' .
+                             'style -s%s calls for packed (.orig.tar.<ext>)'),
+                          $sourcestyle);
+                }
+            } elsif (-f _) {
+                $origtargz = $origarg;
+                $sourcestyle =~ y/aA/pP/;
+                unless ($sourcestyle =~ m/[kpsKPS]/) {
+                    error(g_('orig argument is packed but source handling ' .
+                             'style -s%s calls for unpacked (.orig/)'),
+                          $sourcestyle);
+                }
+            } else {
+                error(g_('orig argument %s is not a plain file or directory'),
+                      $origarg);
+            }
+        } else {
+            $sourcestyle =~ y/aA/nn/;
+            unless ($sourcestyle =~ m/n/) {
+                error(g_('orig argument is empty (means no orig, no diff) ' .
+                         'but source handling style -s%s wants something'),
+                      $sourcestyle);
+            }
+        }
+    } elsif ($sourcestyle =~ m/[aA]/) {
+	# We have no explicit <orig-dir> or <orig-targz>, try to use
+	# a .orig tarball first, then a .orig directory and fall back to
+	# creating a native .tar.gz
+	if ($origtargz) {
+	    $sourcestyle =~ y/aA/pP/; # .orig.tar.<ext>
+	} else {
+	    if (stat($origdir)) {
+		unless (-d _) {
+                    error(g_("unpacked orig '%s' exists but is not a directory"),
+		          $origdir);
+                }
+		$sourcestyle =~ y/aA/rR/; # .orig directory
+	    } elsif ($! != ENOENT) {
+		syserr(g_("unable to stat putative unpacked orig '%s'"), $origdir);
+	    } else {
+		$sourcestyle =~ y/aA/nn/; # Native tar.gz
+	    }
+	}
+    }
+
+    my $v = Dpkg::Version->new($self->{fields}->{'Version'});
+    if ($sourcestyle =~ m/[kpursKPUR]/) {
+        error(g_('non-native package version does not contain a revision'))
+            if $v->is_native();
+    } else {
+        # TODO: This will become fatal in the near future.
+        warning(g_('native package version may not have a revision'))
+            unless $v->is_native();
+    }
+
+    my ($dirname, $dirbase) = fileparse($dir);
+    if ($dirname ne $basedirname) {
+	warning(g_("source directory '%s' is not <sourcepackage>" .
+	           "-<upstreamversion> '%s'"), $dir, $basedirname);
+    }
+
+    my ($tarname, $tardirname, $tardirbase);
+    my $tarsign;
+    if ($sourcestyle ne 'n') {
+	my ($origdirname, $origdirbase) = fileparse($origdir);
+
+        if ($origdirname ne "$basedirname.orig") {
+            warning(g_('.orig directory name %s is not <package>' .
+	               '-<upstreamversion> (wanted %s)'),
+	            $origdirname, "$basedirname.orig");
+        }
+        $tardirbase = $origdirbase;
+        $tardirname = $origdirname;
+
+	$tarname = $origtargz || "$basename.orig.tar.gz";
+	$tarsign = "$tarname.asc";
+	unless ($tarname =~ /\Q$basename\E\.orig\.tar\.gz/) {
+	    warning(g_('.orig.tar name %s is not <package>_<upstreamversion>' .
+	               '.orig.tar (wanted %s)'),
+	            $tarname, "$basename.orig.tar.gz");
+	}
+    }
+
+    if ($sourcestyle eq 'n') {
+        $self->{options}{ARGV} = []; # ensure we have no error
+        Dpkg::Source::Package::V3::Native::do_build($self, $dir);
+    } elsif ($sourcestyle =~ m/[urUR]/) {
+        if (stat($tarname)) {
+            unless ($sourcestyle =~ m/[UR]/) {
+		error(g_("tarfile '%s' already exists, not overwriting, " .
+		         'giving up; use -sU or -sR to override'), $tarname);
+            }
+        } elsif ($! != ENOENT) {
+	    syserr(g_("unable to check for existence of '%s'"), $tarname);
+        }
+
+	info(g_('building %s in %s'),
+	     $sourcepackage, $tarname);
+
+	my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
+				       DIR => getcwd(), UNLINK => 0);
+	my $tar = Dpkg::Source::Archive->new(filename => $newtar,
+		    compression => compression_guess_from_filename($tarname),
+		    compression_level => $self->{options}{comp_level});
+	$tar->create(options => \@tar_ignore, chdir => $tardirbase);
+	$tar->add_directory($tardirname);
+	$tar->finish();
+	rename($newtar, $tarname)
+	    or syserr(g_("unable to rename '%s' (newly created) to '%s'"),
+	              $newtar, $tarname);
+	chmod(0666 &~ umask(), $tarname)
+	    or syserr(g_("unable to change permission of '%s'"), $tarname);
+    } else {
+	info(g_('building %s using existing %s'),
+	     $sourcepackage, $tarname);
+    }
+
+    if ($tarname) {
+        $self->add_file($tarname);
+        if (-e "$tarname.sig" and not -e "$tarname.asc") {
+            $self->armor_original_tarball_signature("$tarname.sig", "$tarname.asc");
+        }
+    }
+    if ($tarsign and -e $tarsign) {
+        $self->check_original_tarball_signature($dir, $tarsign);
+
+        info(g_('building %s using existing %s'), $sourcepackage, $tarsign);
+        $self->add_file($tarsign);
+    } else {
+        my $key = $self->get_upstream_signing_key($dir);
+        if (-e $key) {
+            warning(g_('upstream signing key but no upstream tarball signature'));
+        }
+    }
+
+    if ($sourcestyle =~ m/[kpKP]/) {
+        if (stat($origdir)) {
+            unless ($sourcestyle =~ m/[KP]/) {
+                error(g_("orig directory '%s' already exists, not overwriting, ".
+                         'giving up; use -sA, -sK or -sP to override'),
+                      $origdir);
+            }
+            erasedir($origdir);
+        } elsif ($! != ENOENT) {
+            syserr(g_("unable to check for existence of orig directory '%s'"),
+                    $origdir);
+        }
+
+	my $tar = Dpkg::Source::Archive->new(filename => $origtargz);
+	$tar->extract($origdir);
+    }
+
+    my $ur; # Unrepresentable changes
+    if ($sourcestyle =~ m/[kpursKPUR]/) {
+	my $diffname = "$basenamerev.diff.gz";
+	info(g_('building %s in %s'),
+	     $sourcepackage, $diffname);
+	my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX",
+					DIR => getcwd(), UNLINK => 0);
+        push_exit_handler(sub { unlink($newdiffgz) });
+        my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz,
+                                            compression => 'gzip',
+                                            compression_level => $self->{options}{comp_level});
+        $diff->create();
+        $diff->add_diff_directory($origdir, $dir,
+                basedirname => $basedirname,
+                diff_ignore_regex => $diff_ignore_regex,
+                options => []); # Force empty set of options to drop the
+                                # default -p option
+        $diff->finish() || $ur++;
+        pop_exit_handler();
+
+	my $analysis = $diff->analyze($origdir);
+	my @files = grep { ! m{^debian/} }
+		    map { s{^[^/]+/+}{}r }
+		    sort keys %{$analysis->{filepatched}};
+	if (scalar @files) {
+	    warning(g_('the diff modifies the following upstream files: %s'),
+	            "\n " . join("\n ", @files));
+	    info(g_("use the '3.0 (quilt)' format to have separate and " .
+	            'documented changes to upstream files, see dpkg-source(1)'));
+	    error(g_('aborting due to --abort-on-upstream-changes'))
+		if $self->{options}{abort_on_upstream_changes};
+	}
+
+	rename($newdiffgz, $diffname)
+	    or syserr(g_("unable to rename '%s' (newly created) to '%s'"),
+	              $newdiffgz, $diffname);
+	chmod(0666 &~ umask(), $diffname)
+	    or syserr(g_("unable to change permission of '%s'"), $diffname);
+
+	$self->add_file($diffname);
+    }
+
+    if ($sourcestyle =~ m/[prPR]/) {
+        erasedir($origdir);
+    }
+
+    if ($ur) {
+        errormsg(g_('unrepresentable changes to source'));
+        exit(1);
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm
new file mode 100644
index 0000000..b3c21e5
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V2.pm
@@ -0,0 +1,744 @@
+# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-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/>.
+
+package Dpkg::Source::Package::V2;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use List::Util qw(first);
+use Cwd;
+use File::Basename;
+use File::Temp qw(tempfile tempdir);
+use File::Path qw(make_path);
+use File::Spec;
+use File::Find;
+use File::Copy;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::File;
+use Dpkg::Path qw(find_command);
+use Dpkg::Compression;
+use Dpkg::Source::Archive;
+use Dpkg::Source::Patch;
+use Dpkg::Source::BinaryFiles;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
+use Dpkg::Vendor qw(run_vendor_hook);
+use Dpkg::Control;
+use Dpkg::Changelog::Parse;
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+sub init_options {
+    my $self = shift;
+    $self->SUPER::init_options();
+    $self->{options}{include_removal} //= 0;
+    $self->{options}{include_timestamp} //= 0;
+    $self->{options}{include_binaries} //= 0;
+    $self->{options}{preparation} //= 1;
+    $self->{options}{skip_patches} //= 0;
+    $self->{options}{unapply_patches} //= 'auto';
+    $self->{options}{skip_debianization} //= 0;
+    $self->{options}{create_empty_orig} //= 0;
+    $self->{options}{auto_commit} //= 0;
+    $self->{options}{ignore_bad_version} //= 0;
+}
+
+my @module_cmdline = (
+    {
+        name => '--include-removal',
+        help => N_('include removed files in the patch'),
+        when => 'build',
+    }, {
+        name => '--include-timestamp',
+        help => N_('include timestamp in the patch'),
+        when => 'build',
+    }, {
+        name => '--include-binaries',
+        help => N_('include binary files in the tarball'),
+        when => 'build',
+    }, {
+        name => '--no-preparation',
+        help => N_('do not prepare build tree by applying patches'),
+        when => 'build',
+    }, {
+        name => '--no-unapply-patches',
+        help => N_('do not unapply patches if previously applied'),
+        when => 'build',
+    }, {
+        name => '--unapply-patches',
+        help => N_('unapply patches if previously applied (default)'),
+        when => 'build',
+    }, {
+        name => '--create-empty-orig',
+        help => N_('create an empty original tarball if missing'),
+        when => 'build',
+    }, {
+        name => '--abort-on-upstream-changes',
+        help => N_('abort if generated diff has upstream files changes'),
+        when => 'build',
+    }, {
+        name => '--auto-commit',
+        help => N_('record generated patches, instead of aborting'),
+        when => 'build',
+    }, {
+        name => '--skip-debianization',
+        help => N_('do not extract debian tarball into upstream sources'),
+        when => 'extract',
+    }, {
+        name => '--skip-patches',
+        help => N_('do not apply patches at the end of the extraction'),
+        when => 'extract',
+    }
+);
+
+sub describe_cmdline_options {
+    return @module_cmdline;
+}
+
+sub parse_cmdline_option {
+    my ($self, $opt) = @_;
+    if ($opt eq '--include-removal') {
+        $self->{options}{include_removal} = 1;
+        return 1;
+    } elsif ($opt eq '--include-timestamp') {
+        $self->{options}{include_timestamp} = 1;
+        return 1;
+    } elsif ($opt eq '--include-binaries') {
+        $self->{options}{include_binaries} = 1;
+        return 1;
+    } elsif ($opt eq '--no-preparation') {
+        $self->{options}{preparation} = 0;
+        return 1;
+    } elsif ($opt eq '--skip-patches') {
+        $self->{options}{skip_patches} = 1;
+        return 1;
+    } elsif ($opt eq '--unapply-patches') {
+        $self->{options}{unapply_patches} = 'yes';
+        return 1;
+    } elsif ($opt eq '--no-unapply-patches') {
+        $self->{options}{unapply_patches} = 'no';
+        return 1;
+    } elsif ($opt eq '--skip-debianization') {
+        $self->{options}{skip_debianization} = 1;
+        return 1;
+    } elsif ($opt eq '--create-empty-orig') {
+        $self->{options}{create_empty_orig} = 1;
+        return 1;
+    } elsif ($opt eq '--abort-on-upstream-changes') {
+        $self->{options}{auto_commit} = 0;
+        return 1;
+    } elsif ($opt eq '--auto-commit') {
+        $self->{options}{auto_commit} = 1;
+        return 1;
+    } elsif ($opt eq '--ignore-bad-version') {
+        $self->{options}{ignore_bad_version} = 1;
+        return 1;
+    }
+    return 0;
+}
+
+sub do_extract {
+    my ($self, $newdirectory) = @_;
+    my $fields = $self->{fields};
+
+    my $basename = $self->get_basename();
+    my $basenamerev = $self->get_basename(1);
+
+    my ($tarfile, $debianfile, %addonfile, %seen);
+    my ($tarsign, %addonsign);
+    my $re_ext = compression_get_file_extension_regex();
+    foreach my $file ($self->get_files()) {
+        my $uncompressed = $file;
+        $uncompressed =~ s/\.$re_ext$/.*/;
+        $uncompressed =~ s/\.$re_ext\.asc$/.*.asc/;
+        error(g_('duplicate files in %s source package: %s'), 'v2.0',
+              $uncompressed) if $seen{$uncompressed};
+        $seen{$uncompressed} = 1;
+        if ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext$/) {
+            $tarfile = $file;
+        } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext\.asc$/) {
+            $tarsign = $file;
+        } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext$/) {
+            $addonfile{$1} = $file;
+        } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext\.asc$/) {
+            $addonsign{$1} = $file;
+        } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$re_ext$/) {
+            $debianfile = $file;
+        } else {
+            error(g_('unrecognized file for a %s source package: %s'),
+            'v2.0', $file);
+        }
+    }
+
+    unless ($tarfile and $debianfile) {
+        error(g_('missing orig.tar or debian.tar file in v2.0 source package'));
+    }
+    if ($tarsign and $tarfile ne substr $tarsign, 0, -4) {
+        error(g_('mismatched orig.tar %s for signature %s in source package'),
+              $tarfile, $tarsign);
+    }
+    foreach my $name (keys %addonsign) {
+        error(g_('missing addon orig.tar for signature %s in source package'),
+              $addonsign{$name})
+            if not exists $addonfile{$name};
+        error(g_('mismatched addon orig.tar %s for signature %s in source package'),
+              $addonfile{$name}, $addonsign{$name})
+            if $addonfile{$name} ne substr $addonsign{$name}, 0, -4;
+    }
+
+    if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
+        error(g_('unpack target exists: %s'), $newdirectory);
+    } else {
+        erasedir($newdirectory);
+    }
+
+    # Extract main tarball
+    info(g_('unpacking %s'), $tarfile);
+    my $tar = Dpkg::Source::Archive->new(
+        filename => File::Spec->catfile($self->{basedir}, $tarfile),
+    );
+    $tar->extract($newdirectory,
+                  options => [ '--anchored', '--no-wildcards-match-slash',
+                               '--exclude', '*/.pc', '--exclude', '.pc' ]);
+    # The .pc exclusion is only needed for 3.0 (quilt) and to avoid
+    # having an upstream tarball provide a directory with symlinks
+    # that would be blindly followed when applying the patches
+
+    # Extract additional orig tarballs
+    foreach my $subdir (sort keys %addonfile) {
+        my $file = $addonfile{$subdir};
+        info(g_('unpacking %s'), $file);
+
+        # If the pathname is an empty directory, just silently remove it, as
+        # it might be part of a git repository, as a submodule for example.
+        rmdir "$newdirectory/$subdir";
+        if (-e "$newdirectory/$subdir") {
+            warning(g_("required removal of '%s' installed by original tarball"),
+                    $subdir);
+            erasedir("$newdirectory/$subdir");
+        }
+        $tar = Dpkg::Source::Archive->new(
+            filename => File::Spec->catfile($self->{basedir}, $file),
+        );
+        $tar->extract("$newdirectory/$subdir");
+    }
+
+    # Stop here if debianization is not wanted
+    return if $self->{options}{skip_debianization};
+
+    # Extract debian tarball after removing the debian directory
+    info(g_('unpacking %s'), $debianfile);
+    erasedir("$newdirectory/debian");
+    $tar = Dpkg::Source::Archive->new(
+        filename => File::Spec->catfile($self->{basedir}, $debianfile),
+    );
+    $tar->extract($newdirectory, in_place => 1);
+
+    # Apply patches (in a separate method as it might be overridden)
+    $self->apply_patches($newdirectory, usage => 'unpack')
+        unless $self->{options}{skip_patches};
+}
+
+sub get_autopatch_name {
+    return 'zz_debian-diff-auto';
+}
+
+sub _get_patches {
+    my ($self, $dir, %opts) = @_;
+    $opts{skip_auto} //= 0;
+    my @patches;
+    my $pd = "$dir/debian/patches";
+    my $auto_patch = $self->get_autopatch_name();
+    if (-d $pd) {
+        opendir(my $dir_dh, $pd) or syserr(g_('cannot opendir %s'), $pd);
+        foreach my $patch (sort readdir($dir_dh)) {
+            # patches match same rules as run-parts
+            next unless $patch =~ /^[\w-]+$/ and -f "$pd/$patch";
+            next if $opts{skip_auto} and $patch eq $auto_patch;
+            push @patches, $patch;
+        }
+        closedir($dir_dh);
+    }
+    return @patches;
+}
+
+sub apply_patches {
+    my ($self, $dir, %opts) = @_;
+    $opts{skip_auto} //= 0;
+    my @patches = $self->_get_patches($dir, %opts);
+    return unless scalar(@patches);
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+    open(my $applied_fh, '>', $applied)
+        or syserr(g_('cannot write %s'), $applied);
+    print { $applied_fh } "# During $opts{usage}\n";
+    my $timestamp = fs_time($applied);
+    foreach my $patch ($self->_get_patches($dir, %opts)) {
+        my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch);
+        info(g_('applying %s'), $patch) unless $opts{skip_auto};
+        my $patch_obj = Dpkg::Source::Patch->new(filename => $path);
+        $patch_obj->apply($dir, force_timestamp => 1,
+                          timestamp => $timestamp,
+                          add_options => [ '-E' ]);
+        print { $applied_fh } "$patch\n";
+    }
+    close($applied_fh);
+}
+
+sub unapply_patches {
+    my ($self, $dir, %opts) = @_;
+    my @patches = reverse($self->_get_patches($dir, %opts));
+    return unless scalar(@patches);
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+    my $timestamp = fs_time($applied);
+    foreach my $patch (@patches) {
+        my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch);
+        info(g_('unapplying %s'), $patch) unless $opts{quiet};
+        my $patch_obj = Dpkg::Source::Patch->new(filename => $path);
+        $patch_obj->apply($dir, force_timestamp => 1, verbose => 0,
+                          timestamp => $timestamp,
+                          add_options => [ '-E', '-R' ]);
+    }
+    unlink($applied);
+}
+
+sub _upstream_tarball_template {
+    my $self = shift;
+    my $ext = '{' . join(',',
+        sort map {
+            compression_get_file_extension($_)
+        } compression_get_list()) . '}';
+    return File::Spec->catfile('..', $self->get_basename() . ".orig.tar.$ext");
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+    return 1 if $self->find_original_tarballs(include_supplementary => 0);
+    return 1 if $self->{options}{create_empty_orig} and
+                $self->find_original_tarballs(include_main => 0);
+    return (0, sprintf(g_('no upstream tarball found at %s'),
+                       $self->_upstream_tarball_template()));
+}
+
+sub before_build {
+    my ($self, $dir) = @_;
+    $self->check_patches_applied($dir) if $self->{options}{preparation};
+}
+
+sub after_build {
+    my ($self, $dir) = @_;
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+    my $reason = '';
+    if (-e $applied) {
+        $reason = file_slurp($applied);
+    }
+    my $opt_unapply = $self->{options}{unapply_patches};
+    if (($opt_unapply eq 'auto' and $reason =~ /^# During preparation/) or
+        $opt_unapply eq 'yes') {
+        $self->unapply_patches($dir);
+    }
+}
+
+sub prepare_build {
+    my ($self, $dir) = @_;
+    $self->{diff_options} = {
+        diff_ignore_regex => $self->{options}{diff_ignore_regex} .
+                             '|(^|/)debian/patches/.dpkg-source-applied$',
+        include_removal => $self->{options}{include_removal},
+        include_timestamp => $self->{options}{include_timestamp},
+        use_dev_null => 1,
+    };
+    push @{$self->{options}{tar_ignore}}, 'debian/patches/.dpkg-source-applied';
+    $self->check_patches_applied($dir) if $self->{options}{preparation};
+    if ($self->{options}{create_empty_orig} and
+        not $self->find_original_tarballs(include_supplementary => 0))
+    {
+        # No main orig.tar, create a dummy one
+        my $filename = $self->get_basename() . '.orig.tar.' .
+                       $self->{options}{comp_ext};
+        my $tar = Dpkg::Source::Archive->new(filename => $filename,
+                                             compression_level => $self->{options}{comp_level});
+        $tar->create();
+        $tar->finish();
+    }
+}
+
+sub check_patches_applied {
+    my ($self, $dir) = @_;
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+    unless (-e $applied) {
+        info(g_('patches are not applied, applying them now'));
+        $self->apply_patches($dir, usage => 'preparation');
+    }
+}
+
+sub _generate_patch {
+    my ($self, $dir, %opts) = @_;
+    my ($dirname, $updir) = fileparse($dir);
+    my $basedirname = $self->get_basename();
+    $basedirname =~ s/_/-/;
+
+    # Identify original tarballs
+    my ($tarfile, %addonfile);
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    my @origtarfiles;
+    my @origtarsigns;
+    foreach my $file (sort $self->find_original_tarballs()) {
+        if ($file =~ /\.orig\.tar\.$comp_ext_regex$/) {
+            if (defined($tarfile)) {
+                error(g_('several orig.tar files found (%s and %s) but only ' .
+                         'one is allowed'), $tarfile, $file);
+            }
+            $tarfile = $file;
+        } elsif ($file =~ /\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
+            $addonfile{$1} = $file;
+        } else {
+            next;
+        }
+
+        push @origtarfiles, $file;
+        $self->add_file($file);
+
+        # Check for an upstream signature.
+        if (-e "$file.sig" and not -e "$file.asc") {
+            $self->armor_original_tarball_signature("$file.sig", "$file.asc");
+        }
+        if (-e "$file.asc") {
+            push @origtarfiles, "$file.asc";
+            push @origtarsigns, "$file.asc";
+            $self->add_file("$file.asc")
+        }
+    }
+
+    error(g_('no upstream tarball found at %s'),
+          $self->_upstream_tarball_template()) unless $tarfile;
+
+    if ($opts{usage} eq 'build') {
+        if (@origtarsigns) {
+            $self->check_original_tarball_signature($dir, @origtarsigns);
+        } else {
+            my $key = $self->get_upstream_signing_key($dir);
+            if (-e $key) {
+                warning(g_('upstream signing key but no upstream tarball signature'));
+            }
+        }
+
+        foreach my $origtarfile (@origtarfiles) {
+            info(g_('building %s using existing %s'),
+                 $self->{fields}{'Source'}, $origtarfile);
+        }
+    }
+
+    # Unpack a second copy for comparison
+    my $tmp = tempdir("$dirname.orig.XXXXXX", DIR => $updir);
+    push_exit_handler(sub { erasedir($tmp) });
+
+    # Extract main tarball
+    my $tar = Dpkg::Source::Archive->new(filename => $tarfile);
+    $tar->extract($tmp);
+
+    # Extract additional orig tarballs
+    foreach my $subdir (keys %addonfile) {
+        my $file = $addonfile{$subdir};
+        $tar = Dpkg::Source::Archive->new(filename => $file);
+        $tar->extract("$tmp/$subdir");
+    }
+
+    # Copy over the debian directory
+    erasedir("$tmp/debian");
+    system('cp', '-a', '--', "$dir/debian", "$tmp/");
+    subprocerr(g_('copy of the debian directory')) if $?;
+
+    # Apply all patches except the last automatic one
+    $opts{skip_auto} //= 0;
+    $self->apply_patches($tmp, skip_auto => $opts{skip_auto}, usage => 'build');
+
+    # Create a patch
+    my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . '.diff.XXXXXX',
+                                      TMPDIR => 1, UNLINK => 0);
+    push_exit_handler(sub { unlink($tmpdiff) });
+    my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff,
+                                        compression => 'none');
+    $diff->create();
+    $diff->set_header(sub {
+        if ($opts{header_from} and -e $opts{header_from}) {
+            my $header_from = Dpkg::Source::Patch->new(
+                filename => $opts{header_from});
+            my $analysis = $header_from->analyze($dir, verbose => 0);
+            return $analysis->{patchheader};
+        } else {
+            return $self->_get_patch_header($dir);
+        }
+    });
+    $diff->add_diff_directory($tmp, $dir, basedirname => $basedirname,
+            %{$self->{diff_options}},
+            handle_binary_func => $opts{handle_binary},
+            order_from => $opts{order_from});
+    error(g_('unrepresentable changes to source')) if not $diff->finish();
+
+    if (-s $tmpdiff) {
+        info(g_('local changes detected, the modified files are:'));
+        my $analysis = $diff->analyze($dir, verbose => 0);
+        foreach my $fn (sort keys %{$analysis->{filepatched}}) {
+            print " $fn\n";
+        }
+    }
+
+    # Remove the temporary directory
+    erasedir($tmp);
+    pop_exit_handler();
+    pop_exit_handler();
+
+    return $tmpdiff;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    my @argv = @{$self->{options}{ARGV}};
+    if (scalar(@argv)) {
+        usageerr(g_("-b takes only one parameter with format '%s'"),
+                 $self->{fields}{'Format'});
+    }
+    $self->prepare_build($dir);
+
+    my $include_binaries = $self->{options}{include_binaries};
+    my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}};
+
+    my $sourcepackage = $self->{fields}{'Source'};
+    my $basenamerev = $self->get_basename(1);
+
+    # Check if the debian directory contains unwanted binary files
+    my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir);
+
+    $binaryfiles->detect_binary_files(
+        exclude_globs => $self->{options}{tar_ignore},
+        include_binaries => $include_binaries,
+    );
+
+    # Handle modified binary files detected by the auto-patch generation
+    my $handle_binary = sub {
+        my ($self, $old, $new, %opts) = @_;
+
+        my $file = $opts{filename};
+        $binaryfiles->new_binary_found($file);
+        unless ($include_binaries or $binaryfiles->binary_is_allowed($file)) {
+            errormsg(g_('cannot represent change to %s: %s'), $file,
+                     g_('binary file contents changed'));
+            errormsg(g_('add %s in debian/source/include-binaries if you want ' .
+                        'to store the modified binary in the debian tarball'),
+                     $file);
+            $self->register_error();
+        }
+    };
+
+    # Create a patch
+    my $autopatch = File::Spec->catfile($dir, 'debian', 'patches',
+                                        $self->get_autopatch_name());
+    my $tmpdiff = $self->_generate_patch($dir, order_from => $autopatch,
+                                        header_from => $autopatch,
+                                        handle_binary => $handle_binary,
+                                        skip_auto => $self->{options}{auto_commit},
+                                        usage => 'build');
+    unless (-z $tmpdiff or $self->{options}{auto_commit}) {
+        info(g_('Hint: make sure the version in debian/changelog matches ' .
+                'the unpacked source tree'));
+        info(g_('you can integrate the local changes with %s'),
+             'dpkg-source --commit');
+        error(g_('aborting due to unexpected upstream changes, see %s'),
+              $tmpdiff);
+    }
+    push_exit_handler(sub { unlink($tmpdiff) });
+    $binaryfiles->update_debian_source_include_binaries() if $include_binaries;
+
+    # Install the diff as the new autopatch
+    if ($self->{options}{auto_commit}) {
+        make_path(File::Spec->catdir($dir, 'debian', 'patches'));
+        $autopatch = $self->register_patch($dir, $tmpdiff,
+                                           $self->get_autopatch_name());
+        info(g_('local changes have been recorded in a new patch: %s'),
+             $autopatch) if -e $autopatch;
+        rmdir(File::Spec->catdir($dir, 'debian', 'patches')); # No check on purpose
+    }
+    unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff);
+    pop_exit_handler();
+
+    # Create the debian.tar
+    my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext};
+    info(g_('building %s in %s'), $sourcepackage, $debianfile);
+    my $tar = Dpkg::Source::Archive->new(filename => $debianfile,
+                                         compression_level => $self->{options}{comp_level});
+    $tar->create(options => \@tar_ignore, chdir => $dir);
+    $tar->add_directory('debian');
+    foreach my $binary ($binaryfiles->get_seen_binaries()) {
+        $tar->add_file($binary) unless $binary =~ m{^debian/};
+    }
+    $tar->finish();
+
+    $self->add_file($debianfile);
+}
+
+sub _get_patch_header {
+    my ($self, $dir) = @_;
+
+    my $ph = File::Spec->catfile($dir, 'debian', 'source', 'local-patch-header');
+    unless (-f $ph) {
+        $ph = File::Spec->catfile($dir, 'debian', 'source', 'patch-header');
+    }
+    if (-f $ph) {
+        return file_slurp($ph);
+    }
+
+    if ($self->{options}->{single_debian_patch}) {
+        return <<'AUTOGEN_HEADER';
+This is an autogenerated patch header for a single-debian-patch file. The
+delta against upstream is either kept as a single patch, or maintained
+in some VCS, and exported as a single patch instead of more manageable
+atomic patches.
+
+AUTOGEN_HEADER
+    }
+
+    my $ch_info = changelog_parse(offset => 0, count => 1,
+        file => $self->{options}{changelog_file});
+    return '' if not defined $ch_info;
+    my $header = Dpkg::Control->new(type => CTRL_UNKNOWN);
+    $header->{'Description'} = "<short summary of the patch>\n";
+    $header->{'Description'} .=
+"TODO: Put a short summary on the line above and replace this paragraph
+with a longer explanation of this change. Complete the meta-information
+with other relevant fields (see below for details). To make it easier, the
+information below has been extracted from the changelog. Adjust it or drop
+it.\n";
+    $header->{'Description'} .= $ch_info->{'Changes'} . "\n";
+    $header->{'Author'} = $ch_info->{'Maintainer'};
+    my $yyyy_mm_dd = POSIX::strftime('%Y-%m-%d', gmtime);
+
+    my $text;
+    $text = "$header";
+    run_vendor_hook('extend-patch-header', \$text, $ch_info);
+    $text .= "\n---
+The information above should follow the Patch Tagging Guidelines, please
+checkout https://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: (upstream|backport|vendor|other), (<patch-url>|commit:<commit-id>)
+Bug: <upstream-bugtracker-url>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: (no|not-needed|<patch-forwarded-url>)
+Applied-Upstream: <version>, (<commit-url>|commit:<commid-id>)
+Reviewed-By: <name and email of someone who approved/reviewed the patch>
+Last-Update: $yyyy_mm_dd\n\n";
+    return $text;
+}
+
+sub register_patch {
+    my ($self, $dir, $patch_file, $patch_name) = @_;
+    my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name);
+    if (-s $patch_file) {
+        copy($patch_file, $patch)
+            or syserr(g_('failed to copy %s to %s'), $patch_file, $patch);
+        chmod_if_needed(0666 & ~ umask(), $patch)
+            or syserr(g_("unable to change permission of '%s'"), $patch);
+        my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+        open(my $applied_fh, '>>', $applied)
+            or syserr(g_('cannot write %s'), $applied);
+        print { $applied_fh } "$patch\n";
+        close($applied_fh) or syserr(g_('cannot close %s'), $applied);
+    } elsif (-e $patch) {
+        unlink($patch) or syserr(g_('cannot remove %s'), $patch);
+    }
+    return $patch;
+}
+
+sub _is_bad_patch_name {
+    my ($dir, $patch_name) = @_;
+
+    return 1 if not defined($patch_name);
+    return 1 if not length($patch_name);
+
+    my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name);
+    if (-e $patch) {
+        warning(g_('cannot register changes in %s, this patch already exists'),
+                $patch);
+        return 1;
+    }
+    return 0;
+}
+
+sub do_commit {
+    my ($self, $dir) = @_;
+    my ($patch_name, $tmpdiff) = @{$self->{options}{ARGV}};
+
+    $self->prepare_build($dir);
+
+    # Try to fix up a broken relative filename for the patch
+    if ($tmpdiff and not -e $tmpdiff) {
+        $tmpdiff = File::Spec->catfile($dir, $tmpdiff)
+            unless File::Spec->file_name_is_absolute($tmpdiff);
+        error(g_("patch file '%s' doesn't exist"), $tmpdiff) if not -e $tmpdiff;
+    }
+
+    my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir);
+    my $handle_binary = sub {
+        my ($self, $old, $new, %opts) = @_;
+        my $fn = File::Spec->abs2rel($new, $dir);
+        $binaryfiles->new_binary_found($fn);
+    };
+
+    unless ($tmpdiff) {
+        $tmpdiff = $self->_generate_patch($dir, handle_binary => $handle_binary,
+                                         usage => 'commit');
+        $binaryfiles->update_debian_source_include_binaries();
+    }
+    push_exit_handler(sub { unlink($tmpdiff) });
+    unless (-s $tmpdiff) {
+        unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff);
+        info(g_('there are no local changes to record'));
+        return;
+    }
+    while (_is_bad_patch_name($dir, $patch_name)) {
+        # Ask the patch name interactively
+        print g_('Enter the desired patch name: ');
+        $patch_name = <STDIN>;
+        if (not defined $patch_name) {
+            error(g_('no patch name given; cannot proceed'));
+        }
+        chomp $patch_name;
+        $patch_name =~ s/\s+/-/g;
+        $patch_name =~ s/\///g;
+    }
+    make_path(File::Spec->catdir($dir, 'debian', 'patches'));
+    my $patch = $self->register_patch($dir, $tmpdiff, $patch_name);
+    my @editors = ('sensible-editor', $ENV{VISUAL}, $ENV{EDITOR}, 'vi');
+    my $editor = first { find_command($_) } @editors;
+    if (not $editor) {
+        error(g_('cannot find an editor'));
+    }
+    system($editor, $patch);
+    subprocerr($editor) if $?;
+    unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff);
+    pop_exit_handler();
+    info(g_('local changes have been recorded in a new patch: %s'), $patch);
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V3/Bzr.pm b/scripts/Dpkg/Source/Package/V3/Bzr.pm
new file mode 100644
index 0000000..2f18fee
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Bzr.pm
@@ -0,0 +1,213 @@
+#
+# bzr support for dpkg-source
+#
+# Copyright © 2007 Colin Watson <cjwatson@debian.org>.
+# Based on Dpkg::Source::Package::V3_0::git, which is:
+# Copyright © 2007 Joey Hess <joeyh@debian.org>.
+# Copyright © 2008 Frank Lichtenheld <djpig@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/>.
+
+package Dpkg::Source::Package::V3::Bzr;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Cwd;
+use File::Basename;
+use File::Spec;
+use File::Find;
+use File::Temp qw(tempdir);
+
+use Dpkg::Gettext;
+use Dpkg::Compression;
+use Dpkg::ErrorHandling;
+use Dpkg::Source::Archive;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
+use Dpkg::Path qw(find_command);
+use Dpkg::Source::Functions qw(erasedir);
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+sub prerequisites {
+    return 1 if find_command('bzr');
+    error(g_('cannot unpack bzr-format source package because ' .
+             'bzr is not in the PATH'));
+}
+
+sub _check_workdir {
+    my $srcdir = shift;
+
+    if (! -d "$srcdir/.bzr") {
+        error(g_('source directory is not the top directory of a bzr repository (%s/.bzr not present), but Format bzr was specified'),
+              $srcdir);
+    }
+
+    # Symlinks from .bzr to outside could cause unpack failures, or
+    # point to files they shouldn't, so check for and don't allow.
+    if (-l "$srcdir/.bzr") {
+        error(g_('%s is a symlink'), "$srcdir/.bzr");
+    }
+    my $abs_srcdir = Cwd::abs_path($srcdir);
+    find(sub {
+        if (-l) {
+            if (Cwd::abs_path(readlink) !~ /^\Q$abs_srcdir\E(?:\/|$)/) {
+                error(g_('%s is a symlink to outside %s'),
+                      $File::Find::name, $srcdir);
+            }
+        }
+    }, "$srcdir/.bzr");
+
+    return 1;
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+
+    return (0, g_("doesn't contain a bzr repository")) unless -d "$dir/.bzr";
+    return 1;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    my @argv = @{$self->{options}{ARGV}};
+    # TODO: warn here?
+    #my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}};
+    my $diff_ignore_regex = $self->{options}{diff_ignore_regex};
+
+    $dir =~ s{/+$}{}; # Strip trailing /
+    my ($dirname, $updir) = fileparse($dir);
+
+    if (scalar(@argv)) {
+        usageerr(g_("-b takes only one parameter with format '%s'"),
+                 $self->{fields}{'Format'});
+    }
+
+    my $sourcepackage = $self->{fields}{'Source'};
+    my $basenamerev = $self->get_basename(1);
+    my $basename = $self->get_basename();
+    my $basedirname = $basename;
+    $basedirname =~ s/_/-/;
+
+    _check_workdir($dir);
+
+    my $old_cwd = getcwd();
+    chdir $dir or syserr(g_("unable to chdir to '%s'"), $dir);
+
+    local $_;
+
+    # Check for uncommitted files.
+    # To support dpkg-source -i, remove any ignored files from the
+    # output of bzr status.
+    open(my $bzr_status_fh, '-|', 'bzr', 'status')
+        or subprocerr('bzr status');
+    my @files;
+    while (<$bzr_status_fh>) {
+        chomp;
+        next unless s/^ +//;
+        if (! length $diff_ignore_regex ||
+            ! m/$diff_ignore_regex/o) {
+            push @files, $_;
+        }
+    }
+    close($bzr_status_fh) or syserr(g_('bzr status exited nonzero'));
+    if (@files) {
+        error(g_('uncommitted, not-ignored changes in working directory: %s'),
+              join(' ', @files));
+    }
+
+    chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd);
+
+    my $tmp = tempdir("$dirname.bzr.XXXXXX", DIR => $updir);
+    push_exit_handler(sub { erasedir($tmp) });
+    my $tardir = "$tmp/$dirname";
+
+    system('bzr', 'branch', $dir, $tardir);
+    subprocerr("bzr branch $dir $tardir") if $?;
+
+    # Remove the working tree.
+    system('bzr', 'remove-tree', $tardir);
+    subprocerr("bzr remove-tree $tardir") if $?;
+
+    # Some branch metadata files are unhelpful.
+    unlink("$tardir/.bzr/branch/branch-name",
+           "$tardir/.bzr/branch/parent");
+
+    # Create the tar file
+    my $debianfile = "$basenamerev.bzr.tar." . $self->{options}{comp_ext};
+    info(g_('building %s in %s'),
+         $sourcepackage, $debianfile);
+    my $tar = Dpkg::Source::Archive->new(filename => $debianfile,
+                                         compression => $self->{options}{compression},
+                                         compression_level => $self->{options}{comp_level});
+    $tar->create(chdir => $tmp);
+    $tar->add_directory($dirname);
+    $tar->finish();
+
+    erasedir($tmp);
+    pop_exit_handler();
+
+    $self->add_file($debianfile);
+}
+
+# Called after a tarball is unpacked, to check out the working copy.
+sub do_extract {
+    my ($self, $newdirectory) = @_;
+    my $fields = $self->{fields};
+
+    my $basename = $self->get_basename();
+    my $basenamerev = $self->get_basename(1);
+
+    my @files = $self->get_files();
+    if (@files > 1) {
+        error(g_('format v3.0 (bzr) uses only one source file'));
+    }
+    my $tarfile = $files[0];
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$comp_ext_regex$/) {
+        error(g_('expected %s, got %s'),
+              "$basenamerev.bzr.tar.$comp_ext_regex", $tarfile);
+    }
+
+    if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
+        error(g_('unpack target exists: %s'), $newdirectory);
+    } else {
+        erasedir($newdirectory);
+    }
+
+    # Extract main tarball
+    info(g_('unpacking %s'), $tarfile);
+    my $tar = Dpkg::Source::Archive->new(
+        filename => File::Spec->catfile($self->{basedir}, $tarfile),
+    );
+    $tar->extract($newdirectory);
+
+    _check_workdir($newdirectory);
+
+    my $old_cwd = getcwd();
+    chdir($newdirectory)
+        or syserr(g_("unable to chdir to '%s'"), $newdirectory);
+
+    # Reconstitute the working tree.
+    system('bzr', 'checkout');
+    subprocerr('bzr checkout') if $?;
+
+    chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd);
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V3/Custom.pm b/scripts/Dpkg/Source/Package/V3/Custom.pm
new file mode 100644
index 0000000..63f1769
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Custom.pm
@@ -0,0 +1,74 @@
+# Copyright © 2008 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Source::Package::V3::Custom;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+my @module_cmdline = (
+    {
+        name => '--target-format=<value>',
+        help => N_('define the format of the generated source package'),
+        when => 'build',
+    }
+);
+
+sub describe_cmdline_options {
+    return @module_cmdline;
+}
+
+sub parse_cmdline_option {
+    my ($self, $opt) = @_;
+    if ($opt =~ /^--target-format=(.*)$/) {
+        $self->{options}{target_format} = $1;
+        return 1;
+    }
+    return 0;
+}
+sub do_extract {
+    error(g_("Format '3.0 (custom)' is only used to create source packages"));
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+
+    return (0, g_('no files indicated on command line'))
+        unless scalar(@{$self->{options}{ARGV}});
+    return 1;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    # Update real target format
+    my $format = $self->{options}{target_format};
+    error(g_('--target-format option is missing')) unless $format;
+    $self->{fields}{'Format'} = $format;
+    # Add all files
+    foreach my $file (@{$self->{options}{ARGV}}) {
+        $self->add_file($file);
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V3/Git.pm b/scripts/Dpkg/Source/Package/V3/Git.pm
new file mode 100644
index 0000000..721036a
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Git.pm
@@ -0,0 +1,283 @@
+#
+# git support for dpkg-source
+#
+# Copyright © 2007,2010 Joey Hess <joeyh@debian.org>.
+# Copyright © 2008 Frank Lichtenheld <djpig@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/>.
+
+package Dpkg::Source::Package::V3::Git;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+
+use Cwd qw(abs_path getcwd);
+use File::Basename;
+use File::Spec;
+use File::Temp qw(tempdir);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
+use Dpkg::Path qw(find_command);
+use Dpkg::Source::Functions qw(erasedir);
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+# Remove variables from the environment that might cause git to do
+# something unexpected.
+delete $ENV{GIT_DIR};
+delete $ENV{GIT_INDEX_FILE};
+delete $ENV{GIT_OBJECT_DIRECTORY};
+delete $ENV{GIT_ALTERNATE_OBJECT_DIRECTORIES};
+delete $ENV{GIT_WORK_TREE};
+
+sub prerequisites {
+    return 1 if find_command('git');
+    error(g_('cannot unpack git-format source package because ' .
+             'git is not in the PATH'));
+}
+
+sub _check_workdir {
+    my $srcdir = shift;
+
+    if (! -d "$srcdir/.git") {
+        error(g_('source directory is not the top directory of a git ' .
+                 'repository (%s/.git not present), but Format git was ' .
+                 'specified'), $srcdir);
+    }
+    if (-s "$srcdir/.gitmodules") {
+        error(g_('git repository %s uses submodules; this is not yet supported'),
+              $srcdir);
+    }
+
+    return 1;
+}
+
+sub _parse_vcs_git {
+    my $vcs_git = shift;
+    my ($url, $opt, $branch) = split ' ', $vcs_git;
+
+    if (defined $opt && $opt eq '-b' && defined $branch) {
+        return ($url, $branch);
+    } else {
+        return ($url);
+    }
+}
+
+my @module_cmdline = (
+    {
+        name => '--git-ref=<ref>',
+        help => N_('specify a git <ref> to include in the git bundle'),
+        when => 'build',
+    }, {
+        name => '--git-depth=<number>',
+        help => N_('create a shallow clone with <number> depth'),
+        when => 'build',
+    }
+);
+
+sub describe_cmdline_options {
+    my $self = shift;
+
+    my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline );
+
+    return @cmdline;
+}
+
+sub parse_cmdline_option {
+    my ($self, $opt) = @_;
+    return 1 if $self->SUPER::parse_cmdline_option($opt);
+    if ($opt =~ /^--git-ref=(.*)$/) {
+        push @{$self->{options}{git_ref}}, $1;
+        return 1;
+    } elsif ($opt =~ /^--git-depth=(\d+)$/) {
+        $self->{options}{git_depth} = $1;
+        return 1;
+    }
+    return 0;
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+
+    return (0, g_("doesn't contain a git repository")) unless -d "$dir/.git";
+    return 1;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    my $diff_ignore_regex = $self->{options}{diff_ignore_regex};
+
+    $dir =~ s{/+$}{}; # Strip trailing /
+    my ($dirname, $updir) = fileparse($dir);
+    my $basenamerev = $self->get_basename(1);
+
+    _check_workdir($dir);
+
+    my $old_cwd = getcwd();
+    chdir $dir or syserr(g_("unable to chdir to '%s'"), $dir);
+
+    # Check for uncommitted files.
+    # To support dpkg-source -i, get a list of files
+    # equivalent to the ones git status finds, and remove any
+    # ignored files from it.
+    my @ignores = '--exclude-per-directory=.gitignore';
+    my $core_excludesfile = qx(git config --get core.excludesfile);
+    chomp $core_excludesfile;
+    if (length $core_excludesfile && -e $core_excludesfile) {
+        push @ignores, "--exclude-from=$core_excludesfile";
+    }
+    if (-e '.git/info/exclude') {
+        push @ignores, '--exclude-from=.git/info/exclude';
+    }
+    open(my $git_ls_files_fh, '-|', 'git', 'ls-files', '--modified', '--deleted',
+         '-z', '--others', @ignores) or subprocerr('git ls-files');
+    my @files;
+    {
+      local $_;
+      local $/ = "\0";
+      while (<$git_ls_files_fh>) {
+          chomp;
+          if (! length $diff_ignore_regex ||
+              ! m/$diff_ignore_regex/o) {
+              push @files, $_;
+          }
+      }
+    }
+    close($git_ls_files_fh) or syserr(g_('git ls-files exited nonzero'));
+    if (@files) {
+        error(g_('uncommitted, not-ignored changes in working directory: %s'),
+              join(' ', @files));
+    }
+
+    # If a depth was specified, need to create a shallow clone and
+    # bundle that.
+    my $tmp;
+    my $shallowfile;
+    if ($self->{options}{git_depth}) {
+        chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd);
+        $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir);
+        push_exit_handler(sub { erasedir($tmp) });
+        my $clone_dir = "$tmp/repo.git";
+        # file:// is needed to avoid local cloning, which does not
+        # create a shallow clone.
+        info(g_('creating shallow clone with depth %s'),
+                $self->{options}{git_depth});
+        system('git', 'clone', '--depth=' . $self->{options}{git_depth},
+               '--quiet', '--bare', 'file://' . abs_path($dir), $clone_dir);
+        subprocerr('git clone') if $?;
+        chdir($clone_dir)
+            or syserr(g_("unable to chdir to '%s'"), $clone_dir);
+        $shallowfile = "$basenamerev.gitshallow";
+        system('cp', '-f', 'shallow', "$old_cwd/$shallowfile");
+        subprocerr('cp shallow') if $?;
+    }
+
+    # Create the git bundle.
+    my $bundlefile = "$basenamerev.git";
+    my @bundle_arg = $self->{options}{git_ref} ?
+        (@{$self->{options}{git_ref}}) : '--all';
+    info(g_('bundling: %s'), join(' ', @bundle_arg));
+    system('git', 'bundle', 'create', "$old_cwd/$bundlefile",
+           @bundle_arg,
+           'HEAD', # ensure HEAD is included no matter what
+           '--', # avoids ambiguity error when referring to eg, a debian branch
+    );
+    subprocerr('git bundle') if $?;
+
+    chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd);
+
+    if (defined $tmp) {
+        erasedir($tmp);
+        pop_exit_handler();
+    }
+
+    $self->add_file($bundlefile);
+    if (defined $shallowfile) {
+        $self->add_file($shallowfile);
+    }
+}
+
+sub do_extract {
+    my ($self, $newdirectory) = @_;
+    my $fields = $self->{fields};
+
+    my $basenamerev = $self->get_basename(1);
+
+    my @files = $self->get_files();
+    my ($bundle, $shallow);
+    foreach my $file (@files) {
+        if ($file =~ /^\Q$basenamerev\E\.git$/) {
+            if (! defined $bundle) {
+                $bundle = $file;
+            } else {
+                error(g_('format v3.0 (git) uses only one .git file'));
+            }
+        } elsif ($file =~ /^\Q$basenamerev\E\.gitshallow$/) {
+            if (! defined $shallow) {
+                $shallow = $file;
+            } else {
+                error(g_('format v3.0 (git) uses only one .gitshallow file'));
+            }
+        } else {
+            error(g_('format v3.0 (git) unknown file: %s'), $file);
+        }
+    }
+    if (! defined $bundle) {
+        error(g_('format v3.0 (git) expected %s'), "$basenamerev.git");
+    }
+
+    if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
+        error(g_('unpack target exists: %s'), $newdirectory);
+    } else {
+        erasedir($newdirectory);
+    }
+
+    # Extract git bundle.
+    info(g_('cloning %s'), $bundle);
+    my $bundle_path = File::Spec->catfile($self->{basedir}, $bundle);
+    system('git', 'clone', '--quiet', '--origin=bundle', $bundle_path, $newdirectory);
+    subprocerr('git bundle') if $?;
+
+    if (defined $shallow) {
+        # Move shallow info file into place, so git does not
+        # try to follow parents of shallow refs.
+        info(g_('setting up shallow clone'));
+        my $shallow_orig = File::Spec->catfile($self->{basedir}, $shallow);
+        my $shallow_dest = File::Spec->catfile($newdirectory, '.git', 'shallow');
+        system('cp', '-f',  $shallow_orig, $shallow_dest);
+        subprocerr('cp') if $?;
+    }
+
+    _check_workdir($newdirectory);
+
+    if (defined $fields->{'Vcs-Git'}) {
+        my $remote = 'origin';
+        my ($url, $head) = _parse_vcs_git($fields->{'Vcs-Git'});
+
+        my @git_remote_add = (qw(git -C), $newdirectory, qw(remote add));
+        push @git_remote_add, '-m', $head if defined $head;
+
+        info(g_('setting remote %s to %s'), $remote, $url);
+        system(@git_remote_add, $remote, $url);
+        subprocerr('git remote add') if $?;
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V3/Native.pm b/scripts/Dpkg/Source/Package/V3/Native.pm
new file mode 100644
index 0000000..933315a
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Native.pm
@@ -0,0 +1,121 @@
+# Copyright © 2008 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Source::Package::V3::Native;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Cwd;
+use File::Basename;
+use File::Spec;
+use File::Temp qw(tempfile);
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Compression;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
+use Dpkg::Version;
+use Dpkg::Source::Archive;
+use Dpkg::Source::Functions qw(erasedir);
+
+use parent qw(Dpkg::Source::Package);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+sub do_extract {
+    my ($self, $newdirectory) = @_;
+    my $sourcestyle = $self->{options}{sourcestyle};
+    my $fields = $self->{fields};
+
+    my $basename = $self->get_basename();
+    my $basenamerev = $self->get_basename(1);
+
+    my $tarfile;
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    foreach my $file ($self->get_files()) {
+	if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_ext_regex$/) {
+            error(g_('multiple tarfiles in native source package')) if $tarfile;
+            $tarfile = $file;
+	} else {
+	    error(g_('unrecognized file for a native source package: %s'), $file);
+	}
+    }
+
+    error(g_('no tarfile in Files field')) unless $tarfile;
+
+    if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
+        error(g_('unpack target exists: %s'), $newdirectory);
+    } else {
+        erasedir($newdirectory);
+    }
+
+    info(g_('unpacking %s'), $tarfile);
+    my $tar = Dpkg::Source::Archive->new(
+        filename => File::Spec->catfile($self->{basedir}, $tarfile),
+    );
+    $tar->extract($newdirectory);
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+
+    my $v = Dpkg::Version->new($self->{fields}->{'Version'});
+    return (0, g_('native package version may not have a revision'))
+        unless $v->is_native();
+
+    return 1;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+    my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}};
+    my @argv = @{$self->{options}{ARGV}};
+
+    if (scalar(@argv)) {
+        usageerr(g_("-b takes only one parameter with format '%s'"),
+                 $self->{fields}{'Format'});
+    }
+
+    my $sourcepackage = $self->{fields}{'Source'};
+    my $basenamerev = $self->get_basename(1);
+    my $tarname = "$basenamerev.tar." . $self->{options}{comp_ext};
+
+    info(g_('building %s in %s'), $sourcepackage, $tarname);
+
+    my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
+                                   DIR => getcwd(), UNLINK => 0);
+    push_exit_handler(sub { unlink($newtar) });
+
+    my ($dirname, $dirbase) = fileparse($dir);
+    my $tar = Dpkg::Source::Archive->new(filename => $newtar,
+                compression => compression_guess_from_filename($tarname),
+                compression_level => $self->{options}{comp_level});
+    $tar->create(options => \@tar_ignore, chdir => $dirbase);
+    $tar->add_directory($dirname);
+    $tar->finish();
+    rename($newtar, $tarname)
+        or syserr(g_("unable to rename '%s' (newly created) to '%s'"),
+                  $newtar, $tarname);
+    pop_exit_handler();
+    chmod(0666 &~ umask(), $tarname)
+        or syserr(g_("unable to change permission of '%s'"), $tarname);
+
+    $self->add_file($tarname);
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Package/V3/Quilt.pm b/scripts/Dpkg/Source/Package/V3/Quilt.pm
new file mode 100644
index 0000000..1359168
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Quilt.pm
@@ -0,0 +1,269 @@
+# Copyright © 2008-2012 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Source::Package::V3::Quilt;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use List::Util qw(any);
+use File::Spec;
+use File::Copy;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::File;
+use Dpkg::Version;
+use Dpkg::Source::Patch;
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
+use Dpkg::Source::Quilt;
+use Dpkg::Exit;
+
+# Based on wig&pen implementation
+use parent qw(Dpkg::Source::Package::V2);
+
+our $CURRENT_MINOR_VERSION = '0';
+
+sub init_options {
+    my $self = shift;
+    $self->{options}{single_debian_patch} //= 0;
+    $self->{options}{allow_version_of_quilt_db} //= [];
+
+    $self->SUPER::init_options();
+}
+
+my @module_cmdline = (
+    {
+        name => '--single-debian-patch',
+        help => N_('use a single debianization patch'),
+        when => 'build',
+    }, {
+        name => '--allow-version-of-quilt-db=<version>',
+        help => N_('accept quilt metadata <version> even if unknown'),
+        when => 'build',
+    }
+);
+
+sub describe_cmdline_options {
+    my $self = shift;
+
+    my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline );
+
+    return @cmdline;
+}
+
+sub parse_cmdline_option {
+    my ($self, $opt) = @_;
+    return 1 if $self->SUPER::parse_cmdline_option($opt);
+    if ($opt eq '--single-debian-patch') {
+        $self->{options}{single_debian_patch} = 1;
+        # For backwards compatibility.
+        $self->{options}{auto_commit} = 1;
+        return 1;
+    } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) {
+        push @{$self->{options}{allow_version_of_quilt_db}}, $1;
+        return 1;
+    }
+    return 0;
+}
+
+sub _build_quilt_object {
+    my ($self, $dir) = @_;
+    return $self->{quilt}{$dir} if exists $self->{quilt}{$dir};
+    $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir);
+    return $self->{quilt}{$dir};
+}
+
+sub can_build {
+    my ($self, $dir) = @_;
+    my ($code, $msg) = $self->SUPER::can_build($dir);
+    return ($code, $msg) if $code == 0;
+
+    my $v = Dpkg::Version->new($self->{fields}->{'Version'});
+    return (0, g_('non-native package version does not contain a revision'))
+        if $v->is_native();
+
+    my $quilt = $self->_build_quilt_object($dir);
+    $msg = $quilt->find_problems();
+    return (0, $msg) if $msg;
+    return 1;
+}
+
+sub get_autopatch_name {
+    my $self = shift;
+    if ($self->{options}{single_debian_patch}) {
+        return 'debian-changes';
+    } else {
+        return 'debian-changes-' . $self->{fields}{'Version'};
+    }
+}
+
+sub apply_patches {
+    my ($self, $dir, %opts) = @_;
+
+    if ($opts{usage} eq 'unpack') {
+        $opts{verbose} = 1;
+    } elsif ($opts{usage} eq 'build') {
+        $opts{warn_options} = 1;
+        $opts{verbose} = 0;
+    }
+
+    my $quilt = $self->_build_quilt_object($dir);
+    $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings
+
+    # Always create the quilt db so that if the maintainer calls quilt to
+    # create a patch, it's stored in the right directory
+    $quilt->save_db();
+
+    # Update debian/patches/series symlink if needed to allow quilt usage
+    my $series = $quilt->get_series_file();
+    my $basename = (File::Spec->splitpath($series))[2];
+    if ($basename ne 'series') {
+        my $dest = $quilt->get_patch_file('series');
+        unlink($dest) if -l $dest;
+        unless (-f _) { # Don't overwrite real files
+            symlink($basename, $dest)
+                or syserr(g_("can't create symlink %s"), $dest);
+        }
+    }
+
+    return unless scalar($quilt->series());
+
+    info(g_('using patch list from %s'), "debian/patches/$basename");
+
+    if ($opts{usage} eq 'preparation' and
+        $self->{options}{unapply_patches} eq 'auto') {
+        # We're applying the patches in --before-build, remember to unapply
+        # them afterwards in --after-build
+        my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
+        file_touch($pc_unapply);
+    }
+
+    # Apply patches
+    my $pc_applied = $quilt->get_db_file('applied-patches');
+    $opts{timestamp} = fs_time($pc_applied);
+    if ($opts{skip_auto}) {
+        my $auto_patch = $self->get_autopatch_name();
+        $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch);
+    } else {
+        $quilt->push(%opts) while $quilt->next();
+    }
+}
+
+sub unapply_patches {
+    my ($self, $dir, %opts) = @_;
+
+    my $quilt = $self->_build_quilt_object($dir);
+
+    $opts{verbose} //= 1;
+
+    my $pc_applied = $quilt->get_db_file('applied-patches');
+    my @applied = $quilt->applied();
+    $opts{timestamp} = fs_time($pc_applied) if @applied;
+
+    $quilt->pop(%opts) while $quilt->top();
+
+    erasedir($quilt->get_db_dir());
+}
+
+sub prepare_build {
+    my ($self, $dir) = @_;
+    $self->SUPER::prepare_build($dir);
+    # Skip .pc directories of quilt by default and ignore difference
+    # on debian/patches/series symlinks and d/p/.dpkg-source-applied
+    # stamp file created by ourselves
+    my $func = sub {
+        my $pathname = shift;
+
+        return 1 if $pathname eq 'debian/patches/series' and -l $pathname;
+        return 1 if $pathname =~ /^\.pc(\/|$)/;
+        return 1 if $pathname =~ /$self->{options}{diff_ignore_regex}/;
+        return 0;
+    };
+    $self->{diff_options}{diff_ignore_func} = $func;
+}
+
+sub do_build {
+    my ($self, $dir) = @_;
+
+    my $quilt = $self->_build_quilt_object($dir);
+    my $version = $quilt->get_db_version();
+
+    if (defined($version) and $version != 2) {
+        if (any { $version eq $_ }
+            @{$self->{options}{allow_version_of_quilt_db}})
+        {
+            warning(g_('unsupported version of the quilt metadata: %s'), $version);
+        } else {
+            error(g_('unsupported version of the quilt metadata: %s'), $version);
+        }
+    }
+
+    $self->SUPER::do_build($dir);
+}
+
+sub after_build {
+    my ($self, $dir) = @_;
+    my $quilt = $self->_build_quilt_object($dir);
+    my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
+    my $opt_unapply = $self->{options}{unapply_patches};
+    if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') {
+        unlink($pc_unapply);
+        $self->unapply_patches($dir);
+    }
+}
+
+sub check_patches_applied {
+    my ($self, $dir) = @_;
+
+    my $quilt = $self->_build_quilt_object($dir);
+    my $next = $quilt->next();
+    return if not defined $next;
+
+    my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next);
+    my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch);
+    return unless $patch_obj->check_apply($dir, fatal_dupes => 1);
+
+    $self->apply_patches($dir, usage => 'preparation', verbose => 1);
+}
+
+sub register_patch {
+    my ($self, $dir, $tmpdiff, $patch_name) = @_;
+
+    my $quilt = $self->_build_quilt_object($dir);
+    my $patch = $quilt->get_patch_file($patch_name);
+
+    if (-s $tmpdiff) {
+        copy($tmpdiff, $patch)
+            or syserr(g_('failed to copy %s to %s'), $tmpdiff, $patch);
+        chmod_if_needed(0666 & ~ umask(), $patch)
+            or syserr(g_("unable to change permission of '%s'"), $patch);
+    } elsif (-e $patch) {
+        unlink($patch) or syserr(g_('cannot remove %s'), $patch);
+    }
+
+    if (-e $patch) {
+        # Add patch to series file
+        $quilt->register($patch_name);
+    } else {
+        # Remove auto_patch from series
+        $quilt->unregister($patch_name);
+    }
+    return $patch;
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm
new file mode 100644
index 0000000..e670898
--- /dev/null
+++ b/scripts/Dpkg/Source/Patch.pm
@@ -0,0 +1,697 @@
+# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2010, 2012-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/>.
+
+package Dpkg::Source::Patch;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use POSIX qw(:errno_h :sys_wait_h);
+use File::Find;
+use File::Basename;
+use File::Spec;
+use File::Path qw(make_path);
+use File::Compare;
+use Fcntl ':mode';
+use Time::HiRes qw(stat);
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::IPC;
+use Dpkg::Source::Functions qw(fs_time);
+
+use parent qw(Dpkg::Compression::FileHandle);
+
+sub create {
+    my ($self, %opts) = @_;
+    $self->ensure_open('w'); # Creates the file
+    *$self->{errors} = 0;
+    *$self->{empty} = 1;
+    if ($opts{old} and $opts{new} and $opts{filename}) {
+        $opts{old} = '/dev/null' unless -e $opts{old};
+        $opts{new} = '/dev/null' unless -e $opts{new};
+        if (-d $opts{old} and -d $opts{new}) {
+            $self->add_diff_directory($opts{old}, $opts{new}, %opts);
+        } elsif (-f $opts{old} and -f $opts{new}) {
+            $self->add_diff_file($opts{old}, $opts{new}, %opts);
+        } else {
+            $self->_fail_not_same_type($opts{old}, $opts{new}, $opts{filename});
+        }
+        $self->finish() unless $opts{nofinish};
+    }
+}
+
+sub set_header {
+    my ($self, $header) = @_;
+    *$self->{header} = $header;
+}
+
+sub get_header {
+    my $self = shift;
+
+    if (ref *$self->{header} eq 'CODE') {
+        return *$self->{header}->();
+    } else {
+        return *$self->{header};
+    }
+}
+
+sub add_diff_file {
+    my ($self, $old, $new, %opts) = @_;
+    $opts{include_timestamp} //= 0;
+    my $handle_binary = $opts{handle_binary_func} // sub {
+        my ($self, $old, $new, %opts) = @_;
+        my $file = $opts{filename};
+        $self->_fail_with_msg($file, g_('binary file contents changed'));
+    };
+    # Optimization to avoid forking diff if unnecessary
+    return 1 if compare($old, $new, 4096) == 0;
+    # Default diff options
+    my @options;
+    if ($opts{options}) {
+        push @options, @{$opts{options}};
+    } else {
+        push @options, '-p';
+    }
+    # Add labels
+    if ($opts{label_old} and $opts{label_new}) {
+	if ($opts{include_timestamp}) {
+	    my $ts = (stat($old))[9];
+	    my $t = POSIX::strftime('%Y-%m-%d %H:%M:%S', gmtime($ts));
+	    $opts{label_old} .= sprintf("\t%s.%09d +0000", $t,
+	                                ($ts - int($ts)) * 1_000_000_000);
+	    $ts = (stat($new))[9];
+	    $t = POSIX::strftime('%Y-%m-%d %H:%M:%S', gmtime($ts));
+	    $opts{label_new} .= sprintf("\t%s.%09d +0000", $t,
+	                                ($ts - int($ts)) * 1_000_000_000);
+	} else {
+	    # Space in filenames need special treatment
+	    $opts{label_old} .= "\t" if $opts{label_old} =~ / /;
+	    $opts{label_new} .= "\t" if $opts{label_new} =~ / /;
+	}
+        push @options, '-L', $opts{label_old},
+                       '-L', $opts{label_new};
+    }
+    # Generate diff
+    my $diffgen;
+    my $diff_pid = spawn(
+        exec => [ 'diff', '-u', @options, '--', $old, $new ],
+        env => { LC_ALL => 'C', LANG => 'C', TZ => 'UTC0' },
+        to_pipe => \$diffgen,
+    );
+    # Check diff and write it in patch file
+    my $difflinefound = 0;
+    my $binary = 0;
+    local $_;
+
+    while (<$diffgen>) {
+        if (m/^(?:binary|[^-+\@ ].*\bdiffer\b)/i) {
+            $binary = 1;
+            $handle_binary->($self, $old, $new, %opts);
+            last;
+        } elsif (m/^[-+\@ ]/) {
+            $difflinefound++;
+        } elsif (m/^\\ /) {
+            warning(g_('file %s has no final newline (either ' .
+                       'original or modified version)'), $new);
+        } else {
+            chomp;
+            error(g_("unknown line from diff -u on %s: '%s'"), $new, $_);
+        }
+	if (*$self->{empty} and defined(*$self->{header})) {
+	    $self->print($self->get_header()) or syserr(g_('failed to write'));
+	    *$self->{empty} = 0;
+	}
+        print { $self } $_ or syserr(g_('failed to write'));
+    }
+    close($diffgen) or syserr('close on diff pipe');
+    wait_child($diff_pid, nocheck => 1,
+               cmdline => "diff -u @options -- $old $new");
+    # Verify diff process ended successfully
+    # Exit code of diff: 0 => no difference, 1 => diff ok, 2 => error
+    # Ignore error if binary content detected
+    my $exit = WEXITSTATUS($?);
+    unless (WIFEXITED($?) && ($exit == 0 || $exit == 1 || $binary)) {
+        subprocerr(g_('diff on %s'), $new);
+    }
+    return ($exit == 0 || $exit == 1);
+}
+
+sub add_diff_directory {
+    my ($self, $old, $new, %opts) = @_;
+    # TODO: make this function more configurable
+    # - offer to disable some checks
+    my $basedir = $opts{basedirname} || basename($new);
+    my $diff_ignore;
+    if ($opts{diff_ignore_func}) {
+        $diff_ignore = $opts{diff_ignore_func};
+    } elsif ($opts{diff_ignore_regex}) {
+        $diff_ignore = sub { return $_[0] =~ /$opts{diff_ignore_regex}/o };
+    } else {
+        $diff_ignore = sub { return 0 };
+    }
+
+    my @diff_files;
+    my %files_in_new;
+    my $scan_new = sub {
+        my $fn = (length > length($new)) ? substr($_, length($new) + 1) : '.';
+        return if $diff_ignore->($fn);
+        $files_in_new{$fn} = 1;
+        lstat("$new/$fn") or syserr(g_('cannot stat file %s'), "$new/$fn");
+        my $mode = S_IMODE((lstat(_))[2]);
+        my $size = (lstat(_))[7];
+        if (-l _) {
+            unless (-l "$old/$fn") {
+                $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+                return;
+            }
+            my $n = readlink("$new/$fn");
+            unless (defined $n) {
+                syserr(g_('cannot read link %s'), "$new/$fn");
+            }
+            my $n2 = readlink("$old/$fn");
+            unless (defined $n2) {
+                syserr(g_('cannot read link %s'), "$old/$fn");
+            }
+            unless ($n eq $n2) {
+                $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+            }
+        } elsif (-f _) {
+            my $old_file = "$old/$fn";
+            if (not lstat("$old/$fn")) {
+                if ($! != ENOENT) {
+                    syserr(g_('cannot stat file %s'), "$old/$fn");
+                }
+                $old_file = '/dev/null';
+            } elsif (not -f _) {
+                $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+                return;
+            }
+
+            my $label_old = "$basedir.orig/$fn";
+            if ($opts{use_dev_null}) {
+                $label_old = $old_file if $old_file eq '/dev/null';
+            }
+            push @diff_files, [$fn, $mode, $size, $old_file, "$new/$fn",
+                               $label_old, "$basedir/$fn"];
+        } elsif (-p _) {
+            unless (-p "$old/$fn") {
+                $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+            }
+        } elsif (-b _ || -c _ || -S _) {
+            $self->_fail_with_msg("$new/$fn",
+                g_('device or socket is not allowed'));
+        } elsif (-d _) {
+            if (not lstat("$old/$fn")) {
+                if ($! != ENOENT) {
+                    syserr(g_('cannot stat file %s'), "$old/$fn");
+                }
+            } elsif (not -d _) {
+                $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+            }
+        } else {
+            $self->_fail_with_msg("$new/$fn", g_('unknown file type'));
+        }
+    };
+    my $scan_old = sub {
+        my $fn = (length > length($old)) ? substr($_, length($old) + 1) : '.';
+        return if $diff_ignore->($fn);
+        return if $files_in_new{$fn};
+        lstat("$old/$fn") or syserr(g_('cannot stat file %s'), "$old/$fn");
+        if (-f _) {
+            if (not defined $opts{include_removal}) {
+                warning(g_('ignoring deletion of file %s'), $fn);
+            } elsif (not $opts{include_removal}) {
+                warning(g_('ignoring deletion of file %s, use --include-removal to override'), $fn);
+            } else {
+                push @diff_files, [$fn, 0, 0, "$old/$fn", '/dev/null',
+                                   "$basedir.orig/$fn", '/dev/null'];
+            }
+        } elsif (-d _) {
+            warning(g_('ignoring deletion of directory %s'), $fn);
+        } elsif (-l _) {
+            warning(g_('ignoring deletion of symlink %s'), $fn);
+        } else {
+            $self->_fail_not_same_type("$old/$fn", "$new/$fn", $fn);
+        }
+    };
+
+    find({ wanted => $scan_new, no_chdir => 1 }, $new);
+    find({ wanted => $scan_old, no_chdir => 1 }, $old);
+
+    if ($opts{order_from} and -e $opts{order_from}) {
+        my $order_from = Dpkg::Source::Patch->new(
+            filename => $opts{order_from});
+        my $analysis = $order_from->analyze($basedir, verbose => 0);
+        my %patchorder;
+        my $i = 0;
+        foreach my $fn (@{$analysis->{patchorder}}) {
+            $fn =~ s{^[^/]+/}{};
+            $patchorder{$fn} = $i++;
+        }
+        # 'quilt refresh' sorts files as follows:
+        #   - Any files in the existing patch come first, in the order in
+        #     which they appear in the existing patch.
+        #   - New files follow, sorted lexicographically.
+        # This seems a reasonable policy to follow, and avoids autopatches
+        # being shuffled when they are regenerated.
+        foreach my $diff_file (sort { $a->[0] cmp $b->[0] } @diff_files) {
+            my $fn = $diff_file->[0];
+            $patchorder{$fn} //= $i++;
+        }
+        @diff_files = sort { $patchorder{$a->[0]} <=> $patchorder{$b->[0]} }
+                      @diff_files;
+    } else {
+        @diff_files = sort { $a->[0] cmp $b->[0] } @diff_files;
+    }
+
+    foreach my $diff_file (@diff_files) {
+        my ($fn, $mode, $size,
+            $old_file, $new_file, $label_old, $label_new) = @$diff_file;
+        my $success = $self->add_diff_file($old_file, $new_file,
+                                           filename => $fn,
+                                           label_old => $label_old,
+                                           label_new => $label_new, %opts);
+        if ($success and
+            $old_file eq '/dev/null' and $new_file ne '/dev/null') {
+            if (not $size) {
+                warning(g_("newly created empty file '%s' will not " .
+                           'be represented in diff'), $fn);
+            } else {
+                if ($mode & (S_IXUSR | S_IXGRP | S_IXOTH)) {
+                    warning(g_("executable mode %04o of '%s' will " .
+                               'not be represented in diff'), $mode, $fn)
+                        unless $fn eq 'debian/rules';
+                }
+                if ($mode & (S_ISUID | S_ISGID | S_ISVTX)) {
+                    warning(g_("special mode %04o of '%s' will not " .
+                               'be represented in diff'), $mode, $fn);
+                }
+            }
+        }
+    }
+}
+
+sub finish {
+    my $self = shift;
+    close($self) or syserr(g_('cannot close %s'), $self->get_filename());
+    return not *$self->{errors};
+}
+
+sub register_error {
+    my $self = shift;
+    *$self->{errors}++;
+}
+sub _fail_with_msg {
+    my ($self, $file, $msg) = @_;
+    errormsg(g_('cannot represent change to %s: %s'), $file, $msg);
+    $self->register_error();
+}
+sub _fail_not_same_type {
+    my ($self, $old, $new, $file) = @_;
+    my $old_type = get_type($old);
+    my $new_type = get_type($new);
+    errormsg(g_('cannot represent change to %s:'), $file);
+    errormsg(g_('  new version is %s'), $new_type);
+    errormsg(g_('  old version is %s'), $old_type);
+    $self->register_error();
+}
+
+sub _getline {
+    my $handle = shift;
+
+    my $line = <$handle>;
+    if (defined $line) {
+        # Strip end-of-line chars
+        chomp($line);
+        $line =~ s/\r$//;
+    }
+    return $line;
+}
+
+# Fetch the header filename ignoring the optional timestamp
+sub _fetch_filename {
+    my ($diff, $header) = @_;
+
+    # Strip any leading spaces.
+    $header =~ s/^\s+//;
+
+    # Is it a C-style string?
+    if ($header =~ m/^"/) {
+        error(g_('diff %s patches file with C-style encoded filename'), $diff);
+    } else {
+        # Tab is the official separator, it's always used when
+        # filename contain spaces. Try it first, otherwise strip on space
+        # if there's no tab
+        $header =~ s/\s.*// unless $header =~ s/\t.*//;
+    }
+
+    return $header;
+}
+
+sub _intuit_file_patched {
+    my ($old, $new) = @_;
+
+    return $new unless defined $old;
+    return $old unless defined $new;
+    return $new if -e $new and not -e $old;
+    return $old if -e $old and not -e $new;
+
+    # We don't consider the case where both files are non-existent and
+    # where patch picks the one with the fewest directories to create
+    # since dpkg-source will pre-create the required directories
+
+    # Precalculate metrics used by patch
+    my ($tmp_o, $tmp_n) = ($old, $new);
+    my ($len_o, $len_n) = (length($old), length($new));
+    $tmp_o =~ s{[/\\]+}{/}g;
+    $tmp_n =~ s{[/\\]+}{/}g;
+    my $nb_comp_o = ($tmp_o =~ tr{/}{/});
+    my $nb_comp_n = ($tmp_n =~ tr{/}{/});
+    $tmp_o =~ s{^.*/}{};
+    $tmp_n =~ s{^.*/}{};
+    my ($blen_o, $blen_n) = (length($tmp_o), length($tmp_n));
+
+    # Decide like patch would
+    if ($nb_comp_o != $nb_comp_n) {
+        return ($nb_comp_o < $nb_comp_n) ? $old : $new;
+    } elsif ($blen_o != $blen_n) {
+        return ($blen_o < $blen_n) ? $old : $new;
+    } elsif ($len_o != $len_n) {
+        return ($len_o < $len_n) ? $old : $new;
+    }
+    return $old;
+}
+
+# check diff for sanity, find directories to create as a side effect
+sub analyze {
+    my ($self, $destdir, %opts) = @_;
+
+    $opts{verbose} //= 1;
+    my $diff = $self->get_filename();
+    my %filepatched;
+    my %dirtocreate;
+    my @patchorder;
+    my $patch_header = '';
+    my $diff_count = 0;
+
+    my $line = _getline($self);
+
+  HUNK:
+    while (defined $line or not eof $self) {
+	my (%path, %fn);
+
+	# Skip comments leading up to the patch (if any). Although we do not
+	# look for an Index: pseudo-header in the comments, because we would
+	# not use it anyway, as we require both ---/+++ filename headers.
+	while (1) {
+	    if ($line =~ /^(?:--- |\+\+\+ |@@ -)/) {
+		last;
+	    } else {
+		$patch_header .= "$line\n";
+	    }
+	    $line = _getline($self);
+	    last HUNK if not defined $line;
+	}
+	$diff_count++;
+	# read file header (---/+++ pair)
+	unless ($line =~ s/^--- //) {
+	    error(g_("expected ^--- in line %d of diff '%s'"), $., $diff);
+	}
+	$path{old} = $line = _fetch_filename($diff, $line);
+	if ($line ne '/dev/null' and $line =~ s{^[^/]*/+}{$destdir/}) {
+	    $fn{old} = $line;
+	}
+	if ($line =~ /\.dpkg-orig$/) {
+	    error(g_("diff '%s' patches file with name ending in .dpkg-orig"),
+	          $diff);
+	}
+
+	$line = _getline($self);
+	unless (defined $line) {
+	    error(g_("diff '%s' finishes in middle of ---/+++ (line %d)"),
+	          $diff, $.);
+	}
+	unless ($line =~ s/^\+\+\+ //) {
+	    error(g_("line after --- isn't as expected in diff '%s' (line %d)"),
+	          $diff, $.);
+	}
+	$path{new} = $line = _fetch_filename($diff, $line);
+	if ($line ne '/dev/null' and $line =~ s{^[^/]*/+}{$destdir/}) {
+	    $fn{new} = $line;
+	}
+
+	unless (defined $fn{old} or defined $fn{new}) {
+	    error(g_("none of the filenames in ---/+++ are valid in diff '%s' (line %d)"),
+		  $diff, $.);
+	}
+
+	# Safety checks on both filenames that patch could use
+	foreach my $key ('old', 'new') {
+	    next unless defined $fn{$key};
+	    if ($path{$key} =~ m{/\.\./}) {
+		error(g_('%s contains an insecure path: %s'), $diff, $path{$key});
+	    }
+	    my $path = $fn{$key};
+	    while (1) {
+		if (-l $path) {
+		    error(g_('diff %s modifies file %s through a symlink: %s'),
+			  $diff, $fn{$key}, $path);
+		}
+		last unless $path =~ s{/+[^/]*$}{};
+		last if length($path) <= length($destdir); # $destdir is assumed safe
+	    }
+	}
+
+        if ($path{old} eq '/dev/null' and $path{new} eq '/dev/null') {
+            error(g_("original and modified files are /dev/null in diff '%s' (line %d)"),
+                  $diff, $.);
+        } elsif ($path{new} eq '/dev/null') {
+            error(g_("file removal without proper filename in diff '%s' (line %d)"),
+                  $diff, $. - 1) unless defined $fn{old};
+            if ($opts{verbose}) {
+                warning(g_('diff %s removes a non-existing file %s (line %d)'),
+                        $diff, $fn{old}, $.) unless -e $fn{old};
+            }
+        }
+	my $fn = _intuit_file_patched($fn{old}, $fn{new});
+
+	my $dirname = $fn;
+	if ($dirname =~ s{/[^/]+$}{} and not -d $dirname) {
+	    $dirtocreate{$dirname} = 1;
+	}
+
+	if (-e $fn and not -f _) {
+	    error(g_("diff '%s' patches something which is not a plain file"),
+	          $diff);
+	}
+
+	if ($filepatched{$fn}) {
+            $filepatched{$fn}++;
+
+            if ($opts{fatal_dupes}) {
+                error(g_("diff '%s' patches files multiple times; split the " .
+                         'diff in multiple files or merge the hunks into a ' .
+                         'single one'), $diff);
+            } elsif ($opts{verbose} and $filepatched{$fn} == 2) {
+                warning(g_("diff '%s' patches file %s more than once"), $diff, $fn)
+            }
+	} else {
+	    $filepatched{$fn} = 1;
+	    push @patchorder, $fn;
+	}
+
+	# read hunks
+	my $hunk = 0;
+	while (defined($line = _getline($self))) {
+	    # read hunk header (@@)
+	    next if $line =~ /^\\ /;
+	    last unless $line =~ /^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@(?: .*)?$/;
+	    my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1);
+	    # read hunk
+	    while ($olines || $nlines) {
+		unless (defined($line = _getline($self))) {
+                    if (($olines == $nlines) and ($olines < 3)) {
+                        warning(g_("unexpected end of diff '%s'"), $diff)
+                            if $opts{verbose};
+                        last;
+                    } else {
+                        error(g_("unexpected end of diff '%s'"), $diff);
+                    }
+		}
+		next if $line =~ /^\\ /;
+		# Check stats
+		if ($line =~ /^ / or length $line == 0) {
+		    --$olines;
+		    --$nlines;
+		} elsif ($line =~ /^-/) {
+		    --$olines;
+		} elsif ($line =~ /^\+/) {
+		    --$nlines;
+		} else {
+		    error(g_("expected [ +-] at start of line %d of diff '%s'"),
+		          $., $diff);
+		}
+	    }
+	    $hunk++;
+	}
+	unless ($hunk) {
+	    error(g_("expected ^\@\@ at line %d of diff '%s'"), $., $diff);
+	}
+    }
+    close($self);
+    unless ($diff_count) {
+	warning(g_("diff '%s' doesn't contain any patch"), $diff)
+	    if $opts{verbose};
+    }
+    *$self->{analysis}{$destdir}{dirtocreate} = \%dirtocreate;
+    *$self->{analysis}{$destdir}{filepatched} = \%filepatched;
+    *$self->{analysis}{$destdir}{patchorder} = \@patchorder;
+    *$self->{analysis}{$destdir}{patchheader} = $patch_header;
+    return *$self->{analysis}{$destdir};
+}
+
+sub prepare_apply {
+    my ($self, $analysis, %opts) = @_;
+    if ($opts{create_dirs}) {
+	foreach my $dir (keys %{$analysis->{dirtocreate}}) {
+	    eval { make_path($dir, { mode => 0777 }) };
+	    syserr(g_('cannot create directory %s'), $dir) if $@;
+	}
+    }
+}
+
+sub apply {
+    my ($self, $destdir, %opts) = @_;
+    # Set default values to options
+    $opts{force_timestamp} //= 1;
+    $opts{remove_backup} //= 1;
+    $opts{create_dirs} //= 1;
+    $opts{options} ||= [
+        '-t',
+        '-F', '0',
+        '-N',
+        '-p1',
+        '-u',
+        '-V', 'never',
+        '-b',
+        '-z', '.dpkg-orig',
+    ];
+    $opts{add_options} //= [];
+    push @{$opts{options}}, @{$opts{add_options}};
+    # Check the diff and create missing directories
+    my $analysis = $self->analyze($destdir, %opts);
+    $self->prepare_apply($analysis, %opts);
+    # Apply the patch
+    $self->ensure_open('r');
+    my ($stdout, $stderr) = ('', '');
+    spawn(
+	exec => [ $Dpkg::PROGPATCH, @{$opts{options}} ],
+	chdir => $destdir,
+	env => { LC_ALL => 'C', LANG => 'C', PATCH_GET => '0' },
+	delete_env => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour
+	wait_child => 1,
+	nocheck => 1,
+	from_handle => $self->get_filehandle(),
+	to_string => \$stdout,
+	error_to_string => \$stderr,
+    );
+    if ($?) {
+	print { *STDOUT } $stdout;
+	print { *STDERR } $stderr;
+	subprocerr("LC_ALL=C $Dpkg::PROGPATCH " . join(' ', @{$opts{options}}) .
+	           ' < ' . $self->get_filename());
+    }
+    $self->close();
+    # Reset the timestamp of all the patched files
+    # and remove .dpkg-orig files
+    my @files = keys %{$analysis->{filepatched}};
+    my $now = $opts{timestamp};
+    $now //= fs_time($files[0]) if $opts{force_timestamp} && scalar @files;
+    foreach my $fn (@files) {
+	if ($opts{force_timestamp}) {
+	    utime($now, $now, $fn) or $! == ENOENT
+		or syserr(g_('cannot change timestamp for %s'), $fn);
+	}
+	if ($opts{remove_backup}) {
+	    $fn .= '.dpkg-orig';
+	    unlink($fn) or syserr(g_('remove patch backup file %s'), $fn);
+	}
+    }
+    return $analysis;
+}
+
+# Verify if check will work...
+sub check_apply {
+    my ($self, $destdir, %opts) = @_;
+    # Set default values to options
+    $opts{create_dirs} //= 1;
+    $opts{options} ||= [
+        '--dry-run',
+        '-s',
+        '-t',
+        '-F', '0',
+        '-N',
+        '-p1',
+        '-u',
+        '-V', 'never',
+        '-b',
+        '-z', '.dpkg-orig',
+    ];
+    $opts{add_options} //= [];
+    push @{$opts{options}}, @{$opts{add_options}};
+    # Check the diff and create missing directories
+    my $analysis = $self->analyze($destdir, %opts);
+    $self->prepare_apply($analysis, %opts);
+    # Apply the patch
+    $self->ensure_open('r');
+    my $patch_pid = spawn(
+	exec => [ $Dpkg::PROGPATCH, @{$opts{options}} ],
+	chdir => $destdir,
+	env => { LC_ALL => 'C', LANG => 'C', PATCH_GET => '0' },
+	delete_env => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour
+	from_handle => $self->get_filehandle(),
+	to_file => '/dev/null',
+	error_to_file => '/dev/null',
+    );
+    wait_child($patch_pid, nocheck => 1);
+    my $exit = WEXITSTATUS($?);
+    subprocerr("$Dpkg::PROGPATCH --dry-run") unless WIFEXITED($?);
+    $self->close();
+    return ($exit == 0);
+}
+
+# Helper functions
+sub get_type {
+    my $file = shift;
+    if (not lstat($file)) {
+        return g_('nonexistent') if $! == ENOENT;
+        syserr(g_('cannot stat %s'), $file);
+    } else {
+        -f _ && return g_('plain file');
+        -d _ && return g_('directory');
+        -l _ && return sprintf(g_('symlink to %s'), readlink($file));
+        -b _ && return g_('block device');
+        -c _ && return g_('character device');
+        -p _ && return g_('named pipe');
+        -S _ && return g_('named socket');
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/Source/Quilt.pm b/scripts/Dpkg/Source/Quilt.pm
new file mode 100644
index 0000000..3e655fa
--- /dev/null
+++ b/scripts/Dpkg/Source/Quilt.pm
@@ -0,0 +1,383 @@
+# Copyright © 2008-2012 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Source::Quilt;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+
+use List::Util qw(any none);
+use File::Spec;
+use File::Copy;
+use File::Find;
+use File::Path qw(make_path);
+use File::Basename;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::File;
+use Dpkg::Source::Patch;
+use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
+use Dpkg::Vendor qw(get_current_vendor);
+
+sub new {
+    my ($this, $dir, %opts) = @_;
+    my $class = ref($this) || $this;
+
+    my $self = {
+        dir => $dir,
+    };
+    bless $self, $class;
+
+    $self->load_series();
+    $self->load_db();
+
+    return $self;
+}
+
+sub setup_db {
+    my $self = shift;
+    my $db_dir = $self->get_db_file();
+    if (not -d $db_dir) {
+        mkdir $db_dir or syserr(g_('cannot mkdir %s'), $db_dir);
+    }
+    my $file = $self->get_db_file('.version');
+    if (not -e $file) {
+        file_dump($file, "2\n");
+    }
+    # The files below are used by quilt to know where patches are stored
+    # and what file contains the patch list (supported by quilt >= 0.48-5
+    # in Debian).
+    $file = $self->get_db_file('.quilt_patches');
+    if (not -e $file) {
+        file_dump($file, "debian/patches\n");
+    }
+    $file = $self->get_db_file('.quilt_series');
+    if (not -e $file) {
+        my $series = $self->get_series_file();
+        $series = (File::Spec->splitpath($series))[2];
+        file_dump($file, "$series\n");
+    }
+}
+
+sub load_db {
+    my $self = shift;
+
+    my $pc_applied = $self->get_db_file('applied-patches');
+    $self->{applied_patches} = [ $self->read_patch_list($pc_applied) ];
+}
+
+sub save_db {
+    my $self = shift;
+
+    $self->setup_db();
+    my $pc_applied = $self->get_db_file('applied-patches');
+    $self->write_patch_list($pc_applied, $self->{applied_patches});
+}
+
+sub load_series {
+    my ($self, %opts) = @_;
+
+    my $series = $self->get_series_file();
+    $self->{series} = [ $self->read_patch_list($series, %opts) ];
+}
+
+sub series {
+    my $self = shift;
+    return @{$self->{series}};
+}
+
+sub applied {
+    my $self = shift;
+    return @{$self->{applied_patches}};
+}
+
+sub top {
+    my $self = shift;
+    my $count = scalar @{$self->{applied_patches}};
+    return $self->{applied_patches}[$count - 1] if $count;
+    return;
+}
+
+sub register {
+    my ($self, $patch_name) = @_;
+
+    return if any { $_ eq $patch_name } @{$self->{series}};
+
+    # Add patch to series files.
+    $self->setup_db();
+    $self->_file_add_line($self->get_series_file(), $patch_name);
+    $self->_file_add_line($self->get_db_file('applied-patches'), $patch_name);
+    $self->load_db();
+    $self->load_series();
+
+    # Ensure quilt meta-data is created and in sync with some trickery:
+    # Reverse-apply the patch, drop .pc/$patch, and re-apply it with the
+    # correct options to recreate the backup files.
+    $self->pop(reverse_apply => 1);
+    $self->push();
+}
+
+sub unregister {
+    my ($self, $patch_name) = @_;
+
+    return if none { $_ eq $patch_name } @{$self->{series}};
+
+    my $series = $self->get_series_file();
+
+    $self->_file_drop_line($series, $patch_name);
+    $self->_file_drop_line($self->get_db_file('applied-patches'), $patch_name);
+    erasedir($self->get_db_file($patch_name));
+    $self->load_db();
+    $self->load_series();
+
+    # Clean up empty series.
+    unlink $series if -z $series;
+}
+
+sub next {
+    my $self = shift;
+    my $count_applied = scalar @{$self->{applied_patches}};
+    my $count_series = scalar @{$self->{series}};
+    return $self->{series}[$count_applied] if ($count_series > $count_applied);
+    return;
+}
+
+sub push {
+    my ($self, %opts) = @_;
+    $opts{verbose} //= 0;
+    $opts{timestamp} //= fs_time($self->{dir});
+
+    my $patch = $self->next();
+    return unless defined $patch;
+
+    my $path = $self->get_patch_file($patch);
+    my $obj = Dpkg::Source::Patch->new(filename => $path);
+
+    info(g_('applying %s'), $patch) if $opts{verbose};
+    eval {
+        $obj->apply($self->{dir}, timestamp => $opts{timestamp},
+                    verbose => $opts{verbose},
+                    force_timestamp => 1, create_dirs => 1, remove_backup => 0,
+                    options => [ '-t', '-F', '0', '-N', '-p1', '-u',
+                                 '-V', 'never', '-E', '-b',
+                                 '-B', ".pc/$patch/", '--reject-file=-' ]);
+    };
+    if ($@) {
+        info(g_('the patch has fuzz which is not allowed, or is malformed'));
+        info(g_("if patch '%s' is correctly applied by quilt, use '%s' to update it"),
+             $patch, 'quilt refresh');
+        info(g_('if the file is present in the unpacked source, make sure it ' .
+                'is also present in the orig tarball'));
+        $self->restore_quilt_backup_files($patch, %opts);
+        erasedir($self->get_db_file($patch));
+        die $@;
+    }
+    CORE::push @{$self->{applied_patches}}, $patch;
+    $self->save_db();
+}
+
+sub pop {
+    my ($self, %opts) = @_;
+    $opts{verbose} //= 0;
+    $opts{timestamp} //= fs_time($self->{dir});
+    $opts{reverse_apply} //= 0;
+
+    my $patch = $self->top();
+    return unless defined $patch;
+
+    info(g_('unapplying %s'), $patch) if $opts{verbose};
+    my $backup_dir = $self->get_db_file($patch);
+    if (-d $backup_dir and not $opts{reverse_apply}) {
+        # Use the backup copies to restore
+        $self->restore_quilt_backup_files($patch);
+    } else {
+        # Otherwise reverse-apply the patch
+        my $path = $self->get_patch_file($patch);
+        my $obj = Dpkg::Source::Patch->new(filename => $path);
+
+        $obj->apply($self->{dir}, timestamp => $opts{timestamp},
+                    verbose => 0, force_timestamp => 1, remove_backup => 0,
+                    options => [ '-R', '-t', '-N', '-p1',
+                                 '-u', '-V', 'never', '-E',
+                                 '--no-backup-if-mismatch' ]);
+    }
+
+    erasedir($backup_dir);
+    pop @{$self->{applied_patches}};
+    $self->save_db();
+}
+
+sub get_db_version {
+    my $self = shift;
+    my $pc_ver = $self->get_db_file('.version');
+    if (-f $pc_ver) {
+        my $version = file_slurp($pc_ver);
+        chomp $version;
+        return $version;
+    }
+    return;
+}
+
+sub find_problems {
+    my $self = shift;
+    my $patch_dir = $self->get_patch_file();
+    if (-e $patch_dir and not -d _) {
+        return sprintf(g_('%s should be a directory or non-existing'), $patch_dir);
+    }
+    my $series = $self->get_series_file();
+    if (-e $series and not -f _) {
+        return sprintf(g_('%s should be a file or non-existing'), $series);
+    }
+    return;
+}
+
+sub get_series_file {
+    my $self = shift;
+    my $vendor = lc(get_current_vendor() || 'debian');
+    # Series files are stored alongside patches
+    my $default_series = $self->get_patch_file('series');
+    my $vendor_series = $self->get_patch_file("$vendor.series");
+    return $vendor_series if -e $vendor_series;
+    return $default_series;
+}
+
+sub get_db_file {
+    my $self = shift;
+    return File::Spec->catfile($self->{dir}, '.pc', @_);
+}
+
+sub get_db_dir {
+    my $self = shift;
+    return $self->get_db_file();
+}
+
+sub get_patch_file {
+    my $self = shift;
+    return File::Spec->catfile($self->{dir}, 'debian', 'patches', @_);
+}
+
+sub get_patch_dir {
+    my $self = shift;
+    return $self->get_patch_file();
+}
+
+## METHODS BELOW ARE INTERNAL ##
+
+sub _file_load {
+    my ($self, $file) = @_;
+
+    open my $file_fh, '<', $file or syserr(g_('cannot read %s'), $file);
+    my @lines = <$file_fh>;
+    close $file_fh;
+
+    return @lines;
+}
+
+sub _file_add_line {
+    my ($self, $file, $line) = @_;
+
+    my @lines;
+    @lines = $self->_file_load($file) if -f $file;
+    CORE::push @lines, $line;
+    chomp @lines;
+
+    open my $file_fh, '>', $file or syserr(g_('cannot write %s'), $file);
+    print { $file_fh } "$_\n" foreach @lines;
+    close $file_fh;
+}
+
+sub _file_drop_line {
+    my ($self, $file, $re) = @_;
+
+    my @lines = $self->_file_load($file);
+    open my $file_fh, '>', $file or syserr(g_('cannot write %s'), $file);
+    print { $file_fh } $_ foreach grep { not /^\Q$re\E\s*$/ } @lines;
+    close $file_fh;
+}
+
+sub read_patch_list {
+    my ($self, $file, %opts) = @_;
+    return () if not defined $file or not -f $file;
+    $opts{warn_options} //= 0;
+    my @patches;
+    open(my $series_fh, '<' , $file) or syserr(g_('cannot read %s'), $file);
+    while (defined(my $line = <$series_fh>)) {
+        chomp $line;
+        # Strip leading/trailing spaces
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        # Strip comment
+        $line =~ s/(?:^|\s+)#.*$//;
+        next unless $line;
+        if ($line =~ /^(\S+)\s+(.*)$/) {
+            $line = $1;
+            if ($2 ne '-p1') {
+                warning(g_('the series file (%s) contains unsupported ' .
+                           "options ('%s', line %s); dpkg-source might " .
+                           'fail when applying patches'),
+                        $file, $2, $.) if $opts{warn_options};
+            }
+        }
+        if ($line =~ m{(^|/)\.\./}) {
+            error(g_('%s contains an insecure path: %s'), $file, $line);
+        }
+        CORE::push @patches, $line;
+    }
+    close($series_fh);
+    return @patches;
+}
+
+sub write_patch_list {
+    my ($self, $series, $patches) = @_;
+
+    open my $series_fh, '>', $series or syserr(g_('cannot write %s'), $series);
+    foreach my $patch (@{$patches}) {
+        print { $series_fh } "$patch\n";
+    }
+    close $series_fh;
+}
+
+sub restore_quilt_backup_files {
+    my ($self, $patch, %opts) = @_;
+    my $patch_dir = $self->get_db_file($patch);
+    return unless -d $patch_dir;
+    info(g_('restoring quilt backup files for %s'), $patch) if $opts{verbose};
+    find({
+        no_chdir => 1,
+        wanted => sub {
+            return if -d;
+            my $relpath_in_srcpkg = File::Spec->abs2rel($_, $patch_dir);
+            my $target = File::Spec->catfile($self->{dir}, $relpath_in_srcpkg);
+            if (-s) {
+                unlink($target);
+                make_path(dirname($target));
+                unless (link($_, $target)) {
+                    copy($_, $target)
+                        or syserr(g_('failed to copy %s to %s'), $_, $target);
+                    chmod_if_needed((stat _)[2], $target)
+                        or syserr(g_("unable to change permission of '%s'"), $target);
+                }
+            } else {
+                # empty files are "backups" for new files that patch created
+                unlink($target);
+            }
+        }
+    }, $patch_dir);
+}
+
+1;
diff --git a/scripts/Dpkg/Substvars.pm b/scripts/Dpkg/Substvars.pm
new file mode 100644
index 0000000..d2abc3f
--- /dev/null
+++ b/scripts/Dpkg/Substvars.pm
@@ -0,0 +1,501 @@
+# Copyright © 2006-2009, 2012-2020, 2022 Guillem Jover <guillem@debian.org>
+# Copyright © 2007-2010 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Substvars;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.01';
+
+use Dpkg ();
+use Dpkg::Arch qw(get_host_arch);
+use Dpkg::Vendor qw(get_current_vendor);
+use Dpkg::Version;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+use parent qw(Dpkg::Interface::Storable);
+
+my $maxsubsts = 50;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Substvars - handle variable substitution in strings
+
+=head1 DESCRIPTION
+
+It provides a class which is able to substitute variables in strings.
+
+=cut
+
+use constant {
+    SUBSTVAR_ATTR_USED => 1,
+    SUBSTVAR_ATTR_AUTO => 2,
+    SUBSTVAR_ATTR_AGED => 4,
+    SUBSTVAR_ATTR_OPT  => 8,
+};
+
+=head1 METHODS
+
+=over 8
+
+=item $s = Dpkg::Substvars->new($file)
+
+Create a new object that can do substitutions. By default it contains
+generic substitutions like ${Newline}, ${Space}, ${Tab}, ${dpkg:Version}
+and ${dpkg:Upstream-Version}.
+
+Additional substitutions will be read from the $file passed as parameter.
+
+It keeps track of which substitutions were actually used (only counting
+substvars(), not get()), and warns about unused substvars when asked to. The
+substitutions that are always present are not included in these warnings.
+
+=cut
+
+sub new {
+    my ($this, $arg) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+        vars => {
+            'Newline' => "\n",
+            'Space' => ' ',
+            'Tab' => "\t",
+            'dpkg:Version' => $Dpkg::PROGVERSION,
+            'dpkg:Upstream-Version' => $Dpkg::PROGVERSION,
+            },
+        attr => {},
+	msg_prefix => '',
+    };
+    $self->{vars}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
+    bless $self, $class;
+
+    my $attr = SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO;
+    $self->{attr}{$_} = $attr foreach keys %{$self->{vars}};
+    if ($arg) {
+        $self->load($arg) if -e $arg;
+    }
+    return $self;
+}
+
+=item $s->set($key, $value)
+
+Add/replace a substitution.
+
+=cut
+
+sub set {
+    my ($self, $key, $value, $attr) = @_;
+
+    $attr //= 0;
+
+    $self->{vars}{$key} = $value;
+    $self->{attr}{$key} = $attr;
+}
+
+=item $s->set_as_used($key, $value)
+
+Add/replace a substitution and mark it as used (no warnings will be produced
+even if unused).
+
+=cut
+
+sub set_as_used {
+    my ($self, $key, $value) = @_;
+
+    $self->set($key, $value, SUBSTVAR_ATTR_USED);
+}
+
+=item $s->set_as_auto($key, $value)
+
+Add/replace a substitution and mark it as used and automatic (no warnings
+will be produced even if unused).
+
+=cut
+
+sub set_as_auto {
+    my ($self, $key, $value) = @_;
+
+    $self->set($key, $value, SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO);
+}
+
+=item $s->get($key)
+
+Get the value of a given substitution.
+
+=cut
+
+sub get {
+    my ($self, $key) = @_;
+    return $self->{vars}{$key};
+}
+
+=item $s->delete($key)
+
+Remove a given substitution.
+
+=cut
+
+sub delete {
+    my ($self, $key) = @_;
+    delete $self->{attr}{$key};
+    return delete $self->{vars}{$key};
+}
+
+=item $s->mark_as_used($key)
+
+Prevents warnings about a unused substitution, for example if it is provided by
+default.
+
+=cut
+
+sub mark_as_used {
+    my ($self, $key) = @_;
+    $self->{attr}{$key} |= SUBSTVAR_ATTR_USED;
+}
+
+=item $s->parse($fh, $desc)
+
+Add new substitutions read from the filehandle. $desc is used to identify
+the filehandle in error messages.
+
+Returns the number of substitutions that have been parsed with success.
+
+=cut
+
+sub parse {
+    my ($self, $fh, $varlistfile) = @_;
+    my $count = 0;
+    local $_;
+
+    binmode($fh);
+    while (<$fh>) {
+        my $attr;
+
+	next if m/^\s*\#/ || !m/\S/;
+	s/\s*\n$//;
+	if (! m/^(\w[-:0-9A-Za-z]*)(\?)?\=(.*)$/) {
+	    error(g_('bad line in substvars file %s at line %d'),
+		  $varlistfile, $.);
+	}
+        if (defined $2) {
+            $attr = (SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_OPT) if $2 eq '?';
+        }
+        $self->set($1, $3, $attr);
+        $count++;
+    }
+
+    return $count
+}
+
+=item $s->load($file)
+
+Add new substitutions read from $file.
+
+=item $s->set_version_substvars($sourceversion, $binaryversion)
+
+Defines ${binary:Version}, ${source:Version} and
+${source:Upstream-Version} based on the given version strings.
+
+These will never be warned about when unused.
+
+=cut
+
+sub set_version_substvars {
+    my ($self, $sourceversion, $binaryversion) = @_;
+
+    # Handle old function signature taking only one argument.
+    $binaryversion //= $sourceversion;
+
+    # For backwards compatibility on binNMUs that do not use the Binary-Only
+    # field on the changelog, always fix up the source version.
+    $sourceversion =~ s/\+b[0-9]+$//;
+
+    my $vs = Dpkg::Version->new($sourceversion, check => 1);
+    if (not defined $vs) {
+        error(g_('invalid source version %s'), $sourceversion);
+    }
+    my $upstreamversion = $vs->as_string(omit_revision => 1);
+
+    my $attr = SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO;
+
+    $self->set('binary:Version', $binaryversion, $attr);
+    $self->set('source:Version', $sourceversion, $attr);
+    $self->set('source:Upstream-Version', $upstreamversion, $attr);
+
+    # XXX: Source-Version is now obsolete, remove in 1.19.x.
+    $self->set('Source-Version', $binaryversion, $attr | SUBSTVAR_ATTR_AGED);
+}
+
+=item $s->set_arch_substvars()
+
+Defines architecture variables: ${Arch}.
+
+This will never be warned about when unused.
+
+=cut
+
+sub set_arch_substvars {
+    my $self = shift;
+
+    my $attr = SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO;
+
+    $self->set('Arch', get_host_arch(), $attr);
+}
+
+=item $s->set_vendor_substvars()
+
+Defines vendor variables: ${vendor:Name} and ${vendor:Id}.
+
+These will never be warned about when unused.
+
+=cut
+
+sub set_vendor_substvars {
+    my ($self, $desc) = @_;
+
+    my $attr = SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO;
+
+    my $vendor = get_current_vendor();
+    $self->set('vendor:Name', $vendor, $attr);
+    $self->set('vendor:Id', lc $vendor, $attr);
+}
+
+=item $s->set_desc_substvars()
+
+Defines source description variables: ${source:Synopsis} and
+${source:Extended-Description}.
+
+These will never be warned about when unused.
+
+=cut
+
+sub set_desc_substvars {
+    my ($self, $desc) = @_;
+
+    my ($synopsis, $extended) = split /\n/, $desc, 2;
+
+    my $attr = SUBSTVAR_ATTR_USED | SUBSTVAR_ATTR_AUTO;
+
+    $self->set('source:Synopsis', $synopsis, $attr);
+    $self->set('source:Extended-Description', $extended, $attr);
+}
+
+=item $s->set_field_substvars($ctrl, $prefix)
+
+Defines field variables from a Dpkg::Control object, with each variable
+having the form "${$prefix:$field}".
+
+They will never be warned about when unused.
+
+=cut
+
+sub set_field_substvars {
+    my ($self, $ctrl, $prefix) = @_;
+
+    foreach my $field (keys %{$ctrl}) {
+        $self->set_as_auto("$prefix:$field", $ctrl->{$field});
+    }
+}
+
+=item $newstring = $s->substvars($string)
+
+Substitutes variables in $string and return the result in $newstring.
+
+=cut
+
+sub substvars {
+    my ($self, $v, %opts) = @_;
+    my $lhs;
+    my $vn;
+    my $rhs = '';
+    my $count = 0;
+    $opts{msg_prefix} //= $self->{msg_prefix};
+    $opts{no_warn} //= 0;
+
+    while ($v =~ m/^(.*?)\$\{([-:0-9a-z]+)\}(.*)$/si) {
+        # If we have consumed more from the leftover data, then
+        # reset the recursive counter.
+        $count = 0 if (length($3) < length($rhs));
+
+        if ($count >= $maxsubsts) {
+            error($opts{msg_prefix} .
+                  g_("too many substitutions - recursive ? - in '%s'"), $v);
+        }
+        $lhs = $1;
+        $vn = $2;
+        $rhs = $3;
+        if (defined($self->{vars}{$vn})) {
+            $v = $lhs . $self->{vars}{$vn} . $rhs;
+            $self->mark_as_used($vn);
+            $count++;
+
+            if ($self->{attr}{$vn} & SUBSTVAR_ATTR_AGED) {
+                error($opts{msg_prefix} .
+                      g_('obsolete substitution variable ${%s}'), $vn);
+            }
+        } else {
+            warning($opts{msg_prefix} .
+                    g_('substitution variable ${%s} used, but is not defined'),
+	            $vn) unless $opts{no_warn};
+            $v = $lhs . $rhs;
+        }
+    }
+    return $v;
+}
+
+=item $s->warn_about_unused()
+
+Issues warning about any variables that were set, but not used.
+
+=cut
+
+sub warn_about_unused {
+    my ($self, %opts) = @_;
+    $opts{msg_prefix} //= $self->{msg_prefix};
+
+    foreach my $vn (sort keys %{$self->{vars}}) {
+        next if $self->{attr}{$vn} & SUBSTVAR_ATTR_USED;
+        # Empty substitutions variables are ignored on the basis
+        # that they are not required in the current situation
+        # (example: debhelper's misc:Depends in many cases)
+        next if $self->{vars}{$vn} eq '';
+        warning($opts{msg_prefix} .
+                g_('substitution variable ${%s} unused, but is defined'),
+                $vn);
+    }
+}
+
+=item $s->set_msg_prefix($prefix)
+
+Define a prefix displayed before all warnings/error messages output
+by the module.
+
+=cut
+
+sub set_msg_prefix {
+    my ($self, $prefix) = @_;
+    $self->{msg_prefix} = $prefix;
+}
+
+=item $s->filter(remove => $rmfunc)
+
+=item $s->filter(keep => $keepfun)
+
+Filter the substitution variables, either removing or keeping all those
+that return true when $rmfunc->($key) or $keepfunc->($key) is called.
+
+=cut
+
+sub filter {
+    my ($self, %opts) = @_;
+
+    my $remove = $opts{remove} // sub { 0 };
+    my $keep = $opts{keep} // sub { 1 };
+
+    foreach my $vn (keys %{$self->{vars}}) {
+        $self->delete($vn) if $remove->($vn) or not $keep->($vn);
+    }
+}
+
+=item "$s"
+
+Return a string representation of all substitutions variables except the
+automatic ones.
+
+=item $str = $s->output([$fh])
+
+Return all substitutions variables except the automatic ones. If $fh
+is passed print them into the filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    # Store all non-automatic substitutions only
+    foreach my $vn (sort keys %{$self->{vars}}) {
+	next if $self->{attr}{$vn} & SUBSTVAR_ATTR_AUTO;
+        my $op = $self->{attr}{$vn} & SUBSTVAR_ATTR_OPT ? '?=' : '=';
+        my $line = "$vn$op" . $self->{vars}{$vn} . "\n";
+	print { $fh } $line if defined $fh;
+	$str .= $line;
+    }
+    return $str;
+}
+
+=item $s->save($file)
+
+Store all substitutions variables except the automatic ones in the
+indicated file.
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 2.01 (dpkg 1.21.8)
+
+New feature: Add support for optional substitution variables.
+
+=head2 Version 2.00 (dpkg 1.20.0)
+
+Remove method: $s->no_warn().
+
+New method: $s->set_vendor_substvars().
+
+=head2 Version 1.06 (dpkg 1.19.0)
+
+New method: $s->set_desc_substvars().
+
+=head2 Version 1.05 (dpkg 1.18.11)
+
+Obsolete substvar: Emit an error on Source-Version substvar usage.
+
+New return: $s->parse() now returns the number of parsed substvars.
+
+New method: $s->set_field_substvars().
+
+=head2 Version 1.04 (dpkg 1.18.0)
+
+New method: $s->filter().
+
+=head2 Version 1.03 (dpkg 1.17.11)
+
+New method: $s->set_as_auto().
+
+=head2 Version 1.02 (dpkg 1.16.5)
+
+New argument: Accept a $binaryversion in $s->set_version_substvars(),
+passing a single argument is still supported.
+
+New method: $s->mark_as_used().
+
+Deprecated method: $s->no_warn(), use $s->mark_as_used() instead.
+
+=head2 Version 1.01 (dpkg 1.16.4)
+
+New method: $s->set_as_used().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Vars.pm b/scripts/Dpkg/Vars.pm
new file mode 100644
index 0000000..2253e39
--- /dev/null
+++ b/scripts/Dpkg/Vars.pm
@@ -0,0 +1,53 @@
+# Copyright © 2007-2009,2012-2013 Guillem Jover <guillem@debian.org>
+# Copyright © 2007 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Vars;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.03';
+our @EXPORT = qw(
+    get_source_package
+    set_source_package
+);
+
+use Exporter qw(import);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Package;
+
+my $sourcepackage;
+
+sub get_source_package {
+    return $sourcepackage;
+}
+
+sub set_source_package {
+    my $v = shift;
+    my $err = pkg_name_is_illegal($v);
+    error(g_("source package name '%s' is illegal: %s"), $v, $err) if $err;
+
+    if (not defined($sourcepackage)) {
+        $sourcepackage = $v;
+    } elsif ($v ne $sourcepackage) {
+        error(g_('source package has two conflicting values - %s and %s'),
+              $sourcepackage, $v);
+    }
+}
+
+1;
diff --git a/scripts/Dpkg/Vendor.pm b/scripts/Dpkg/Vendor.pm
new file mode 100644
index 0000000..059e442
--- /dev/null
+++ b/scripts/Dpkg/Vendor.pm
@@ -0,0 +1,289 @@
+# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009, 2012-2017, 2022 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/>.
+
+package Dpkg::Vendor;
+
+use strict;
+use warnings;
+use feature qw(state);
+
+our $VERSION = '1.02';
+our @EXPORT_OK = qw(
+    get_current_vendor
+    get_vendor_info
+    get_vendor_file
+    get_vendor_dir
+    get_vendor_object
+    run_vendor_hook
+);
+
+use Exporter qw(import);
+use List::Util qw(uniq);
+
+use Dpkg ();
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::BuildEnv;
+use Dpkg::Control::HashCore;
+
+my $origins = "$Dpkg::CONFDIR/origins";
+$origins = $ENV{DPKG_ORIGINS_DIR} if $ENV{DPKG_ORIGINS_DIR};
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Vendor - get access to some vendor specific information
+
+=head1 DESCRIPTION
+
+The files in $Dpkg::CONFDIR/origins/ can provide information about various
+vendors who are providing Debian packages. Currently those files look like
+this:
+
+  Vendor: Debian
+  Vendor-URL: https://www.debian.org/
+  Bugs: debbugs://bugs.debian.org
+
+If the vendor derives from another vendor, the file should document
+the relationship by listing the base distribution in the Parent field:
+
+  Parent: Debian
+
+The file should be named according to the vendor name. The usual convention
+is to name the vendor file using the vendor name in all lowercase, but some
+variation is permitted. Namely, spaces are mapped to dashes ('-'), and the
+file can have the same casing as the Vendor field, or it can be capitalized.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $dir = get_vendor_dir()
+
+Returns the current dpkg origins directory name, where the vendor files
+are stored.
+
+=cut
+
+sub get_vendor_dir {
+    return $origins;
+}
+
+=item $fields = get_vendor_info($name)
+
+Returns a Dpkg::Control object with the information parsed from the
+corresponding vendor file in $Dpkg::CONFDIR/origins/. If $name is omitted,
+it will use $Dpkg::CONFDIR/origins/default which is supposed to be a symlink
+to the vendor of the currently installed operating system. Returns undef
+if there's no file for the given vendor.
+
+=cut
+
+my $vendor_sep_regex = qr{[^A-Za-z0-9]+};
+
+sub get_vendor_info(;$) {
+    my $vendor = shift || 'default';
+    my $vendor_key = lc $vendor =~ s{$vendor_sep_regex}{}gr;
+    state %VENDOR_CACHE;
+    return $VENDOR_CACHE{$vendor_key} if exists $VENDOR_CACHE{$vendor_key};
+
+    my $file = get_vendor_file($vendor);
+    return unless $file;
+    my $fields = Dpkg::Control::HashCore->new();
+    $fields->load($file, compression => 0) or error(g_('%s is empty'), $file);
+    $VENDOR_CACHE{$vendor_key} = $fields;
+    return $fields;
+}
+
+=item $name = get_vendor_file($name)
+
+Check if there's a file for the given vendor and returns its
+name.
+
+The vendor filename will be derived from the vendor name, by replacing any
+number of non-alphanumeric characters (that is B<[^A-Za-z0-9]>) into "B<->",
+then the resulting name will be tried in sequence by lower-casing it,
+keeping it as is, lower-casing then capitalizing it, and capitalizing it.
+
+In addition, for historical and backwards compatibility, the name will
+be tried keeping it as is without non-alphanumeric characters remapping,
+then the resulting name will be tried in sequence by lower-casing it,
+keeping it as is, lower-casing then capitalizing it, and capitalizing it.
+And finally the name will be tried by replacing only spaces to "B<->",
+then the resulting name will be tried in sequence by lower-casing it,
+keeping it as is, lower-casing then capitalizing it, and capitalizing it.
+
+But these backwards compatible name lookups will be removed during
+the dpkg 1.22.x release cycle.
+
+=cut
+
+sub get_vendor_file(;$) {
+    my $vendor = shift || 'default';
+
+    my @names;
+    my $vendor_sep = $vendor =~ s{$vendor_sep_regex}{-}gr;
+    push @names, lc $vendor_sep, $vendor_sep, ucfirst lc $vendor_sep, ucfirst $vendor_sep;
+
+    # XXX: Backwards compatibility, remove on 1.22.x.
+    my %name_seen = map { $_ => 1 } @names;
+    my @obsolete_names = uniq grep {
+        my $seen = exists $name_seen{$_};
+        $name_seen{$_} = 1;
+        not $seen;
+    } (
+        (lc $vendor, $vendor, ucfirst lc $vendor, ucfirst $vendor),
+        ($vendor =~ s{\s+}{-}g) ?
+        (lc $vendor, $vendor, ucfirst lc $vendor, ucfirst $vendor) : ()
+    );
+    my %obsolete_name = map { $_ => 1 } @obsolete_names;
+    push @names, @obsolete_names;
+
+    foreach my $name (uniq @names) {
+        next unless -e "$origins/$name";
+        if (exists $obsolete_name{$name}) {
+            warning(g_('%s origin filename is deprecated; ' .
+                       'it should have only alphanumeric or dash characters'),
+                    $name);
+        }
+        return "$origins/$name";
+    }
+    return;
+}
+
+=item $name = get_current_vendor()
+
+Returns the name of the current vendor. If DEB_VENDOR is set, it uses
+that first, otherwise it falls back to parsing $Dpkg::CONFDIR/origins/default.
+If that file doesn't exist, it returns undef.
+
+=cut
+
+sub get_current_vendor() {
+    my $f;
+    if (Dpkg::BuildEnv::has('DEB_VENDOR')) {
+        $f = get_vendor_info(Dpkg::BuildEnv::get('DEB_VENDOR'));
+        return $f->{'Vendor'} if defined $f;
+    }
+    $f = get_vendor_info();
+    return $f->{'Vendor'} if defined $f;
+    return;
+}
+
+=item $object = get_vendor_object($name)
+
+Return the Dpkg::Vendor::* object of the corresponding vendor.
+If $name is omitted, return the object of the current vendor.
+If no vendor can be identified, then return the Dpkg::Vendor::Default
+object.
+
+The module name will be derived from the vendor name, by splitting parts
+around groups of non alphanumeric character (that is B<[^A-Za-z0-9]>)
+separators, by either capitalizing or lower-casing and capitalizing each part
+and then joining them without the separators. So the expected casing is based
+on the one from the B<Vendor> field in the F<origins> file.
+
+In addition, for historical and backwards compatibility, the module name
+will also be looked up without non-alphanumeric character stripping, by
+capitalizing, lower-casing then capitalizing, as-is or lower-casing.
+But these name lookups will be removed during the 1.22.x release cycle.
+
+=cut
+
+sub get_vendor_object {
+    my $vendor = shift || get_current_vendor() || 'Default';
+    my $vendor_key = lc $vendor =~ s{$vendor_sep_regex}{}gr;
+    state %OBJECT_CACHE;
+    return $OBJECT_CACHE{$vendor_key} if exists $OBJECT_CACHE{$vendor_key};
+
+    my ($obj, @names);
+
+    my @vendor_parts = split m{$vendor_sep_regex}, $vendor;
+    push @names, join q{}, map { ucfirst } @vendor_parts;
+    push @names, join q{}, map { ucfirst lc } @vendor_parts;
+
+    # XXX: Backwards compatibility, remove on 1.22.x.
+    my %name_seen = map { $_ => 1 } @names;
+    my @obsolete_names = uniq grep {
+        my $seen = exists $name_seen{$_};
+        $name_seen{$_} = 1;
+        not $seen;
+    } (ucfirst $vendor, ucfirst lc $vendor, $vendor, lc $vendor);
+    my %obsolete_name = map { $_ => 1 } @obsolete_names;
+    push @names, @obsolete_names;
+
+    foreach my $name (uniq @names) {
+        eval qq{
+            pop \@INC if \$INC[-1] eq '.';
+            require Dpkg::Vendor::$name;
+            \$obj = Dpkg::Vendor::$name->new();
+        };
+        unless ($@) {
+            $OBJECT_CACHE{$vendor_key} = $obj;
+            if (exists $obsolete_name{$name}) {
+                warning(g_('%s module name is deprecated; ' .
+                           'it should be capitalized with only alphanumeric characters'),
+                        "Dpkg::Vendor::$name");
+            }
+            return $obj;
+        }
+    }
+
+    my $info = get_vendor_info($vendor);
+    if (defined $info and defined $info->{'Parent'}) {
+        return get_vendor_object($info->{'Parent'});
+    } else {
+        return get_vendor_object('Default');
+    }
+}
+
+=item run_vendor_hook($hookid, @params)
+
+Run a hook implemented by the current vendor object.
+
+=cut
+
+sub run_vendor_hook {
+    my $vendor_obj = get_vendor_object();
+    $vendor_obj->run_hook(@_);
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.21.10)
+
+Deprecated behavior: get_vendor_file() loading vendor files with no special
+characters remapping. get_vendor_object() loading vendor module names with
+no special character stripping.
+
+=head2 Version 1.01 (dpkg 1.17.0)
+
+New function: get_vendor_dir().
+
+=head2 Version 1.00 (dpkg 1.16.1)
+
+Mark the module as public.
+
+=head1 SEE ALSO
+
+deb-origin(5).
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Vendor/Debian.pm b/scripts/Dpkg/Vendor/Debian.pm
new file mode 100644
index 0000000..06aa49a
--- /dev/null
+++ b/scripts/Dpkg/Vendor/Debian.pm
@@ -0,0 +1,522 @@
+# Copyright © 2009-2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2009, 2011-2017 Guillem Jover <guillem@debian.org>
+#
+# Hardening build flags handling derived from work of:
+# Copyright © 2009-2011 Kees Cook <kees@debian.org>
+# Copyright © 2007-2008 Canonical, Ltd.
+#
+# 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/>.
+
+package Dpkg::Vendor::Debian;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Types;
+
+use parent qw(Dpkg::Vendor::Default);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Vendor::Debian - Debian vendor class
+
+=head1 DESCRIPTION
+
+This vendor class customizes the behaviour of dpkg scripts for Debian
+specific behavior and policies.
+
+=cut
+
+sub run_hook {
+    my ($self, $hook, @params) = @_;
+
+    if ($hook eq 'package-keyrings') {
+        return ('/usr/share/keyrings/debian-keyring.gpg',
+                '/usr/share/keyrings/debian-nonupload.gpg',
+                '/usr/share/keyrings/debian-maintainers.gpg');
+    } elsif ($hook eq 'archive-keyrings') {
+        return ('/usr/share/keyrings/debian-archive-keyring.gpg');
+    } elsif ($hook eq 'archive-keyrings-historic') {
+        return ('/usr/share/keyrings/debian-archive-removed-keys.gpg');
+    } elsif ($hook eq 'builtin-build-depends') {
+        return qw(build-essential:native);
+    } elsif ($hook eq 'builtin-build-conflicts') {
+        return ();
+    } elsif ($hook eq 'register-custom-fields') {
+    } elsif ($hook eq 'extend-patch-header') {
+        my ($textref, $ch_info) = @params;
+	if ($ch_info->{'Closes'}) {
+	    foreach my $bug (split(/\s+/, $ch_info->{'Closes'})) {
+		$$textref .= "Bug-Debian: https://bugs.debian.org/$bug\n";
+	    }
+	}
+
+	# XXX: Layer violation...
+	require Dpkg::Vendor::Ubuntu;
+	my $b = Dpkg::Vendor::Ubuntu::find_launchpad_closes($ch_info->{'Changes'});
+	foreach my $bug (@$b) {
+	    $$textref .= "Bug-Ubuntu: https://bugs.launchpad.net/bugs/$bug\n";
+	}
+    } elsif ($hook eq 'update-buildflags') {
+        $self->set_build_features(@params);
+        $self->_add_build_flags(@params);
+    } elsif ($hook eq 'builtin-system-build-paths') {
+        return qw(/build/);
+    } elsif ($hook eq 'build-tainted-by') {
+        return $self->_build_tainted_by();
+    } elsif ($hook eq 'sanitize-environment') {
+        # Reset umask to a sane default.
+        umask 0022;
+        # Reset locale to a sane default.
+        $ENV{LC_COLLATE} = 'C.UTF-8';
+    } elsif ($hook eq 'backport-version-regex') {
+        return qr/~(bpo|deb)/;
+    } else {
+        return $self->SUPER::run_hook($hook, @params);
+    }
+}
+
+sub init_build_features {
+    my ($self, $use_feature, $builtin_feature) = @_;
+}
+
+sub set_build_features {
+    my ($self, $flags) = @_;
+
+    # Default feature states.
+    my %use_feature = (
+        future => {
+            lfs => 0,
+        },
+        qa => {
+            bug => 0,
+            canary => 0,
+        },
+        reproducible => {
+            timeless => 1,
+            fixfilepath => 1,
+            fixdebugpath => 1,
+        },
+        optimize => {
+            lto => 0,
+        },
+        sanitize => {
+            address => 0,
+            thread => 0,
+            leak => 0,
+            undefined => 0,
+        },
+        hardening => {
+            # XXX: This is set to undef so that we can cope with the brokenness
+            # of gcc managing this feature builtin.
+            pie => undef,
+            stackprotector => 1,
+            stackprotectorstrong => 1,
+            fortify => 1,
+            format => 1,
+            relro => 1,
+            bindnow => 0,
+        },
+    );
+
+    my %builtin_feature = (
+        hardening => {
+            pie => 1,
+        },
+    );
+
+    $self->init_build_features(\%use_feature, \%builtin_feature);
+
+    ## Setup
+
+    require Dpkg::BuildOptions;
+
+    # Adjust features based on user or maintainer's desires.
+    my $opts_build = Dpkg::BuildOptions->new(envvar => 'DEB_BUILD_OPTIONS');
+    my $opts_maint = Dpkg::BuildOptions->new(envvar => 'DEB_BUILD_MAINT_OPTIONS');
+
+    foreach my $area (sort keys %use_feature) {
+        $opts_build->parse_features($area, $use_feature{$area});
+        $opts_maint->parse_features($area, $use_feature{$area});
+    }
+
+    require Dpkg::Arch;
+
+    my $arch = Dpkg::Arch::get_host_arch();
+    my ($abi, $libc, $os, $cpu) = Dpkg::Arch::debarch_to_debtuple($arch);
+
+    unless (defined $abi and defined $libc and defined $os and defined $cpu) {
+        warning(g_("unknown host architecture '%s'"), $arch);
+        ($abi, $os, $cpu) = ('', '', '');
+    }
+
+    ## Area: future
+
+    if ($use_feature{future}{lfs}) {
+        my ($abi_bits, $abi_endian) = Dpkg::Arch::debarch_to_abiattrs($arch);
+        my $cpu_bits = Dpkg::Arch::debarch_to_cpubits($arch);
+
+        if ($abi_bits != 32 or $cpu_bits != 32) {
+            $use_feature{future}{lfs} = 0;
+        }
+    }
+
+    ## Area: reproducible
+
+    # Mask features that might have an unsafe usage.
+    if ($use_feature{reproducible}{fixfilepath} or
+        $use_feature{reproducible}{fixdebugpath}) {
+        require Cwd;
+
+        my $build_path =$ENV{DEB_BUILD_PATH} || Cwd::getcwd();
+
+        $flags->set_option_value('build-path', $build_path);
+
+        # If we have any unsafe character in the path, disable the flag,
+        # so that we do not need to worry about escaping the characters
+        # on output.
+        if ($build_path =~ m/[^-+:.0-9a-zA-Z~\/_]/) {
+            $use_feature{reproducible}{fixfilepath} = 0;
+            $use_feature{reproducible}{fixdebugpath} = 0;
+        }
+    }
+
+    ## Area: optimize
+
+    if ($opts_build->has('noopt')) {
+        $flags->set_option_value('optimize-level', 0);
+    } else {
+        $flags->set_option_value('optimize-level', 2);
+    }
+
+    ## Area: sanitize
+
+    # Handle logical feature interactions.
+    if ($use_feature{sanitize}{address} and $use_feature{sanitize}{thread}) {
+        # Disable the thread sanitizer when the address one is active, they
+        # are mutually incompatible.
+        $use_feature{sanitize}{thread} = 0;
+    }
+    if ($use_feature{sanitize}{address} or $use_feature{sanitize}{thread}) {
+        # Disable leak sanitizer, it is implied by the address or thread ones.
+        $use_feature{sanitize}{leak} = 0;
+    }
+
+    ## Area: hardening
+
+    # Mask builtin features that are not enabled by default in the compiler.
+    my %builtin_pie_arch = map { $_ => 1 } qw(
+        amd64
+        arm64
+        armel
+        armhf
+        hurd-i386
+        i386
+        kfreebsd-amd64
+        kfreebsd-i386
+        mips
+        mipsel
+        mips64el
+        powerpc
+        ppc64
+        ppc64el
+        riscv64
+        s390x
+        sparc
+        sparc64
+    );
+    if (not exists $builtin_pie_arch{$arch}) {
+        $builtin_feature{hardening}{pie} = 0;
+    }
+
+    # Mask features that are not available on certain architectures.
+    if ($os !~ /^(?:linux|kfreebsd|knetbsd|hurd)$/ or
+	$cpu =~ /^(?:hppa|avr32)$/) {
+	# Disabled on non-(linux/kfreebsd/knetbsd/hurd).
+	# Disabled on hppa, avr32
+	#  (#574716).
+	$use_feature{hardening}{pie} = 0;
+    }
+    if ($cpu =~ /^(?:ia64|alpha|hppa|nios2)$/ or $arch eq 'arm') {
+	# Stack protector disabled on ia64, alpha, hppa, nios2.
+	#   "warning: -fstack-protector not supported for this target"
+	# Stack protector disabled on arm (ok on armel).
+	#   compiler supports it incorrectly (leads to SEGV)
+	$use_feature{hardening}{stackprotector} = 0;
+    }
+    if ($cpu =~ /^(?:ia64|hppa|avr32)$/) {
+	# relro not implemented on ia64, hppa, avr32.
+	$use_feature{hardening}{relro} = 0;
+    }
+
+    # Mask features that might be influenced by other flags.
+    if ($flags->get_option_value('optimize-level') == 0) {
+      # glibc 2.16 and later warn when using -O0 and _FORTIFY_SOURCE.
+      $use_feature{hardening}{fortify} = 0;
+    }
+
+    # Handle logical feature interactions.
+    if ($use_feature{hardening}{relro} == 0) {
+	# Disable bindnow if relro is not enabled, since it has no
+	# hardening ability without relro and may incur load penalties.
+	$use_feature{hardening}{bindnow} = 0;
+    }
+    if ($use_feature{hardening}{stackprotector} == 0) {
+	# Disable stackprotectorstrong if stackprotector is disabled.
+	$use_feature{hardening}{stackprotectorstrong} = 0;
+    }
+
+    ## Commit
+
+    # Set used features to their builtin setting if unset.
+    foreach my $area (sort keys %builtin_feature) {
+        while (my ($feature, $enabled) = each %{$builtin_feature{$area}}) {
+            $flags->set_builtin($area, $feature, $enabled);
+        }
+    }
+
+    # Store the feature usage.
+    foreach my $area (sort keys %use_feature) {
+        while (my ($feature, $enabled) = each %{$use_feature{$area}}) {
+            $flags->set_feature($area, $feature, $enabled);
+        }
+    }
+}
+
+sub _add_build_flags {
+    my ($self, $flags) = @_;
+
+    ## Global default flags
+
+    my @compile_flags = qw(
+        CFLAGS
+        CXXFLAGS
+        OBJCFLAGS
+        OBJCXXFLAGS
+        FFLAGS
+        FCFLAGS
+        GCJFLAGS
+    );
+
+    my $default_flags;
+    my $default_d_flags;
+
+    my $optimize_level = $flags->get_option_value('optimize-level');
+    $default_flags = "-g -O$optimize_level";
+    if ($optimize_level == 0) {
+        $default_d_flags = '-fdebug';
+    } else {
+        $default_d_flags = '-frelease';
+    }
+
+    $flags->append($_, $default_flags) foreach @compile_flags;
+    $flags->append('DFLAGS', $default_d_flags);
+
+    ## Area: future
+
+    if ($flags->use_feature('future', 'lfs')) {
+        $flags->append('CPPFLAGS',
+                       '-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64');
+    }
+
+    ## Area: qa
+
+    # Warnings that detect actual bugs.
+    if ($flags->use_feature('qa', 'bug')) {
+        # C flags
+        my @cflags = qw(
+            implicit-function-declaration
+        );
+        foreach my $warnflag (@cflags) {
+            $flags->append('CFLAGS', "-Werror=$warnflag");
+        }
+
+        # C/C++ flags
+        my @cfamilyflags = qw(
+            array-bounds
+            clobbered
+            volatile-register-var
+        );
+        foreach my $warnflag (@cfamilyflags) {
+            $flags->append('CFLAGS', "-Werror=$warnflag");
+            $flags->append('CXXFLAGS', "-Werror=$warnflag");
+        }
+    }
+
+    # Inject dummy canary options to detect issues with build flag propagation.
+    if ($flags->use_feature('qa', 'canary')) {
+        require Digest::MD5;
+        my $id = Digest::MD5::md5_hex(int rand 4096);
+
+        foreach my $flag (qw(CPPFLAGS CFLAGS OBJCFLAGS CXXFLAGS OBJCXXFLAGS)) {
+            $flags->append($flag, "-D__DEB_CANARY_${flag}_${id}__");
+        }
+        $flags->append('LDFLAGS', "-Wl,-z,deb-canary-${id}");
+    }
+
+    ## Area: reproducible
+
+    # Warn when the __TIME__, __DATE__ and __TIMESTAMP__ macros are used.
+    if ($flags->use_feature('reproducible', 'timeless')) {
+       $flags->append('CPPFLAGS', '-Wdate-time');
+    }
+
+    # Avoid storing the build path in the binaries.
+    if ($flags->use_feature('reproducible', 'fixfilepath') or
+        $flags->use_feature('reproducible', 'fixdebugpath')) {
+        my $build_path = $flags->get_option_value('build-path');
+        my $map;
+
+        # -ffile-prefix-map is a superset of -fdebug-prefix-map, prefer it
+        # if both are set.
+        if ($flags->use_feature('reproducible', 'fixfilepath')) {
+            $map = '-ffile-prefix-map=' . $build_path . '=.';
+        } else {
+            $map = '-fdebug-prefix-map=' . $build_path . '=.';
+        }
+
+        $flags->append($_, $map) foreach @compile_flags;
+    }
+
+    ## Area: optimize
+
+    if ($flags->use_feature('optimize', 'lto')) {
+        my $flag = '-flto=auto -ffat-lto-objects';
+        $flags->append($_, $flag) foreach (@compile_flags, 'LDFLAGS');
+    }
+
+    ## Area: sanitize
+
+    if ($flags->use_feature('sanitize', 'address')) {
+        my $flag = '-fsanitize=address -fno-omit-frame-pointer';
+        $flags->append('CFLAGS', $flag);
+        $flags->append('CXXFLAGS', $flag);
+        $flags->append('LDFLAGS', '-fsanitize=address');
+    }
+
+    if ($flags->use_feature('sanitize', 'thread')) {
+        my $flag = '-fsanitize=thread';
+        $flags->append('CFLAGS', $flag);
+        $flags->append('CXXFLAGS', $flag);
+        $flags->append('LDFLAGS', $flag);
+    }
+
+    if ($flags->use_feature('sanitize', 'leak')) {
+        $flags->append('LDFLAGS', '-fsanitize=leak');
+    }
+
+    if ($flags->use_feature('sanitize', 'undefined')) {
+        my $flag = '-fsanitize=undefined';
+        $flags->append('CFLAGS', $flag);
+        $flags->append('CXXFLAGS', $flag);
+        $flags->append('LDFLAGS', $flag);
+    }
+
+    ## Area: hardening
+
+    # PIE
+    my $use_pie = $flags->get_feature('hardening', 'pie');
+    my %hardening_builtins = $flags->get_builtins('hardening');
+    if (defined $use_pie && $use_pie && ! $hardening_builtins{pie}) {
+	my $flag = "-specs=$Dpkg::DATADIR/pie-compile.specs";
+        $flags->append($_, $flag) foreach @compile_flags;
+	$flags->append('LDFLAGS', "-specs=$Dpkg::DATADIR/pie-link.specs");
+    } elsif (defined $use_pie && ! $use_pie && $hardening_builtins{pie}) {
+	my $flag = "-specs=$Dpkg::DATADIR/no-pie-compile.specs";
+        $flags->append($_, $flag) foreach @compile_flags;
+	$flags->append('LDFLAGS', "-specs=$Dpkg::DATADIR/no-pie-link.specs");
+    }
+
+    # Stack protector
+    if ($flags->use_feature('hardening', 'stackprotectorstrong')) {
+	my $flag = '-fstack-protector-strong';
+        $flags->append($_, $flag) foreach @compile_flags;
+    } elsif ($flags->use_feature('hardening', 'stackprotector')) {
+	my $flag = '-fstack-protector --param=ssp-buffer-size=4';
+        $flags->append($_, $flag) foreach @compile_flags;
+    }
+
+    # Fortify Source
+    if ($flags->use_feature('hardening', 'fortify')) {
+	$flags->append('CPPFLAGS', '-D_FORTIFY_SOURCE=2');
+    }
+
+    # Format Security
+    if ($flags->use_feature('hardening', 'format')) {
+	my $flag = '-Wformat -Werror=format-security';
+	$flags->append('CFLAGS', $flag);
+	$flags->append('CXXFLAGS', $flag);
+	$flags->append('OBJCFLAGS', $flag);
+	$flags->append('OBJCXXFLAGS', $flag);
+    }
+
+    # Read-only Relocations
+    if ($flags->use_feature('hardening', 'relro')) {
+	$flags->append('LDFLAGS', '-Wl,-z,relro');
+    }
+
+    # Bindnow
+    if ($flags->use_feature('hardening', 'bindnow')) {
+	$flags->append('LDFLAGS', '-Wl,-z,now');
+    }
+}
+
+sub _build_tainted_by {
+    my $self = shift;
+    my %tainted;
+
+    foreach my $pathname (qw(/bin /sbin /lib /lib32 /libo32 /libx32 /lib64)) {
+        next unless -l $pathname;
+
+        my $linkname = readlink $pathname;
+        if ($linkname eq "usr$pathname" or $linkname eq "/usr$pathname") {
+            $tainted{'merged-usr-via-aliased-dirs'} = 1;
+            last;
+        }
+    }
+
+    require File::Find;
+    my %usr_local_types = (
+        configs => [ qw(etc) ],
+        includes => [ qw(include) ],
+        programs => [ qw(bin sbin) ],
+        libraries => [ qw(lib) ],
+    );
+    foreach my $type (keys %usr_local_types) {
+        File::Find::find({
+            wanted => sub { $tainted{"usr-local-has-$type"} = 1 if -f },
+            no_chdir => 1,
+        }, grep { -d } map { "/usr/local/$_" } @{$usr_local_types{$type}});
+    }
+
+    my @tainted = sort keys %tainted;
+    return @tainted;
+}
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Vendor/Default.pm b/scripts/Dpkg/Vendor/Default.pm
new file mode 100644
index 0000000..8362b5b
--- /dev/null
+++ b/scripts/Dpkg/Vendor/Default.pm
@@ -0,0 +1,229 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Vendor::Default;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+# If you use this file as template to create a new vendor class, please
+# uncomment the following lines
+#use parent qw(Dpkg::Vendor::Default);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Vendor::Default - default vendor class
+
+=head1 DESCRIPTION
+
+A vendor class is used to provide vendor specific behaviour
+in various places. This is the default class used in case
+there's none for the current vendor or in case the vendor could
+not be identified (see Dpkg::Vendor documentation).
+
+It provides some hooks that are called by various dpkg-* tools.
+If you need a new hook, please file a bug against dpkg-dev and explain
+your need. Note that the hook API has no guarantee to be stable over an
+extended period of time. If you run an important distribution that makes
+use of vendor hooks, you'd better submit them for integration so that
+we avoid breaking your code.
+
+=head1 METHODS
+
+=over 4
+
+=item $vendor_obj = Dpkg::Vendor::Default->new()
+
+Creates the default vendor object. Can be inherited by all vendor objects
+if they don't need any specific initialization at object creation time.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+    return $self;
+}
+
+=item $vendor_obj->run_hook($id, @params)
+
+Run the corresponding hook. The parameters are hook-specific. The
+supported hooks are:
+
+=over 8
+
+=item before-source-build ($srcpkg)
+
+The first parameter is a Dpkg::Source::Package object. The hook is called
+just before the execution of $srcpkg->build().
+
+=item package-keyrings ()
+
+The hook is called when dpkg-source is checking a signature on a source
+package (since dpkg 1.18.11). It takes no parameters, but returns a
+(possibly empty) list of vendor-specific keyrings.
+
+=item archive-keyrings ()
+
+The hook is called when there is a need to check signatures on artifacts
+from repositories, for example by a download method (since dpkg 1.18.11).
+It takes no parameters, but returns a (possibly empty) list of
+vendor-specific keyrings.
+
+=item archive-keyrings-historic ()
+
+The hook is called when there is a need to check signatures on artifacts
+from historic repositories, for example by a download method
+(since dpkg 1.18.11). It takes no parameters, but returns a (possibly empty)
+list of vendor-specific keyrings.
+
+=item builtin-build-depends ()
+
+The hook is called when dpkg-checkbuilddeps is initializing the source
+package build dependencies (since dpkg 1.18.2). It takes no parameters,
+but returns a (possibly empty) list of vendor-specific B<Build-Depends>.
+
+=item builtin-build-conflicts ()
+
+The hook is called when dpkg-checkbuilddeps is initializing the source
+package build conflicts (since dpkg 1.18.2). It takes no parameters,
+but returns a (possibly empty) list of vendor-specific B<Build-Conflicts>.
+
+=item register-custom-fields ()
+
+The hook is called in Dpkg::Control::Fields to register custom fields.
+You should return a list of arrays. Each array is an operation to perform.
+The first item is the name of the operation and corresponds
+to a field_* function provided by Dpkg::Control::Fields. The remaining
+fields are the parameters that are passed unchanged to the corresponding
+function.
+
+Known operations are "register", "insert_after" and "insert_before".
+
+=item post-process-changelog-entry ($fields)
+
+The hook is called in Dpkg::Changelog to post-process a
+Dpkg::Changelog::Entry after it has been created and filled with the
+appropriate values.
+
+=item update-buildflags ($flags)
+
+The hook is called in Dpkg::BuildFlags to allow the vendor to override
+the default values set for the various build flags. $flags is a
+Dpkg::BuildFlags object.
+
+=item builtin-system-build-paths ()
+
+The hook is called by dpkg-genbuildinfo to determine if the current path
+should be recorded in the B<Build-Path> field (since dpkg 1.18.11). It takes
+no parameters, but returns a (possibly empty) list of root paths considered
+acceptable. As an example, if the list contains "/build/", a Build-Path
+field will be created if the current directory is "/build/dpkg-1.18.0". If
+the list contains "/", the path will always be recorded. If the list is
+empty, the current path will never be recorded.
+
+=item build-tainted-by ()
+
+The hook is called by dpkg-genbuildinfo to determine if the current system
+has been tainted in some way that could affect the resulting build, which
+will be recorded in the B<Build-Tainted-By> field (since dpkg 1.19.5). It
+takes no parameters, but returns a (possibly empty) list of tainted reason
+tags (formed by alphanumeric and dash characters).
+
+=item sanitize-environment ()
+
+The hook is called by dpkg-buildpackage to sanitize its build environment
+(since dpkg 1.20.0).
+
+=item backport-version-regex ()
+
+The hook is called by dpkg-genchanges and dpkg-mergechangelog to determine
+the backport version string that should be specially handled as not an earlier
+than version or remapped so that it does not get considered as a pre-release
+(since dpkg 1.21.3).
+The returned string is a regex with one capture group for the backport
+delimiter string, or undef if there is no regex.
+
+=back
+
+=cut
+
+sub run_hook {
+    my ($self, $hook, @params) = @_;
+
+    if ($hook eq 'before-source-build') {
+        my $srcpkg = shift @params;
+    } elsif ($hook eq 'package-keyrings') {
+        return ();
+    } elsif ($hook eq 'archive-keyrings') {
+        return ();
+    } elsif ($hook eq 'archive-keyrings-historic') {
+        return ();
+    } elsif ($hook eq 'register-custom-fields') {
+        return ();
+    } elsif ($hook eq 'builtin-build-depends') {
+        return ();
+    } elsif ($hook eq 'builtin-build-conflicts') {
+        return ();
+    } elsif ($hook eq 'post-process-changelog-entry') {
+        my $fields = shift @params;
+    } elsif ($hook eq 'extend-patch-header') {
+	my ($textref, $ch_info) = @params;
+    } elsif ($hook eq 'update-buildflags') {
+	my $flags = shift @params;
+    } elsif ($hook eq 'builtin-system-build-paths') {
+        return ();
+    } elsif ($hook eq 'build-tainted-by') {
+        return ();
+    } elsif ($hook eq 'sanitize-environment') {
+        return;
+    } elsif ($hook eq 'backport-version-regex') {
+        return;
+    }
+
+    # Default return value for unknown/unimplemented hooks
+    return;
+}
+
+=item $vendor->set_build_features($flags)
+
+Sets the vendor build features, which will then be used to initialize the
+build flags.
+
+=cut
+
+sub set_build_features {
+    my ($self, $flags) = @_;
+
+    return;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Vendor/Devuan.pm b/scripts/Dpkg/Vendor/Devuan.pm
new file mode 100644
index 0000000..661dc9e
--- /dev/null
+++ b/scripts/Dpkg/Vendor/Devuan.pm
@@ -0,0 +1,68 @@
+# Copyright © 2022 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/>.
+
+package Dpkg::Vendor::Devuan;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use parent qw(Dpkg::Vendor::Debian);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Vendor::Devuan - Devuan vendor class
+
+=head1 DESCRIPTION
+
+This vendor class customizes the behaviour of dpkg scripts for Devuan
+specific behavior and policies.
+
+=cut
+
+sub run_hook {
+    my ($self, $hook, @params) = @_;
+
+    if ($hook eq 'package-keyrings') {
+        return ('/usr/share/keyrings/devuan-keyring.gpg',
+                '/usr/share/keyrings/devuan-maintainers.gpg');
+    } elsif ($hook eq 'archive-keyrings') {
+        return ('/usr/share/keyrings/devuan-archive-keyring.gpg');
+    } elsif ($hook eq 'archive-keyrings-historic') {
+        return ('/usr/share/keyrings/devuan-archive-removed-keys.gpg');
+    } elsif ($hook eq 'extend-patch-header') {
+        my ($textref, $ch_info) = @params;
+        if ($ch_info->{'Closes'}) {
+            foreach my $bug (split(/\s+/, $ch_info->{'Closes'})) {
+                $$textref .= "Bug-Devuan: https://bugs.devuan.org/$bug\n";
+            }
+        }
+    } else {
+        return $self->SUPER::run_hook($hook, @params);
+    }
+}
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a private module.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Vendor/Ubuntu.pm b/scripts/Dpkg/Vendor/Ubuntu.pm
new file mode 100644
index 0000000..9c77519
--- /dev/null
+++ b/scripts/Dpkg/Vendor/Ubuntu.pm
@@ -0,0 +1,174 @@
+# Copyright © 2008 Ian Jackson <ijackson@chiark.greenend.org.uk>
+# Copyright © 2008 Canonical, Ltd.
+#   written by Colin Watson <cjwatson@ubuntu.com>
+# Copyright © 2008 James Westby <jw+debian@jameswestby.net>
+# Copyright © 2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Vendor::Ubuntu;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use List::Util qw(any);
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::Control::Types;
+
+use parent qw(Dpkg::Vendor::Debian);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Vendor::Ubuntu - Ubuntu vendor class
+
+=head1 DESCRIPTION
+
+This vendor class customizes the behaviour of dpkg scripts for Ubuntu
+specific behavior and policies.
+
+=cut
+
+sub run_hook {
+    my ($self, $hook, @params) = @_;
+
+    if ($hook eq 'before-source-build') {
+        my $src = shift @params;
+        my $fields = $src->{fields};
+
+        # check that Maintainer/XSBC-Original-Maintainer comply to
+        # https://wiki.ubuntu.com/DebianMaintainerField
+        if (defined($fields->{'Version'}) and defined($fields->{'Maintainer'}) and
+           $fields->{'Version'} =~ /ubuntu/) {
+           if ($fields->{'Maintainer'} !~ /(?:ubuntu|canonical)/i) {
+               if (length $ENV{DEBEMAIL} and $ENV{DEBEMAIL} =~ /\@(?:ubuntu|canonical)\.com/) {
+                   error(g_('Version number suggests Ubuntu changes, but Maintainer: does not have Ubuntu address'));
+               } else {
+                   warning(g_('Version number suggests Ubuntu changes, but Maintainer: does not have Ubuntu address'));
+               }
+           }
+           unless ($fields->{'Original-Maintainer'}) {
+               warning(g_('Version number suggests Ubuntu changes, but there is no XSBC-Original-Maintainer field'));
+           }
+        }
+    } elsif ($hook eq 'package-keyrings') {
+        return ($self->SUPER::run_hook($hook),
+                '/usr/share/keyrings/ubuntu-archive-keyring.gpg');
+    } elsif ($hook eq 'archive-keyrings') {
+        return ($self->SUPER::run_hook($hook),
+                '/usr/share/keyrings/ubuntu-archive-keyring.gpg');
+    } elsif ($hook eq 'archive-keyrings-historic') {
+        return ($self->SUPER::run_hook($hook),
+                '/usr/share/keyrings/ubuntu-archive-removed-keys.gpg');
+    } elsif ($hook eq 'register-custom-fields') {
+        my @field_ops = $self->SUPER::run_hook($hook);
+        push @field_ops, [
+            'register', 'Launchpad-Bugs-Fixed',
+              CTRL_FILE_CHANGES | CTRL_CHANGELOG,
+        ], [
+            'insert_after', CTRL_FILE_CHANGES, 'Closes', 'Launchpad-Bugs-Fixed',
+        ], [
+            'insert_after', CTRL_CHANGELOG, 'Closes', 'Launchpad-Bugs-Fixed',
+        ];
+        return @field_ops;
+    } elsif ($hook eq 'post-process-changelog-entry') {
+        my $fields = shift @params;
+
+        # Add Launchpad-Bugs-Fixed field
+        my $bugs = find_launchpad_closes($fields->{'Changes'} // '');
+        if (scalar(@$bugs)) {
+            $fields->{'Launchpad-Bugs-Fixed'} = join(' ', @$bugs);
+        }
+    } elsif ($hook eq 'update-buildflags') {
+	my $flags = shift @params;
+
+        # Run the Debian hook to add hardening flags
+        $self->SUPER::run_hook($hook, $flags);
+
+	# Per https://wiki.ubuntu.com/DistCompilerFlags
+        $flags->prepend('LDFLAGS', '-Wl,-Bsymbolic-functions');
+    } else {
+        return $self->SUPER::run_hook($hook, @params);
+    }
+}
+
+# Override Debian default features.
+sub init_build_features {
+    my ($self, $use_feature, $builtin_feature) = @_;
+
+    $self->SUPER::init_build_features($use_feature, $builtin_feature);
+
+    require Dpkg::Arch;
+    my $arch = Dpkg::Arch::get_host_arch();
+
+    if (any { $_ eq $arch } qw(amd64 arm64 ppc64el s390x)) {
+        $use_feature->{optimize}{lto} = 1;
+    }
+}
+
+sub set_build_features {
+    my ($self, $flags) = @_;
+
+    $self->SUPER::set_build_features($flags);
+
+    require Dpkg::Arch;
+    my $arch = Dpkg::Arch::get_host_arch();
+
+    if ($arch eq 'ppc64el' && $flags->get_option_value('optimize-level') != 0) {
+        $flags->set_option_value('optimize-level', 3);
+    }
+}
+
+=head1 PUBLIC FUNCTIONS
+
+=over
+
+=item $bugs = Dpkg::Vendor::Ubuntu::find_launchpad_closes($changes)
+
+Takes one string as argument and finds "LP: #123456, #654321" statements,
+which are references to bugs on Launchpad. Returns all closed bug
+numbers in an array reference.
+
+=cut
+
+sub find_launchpad_closes {
+    my $changes = shift;
+    my %closes;
+
+    while ($changes &&
+          ($changes =~ /lp:\s+\#\d+(?:,\s*\#\d+)*/pig)) {
+        $closes{$_} = 1 foreach (${^MATCH} =~ /\#?\s?(\d+)/g);
+    }
+
+    my @closes = sort { $a <=> $b } keys %closes;
+
+    return \@closes;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 0.xx
+
+This is a semi-private module. Only documented functions are public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm
new file mode 100644
index 0000000..51d46c5
--- /dev/null
+++ b/scripts/Dpkg/Version.pm
@@ -0,0 +1,491 @@
+# Copyright © Colin Watson <cjwatson@debian.org>
+# Copyright © Ian Jackson <ijackson@chiark.greenend.org.uk>
+# Copyright © 2007 Don Armstrong <don@donarmstrong.com>.
+# Copyright © 2009 Raphaël Hertzog <hertzog@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/>.
+
+package Dpkg::Version;
+
+use strict;
+use warnings;
+use warnings::register qw(semantic_change::overload::bool);
+
+our $VERSION = '1.03';
+our @EXPORT = qw(
+    version_compare
+    version_compare_relation
+    version_normalize_relation
+    version_compare_string
+    version_compare_part
+    version_split_digits
+    version_check
+    REL_LT
+    REL_LE
+    REL_EQ
+    REL_GE
+    REL_GT
+);
+
+use Exporter qw(import);
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use constant {
+    REL_LT => '<<',
+    REL_LE => '<=',
+    REL_EQ => '=',
+    REL_GE => '>=',
+    REL_GT => '>>',
+};
+
+use overload
+    '<=>' => \&_comparison,
+    'cmp' => \&_comparison,
+    '""'  => sub { return $_[0]->as_string(); },
+    'bool' => sub { return $_[0]->is_valid(); },
+    'fallback' => 1;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Version - handling and comparing dpkg-style version numbers
+
+=head1 DESCRIPTION
+
+The Dpkg::Version module provides pure-Perl routines to compare
+dpkg-style version numbers (as used in Debian packages) and also
+an object oriented interface overriding perl operators
+to do the right thing when you compare Dpkg::Version object between
+them.
+
+=head1 METHODS
+
+=over 4
+
+=item $v = Dpkg::Version->new($version, %opts)
+
+Create a new Dpkg::Version object corresponding to the version indicated in
+the string (scalar) $version. By default it will accepts any string
+and consider it as a valid version. If you pass the option "check => 1",
+it will return undef if the version is invalid (see version_check for
+details).
+
+You can always call $v->is_valid() later on to verify that the version is
+valid.
+
+=cut
+
+sub new {
+    my ($this, $ver, %opts) = @_;
+    my $class = ref($this) || $this;
+    $ver = "$ver" if ref($ver); # Try to stringify objects
+
+    if ($opts{check}) {
+	return unless version_check($ver);
+    }
+
+    my $self = {};
+    if ($ver =~ /^([^:]*):(.+)$/) {
+	$self->{epoch} = $1;
+	$ver = $2;
+    } else {
+	$self->{epoch} = 0;
+	$self->{no_epoch} = 1;
+    }
+    if ($ver =~ /(.*)-(.*)$/) {
+	$self->{version} = $1;
+	$self->{revision} = $2;
+    } else {
+	$self->{version} = $ver;
+	$self->{revision} = 0;
+	$self->{no_revision} = 1;
+    }
+
+    return bless $self, $class;
+}
+
+=item boolean evaluation
+
+When the Dpkg::Version object is used in a boolean evaluation (for example
+in "if ($v)" or "$v ? \"$v\" : 'default'") it returns true if the version
+stored is valid ($v->is_valid()) and false otherwise.
+
+B<Notice>: Between dpkg 1.15.7.2 and 1.19.1 this overload used to return
+$v->as_string() if $v->is_valid(), a breaking change in behavior that caused
+"0" versions to be evaluated as false. To catch any possibly intended code
+that relied on those semantics, this overload will emit a warning with
+category "Dpkg::Version::semantic_change::overload::bool" until dpkg 1.20.x.
+Once fixed, or for already valid code the warning can be quiesced with
+
+  no if $Dpkg::Version::VERSION ge '1.02',
+     warnings => qw(Dpkg::Version::semantic_change::overload::bool);
+
+added after the C<use Dpkg::Version>.
+
+=item $v->is_valid()
+
+Returns true if the version is valid, false otherwise.
+
+=cut
+
+sub is_valid {
+    my $self = shift;
+    return scalar version_check($self);
+}
+
+=item $v->epoch(), $v->version(), $v->revision()
+
+Returns the corresponding part of the full version string.
+
+=cut
+
+sub epoch {
+    my $self = shift;
+    return $self->{epoch};
+}
+
+sub version {
+    my $self = shift;
+    return $self->{version};
+}
+
+sub revision {
+    my $self = shift;
+    return $self->{revision};
+}
+
+=item $v->is_native()
+
+Returns true if the version is native, false if it has a revision.
+
+=cut
+
+sub is_native {
+    my $self = shift;
+    return $self->{no_revision};
+}
+
+=item $v1 <=> $v2, $v1 < $v2, $v1 <= $v2, $v1 > $v2, $v1 >= $v2
+
+Numerical comparison of various versions numbers. One of the two operands
+needs to be a Dpkg::Version, the other one can be anything provided that
+its string representation is a version number.
+
+=cut
+
+sub _comparison {
+    my ($a, $b, $inverted) = @_;
+    if (not ref($b) or not $b->isa('Dpkg::Version')) {
+        $b = Dpkg::Version->new($b);
+    }
+    ($a, $b) = ($b, $a) if $inverted;
+    my $r = version_compare_part($a->epoch(), $b->epoch());
+    return $r if $r;
+    $r = version_compare_part($a->version(), $b->version());
+    return $r if $r;
+    return version_compare_part($a->revision(), $b->revision());
+}
+
+=item "$v", $v->as_string(), $v->as_string(%options)
+
+Accepts an optional option hash reference, affecting the string conversion.
+
+Options:
+
+=over 8
+
+=item omit_epoch (defaults to 0)
+
+Omit the epoch, if present, in the output string.
+
+=item omit_revision (defaults to 0)
+
+Omit the revision, if present, in the output string.
+
+=back
+
+Returns the string representation of the version number.
+
+=cut
+
+sub as_string {
+    my ($self, %opts) = @_;
+    my $no_epoch = $opts{omit_epoch} || $self->{no_epoch};
+    my $no_revision = $opts{omit_revision} || $self->{no_revision};
+
+    my $str = '';
+    $str .= $self->{epoch} . ':' unless $no_epoch;
+    $str .= $self->{version};
+    $str .= '-' . $self->{revision} unless $no_revision;
+    return $str;
+}
+
+=back
+
+=head1 FUNCTIONS
+
+All the functions are exported by default.
+
+=over 4
+
+=item version_compare($a, $b)
+
+Returns -1 if $a is earlier than $b, 0 if they are equal and 1 if $a
+is later than $b.
+
+If $a or $b are not valid version numbers, it dies with an error.
+
+=cut
+
+sub version_compare($$) {
+    my ($a, $b) = @_;
+    my $va = Dpkg::Version->new($a, check => 1);
+    defined($va) || error(g_('%s is not a valid version'), "$a");
+    my $vb = Dpkg::Version->new($b, check => 1);
+    defined($vb) || error(g_('%s is not a valid version'), "$b");
+    return $va <=> $vb;
+}
+
+=item version_compare_relation($a, $rel, $b)
+
+Returns the result (0 or 1) of the given comparison operation. This
+function is implemented on top of version_compare().
+
+Allowed values for $rel are the exported constants REL_GT, REL_GE,
+REL_EQ, REL_LE, REL_LT. Use version_normalize_relation() if you
+have an input string containing the operator.
+
+=cut
+
+sub version_compare_relation($$$) {
+    my ($a, $op, $b) = @_;
+    my $res = version_compare($a, $b);
+
+    if ($op eq REL_GT) {
+	return $res > 0;
+    } elsif ($op eq REL_GE) {
+	return $res >= 0;
+    } elsif ($op eq REL_EQ) {
+	return $res == 0;
+    } elsif ($op eq REL_LE) {
+	return $res <= 0;
+    } elsif ($op eq REL_LT) {
+	return $res < 0;
+    } else {
+	croak "unsupported relation for version_compare_relation(): '$op'";
+    }
+}
+
+=item $rel = version_normalize_relation($rel_string)
+
+Returns the normalized constant of the relation $rel (a value
+among REL_GT, REL_GE, REL_EQ, REL_LE and REL_LT). Supported
+relations names in input are: "gt", "ge", "eq", "le", "lt", ">>", ">=",
+"=", "<=", "<<". ">" and "<" are also supported but should not be used as
+they are obsolete aliases of ">=" and "<=".
+
+=cut
+
+sub version_normalize_relation($) {
+    my $op = shift;
+
+    warning('relation %s is deprecated: use %s or %s',
+            $op, "$op$op", "$op=") if ($op eq '>' or $op eq '<');
+
+    if ($op eq '>>' or $op eq 'gt') {
+	return REL_GT;
+    } elsif ($op eq '>=' or $op eq 'ge' or $op eq '>') {
+	return REL_GE;
+    } elsif ($op eq '=' or $op eq 'eq') {
+	return REL_EQ;
+    } elsif ($op eq '<=' or $op eq 'le' or $op eq '<') {
+	return REL_LE;
+    } elsif ($op eq '<<' or $op eq 'lt') {
+	return REL_LT;
+    } else {
+	croak "bad relation '$op'";
+    }
+}
+
+=item version_compare_string($a, $b)
+
+String comparison function used for comparing non-numerical parts of version
+numbers. Returns -1 if $a is earlier than $b, 0 if they are equal and 1 if $a
+is later than $b.
+
+The "~" character always sort lower than anything else. Digits sort lower
+than non-digits. Among remaining characters alphabetic characters (A-Z, a-z)
+sort lower than the other ones. Within each range, the ASCII decimal value
+of the character is used to sort between characters.
+
+=cut
+
+sub _version_order {
+    my $x = shift;
+
+    if ($x eq '~') {
+        return -1;
+    } elsif ($x =~ /^\d$/) {
+        return $x * 1 + 1;
+    } elsif ($x =~ /^[A-Za-z]$/) {
+        return ord($x);
+    } else {
+        return ord($x) + 256;
+    }
+}
+
+sub version_compare_string($$) {
+    my @a = map { _version_order($_) } split(//, shift);
+    my @b = map { _version_order($_) } split(//, shift);
+    while (1) {
+        my ($a, $b) = (shift @a, shift @b);
+        return 0 if not defined($a) and not defined($b);
+        $a ||= 0; # Default order for "no character"
+        $b ||= 0;
+        return 1 if $a > $b;
+        return -1 if $a < $b;
+    }
+}
+
+=item version_compare_part($a, $b)
+
+Compare two corresponding sub-parts of a version number (either upstream
+version or debian revision).
+
+Each parameter is split by version_split_digits() and resulting items
+are compared together. As soon as a difference happens, it returns -1 if
+$a is earlier than $b, 0 if they are equal and 1 if $a is later than $b.
+
+=cut
+
+sub version_compare_part($$) {
+    my @a = version_split_digits(shift);
+    my @b = version_split_digits(shift);
+    while (1) {
+        my ($a, $b) = (shift @a, shift @b);
+        return 0 if not defined($a) and not defined($b);
+        $a ||= 0; # Default value for lack of version
+        $b ||= 0;
+        if ($a =~ /^\d+$/ and $b =~ /^\d+$/) {
+            # Numerical comparison
+            my $cmp = $a <=> $b;
+            return $cmp if $cmp;
+        } else {
+            # String comparison
+            my $cmp = version_compare_string($a, $b);
+            return $cmp if $cmp;
+        }
+    }
+}
+
+=item @items = version_split_digits($version)
+
+Splits a string in items that are each entirely composed either
+of digits or of non-digits. For instance for "1.024~beta1+svn234" it would
+return ("1", ".", "024", "~beta", "1", "+svn", "234").
+
+=cut
+
+sub version_split_digits($) {
+    my $version = shift;
+
+    return split /(?<=\d)(?=\D)|(?<=\D)(?=\d)/, $version;
+}
+
+=item ($ok, $msg) = version_check($version)
+
+=item $ok = version_check($version)
+
+Checks the validity of $version as a version number. Returns 1 in $ok
+if the version is valid, 0 otherwise. In the latter case, $msg
+contains a description of the problem with the $version scalar.
+
+=cut
+
+sub version_check($) {
+    my $version = shift;
+    my $str;
+    if (defined $version) {
+        $str = "$version";
+        $version = Dpkg::Version->new($str) unless ref($version);
+    }
+    if (not defined($str) or not length($str)) {
+        my $msg = g_('version number cannot be empty');
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if (not defined $version->epoch() or not length $version->epoch()) {
+        my $msg = sprintf(g_('epoch part of the version number cannot be empty'));
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if (not defined $version->version() or not length $version->version()) {
+        my $msg = g_('upstream version cannot be empty');
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if (not defined $version->revision() or not length $version->revision()) {
+        my $msg = sprintf(g_('revision cannot be empty'));
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if ($version->version() =~ m/^[^\d]/) {
+        my $msg = g_('version number does not start with digit');
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if ($str =~ m/([^-+:.0-9a-zA-Z~])/o) {
+        my $msg = sprintf g_("version number contains illegal character '%s'"), $1;
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    if ($version->epoch() !~ /^\d*$/) {
+        my $msg = sprintf(g_('epoch part of the version number ' .
+                             "is not a number: '%s'"), $version->epoch());
+        return (0, $msg) if wantarray;
+        return 0;
+    }
+    return (1, '') if wantarray;
+    return 1;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.03 (dpkg 1.20.0)
+
+Remove deprecation warning from semantic change in 1.02.
+
+=head2 Version 1.02 (dpkg 1.19.1)
+
+Semantic change: bool evaluation semantics restored to their original behavior.
+
+=head2 Version 1.01 (dpkg 1.17.0)
+
+New argument: Accept an options argument in $v->as_string().
+
+New method: $v->is_native().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;