| OLD | NEW |
| (Empty) |
| 1 # Copyright © 2008-2011 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::V2; | |
| 17 | |
| 18 use strict; | |
| 19 use warnings; | |
| 20 | |
| 21 our $VERSION = '0.01'; | |
| 22 | |
| 23 use parent qw(Dpkg::Source::Package); | |
| 24 | |
| 25 use Dpkg; | |
| 26 use Dpkg::Gettext; | |
| 27 use Dpkg::ErrorHandling; | |
| 28 use Dpkg::File; | |
| 29 use Dpkg::Compression; | |
| 30 use Dpkg::Source::Archive; | |
| 31 use Dpkg::Source::Patch; | |
| 32 use Dpkg::Exit qw(push_exit_handler pop_exit_handler); | |
| 33 use Dpkg::Source::Functions qw(erasedir is_binary fs_time); | |
| 34 use Dpkg::Vendor qw(run_vendor_hook); | |
| 35 use Dpkg::Control; | |
| 36 use Dpkg::Changelog::Parse; | |
| 37 | |
| 38 use POSIX qw(:errno_h); | |
| 39 use Cwd; | |
| 40 use File::Basename; | |
| 41 use File::Temp qw(tempfile tempdir); | |
| 42 use File::Path; | |
| 43 use File::Spec; | |
| 44 use File::Find; | |
| 45 use File::Copy; | |
| 46 | |
| 47 our $CURRENT_MINOR_VERSION = '0'; | |
| 48 | |
| 49 sub init_options { | |
| 50 my ($self) = @_; | |
| 51 $self->SUPER::init_options(); | |
| 52 $self->{options}{include_removal} = 0 | |
| 53 unless exists $self->{options}{include_removal}; | |
| 54 $self->{options}{include_timestamp} = 0 | |
| 55 unless exists $self->{options}{include_timestamp}; | |
| 56 $self->{options}{include_binaries} = 0 | |
| 57 unless exists $self->{options}{include_binaries}; | |
| 58 $self->{options}{preparation} = 1 | |
| 59 unless exists $self->{options}{preparation}; | |
| 60 $self->{options}{skip_patches} = 0 | |
| 61 unless exists $self->{options}{skip_patches}; | |
| 62 $self->{options}{unapply_patches} = 'auto' | |
| 63 unless exists $self->{options}{unapply_patches}; | |
| 64 $self->{options}{skip_debianization} = 0 | |
| 65 unless exists $self->{options}{skip_debianization}; | |
| 66 $self->{options}{create_empty_orig} = 0 | |
| 67 unless exists $self->{options}{create_empty_orig}; | |
| 68 $self->{options}{auto_commit} = 0 | |
| 69 unless exists $self->{options}{auto_commit}; | |
| 70 } | |
| 71 | |
| 72 sub parse_cmdline_option { | |
| 73 my ($self, $opt) = @_; | |
| 74 if ($opt =~ /^--include-removal$/) { | |
| 75 $self->{options}{include_removal} = 1; | |
| 76 return 1; | |
| 77 } elsif ($opt =~ /^--include-timestamp$/) { | |
| 78 $self->{options}{include_timestamp} = 1; | |
| 79 return 1; | |
| 80 } elsif ($opt =~ /^--include-binaries$/) { | |
| 81 $self->{options}{include_binaries} = 1; | |
| 82 return 1; | |
| 83 } elsif ($opt =~ /^--no-preparation$/) { | |
| 84 $self->{options}{preparation} = 0; | |
| 85 return 1; | |
| 86 } elsif ($opt =~ /^--skip-patches$/) { | |
| 87 $self->{options}{skip_patches} = 1; | |
| 88 return 1; | |
| 89 } elsif ($opt =~ /^--unapply-patches$/) { | |
| 90 $self->{options}{unapply_patches} = 'yes'; | |
| 91 return 1; | |
| 92 } elsif ($opt =~ /^--no-unapply-patches$/) { | |
| 93 $self->{options}{unapply_patches} = 'no'; | |
| 94 return 1; | |
| 95 } elsif ($opt =~ /^--skip-debianization$/) { | |
| 96 $self->{options}{skip_debianization} = 1; | |
| 97 return 1; | |
| 98 } elsif ($opt =~ /^--create-empty-orig$/) { | |
| 99 $self->{options}{create_empty_orig} = 1; | |
| 100 return 1; | |
| 101 } elsif ($opt =~ /^--abort-on-upstream-changes$/) { | |
| 102 $self->{options}{auto_commit} = 0; | |
| 103 return 1; | |
| 104 } elsif ($opt =~ /^--auto-commit$/) { | |
| 105 $self->{options}{auto_commit} = 1; | |
| 106 return 1; | |
| 107 } | |
| 108 return 0; | |
| 109 } | |
| 110 | |
| 111 sub do_extract { | |
| 112 my ($self, $newdirectory) = @_; | |
| 113 my $fields = $self->{fields}; | |
| 114 | |
| 115 my $dscdir = $self->{basedir}; | |
| 116 | |
| 117 my $basename = $self->get_basename(); | |
| 118 my $basenamerev = $self->get_basename(1); | |
| 119 | |
| 120 my ($tarfile, $debianfile, %origtar, %seen); | |
| 121 my ($tarsign, %origtarsign); | |
| 122 my $re_ext = compression_get_file_extension_regex(); | |
| 123 foreach my $file ($self->get_files()) { | |
| 124 my $uncompressed = $file; | |
| 125 $uncompressed =~ s/\.$re_ext$/.*/; | |
| 126 $uncompressed =~ s/\.$re_ext\.asc$/.*.asc/; | |
| 127 error(_g('duplicate files in %s source package: %s'), 'v2.0', | |
| 128 $uncompressed) if $seen{$uncompressed}; | |
| 129 $seen{$uncompressed} = 1; | |
| 130 if ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext$/) { | |
| 131 $tarfile = $file; | |
| 132 } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext\.asc$/) { | |
| 133 $tarsign = $file; | |
| 134 } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext$/)
{ | |
| 135 $origtar{$1} = $file; | |
| 136 } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext\.a
sc$/) { | |
| 137 $origtarsign{$1} = $file; | |
| 138 } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$re_ext$/) { | |
| 139 $debianfile = $file; | |
| 140 } else { | |
| 141 error(_g('unrecognized file for a %s source package: %s'), | |
| 142 'v2.0', $file); | |
| 143 } | |
| 144 } | |
| 145 | |
| 146 unless ($tarfile and $debianfile) { | |
| 147 error(_g('missing orig.tar or debian.tar file in v2.0 source package')); | |
| 148 } | |
| 149 if ($tarsign and $tarfile ne substr $tarsign, 0, -4) { | |
| 150 error(_g('mismatched orig.tar %s for signature %s in source package'), | |
| 151 $tarfile, $tarsign); | |
| 152 } | |
| 153 foreach my $name (keys %origtarsign) { | |
| 154 error(_g('missing addon orig.tar for signature %s in source package'), | |
| 155 $origtarsign{$name}) | |
| 156 if not exists $origtar{$name}; | |
| 157 error(_g('mismatched addon orig.tar %s for signature %s in source packag
e'), | |
| 158 $origtar{$name}, $origtarsign{$name}) | |
| 159 if $origtar{$name} ne substr $origtarsign{$name}, 0, -4; | |
| 160 } | |
| 161 | |
| 162 erasedir($newdirectory); | |
| 163 | |
| 164 # Extract main tarball | |
| 165 info(_g('unpacking %s'), $tarfile); | |
| 166 my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); | |
| 167 $tar->extract($newdirectory, no_fixperms => 1, | |
| 168 options => [ '--anchored', '--no-wildcards-match-slash', | |
| 169 '--exclude', '*/.pc', '--exclude', '.pc' ]); | |
| 170 # The .pc exclusion is only needed for 3.0 (quilt) and to avoid | |
| 171 # having an upstream tarball provide a directory with symlinks | |
| 172 # that would be blindly followed when applying the patches | |
| 173 | |
| 174 # Extract additional orig tarballs | |
| 175 foreach my $subdir (keys %origtar) { | |
| 176 my $file = $origtar{$subdir}; | |
| 177 info(_g('unpacking %s'), $file); | |
| 178 if (-e "$newdirectory/$subdir") { | |
| 179 warning(_g("required removal of `%s' installed by original tarball")
, $subdir); | |
| 180 erasedir("$newdirectory/$subdir"); | |
| 181 } | |
| 182 $tar = Dpkg::Source::Archive->new(filename => "$dscdir$file"); | |
| 183 $tar->extract("$newdirectory/$subdir", no_fixperms => 1); | |
| 184 } | |
| 185 | |
| 186 # Stop here if debianization is not wanted | |
| 187 return if $self->{options}{skip_debianization}; | |
| 188 | |
| 189 # Extract debian tarball after removing the debian directory | |
| 190 info(_g('unpacking %s'), $debianfile); | |
| 191 erasedir("$newdirectory/debian"); | |
| 192 # Exclude existing symlinks from extraction of debian.tar.gz as we | |
| 193 # don't want to overwrite something outside of $newdirectory due to a | |
| 194 # symlink | |
| 195 my @exclude_symlinks; | |
| 196 my $wanted = sub { | |
| 197 return if not -l $_; | |
| 198 my $fn = File::Spec->abs2rel($_, $newdirectory); | |
| 199 push @exclude_symlinks, '--exclude', $fn; | |
| 200 }; | |
| 201 find({ wanted => $wanted, no_chdir => 1 }, $newdirectory); | |
| 202 $tar = Dpkg::Source::Archive->new(filename => "$dscdir$debianfile"); | |
| 203 $tar->extract($newdirectory, in_place => 1, | |
| 204 options => [ '--anchored', '--no-wildcards', | |
| 205 @exclude_symlinks ]); | |
| 206 | |
| 207 # Apply patches (in a separate method as it might be overriden) | |
| 208 $self->apply_patches($newdirectory, usage => 'unpack') | |
| 209 unless $self->{options}{skip_patches}; | |
| 210 } | |
| 211 | |
| 212 sub get_autopatch_name { | |
| 213 return 'zz_debian-diff-auto'; | |
| 214 } | |
| 215 | |
| 216 sub get_patches { | |
| 217 my ($self, $dir, %opts) = @_; | |
| 218 $opts{skip_auto} //= 0; | |
| 219 my @patches; | |
| 220 my $pd = "$dir/debian/patches"; | |
| 221 my $auto_patch = $self->get_autopatch_name(); | |
| 222 if (-d $pd) { | |
| 223 opendir(my $dir_dh, $pd) or syserr(_g('cannot opendir %s'), $pd); | |
| 224 foreach my $patch (sort readdir($dir_dh)) { | |
| 225 # patches match same rules as run-parts | |
| 226 next unless $patch =~ /^[\w-]+$/ and -f "$pd/$patch"; | |
| 227 next if $opts{skip_auto} and $patch eq $auto_patch; | |
| 228 push @patches, $patch; | |
| 229 } | |
| 230 closedir($dir_dh); | |
| 231 } | |
| 232 return @patches; | |
| 233 } | |
| 234 | |
| 235 sub apply_patches { | |
| 236 my ($self, $dir, %opts) = @_; | |
| 237 $opts{skip_auto} //= 0; | |
| 238 my @patches = $self->get_patches($dir, %opts); | |
| 239 return unless scalar(@patches); | |
| 240 my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-a
pplied'); | |
| 241 open(my $applied_fh, '>', $applied) | |
| 242 or syserr(_g('cannot write %s'), $applied); | |
| 243 print { $applied_fh } "# During $opts{usage}\n"; | |
| 244 my $timestamp = fs_time($applied); | |
| 245 foreach my $patch ($self->get_patches($dir, %opts)) { | |
| 246 my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch); | |
| 247 info(_g('applying %s'), $patch) unless $opts{skip_auto}; | |
| 248 my $patch_obj = Dpkg::Source::Patch->new(filename => $path); | |
| 249 $patch_obj->apply($dir, force_timestamp => 1, | |
| 250 timestamp => $timestamp, | |
| 251 add_options => [ '-E' ]); | |
| 252 print { $applied_fh } "$patch\n"; | |
| 253 } | |
| 254 close($applied_fh); | |
| 255 } | |
| 256 | |
| 257 sub unapply_patches { | |
| 258 my ($self, $dir, %opts) = @_; | |
| 259 my @patches = reverse($self->get_patches($dir, %opts)); | |
| 260 return unless scalar(@patches); | |
| 261 my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-a
pplied'); | |
| 262 my $timestamp = fs_time($applied); | |
| 263 foreach my $patch (@patches) { | |
| 264 my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch); | |
| 265 info(_g('unapplying %s'), $patch) unless $opts{quiet}; | |
| 266 my $patch_obj = Dpkg::Source::Patch->new(filename => $path); | |
| 267 $patch_obj->apply($dir, force_timestamp => 1, verbose => 0, | |
| 268 timestamp => $timestamp, | |
| 269 add_options => [ '-E', '-R' ]); | |
| 270 } | |
| 271 unlink($applied); | |
| 272 } | |
| 273 | |
| 274 sub upstream_tarball_template { | |
| 275 my ($self) = @_; | |
| 276 my $ext = '{' . join(',', | |
| 277 sort map { | |
| 278 compression_get_property($_, 'file_ext') | |
| 279 } compression_get_list()) . '}'; | |
| 280 return '../' . $self->get_basename() . ".orig.tar.$ext"; | |
| 281 } | |
| 282 | |
| 283 sub can_build { | |
| 284 my ($self, $dir) = @_; | |
| 285 return 1 if $self->find_original_tarballs(include_supplementary => 0); | |
| 286 return 1 if $self->{options}{create_empty_orig} and | |
| 287 $self->find_original_tarballs(include_main => 0); | |
| 288 return (0, sprintf(_g('no upstream tarball found at %s'), | |
| 289 $self->upstream_tarball_template())); | |
| 290 } | |
| 291 | |
| 292 sub before_build { | |
| 293 my ($self, $dir) = @_; | |
| 294 $self->check_patches_applied($dir) if $self->{options}{preparation}; | |
| 295 } | |
| 296 | |
| 297 sub after_build { | |
| 298 my ($self, $dir) = @_; | |
| 299 my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-a
pplied'); | |
| 300 my $reason = ''; | |
| 301 if (-e $applied) { | |
| 302 open(my $applied_fh, '<', $applied) | |
| 303 or syserr(_g('cannot read %s'), $applied); | |
| 304 $reason = <$applied_fh>; | |
| 305 close($applied_fh); | |
| 306 } | |
| 307 my $opt_unapply = $self->{options}{unapply_patches}; | |
| 308 if (($opt_unapply eq 'auto' and $reason =~ /^# During preparation/) or | |
| 309 $opt_unapply eq 'yes') { | |
| 310 $self->unapply_patches($dir); | |
| 311 } | |
| 312 } | |
| 313 | |
| 314 sub prepare_build { | |
| 315 my ($self, $dir) = @_; | |
| 316 $self->{diff_options} = { | |
| 317 diff_ignore_regex => $self->{options}{diff_ignore_regex} . | |
| 318 '|(^|/)debian/patches/.dpkg-source-applied$', | |
| 319 include_removal => $self->{options}{include_removal}, | |
| 320 include_timestamp => $self->{options}{include_timestamp}, | |
| 321 use_dev_null => 1, | |
| 322 }; | |
| 323 push @{$self->{options}{tar_ignore}}, 'debian/patches/.dpkg-source-applied'; | |
| 324 $self->check_patches_applied($dir) if $self->{options}{preparation}; | |
| 325 if ($self->{options}{create_empty_orig} and | |
| 326 not $self->find_original_tarballs(include_supplementary => 0)) | |
| 327 { | |
| 328 # No main orig.tar, create a dummy one | |
| 329 my $filename = $self->get_basename() . '.orig.tar.' . | |
| 330 $self->{options}{comp_ext}; | |
| 331 my $tar = Dpkg::Source::Archive->new(filename => $filename); | |
| 332 $tar->create(); | |
| 333 $tar->finish(); | |
| 334 } | |
| 335 } | |
| 336 | |
| 337 sub check_patches_applied { | |
| 338 my ($self, $dir) = @_; | |
| 339 my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-a
pplied'); | |
| 340 unless (-e $applied) { | |
| 341 info(_g('patches are not applied, applying them now')); | |
| 342 $self->apply_patches($dir, usage => 'preparation'); | |
| 343 } | |
| 344 } | |
| 345 | |
| 346 sub generate_patch { | |
| 347 my ($self, $dir, %opts) = @_; | |
| 348 my ($dirname, $updir) = fileparse($dir); | |
| 349 my $basedirname = $self->get_basename(); | |
| 350 $basedirname =~ s/_/-/; | |
| 351 | |
| 352 # Identify original tarballs | |
| 353 my ($tarfile, %origtar); | |
| 354 my $comp_ext_regex = compression_get_file_extension_regex(); | |
| 355 my @origtarballs; | |
| 356 foreach (sort $self->find_original_tarballs()) { | |
| 357 if (/\.orig\.tar\.$comp_ext_regex$/) { | |
| 358 if (defined($tarfile)) { | |
| 359 error(_g('several orig.tar files found (%s and %s) but only ' . | |
| 360 'one is allowed'), $tarfile, $_); | |
| 361 } | |
| 362 $tarfile = $_; | |
| 363 push @origtarballs, $_; | |
| 364 $self->add_file($_); | |
| 365 } elsif (/\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) { | |
| 366 $origtar{$1} = $_; | |
| 367 push @origtarballs, $_; | |
| 368 $self->add_file($_); | |
| 369 } | |
| 370 } | |
| 371 | |
| 372 error(_g('no upstream tarball found at %s'), | |
| 373 $self->upstream_tarball_template()) unless $tarfile; | |
| 374 | |
| 375 if ($opts{usage} eq 'build') { | |
| 376 info(_g('building %s using existing %s'), | |
| 377 $self->{fields}{'Source'}, "@origtarballs"); | |
| 378 } | |
| 379 | |
| 380 # Unpack a second copy for comparison | |
| 381 my $tmp = tempdir("$dirname.orig.XXXXXX", DIR => $updir); | |
| 382 push_exit_handler(sub { erasedir($tmp) }); | |
| 383 | |
| 384 # Extract main tarball | |
| 385 my $tar = Dpkg::Source::Archive->new(filename => $tarfile); | |
| 386 $tar->extract($tmp); | |
| 387 | |
| 388 # Extract additional orig tarballs | |
| 389 foreach my $subdir (keys %origtar) { | |
| 390 my $file = $origtar{$subdir}; | |
| 391 $tar = Dpkg::Source::Archive->new(filename => $file); | |
| 392 $tar->extract("$tmp/$subdir"); | |
| 393 } | |
| 394 | |
| 395 # Copy over the debian directory | |
| 396 erasedir("$tmp/debian"); | |
| 397 system('cp', '-a', '--', "$dir/debian", "$tmp/"); | |
| 398 subprocerr(_g('copy of the debian directory')) if $?; | |
| 399 | |
| 400 # Apply all patches except the last automatic one | |
| 401 $opts{skip_auto} //= 0; | |
| 402 $self->apply_patches($tmp, skip_auto => $opts{skip_auto}, usage => 'build'); | |
| 403 | |
| 404 # Create a patch | |
| 405 my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . '.diff.XXXXXX', | |
| 406 DIR => File::Spec->tmpdir(), UNLINK => 0); | |
| 407 push_exit_handler(sub { unlink($tmpdiff) }); | |
| 408 my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff, | |
| 409 compression => 'none'); | |
| 410 $diff->create(); | |
| 411 if ($opts{header_from} and -e $opts{header_from}) { | |
| 412 my $header_from = Dpkg::Source::Patch->new( | |
| 413 filename => $opts{header_from}); | |
| 414 my $analysis = $header_from->analyze($dir, verbose => 0); | |
| 415 $diff->set_header($analysis->{patchheader}); | |
| 416 } else { | |
| 417 $diff->set_header($self->get_patch_header($dir)); | |
| 418 } | |
| 419 $diff->add_diff_directory($tmp, $dir, basedirname => $basedirname, | |
| 420 %{$self->{diff_options}}, | |
| 421 handle_binary_func => $opts{handle_binary}, | |
| 422 order_from => $opts{order_from}); | |
| 423 error(_g('unrepresentable changes to source')) if not $diff->finish(); | |
| 424 | |
| 425 if (-s $tmpdiff) { | |
| 426 info(_g('local changes detected, the modified files are:')); | |
| 427 my $analysis = $diff->analyze($dir, verbose => 0); | |
| 428 foreach my $fn (sort keys %{$analysis->{filepatched}}) { | |
| 429 print " $fn\n"; | |
| 430 } | |
| 431 } | |
| 432 | |
| 433 # Remove the temporary directory | |
| 434 erasedir($tmp); | |
| 435 pop_exit_handler(); | |
| 436 pop_exit_handler(); | |
| 437 | |
| 438 return $tmpdiff; | |
| 439 } | |
| 440 | |
| 441 sub do_build { | |
| 442 my ($self, $dir) = @_; | |
| 443 my @argv = @{$self->{options}{ARGV}}; | |
| 444 if (scalar(@argv)) { | |
| 445 usageerr(_g("-b takes only one parameter with format `%s'"), | |
| 446 $self->{fields}{'Format'}); | |
| 447 } | |
| 448 $self->prepare_build($dir); | |
| 449 | |
| 450 my $include_binaries = $self->{options}{include_binaries}; | |
| 451 my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; | |
| 452 | |
| 453 my $sourcepackage = $self->{fields}{'Source'}; | |
| 454 my $basenamerev = $self->get_basename(1); | |
| 455 | |
| 456 # Check if the debian directory contains unwanted binary files | |
| 457 my $binaryfiles = Dpkg::Source::Package::V2::BinaryFiles->new($dir); | |
| 458 my $unwanted_binaries = 0; | |
| 459 my $check_binary = sub { | |
| 460 if (-f $_ and is_binary($_)) { | |
| 461 my $fn = File::Spec->abs2rel($_, $dir); | |
| 462 $binaryfiles->new_binary_found($fn); | |
| 463 unless ($include_binaries or $binaryfiles->binary_is_allowed($fn)) { | |
| 464 errormsg(_g('unwanted binary file: %s'), $fn); | |
| 465 $unwanted_binaries++; | |
| 466 } | |
| 467 } | |
| 468 }; | |
| 469 my $tar_ignore_glob = '{' . join(',', | |
| 470 map { | |
| 471 my $copy = $_; | |
| 472 $copy =~ s/,/\\,/g; | |
| 473 $copy; | |
| 474 } @{$self->{options}{tar_ignore}}) . '}'; | |
| 475 my $filter_ignore = sub { | |
| 476 # Filter out files that are not going to be included in the debian | |
| 477 # tarball due to ignores. | |
| 478 my %exclude; | |
| 479 my $reldir = File::Spec->abs2rel($File::Find::dir, $dir); | |
| 480 my $cwd = getcwd(); | |
| 481 # Apply the pattern both from the top dir and from the inspected dir | |
| 482 chdir($dir) or syserr(_g("unable to chdir to `%s'"), $dir); | |
| 483 $exclude{$_} = 1 foreach glob($tar_ignore_glob); | |
| 484 chdir($cwd) or syserr(_g("unable to chdir to `%s'"), $cwd); | |
| 485 chdir($File::Find::dir) | |
| 486 or syserr(_g("unable to chdir to `%s'"), $File::Find::dir); | |
| 487 $exclude{$_} = 1 foreach glob($tar_ignore_glob); | |
| 488 chdir($cwd) or syserr(_g("unable to chdir to `%s'"), $cwd); | |
| 489 my @result; | |
| 490 foreach my $fn (@_) { | |
| 491 unless (exists $exclude{$fn} or exists $exclude{"$reldir/$fn"}) { | |
| 492 push @result, $fn; | |
| 493 } | |
| 494 } | |
| 495 return @result; | |
| 496 }; | |
| 497 find({ wanted => $check_binary, preprocess => $filter_ignore, | |
| 498 no_chdir => 1 }, File::Spec->catdir($dir, 'debian')); | |
| 499 error(P_('detected %d unwanted binary file (add it in ' . | |
| 500 'debian/source/include-binaries to allow its inclusion).', | |
| 501 'detected %d unwanted binary files (add them in ' . | |
| 502 'debian/source/include-binaries to allow their inclusion).', | |
| 503 $unwanted_binaries), $unwanted_binaries) | |
| 504 if $unwanted_binaries; | |
| 505 | |
| 506 # Handle modified binary files detected by the auto-patch generation | |
| 507 my $handle_binary = sub { | |
| 508 my ($self, $old, $new) = @_; | |
| 509 my $relfn = File::Spec->abs2rel($new, $dir); | |
| 510 $binaryfiles->new_binary_found($relfn); | |
| 511 unless ($include_binaries or $binaryfiles->binary_is_allowed($relfn)) { | |
| 512 errormsg(_g('cannot represent change to %s: %s'), $relfn, | |
| 513 _g('binary file contents changed')); | |
| 514 errormsg(_g('add %s in debian/source/include-binaries if you want '
. | |
| 515 'to store the modified binary in the debian tarball'), | |
| 516 $relfn); | |
| 517 $self->register_error(); | |
| 518 } | |
| 519 }; | |
| 520 | |
| 521 # Create a patch | |
| 522 my $autopatch = File::Spec->catfile($dir, 'debian', 'patches', | |
| 523 $self->get_autopatch_name()); | |
| 524 my $tmpdiff = $self->generate_patch($dir, order_from => $autopatch, | |
| 525 header_from => $autopatch, | |
| 526 handle_binary => $handle_binary, | |
| 527 skip_auto => $self->{options}{auto_commi
t}, | |
| 528 usage => 'build'); | |
| 529 unless (-z $tmpdiff or $self->{options}{auto_commit}) { | |
| 530 info(_g('you can integrate the local changes with %s'), | |
| 531 'dpkg-source --commit'); | |
| 532 error(_g('aborting due to unexpected upstream changes, see %s'), | |
| 533 $tmpdiff); | |
| 534 } | |
| 535 push_exit_handler(sub { unlink($tmpdiff) }); | |
| 536 $binaryfiles->update_debian_source_include_binaries() if $include_binaries; | |
| 537 | |
| 538 # Install the diff as the new autopatch | |
| 539 if ($self->{options}{auto_commit}) { | |
| 540 mkpath(File::Spec->catdir($dir, 'debian', 'patches')); | |
| 541 $autopatch = $self->register_patch($dir, $tmpdiff, | |
| 542 $self->get_autopatch_name()); | |
| 543 info(_g('local changes have been recorded in a new patch: %s'), | |
| 544 $autopatch) if -e $autopatch; | |
| 545 rmdir(File::Spec->catdir($dir, 'debian', 'patches')); # No check on purp
ose | |
| 546 } | |
| 547 unlink($tmpdiff) or syserr(_g('cannot remove %s'), $tmpdiff); | |
| 548 pop_exit_handler(); | |
| 549 | |
| 550 # Create the debian.tar | |
| 551 my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext}; | |
| 552 info(_g('building %s in %s'), $sourcepackage, $debianfile); | |
| 553 my $tar = Dpkg::Source::Archive->new(filename => $debianfile); | |
| 554 $tar->create(options => \@tar_ignore, chdir => $dir); | |
| 555 $tar->add_directory('debian'); | |
| 556 foreach my $binary ($binaryfiles->get_seen_binaries()) { | |
| 557 $tar->add_file($binary) unless $binary =~ m{^debian/}; | |
| 558 } | |
| 559 $tar->finish(); | |
| 560 | |
| 561 $self->add_file($debianfile); | |
| 562 } | |
| 563 | |
| 564 sub get_patch_header { | |
| 565 my ($self, $dir) = @_; | |
| 566 my $ph = File::Spec->catfile($dir, 'debian', 'source', 'local-patch-header')
; | |
| 567 unless (-f $ph) { | |
| 568 $ph = File::Spec->catfile($dir, 'debian', 'source', 'patch-header'); | |
| 569 } | |
| 570 my $text; | |
| 571 if (-f $ph) { | |
| 572 open(my $ph_fh, '<', $ph) or syserr(_g('cannot read %s'), $ph); | |
| 573 $text = file_slurp($ph_fh); | |
| 574 close($ph_fh); | |
| 575 return $text; | |
| 576 } | |
| 577 my $ch_info = changelog_parse(offset => 0, count => 1, | |
| 578 file => File::Spec->catfile($dir, 'debian', 'changelog')); | |
| 579 return '' if not defined $ch_info; | |
| 580 my $header = Dpkg::Control->new(type => CTRL_UNKNOWN); | |
| 581 $header->{'Description'} = "<short summary of the patch>\n"; | |
| 582 $header->{'Description'} .= | |
| 583 "TODO: Put a short summary on the line above and replace this paragraph | |
| 584 with a longer explanation of this change. Complete the meta-information | |
| 585 with other relevant fields (see below for details). To make it easier, the | |
| 586 information below has been extracted from the changelog. Adjust it or drop | |
| 587 it.\n"; | |
| 588 $header->{'Description'} .= $ch_info->{'Changes'} . "\n"; | |
| 589 $header->{'Author'} = $ch_info->{'Maintainer'}; | |
| 590 $text = "$header"; | |
| 591 run_vendor_hook('extend-patch-header', \$text, $ch_info); | |
| 592 $text .= "\n--- | |
| 593 The information above should follow the Patch Tagging Guidelines, please | |
| 594 checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here | |
| 595 are templates for supplementary fields that you might want to add: | |
| 596 | |
| 597 Origin: <vendor|upstream|other>, <url of original patch> | |
| 598 Bug: <url in upstream bugtracker> | |
| 599 Bug-Debian: http://bugs.debian.org/<bugnumber> | |
| 600 Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber> | |
| 601 Forwarded: <no|not-needed|url proving that it has been forwarded> | |
| 602 Reviewed-By: <name and email of someone who approved the patch> | |
| 603 Last-Update: <YYYY-MM-DD>\n\n"; | |
| 604 return $text; | |
| 605 } | |
| 606 | |
| 607 sub register_patch { | |
| 608 my ($self, $dir, $patch_file, $patch_name) = @_; | |
| 609 my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name); | |
| 610 if (-s $patch_file) { | |
| 611 copy($patch_file, $patch) | |
| 612 or syserr(_g('failed to copy %s to %s'), $patch_file, $patch); | |
| 613 chmod(0666 & ~ umask(), $patch) | |
| 614 or syserr(_g("unable to change permission of `%s'"), $patch); | |
| 615 my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-sour
ce-applied'); | |
| 616 open(my $applied_fh, '>>', $applied) | |
| 617 or syserr(_g('cannot write %s'), $applied); | |
| 618 print { $applied_fh } "$patch\n"; | |
| 619 close($applied_fh) or syserr(_g('cannot close %s'), $applied); | |
| 620 } elsif (-e $patch) { | |
| 621 unlink($patch) or syserr(_g('cannot remove %s'), $patch); | |
| 622 } | |
| 623 return $patch; | |
| 624 } | |
| 625 | |
| 626 sub _is_bad_patch_name { | |
| 627 my ($dir, $patch_name) = @_; | |
| 628 | |
| 629 return 1 if not defined($patch_name); | |
| 630 return 1 if not length($patch_name); | |
| 631 | |
| 632 my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name); | |
| 633 if (-e $patch) { | |
| 634 warning(_g('cannot register changes in %s, this patch already exists'), | |
| 635 $patch); | |
| 636 return 1; | |
| 637 } | |
| 638 return 0; | |
| 639 } | |
| 640 | |
| 641 sub do_commit { | |
| 642 my ($self, $dir) = @_; | |
| 643 my ($patch_name, $tmpdiff) = @{$self->{options}{ARGV}}; | |
| 644 | |
| 645 $self->prepare_build($dir); | |
| 646 | |
| 647 # Try to fix up a broken relative filename for the patch | |
| 648 if ($tmpdiff and not -e $tmpdiff) { | |
| 649 $tmpdiff = File::Spec->catfile($dir, $tmpdiff) | |
| 650 unless File::Spec->file_name_is_absolute($tmpdiff); | |
| 651 error(_g("patch file '%s' doesn't exist"), $tmpdiff) if not -e $tmpdiff; | |
| 652 } | |
| 653 | |
| 654 my $binaryfiles = Dpkg::Source::Package::V2::BinaryFiles->new($dir); | |
| 655 my $handle_binary = sub { | |
| 656 my ($self, $old, $new) = @_; | |
| 657 my $fn = File::Spec->abs2rel($new, $dir); | |
| 658 $binaryfiles->new_binary_found($fn); | |
| 659 }; | |
| 660 | |
| 661 unless ($tmpdiff) { | |
| 662 $tmpdiff = $self->generate_patch($dir, handle_binary => $handle_binary, | |
| 663 usage => 'commit'); | |
| 664 $binaryfiles->update_debian_source_include_binaries(); | |
| 665 } | |
| 666 push_exit_handler(sub { unlink($tmpdiff) }); | |
| 667 unless (-s $tmpdiff) { | |
| 668 unlink($tmpdiff) or syserr(_g('cannot remove %s'), $tmpdiff); | |
| 669 info(_g('there are no local changes to record')); | |
| 670 return; | |
| 671 } | |
| 672 while (_is_bad_patch_name($dir, $patch_name)) { | |
| 673 # Ask the patch name interactively | |
| 674 print _g('Enter the desired patch name: '); | |
| 675 chomp($patch_name = <STDIN>); | |
| 676 $patch_name =~ s/\s+/-/g; | |
| 677 $patch_name =~ s/\///g; | |
| 678 } | |
| 679 mkpath(File::Spec->catdir($dir, 'debian', 'patches')); | |
| 680 my $patch = $self->register_patch($dir, $tmpdiff, $patch_name); | |
| 681 system('sensible-editor', $patch); | |
| 682 subprocerr('sensible-editor') if $?; | |
| 683 unlink($tmpdiff) or syserr(_g('cannot remove %s'), $tmpdiff); | |
| 684 pop_exit_handler(); | |
| 685 info(_g('local changes have been recorded in a new patch: %s'), $patch); | |
| 686 } | |
| 687 | |
| 688 package Dpkg::Source::Package::V2::BinaryFiles; | |
| 689 | |
| 690 use Dpkg::ErrorHandling; | |
| 691 use Dpkg::Gettext; | |
| 692 | |
| 693 use File::Path; | |
| 694 | |
| 695 sub new { | |
| 696 my ($this, $dir) = @_; | |
| 697 my $class = ref($this) || $this; | |
| 698 | |
| 699 my $self = { | |
| 700 dir => $dir, | |
| 701 allowed_binaries => {}, | |
| 702 seen_binaries => {}, | |
| 703 include_binaries_path => | |
| 704 File::Spec->catfile($dir, 'debian', 'source', 'include-binaries'), | |
| 705 }; | |
| 706 bless $self, $class; | |
| 707 $self->load_allowed_binaries(); | |
| 708 return $self; | |
| 709 } | |
| 710 | |
| 711 sub new_binary_found { | |
| 712 my ($self, $path) = @_; | |
| 713 | |
| 714 $self->{seen_binaries}{$path} = 1; | |
| 715 } | |
| 716 | |
| 717 sub load_allowed_binaries { | |
| 718 my ($self) = @_; | |
| 719 my $incbin_file = $self->{include_binaries_path}; | |
| 720 if (-f $incbin_file) { | |
| 721 open(my $incbin_fh, '<', $incbin_file) | |
| 722 or syserr(_g('cannot read %s'), $incbin_file); | |
| 723 while (defined($_ = <$incbin_fh>)) { | |
| 724 chomp; s/^\s*//; s/\s*$//; | |
| 725 next if /^#/ or /^$/; | |
| 726 $self->{allowed_binaries}{$_} = 1; | |
| 727 } | |
| 728 close($incbin_fh); | |
| 729 } | |
| 730 } | |
| 731 | |
| 732 sub binary_is_allowed { | |
| 733 my ($self, $path) = @_; | |
| 734 return 1 if exists $self->{allowed_binaries}{$path}; | |
| 735 return 0; | |
| 736 } | |
| 737 | |
| 738 sub update_debian_source_include_binaries { | |
| 739 my ($self) = @_; | |
| 740 | |
| 741 my @unknown_binaries = $self->get_unknown_binaries(); | |
| 742 return unless scalar(@unknown_binaries); | |
| 743 | |
| 744 my $incbin_file = $self->{include_binaries_path}; | |
| 745 mkpath(File::Spec->catdir($self->{dir}, 'debian', 'source')); | |
| 746 open(my $incbin_fh, '>>', $incbin_file) | |
| 747 or syserr(_g('cannot write %s'), $incbin_file); | |
| 748 foreach my $binary (@unknown_binaries) { | |
| 749 print { $incbin_fh } "$binary\n"; | |
| 750 info(_g('adding %s to %s'), $binary, 'debian/source/include-binaries'); | |
| 751 $self->{allowed_binaries}{$binary} = 1; | |
| 752 } | |
| 753 close($incbin_fh); | |
| 754 } | |
| 755 | |
| 756 sub get_unknown_binaries { | |
| 757 my ($self) = @_; | |
| 758 return grep { not $self->binary_is_allowed($_) } $self->get_seen_binaries(); | |
| 759 } | |
| 760 | |
| 761 sub get_seen_binaries { | |
| 762 my ($self) = @_; | |
| 763 my @seen = sort keys %{$self->{seen_binaries}}; | |
| 764 return @seen; | |
| 765 } | |
| 766 | |
| 767 1; | |
| OLD | NEW |