chiark - git - mdw - dpkg/blob - scripts/Dpkg/Source/Package/V3/Quilt.pm

   1 # Copyright © 2008-2012 Raphaël Hertzog <hertzog@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 package Dpkg::Source::Package::V3::Quilt;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '0.01';
  22
  23 use File::Spec;
  24 use File::Copy;
  25
  26 use Dpkg::Gettext;
  27 use Dpkg::ErrorHandling;
  28 use Dpkg::Util qw(:list);
  29 use Dpkg::Version;
  30 use Dpkg::Source::Patch;
  31 use Dpkg::Source::Functions qw(erasedir fs_time);
  32 use Dpkg::Source::Quilt;
  33 use Dpkg::Exit;
  34
  35 # Based on wig&pen implementation
  36 use parent qw(Dpkg::Source::Package::V2);
  37
  38 our $CURRENT_MINOR_VERSION = '0';
  39
  40 sub init_options {
  41     my $self = shift;
  42     $self->{options}{single_debian_patch} //= 0;
  43     $self->{options}{allow_version_of_quilt_db} //= [];
  44
  45     $self->SUPER::init_options();
  46 }
  47
  48 my @module_cmdline = (
  49     {
  50         name => '--single-debian-patch',
  51         help => N_('use a single debianization patch'),
  52         when => 'build',
  53     }, {
  54         name => '--allow-version-of-quilt-db=<version>',
  55         help => N_('accept quilt metadata <version> even if unknown'),
  56         when => 'build',
  57     }
  58 );
  59
  60 sub describe_cmdline_options {
  61     my $self = shift;
  62
  63     my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline );
  64
  65     return @cmdline;
  66 }
  67
  68 sub parse_cmdline_option {
  69     my ($self, $opt) = @_;
  70     return 1 if $self->SUPER::parse_cmdline_option($opt);
  71     if ($opt eq '--single-debian-patch') {
  72         $self->{options}{single_debian_patch} = 1;
  73         # For backwards compatibility.
  74         $self->{options}{auto_commit} = 1;
  75         return 1;
  76     } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) {
  77         push @{$self->{options}{allow_version_of_quilt_db}}, $1;
  78         return 1;
  79     }
  80     return 0;
  81 }
  82
  83 sub _build_quilt_object {
  84     my ($self, $dir) = @_;
  85     return $self->{quilt}{$dir} if exists $self->{quilt}{$dir};
  86     $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir);
  87     return $self->{quilt}{$dir};
  88 }
  89
  90 sub can_build {
  91     my ($self, $dir) = @_;
  92     my ($code, $msg) = $self->SUPER::can_build($dir);
  93     return ($code, $msg) if $code == 0;
  94
  95     my $v = Dpkg::Version->new($self->{fields}->{'Version'});
  96     return (0, g_('non-native package version does not contain a revision'))
  97         if $v->is_native();
  98
  99     my $quilt = $self->_build_quilt_object($dir);
 100     $msg = $quilt->find_problems();
 101     return (0, $msg) if $msg;
 102     return 1;
 103 }
 104
 105 sub get_autopatch_name {
 106     my $self = shift;
 107     if ($self->{options}{single_debian_patch}) {
 108         return 'debian-changes';
 109     } else {
 110         return 'debian-changes-' . $self->{fields}{'Version'};
 111     }
 112 }
 113
 114 sub apply_patches {
 115     my ($self, $dir, %opts) = @_;
 116
 117     if ($opts{usage} eq 'unpack') {
 118         $opts{verbose} = 1;
 119     } elsif ($opts{usage} eq 'build') {
 120         $opts{warn_options} = 1;
 121         $opts{verbose} = 0;
 122     }
 123
 124     my $quilt = $self->_build_quilt_object($dir);
 125     $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings
 126
 127     # Always create the quilt db so that if the maintainer calls quilt to
 128     # create a patch, it's stored in the right directory
 129     $quilt->save_db();
 130
 131     # Update debian/patches/series symlink if needed to allow quilt usage
 132     my $series = $quilt->get_series_file();
 133     my $basename = (File::Spec->splitpath($series))[2];
 134     if ($basename ne 'series') {
 135         my $dest = $quilt->get_patch_file('series');
 136         unlink($dest) if -l $dest;
 137         unless (-f _) { # Don't overwrite real files
 138             symlink($basename, $dest)
 139                 or syserr(g_("can't create symlink %s"), $dest);
 140         }
 141     }
 142
 143     return unless scalar($quilt->series());
 144
 145     if ($opts{usage} eq 'preparation' and
 146         $self->{options}{unapply_patches} eq 'auto') {
 147         # We're applying the patches in --before-build, remember to unapply
 148         # them afterwards in --after-build
 149         my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
 150         open(my $unapply_fh, '>', $pc_unapply)
 151             or syserr(g_('cannot write %s'), $pc_unapply);
 152         close($unapply_fh);
 153     }
 154
 155     # Apply patches
 156     my $pc_applied = $quilt->get_db_file('applied-patches');
 157     $opts{timestamp} = fs_time($pc_applied);
 158     if ($opts{skip_auto}) {
 159         my $auto_patch = $self->get_autopatch_name();
 160         $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch);
 161     } else {
 162         $quilt->push(%opts) while $quilt->next();
 163     }
 164 }
 165
 166 sub unapply_patches {
 167     my ($self, $dir, %opts) = @_;
 168
 169     my $quilt = $self->_build_quilt_object($dir);
 170
 171     $opts{verbose} //= 1;
 172
 173     my $pc_applied = $quilt->get_db_file('applied-patches');
 174     my @applied = $quilt->applied();
 175     $opts{timestamp} = fs_time($pc_applied) if @applied;
 176
 177     $quilt->pop(%opts) while $quilt->top();
 178
 179     erasedir($quilt->get_db_dir());
 180 }
 181
 182 sub prepare_build {
 183     my ($self, $dir) = @_;
 184     $self->SUPER::prepare_build($dir);
 185     # Skip .pc directories of quilt by default and ignore difference
 186     # on debian/patches/series symlinks and d/p/.dpkg-source-applied
 187     # stamp file created by ourselves
 188     my $func = sub {
 189         my $pathname = shift;
 190
 191         return 1 if $pathname eq 'debian/patches/series' and -l $pathname;
 192         return 1 if $pathname =~ /^\.pc(\/|$)/;
 193         return 1 if $pathname =~ /$self->{options}{diff_ignore_regex}/;
 194         return 0;
 195     };
 196     $self->{diff_options}{diff_ignore_func} = $func;
 197 }
 198
 199 sub do_build {
 200     my ($self, $dir) = @_;
 201
 202     my $quilt = $self->_build_quilt_object($dir);
 203     my $version = $quilt->get_db_version();
 204
 205     if (defined($version) and $version != 2) {
 206         if (any { $version eq $_ }
 207             @{$self->{options}{allow_version_of_quilt_db}})
 208         {
 209             warning(g_('unsupported version of the quilt metadata: %s'), $version);
 210         } else {
 211             error(g_('unsupported version of the quilt metadata: %s'), $version);
 212         }
 213     }
 214
 215     $self->SUPER::do_build($dir);
 216 }
 217
 218 sub after_build {
 219     my ($self, $dir) = @_;
 220     my $quilt = $self->_build_quilt_object($dir);
 221     my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
 222     my $opt_unapply = $self->{options}{unapply_patches};
 223     if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') {
 224         unlink($pc_unapply);
 225         $self->unapply_patches($dir);
 226     }
 227 }
 228
 229 sub check_patches_applied {
 230     my ($self, $dir) = @_;
 231
 232     my $quilt = $self->_build_quilt_object($dir);
 233     my $next = $quilt->next();
 234     return if not defined $next;
 235
 236     my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next);
 237     my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch);
 238     return unless $patch_obj->check_apply($dir, fatal_dupes => 1);
 239
 240     $self->apply_patches($dir, usage => 'preparation', verbose => 1);
 241 }
 242
 243 sub register_patch {
 244     my ($self, $dir, $tmpdiff, $patch_name) = @_;
 245
 246     my $quilt = $self->_build_quilt_object($dir);
 247     my $patch = $quilt->get_patch_file($patch_name);
 248
 249     if (-s $tmpdiff) {
 250         copy($tmpdiff, $patch)
 251             or syserr(g_('failed to copy %s to %s'), $tmpdiff, $patch);
 252         chmod(0666 & ~ umask(), $patch)
 253             or syserr(g_("unable to change permission of '%s'"), $patch);
 254     } elsif (-e $patch) {
 255         unlink($patch) or syserr(g_('cannot remove %s'), $patch);
 256     }
 257
 258     if (-e $patch) {
 259         # Add patch to series file
 260         $quilt->register($patch_name);
 261     } else {
 262         # Remove auto_patch from series
 263         $quilt->unregister($patch_name);
 264     }
 265     return $patch;
 266 }
 267
 268 1;