Index: third_party/dpkg-dev/scripts/Dpkg/Source/Quilt.pm |
diff --git a/third_party/dpkg-dev/scripts/Dpkg/Source/Quilt.pm b/third_party/dpkg-dev/scripts/Dpkg/Source/Quilt.pm |
new file mode 100644 |
index 0000000000000000000000000000000000000000..7716927eb62ba2e9e6f133bab63a22eee62c6883 |
--- /dev/null |
+++ b/third_party/dpkg-dev/scripts/Dpkg/Source/Quilt.pm |
@@ -0,0 +1,308 @@ |
+# 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.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; |
+use File::Path qw(make_path); |
+use File::Basename; |
+ |
+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(my $version_fh, '>', $file) or syserr(_g('cannot write %s'), $file); |
+ print { $version_fh } "2\n"; |
+ close($version_fh); |
+ } |
+ # 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(my $qpatch_fh, '>', $file) or syserr(_g('cannot write %s'), $file); |
+ print { $qpatch_fh } "debian/patches\n"; |
+ close($qpatch_fh); |
+ } |
+ $file = $self->get_db_file('.quilt_series'); |
+ if (not -e $file) { |
+ open(my $qseries_fh, '>', $file) or syserr(_g('cannot write %s'), $file); |
+ my $series = $self->get_series_file(); |
+ $series = (File::Spec->splitpath($series))[2]; |
+ print { $qseries_fh } "$series\n"; |
+ close($qseries_fh); |
+ } |
+} |
+ |
+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(my $applied_fh, '>', $pc_applied) or |
+ syserr(_g('cannot write %s'), $pc_applied); |
+ foreach my $patch (@{$self->{applied_patches}}) { |
+ print { $applied_fh } "$patch\n"; |
+ } |
+ close($applied_fh); |
+} |
+ |
+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; |
+} |
+ |
+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; |
+} |
+ |
+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', '-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; |
+ $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', '-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(my $ver_fh, '<', $pc_ver) or syserr(_g('cannot read %s'), $pc_ver); |
+ my $version = <$ver_fh>; |
+ chomp $version; |
+ close($ver_fh); |
+ return $version; |
+ } |
+ return; |
+} |
+ |
+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; |
+} |
+ |
+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; |
+ my @patches; |
+ open(my $series_fh, '<' , $file) or syserr(_g('cannot read %s'), $file); |
+ while (defined($_ = <$series_fh>)) { |
+ 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_fh); |
+ 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); |
+ make_path(dirname($target)); |
+ unless (link($_, $target)) { |
+ copy($_, $target) |
+ or syserr(_g('failed to copy %s to %s'), $_, $target); |
+ chmod((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; |