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 |