| OLD | NEW |
|---|
| (Empty) |
| 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::Quilt; | |
| 17 | |
| 18 use strict; | |
| 19 use warnings; | |
| 20 | |
| 21 our $VERSION = '0.01'; | |
| 22 | |
| 23 use Dpkg::Gettext; | |
| 24 use Dpkg::ErrorHandling; | |
| 25 use Dpkg::Source::Patch; | |
| 26 use Dpkg::Source::Functions qw(erasedir fs_time); | |
| 27 use Dpkg::Vendor qw(get_current_vendor); | |
| 28 | |
| 29 use File::Spec; | |
| 30 use File::Copy; | |
| 31 use File::Find; | |
| 32 use File::Path qw(make_path); | |
| 33 use File::Basename; | |
| 34 | |
| 35 sub new { | |
| 36 my ($this, $dir, %opts) = @_; | |
| 37 my $class = ref($this) || $this; | |
| 38 | |
| 39 my $self = { | |
| 40 dir => $dir, | |
| 41 }; | |
| 42 bless $self, $class; | |
| 43 | |
| 44 $self->load_series(); | |
| 45 $self->load_db(); | |
| 46 | |
| 47 return $self; | |
| 48 } | |
| 49 | |
| 50 sub setup_db { | |
| 51 my ($self) = @_; | |
| 52 my $db_dir = $self->get_db_file(); | |
| 53 if (not -d $db_dir) { | |
| 54 mkdir $db_dir or syserr(_g('cannot mkdir %s'), $db_dir); | |
| 55 } | |
| 56 my $file = $self->get_db_file('.version'); | |
| 57 if (not -e $file) { | |
| 58 open(my $version_fh, '>', $file) or syserr(_g('cannot write %s'), $file)
; | |
| 59 print { $version_fh } "2\n"; | |
| 60 close($version_fh); | |
| 61 } | |
| 62 # The files below are used by quilt to know where patches are stored | |
| 63 # and what file contains the patch list (supported by quilt >= 0.48-5 | |
| 64 # in Debian). | |
| 65 $file = $self->get_db_file('.quilt_patches'); | |
| 66 if (not -e $file) { | |
| 67 open(my $qpatch_fh, '>', $file) or syserr(_g('cannot write %s'), $file); | |
| 68 print { $qpatch_fh } "debian/patches\n"; | |
| 69 close($qpatch_fh); | |
| 70 } | |
| 71 $file = $self->get_db_file('.quilt_series'); | |
| 72 if (not -e $file) { | |
| 73 open(my $qseries_fh, '>', $file) or syserr(_g('cannot write %s'), $file)
; | |
| 74 my $series = $self->get_series_file(); | |
| 75 $series = (File::Spec->splitpath($series))[2]; | |
| 76 print { $qseries_fh } "$series\n"; | |
| 77 close($qseries_fh); | |
| 78 } | |
| 79 } | |
| 80 | |
| 81 sub load_db { | |
| 82 my ($self) = @_; | |
| 83 | |
| 84 my $pc_applied = $self->get_db_file('applied-patches'); | |
| 85 $self->{applied_patches} = [ $self->read_patch_list($pc_applied) ]; | |
| 86 } | |
| 87 | |
| 88 sub write_db { | |
| 89 my ($self) = @_; | |
| 90 | |
| 91 $self->setup_db(); | |
| 92 my $pc_applied = $self->get_db_file('applied-patches'); | |
| 93 open(my $applied_fh, '>', $pc_applied) or | |
| 94 syserr(_g('cannot write %s'), $pc_applied); | |
| 95 foreach my $patch (@{$self->{applied_patches}}) { | |
| 96 print { $applied_fh } "$patch\n"; | |
| 97 } | |
| 98 close($applied_fh); | |
| 99 } | |
| 100 | |
| 101 sub load_series { | |
| 102 my ($self, %opts) = @_; | |
| 103 | |
| 104 my $series = $self->get_series_file(); | |
| 105 $self->{series} = [ $self->read_patch_list($series, %opts) ]; | |
| 106 } | |
| 107 | |
| 108 sub series { | |
| 109 my ($self) = @_; | |
| 110 return @{$self->{series}}; | |
| 111 } | |
| 112 | |
| 113 sub applied { | |
| 114 my ($self) = @_; | |
| 115 return @{$self->{applied_patches}}; | |
| 116 } | |
| 117 | |
| 118 sub top { | |
| 119 my ($self) = @_; | |
| 120 my $count = scalar @{$self->{applied_patches}}; | |
| 121 return $self->{applied_patches}[$count - 1] if $count; | |
| 122 return; | |
| 123 } | |
| 124 | |
| 125 sub next { | |
| 126 my ($self) = @_; | |
| 127 my $count_applied = scalar @{$self->{applied_patches}}; | |
| 128 my $count_series = scalar @{$self->{series}}; | |
| 129 return $self->{series}[$count_applied] if ($count_series > $count_applied); | |
| 130 return; | |
| 131 } | |
| 132 | |
| 133 sub push { | |
| 134 my ($self, %opts) = @_; | |
| 135 $opts{verbose} //= 0; | |
| 136 $opts{timestamp} //= fs_time($self->{dir}); | |
| 137 | |
| 138 my $patch = $self->next(); | |
| 139 return unless defined $patch; | |
| 140 | |
| 141 my $path = $self->get_patch_file($patch); | |
| 142 my $obj = Dpkg::Source::Patch->new(filename => $path); | |
| 143 | |
| 144 info(_g('applying %s'), $patch) if $opts{verbose}; | |
| 145 eval { | |
| 146 $obj->apply($self->{dir}, timestamp => $opts{timestamp}, | |
| 147 verbose => $opts{verbose}, | |
| 148 force_timestamp => 1, create_dirs => 1, remove_backup => 0, | |
| 149 options => [ '-t', '-F', '0', '-N', '-p1', '-u', | |
| 150 '-V', 'never', '-g0', '-E', '-b', | |
| 151 '-B', ".pc/$patch/", '--reject-file=-' ]); | |
| 152 }; | |
| 153 if ($@) { | |
| 154 info(_g('fuzz is not allowed when applying patches')); | |
| 155 info(_g("if patch '%s' is correctly applied by quilt, use '%s' to update
it"), | |
| 156 $patch, 'quilt refresh'); | |
| 157 $self->restore_quilt_backup_files($patch, %opts); | |
| 158 erasedir($self->get_db_file($patch)); | |
| 159 die $@; | |
| 160 } | |
| 161 CORE::push @{$self->{applied_patches}}, $patch; | |
| 162 $self->write_db(); | |
| 163 } | |
| 164 | |
| 165 sub pop { | |
| 166 my ($self, %opts) = @_; | |
| 167 $opts{verbose} //= 0; | |
| 168 $opts{timestamp} //= fs_time($self->{dir}); | |
| 169 $opts{reverse_apply} //= 0; | |
| 170 | |
| 171 my $patch = $self->top(); | |
| 172 return unless defined $patch; | |
| 173 | |
| 174 info(_g('unapplying %s'), $patch) if $opts{verbose}; | |
| 175 my $backup_dir = $self->get_db_file($patch); | |
| 176 if (-d $backup_dir and not $opts{reverse_apply}) { | |
| 177 # Use the backup copies to restore | |
| 178 $self->restore_quilt_backup_files($patch); | |
| 179 } else { | |
| 180 # Otherwise reverse-apply the patch | |
| 181 my $path = $self->get_patch_file($patch); | |
| 182 my $obj = Dpkg::Source::Patch->new(filename => $path); | |
| 183 | |
| 184 $obj->apply($self->{dir}, timestamp => $opts{timestamp}, | |
| 185 verbose => 0, force_timestamp => 1, remove_backup => 0, | |
| 186 options => [ '-R', '-t', '-N', '-p1', | |
| 187 '-u', '-V', 'never', '-g0', '-E', | |
| 188 '--no-backup-if-mismatch' ]); | |
| 189 } | |
| 190 | |
| 191 erasedir($backup_dir); | |
| 192 pop @{$self->{applied_patches}}; | |
| 193 $self->write_db(); | |
| 194 } | |
| 195 | |
| 196 sub get_db_version { | |
| 197 my ($self) = @_; | |
| 198 my $pc_ver = $self->get_db_file('.version'); | |
| 199 if (-f $pc_ver) { | |
| 200 open(my $ver_fh, '<', $pc_ver) or syserr(_g('cannot read %s'), $pc_ver); | |
| 201 my $version = <$ver_fh>; | |
| 202 chomp $version; | |
| 203 close($ver_fh); | |
| 204 return $version; | |
| 205 } | |
| 206 return; | |
| 207 } | |
| 208 | |
| 209 sub find_problems { | |
| 210 my ($self) = @_; | |
| 211 my $patch_dir = $self->get_patch_file(); | |
| 212 if (-e $patch_dir and not -d _) { | |
| 213 return sprintf(_g('%s should be a directory or non-existing'), $patch_di
r); | |
| 214 } | |
| 215 my $series = $self->get_series_file(); | |
| 216 if (-e $series and not -f _) { | |
| 217 return sprintf(_g('%s should be a file or non-existing'), $series); | |
| 218 } | |
| 219 return; | |
| 220 } | |
| 221 | |
| 222 sub get_series_file { | |
| 223 my ($self) = @_; | |
| 224 my $vendor = lc(get_current_vendor() || 'debian'); | |
| 225 # Series files are stored alongside patches | |
| 226 my $default_series = $self->get_patch_file('series'); | |
| 227 my $vendor_series = $self->get_patch_file("$vendor.series"); | |
| 228 return $vendor_series if -e $vendor_series; | |
| 229 return $default_series; | |
| 230 } | |
| 231 | |
| 232 sub get_db_file { | |
| 233 my $self = shift; | |
| 234 return File::Spec->catfile($self->{dir}, '.pc', @_); | |
| 235 } | |
| 236 | |
| 237 sub get_db_dir { | |
| 238 my ($self) = @_; | |
| 239 return $self->get_db_file(); | |
| 240 } | |
| 241 | |
| 242 sub get_patch_file { | |
| 243 my $self = shift; | |
| 244 return File::Spec->catfile($self->{dir}, 'debian', 'patches', @_); | |
| 245 } | |
| 246 | |
| 247 sub get_patch_dir { | |
| 248 my ($self) = @_; | |
| 249 return $self->get_patch_file(); | |
| 250 } | |
| 251 | |
| 252 ## METHODS BELOW ARE INTERNAL ## | |
| 253 | |
| 254 sub read_patch_list { | |
| 255 my ($self, $file, %opts) = @_; | |
| 256 return () if not defined $file or not -f $file; | |
| 257 $opts{warn_options} //= 0; | |
| 258 my @patches; | |
| 259 open(my $series_fh, '<' , $file) or syserr(_g('cannot read %s'), $file); | |
| 260 while (defined($_ = <$series_fh>)) { | |
| 261 chomp; s/^\s+//; s/\s+$//; # Strip leading/trailing spaces | |
| 262 s/(^|\s+)#.*$//; # Strip comment | |
| 263 next unless $_; | |
| 264 if (/^(\S+)\s+(.*)$/) { | |
| 265 $_ = $1; | |
| 266 if ($2 ne '-p1') { | |
| 267 warning(_g('the series file (%s) contains unsupported ' . | |
| 268 "options ('%s', line %s); dpkg-source might " . | |
| 269 'fail when applying patches'), | |
| 270 $file, $2, $.) if $opts{warn_options}; | |
| 271 } | |
| 272 } | |
| 273 error(_g('%s contains an insecure path: %s'), $file, $_) if m{(^|/)\.\./
}; | |
| 274 CORE::push @patches, $_; | |
| 275 } | |
| 276 close($series_fh); | |
| 277 return @patches; | |
| 278 } | |
| 279 | |
| 280 sub restore_quilt_backup_files { | |
| 281 my ($self, $patch, %opts) = @_; | |
| 282 my $patch_dir = $self->get_db_file($patch); | |
| 283 return unless -d $patch_dir; | |
| 284 info(_g('restoring quilt backup files for %s'), $patch) if $opts{verbose}; | |
| 285 find({ | |
| 286 no_chdir => 1, | |
| 287 wanted => sub { | |
| 288 return if -d $_; | |
| 289 my $relpath_in_srcpkg = File::Spec->abs2rel($_, $patch_dir); | |
| 290 my $target = File::Spec->catfile($self->{dir}, $relpath_in_srcpkg); | |
| 291 if (-s $_) { | |
| 292 unlink($target); | |
| 293 make_path(dirname($target)); | |
| 294 unless (link($_, $target)) { | |
| 295 copy($_, $target) | |
| 296 or syserr(_g('failed to copy %s to %s'), $_, $target); | |
| 297 chmod((stat(_))[2], $target) | |
| 298 or syserr(_g("unable to change permission of `%s'"), $ta
rget); | |
| 299 } | |
| 300 } else { | |
| 301 # empty files are "backups" for new files that patch created | |
| 302 unlink($target); | |
| 303 } | |
| 304 } | |
| 305 }, $patch_dir); | |
| 306 } | |
| 307 | |
| 308 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
