summaryrefslogtreecommitdiffstats
path: root/scripts/Dpkg/Source/Package/V3
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/Dpkg/Source/Package/V3')
-rw-r--r--scripts/Dpkg/Source/Package/V3/Bzr.pm212
-rw-r--r--scripts/Dpkg/Source/Package/V3/Custom.pm74
-rw-r--r--scripts/Dpkg/Source/Package/V3/Git.pm257
-rw-r--r--scripts/Dpkg/Source/Package/V3/Native.pm119
-rw-r--r--scripts/Dpkg/Source/Package/V3/Quilt.pm270
5 files changed, 932 insertions, 0 deletions
diff --git a/scripts/Dpkg/Source/Package/V3/Bzr.pm b/scripts/Dpkg/Source/Package/V3/Bzr.pm
new file mode 100644
index 0000000..13d49c7
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Bzr.pm
@@ -0,0 +1,212 @@
+#
+# 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::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 _sanity_check {
+ 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/_/-/;
+
+ _sanity_check($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 $dscdir = $self->{basedir};
+
+ 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 => "$dscdir$tarfile");
+ $tar->extract($newdirectory);
+
+ _sanity_check($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..a915807
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Git.pm
@@ -0,0 +1,257 @@
+#
+# 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::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 _sanity_check {
+ 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;
+}
+
+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);
+
+ _sanity_check($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 $dscdir = $self->{basedir};
+ 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);
+ system('git', 'clone', '--quiet', $dscdir . $bundle, $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'));
+ system('cp', '-f', $dscdir . $shallow, "$newdirectory/.git/shallow");
+ subprocerr('cp') if $?;
+ }
+
+ _sanity_check($newdirectory);
+}
+
+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..b53a30f
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Native.pm
@@ -0,0 +1,119 @@
+# 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::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 $dscdir = $self->{basedir};
+ 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 v1.0 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 => "$dscdir$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..45237d2
--- /dev/null
+++ b/scripts/Dpkg/Source/Package/V3/Quilt.pm
@@ -0,0 +1,270 @@
+# 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::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');
+ open(my $unapply_fh, '>', $pc_unapply)
+ or syserr(g_('cannot write %s'), $pc_unapply);
+ close($unapply_fh);
+ }
+
+ # 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;