765 lines
27 KiB
Perl
765 lines
27 KiB
Perl
# 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/>.
|
|
|
|
=encoding utf8
|
|
|
|
=head1 NAME
|
|
|
|
Dpkg::Source::Package::V2 - class for source format 2.0
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides a class to handle the source package format 2.0.
|
|
|
|
B<Note>: This is a private module, its API can change at any time.
|
|
|
|
=cut
|
|
|
|
package Dpkg::Source::Package::V2 0.01;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
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_basedirname();
|
|
|
|
# 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}) {
|
|
hint(g_('make sure the version in debian/changelog matches ' .
|
|
'the unpacked source tree'));
|
|
hint(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';
|
|
Description: 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.
|
|
Forwarded: not-needed
|
|
|
|
---
|
|
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);
|
|
}
|
|
|
|
=head1 CHANGES
|
|
|
|
=head2 Version 0.xx
|
|
|
|
This is a private module.
|
|
|
|
=cut
|
|
|
|
1;
|