Commit 08f65750 authored by Raphaël Hertzog's avatar Raphaël Hertzog

Extract Dpkg::Source::Quilt out of Dpkg::Source::Package::V3::quilt

This new Dpkg::Source::Quilt object handles all the traditional quilt
operations of applying/unapplying patches and the associated handling of
the quilt database (the .pc directory).

This commit should not introduce any user-visible changes.
parent 837de73d
This diff is collapsed.
# 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 <http://www.gnu.org/licenses/>.
package Dpkg::Source::Quilt;
use strict;
use warnings;
our $VERSION = "0.01";
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Source::Patch;
use Dpkg::Source::Functions qw(erasedir fs_time);
use Dpkg::Vendor qw(get_current_vendor);
use File::Spec;
use File::Copy;
use File::Find;
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) = @_;
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) {
open(VERSION, ">", $file) or syserr(_g("cannot write %s"), $file);
print VERSION "2\n";
close(VERSION);
}
# 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) {
open(QPATCH, ">", $file) or syserr(_g("cannot write %s"), $file);
print QPATCH "debian/patches\n";
close(QPATCH);
}
$file = $self->get_db_file(".quilt_series");
if (not -e $file) {
open(QSERIES, ">", $file) or syserr(_g("cannot write %s"), $file);
my $series = $self->get_series_file();
$series = (File::Spec->splitpath($series))[2];
print QSERIES "$series\n";
close(QSERIES);
}
}
sub load_db {
my ($self) = @_;
my $pc_applied = $self->get_db_file("applied-patches");
$self->{'applied-patches'} = [ $self->read_patch_list($pc_applied) ];
}
sub write_db {
my ($self) = @_;
$self->setup_db();
my $pc_applied = $self->get_db_file("applied-patches");
open(APPLIED, ">", $pc_applied) or syserr(_g("cannot write %s"), $pc_applied);
foreach my $patch (@{$self->{'applied-patches'}}) {
print APPLIED "$patch\n";
}
close(APPLIED);
}
sub load_series {
my ($self, %opts) = @_;
my $series = $self->get_series_file();
$self->{'series'} = [ $self->read_patch_list($series, %opts) ];
}
sub series {
my ($self) = @_;
return @{$self->{'series'}};
}
sub applied {
my ($self) = @_;
return @{$self->{'applied-patches'}};
}
sub top {
my ($self) = @_;
my $count = scalar @{$self->{'applied-patches'}};
return $self->{'applied-patches'}[$count - 1] if $count;
return undef;
}
sub next {
my ($self) = @_;
my $count_applied = scalar @{$self->{'applied-patches'}};
my $count_series = scalar @{$self->{'series'}};
return $self->{'series'}[$count_applied] if ($count_series > $count_applied);
return undef;
}
sub push {
my ($self, %opts) = @_;
$opts{"verbose"} = 0 unless defined($opts{"verbose"});
$opts{"timestamp"} = fs_time($self->{'dir'}) unless defined($opts{"timestamp"});
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', '-g0', '-E', '-b',
'-B', ".pc/$patch/", '--reject-file=-' ]);
};
if ($@) {
info(_g("fuzz is not allowed when applying patches"));
info(_g("if patch '%s' is correctly applied by quilt, use '%s' to update it"),
$patch, "quilt refresh");
$self->restore_quilt_backup_files($patch, %opts);
erasedir($self->get_db_file($patch));
die $@;
}
CORE::push @{$self->{'applied-patches'}}, $patch;
$self->write_db();
}
sub pop {
my ($self, %opts) = @_;
$opts{"verbose"} = 0 unless defined($opts{"verbose"});
$opts{"timestamp"} = fs_time($self->{'dir'}) unless defined($opts{"timestamp"});
$opts{"reverse_apply"} = 0 unless defined($opts{"reverse_apply"});
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', '-g0', '-E',
'--no-backup-if-mismatch' ]);
}
erasedir($backup_dir);
pop @{$self->{'applied-patches'}};
$self->write_db();
}
sub get_db_version {
my ($self) = @_;
my $pc_ver = $self->get_db_file(".version");
if (-f $pc_ver) {
open(VER, "<", $pc_ver) || syserr(_g("cannot read %s"), $pc_ver);
my $version = <VER>;
chomp $version;
close(VER);
return $version;
}
return undef;
}
sub find_problems {
my ($self) = @_;
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 undef;
}
sub get_series_file {
my ($self) = @_;
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) = @_;
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) = @_;
return $self->get_patch_file();
}
## METHODS BELOW ARE INTERNAL ##
sub read_patch_list {
my ($self, $file, %opts) = @_;
return () if not defined $file or not -f $file;
$opts{"warn_options"} = 0 unless defined($opts{"warn_options"});
my @patches;
open(SERIES, "<" , $file) || syserr(_g("cannot read %s"), $file);
while(defined($_ = <SERIES>)) {
chomp; s/^\s+//; s/\s+$//; # Strip leading/trailing spaces
s/(^|\s+)#.*$//; # Strip comment
next unless $_;
if (/^(\S+)\s+(.*)$/) {
$_ = $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"};
}
}
error(_g("%s contains an insecure path: %s"), $file, $_) if m{(^|/)\.\./};
CORE::push @patches, $_;
}
close(SERIES);
return @patches;
}
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);
unless (link($_, $target)) {
copy($_, $target) ||
syserr(_g("failed to copy %s to %s"), $_, $target);
chmod($target, (stat(_))[2]) ||
syserr(_g("unable to change permission of `%s'"), $target);
}
} else {
# empty files are "backups" for new files that patch created
unlink($target);
}
}
}, $patch_dir);
}
# vim:et:sw=4:ts=8
1;
......@@ -99,6 +99,7 @@ nobase_dist_perllib_DATA = \
Dpkg/Source/Package/V3/git.pm \
Dpkg/Source/Package/V3/quilt.pm \
Dpkg/Source/Patch.pm \
Dpkg/Source/Quilt.pm \
Dpkg/Substvars.pm \
Dpkg/Vars.pm \
Dpkg/Vendor.pm \
......
......@@ -59,6 +59,7 @@ scripts/Dpkg/Source/Package/V3/custom.pm
scripts/Dpkg/Source/Package/V3/native.pm
scripts/Dpkg/Source/Package/V3/git.pm
scripts/Dpkg/Source/Package/V3/quilt.pm
scripts/Dpkg/Source/Quilt.pm
scripts/Dpkg/Substvars.pm
scripts/Dpkg/Vars.pm
scripts/Dpkg/Vendor.pm
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment