| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © 2008-2009 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::V1; | |
| 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::Compression; | |
| 29 use Dpkg::Source::Archive; | |
| 30 use Dpkg::Source::Patch; | |
| 31 use Dpkg::Exit qw(push_exit_handler pop_exit_handler); | |
| 32 use Dpkg::Source::Functions qw(erasedir); | |
| 33 use Dpkg::Source::Package::V3::Native; | |
| 34 | |
| 35 use POSIX qw(:errno_h); | |
| 36 use Cwd; | |
| 37 use File::Basename; | |
| 38 use File::Temp qw(tempfile); | |
| 39 use File::Spec; | |
| 40 | |
| 41 our $CURRENT_MINOR_VERSION = '0'; | |
| 42 | |
| 43 sub init_options { | |
| 44 my ($self) = @_; | |
| 45 # Don't call $self->SUPER::init_options() on purpose, V1.0 has no | |
| 46 # ignore by default | |
| 47 if ($self->{options}{diff_ignore_regex}) { | |
| 48 $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$'
; | |
| 49 } else { | |
| 50 $self->{options}{diff_ignore_regex} = '(?:^|/)debian/source/local-.*$'; | |
| 51 } | |
| 52 push @{$self->{options}{tar_ignore}}, 'debian/source/local-options', | |
| 53 'debian/source/local-patch-header'; | |
| 54 $self->{options}{sourcestyle} ||= 'X'; | |
| 55 $self->{options}{skip_debianization} ||= 0; | |
| 56 $self->{options}{abort_on_upstream_changes} ||= 0; | |
| 57 } | |
| 58 | |
| 59 sub parse_cmdline_option { | |
| 60 my ($self, $opt) = @_; | |
| 61 my $o = $self->{options}; | |
| 62 if ($opt =~ m/^-s([akpursnAKPUR])$/) { | |
| 63 warning(_g('-s%s option overrides earlier -s%s option'), $1, | |
| 64 $o->{sourcestyle}) if $o->{sourcestyle} ne 'X'; | |
| 65 $o->{sourcestyle} = $1; | |
| 66 $o->{copy_orig_tarballs} = 0 if $1 eq 'n'; # Extract option -sn | |
| 67 return 1; | |
| 68 } elsif ($opt =~ m/^--skip-debianization$/) { | |
| 69 $o->{skip_debianization} = 1; | |
| 70 return 1; | |
| 71 } elsif ($opt =~ m/^--abort-on-upstream-changes$/) { | |
| 72 $o->{abort_on_upstream_changes} = 1; | |
| 73 return 1; | |
| 74 } | |
| 75 return 0; | |
| 76 } | |
| 77 | |
| 78 sub do_extract { | |
| 79 my ($self, $newdirectory) = @_; | |
| 80 my $sourcestyle = $self->{options}{sourcestyle}; | |
| 81 my $fields = $self->{fields}; | |
| 82 | |
| 83 $sourcestyle =~ y/X/p/; | |
| 84 unless ($sourcestyle =~ m/[pun]/) { | |
| 85 usageerr(_g('source handling style -s%s not allowed with -x'), | |
| 86 $sourcestyle); | |
| 87 } | |
| 88 | |
| 89 my $dscdir = $self->{basedir}; | |
| 90 | |
| 91 my $basename = $self->get_basename(); | |
| 92 my $basenamerev = $self->get_basename(1); | |
| 93 | |
| 94 # V1.0 only supports gzip compression | |
| 95 my ($tarfile, $difffile); | |
| 96 my $tarsign; | |
| 97 foreach my $file ($self->get_files()) { | |
| 98 if ($file =~ /^(?:\Q$basename\E\.orig|\Q$basenamerev\E)\.tar\.gz$/) { | |
| 99 error(_g('multiple tarfiles in v1.0 source package')) if $tarfile; | |
| 100 $tarfile = $file; | |
| 101 } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.gz\.asc$/) { | |
| 102 $tarsign = $file; | |
| 103 } elsif ($file =~ /^\Q$basenamerev\E\.diff\.gz$/) { | |
| 104 $difffile = $file; | |
| 105 } else { | |
| 106 error(_g('unrecognized file for a %s source package: %s'), | |
| 107 'v1.0', $file); | |
| 108 } | |
| 109 } | |
| 110 | |
| 111 error(_g('no tarfile in Files field')) unless $tarfile; | |
| 112 my $native = $difffile ? 0 : 1; | |
| 113 if ($native and ($tarfile =~ /\.orig\.tar\.gz$/)) { | |
| 114 warning(_g('native package with .orig.tar')); | |
| 115 $native = 0; # V3::Native doesn't handle orig.tar | |
| 116 } | |
| 117 | |
| 118 if ($native) { | |
| 119 Dpkg::Source::Package::V3::Native::do_extract($self, $newdirectory); | |
| 120 } else { | |
| 121 my $expectprefix = $newdirectory; | |
| 122 $expectprefix .= '.orig'; | |
| 123 | |
| 124 erasedir($newdirectory); | |
| 125 if (-e $expectprefix) { | |
| 126 rename($expectprefix, "$newdirectory.tmp-keep") | |
| 127 or syserr(_g("unable to rename `%s' to `%s'"), $expectprefix, | |
| 128 "$newdirectory.tmp-keep"); | |
| 129 } | |
| 130 | |
| 131 info(_g('unpacking %s'), $tarfile); | |
| 132 my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); | |
| 133 $tar->extract($expectprefix); | |
| 134 | |
| 135 if ($sourcestyle =~ /u/) { | |
| 136 # -su: keep .orig directory unpacked | |
| 137 if (-e "$newdirectory.tmp-keep") { | |
| 138 error(_g('unable to keep orig directory (already exists)')); | |
| 139 } | |
| 140 system('cp', '-ar', '--', $expectprefix, "$newdirectory.tmp-keep"); | |
| 141 subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?; | |
| 142 } | |
| 143 | |
| 144 rename($expectprefix, $newdirectory) | |
| 145 or syserr(_g('failed to rename newly-extracted %s to %s'), | |
| 146 $expectprefix, $newdirectory); | |
| 147 | |
| 148 # rename the copied .orig directory | |
| 149 if (-e "$newdirectory.tmp-keep") { | |
| 150 rename("$newdirectory.tmp-keep", $expectprefix) | |
| 151 or syserr(_g('failed to rename saved %s to %s'), | |
| 152 "$newdirectory.tmp-keep", $expectprefix); | |
| 153 } | |
| 154 } | |
| 155 | |
| 156 if ($difffile and not $self->{options}{skip_debianization}) { | |
| 157 my $patch = "$dscdir$difffile"; | |
| 158 info(_g('applying %s'), $difffile); | |
| 159 my $patch_obj = Dpkg::Source::Patch->new(filename => $patch); | |
| 160 my $analysis = $patch_obj->apply($newdirectory, force_timestamp => 1); | |
| 161 my @files = grep { ! m{^\Q$newdirectory\E/debian/} } | |
| 162 sort keys %{$analysis->{filepatched}}; | |
| 163 info(_g('upstream files that have been modified: %s'), | |
| 164 "\n " . join("\n ", @files)) if scalar @files; | |
| 165 } | |
| 166 } | |
| 167 | |
| 168 sub can_build { | |
| 169 my ($self, $dir) = @_; | |
| 170 | |
| 171 # As long as we can use gzip, we can do it as we have | |
| 172 # native packages as fallback | |
| 173 return (0, _g('only supports gzip compression')) | |
| 174 unless $self->{options}{compression} eq 'gzip'; | |
| 175 return 1; | |
| 176 } | |
| 177 | |
| 178 sub do_build { | |
| 179 my ($self, $dir) = @_; | |
| 180 my $sourcestyle = $self->{options}{sourcestyle}; | |
| 181 my @argv = @{$self->{options}{ARGV}}; | |
| 182 my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; | |
| 183 my $diff_ignore_regex = $self->{options}{diff_ignore_regex}; | |
| 184 | |
| 185 if (scalar(@argv) > 1) { | |
| 186 usageerr(_g('-b takes at most a directory and an orig source ' . | |
| 187 'argument (with v1.0 source package)')); | |
| 188 } | |
| 189 | |
| 190 $sourcestyle =~ y/X/A/; | |
| 191 unless ($sourcestyle =~ m/[akpursnAKPUR]/) { | |
| 192 usageerr(_g('source handling style -s%s not allowed with -b'), | |
| 193 $sourcestyle); | |
| 194 } | |
| 195 | |
| 196 my $sourcepackage = $self->{fields}{'Source'}; | |
| 197 my $basenamerev = $self->get_basename(1); | |
| 198 my $basename = $self->get_basename(); | |
| 199 my $basedirname = $basename; | |
| 200 $basedirname =~ s/_/-/; | |
| 201 | |
| 202 # Try to find a .orig tarball for the package | |
| 203 my $origdir = "$dir.orig"; | |
| 204 my $origtargz = $self->get_basename() . '.orig.tar.gz'; | |
| 205 if (-e $origtargz) { | |
| 206 unless (-f $origtargz) { | |
| 207 error(_g("packed orig `%s' exists but is not a plain file"), $origta
rgz); | |
| 208 } | |
| 209 } else { | |
| 210 $origtargz = undef; | |
| 211 } | |
| 212 | |
| 213 if (@argv) { | |
| 214 # We have a second-argument <orig-dir> or <orig-targz>, check what it | |
| 215 # is to decide the mode to use | |
| 216 my $origarg = shift(@argv); | |
| 217 if (length($origarg)) { | |
| 218 stat($origarg) | |
| 219 or syserr(_g('cannot stat orig argument %s'), $origarg); | |
| 220 if (-d _) { | |
| 221 $origdir = File::Spec->catdir($origarg); | |
| 222 | |
| 223 $sourcestyle =~ y/aA/rR/; | |
| 224 unless ($sourcestyle =~ m/[ursURS]/) { | |
| 225 error(_g('orig argument is unpacked but source handling ' . | |
| 226 'style -s%s calls for packed (.orig.tar.<ext>)'), | |
| 227 $sourcestyle); | |
| 228 } | |
| 229 } elsif (-f _) { | |
| 230 $origtargz = $origarg; | |
| 231 $sourcestyle =~ y/aA/pP/; | |
| 232 unless ($sourcestyle =~ m/[kpsKPS]/) { | |
| 233 error(_g('orig argument is packed but source handling ' . | |
| 234 'style -s%s calls for unpacked (.orig/)'), | |
| 235 $sourcestyle); | |
| 236 } | |
| 237 } else { | |
| 238 error(_g('orig argument %s is not a plain file or directory'), | |
| 239 $origarg); | |
| 240 } | |
| 241 } else { | |
| 242 $sourcestyle =~ y/aA/nn/; | |
| 243 unless ($sourcestyle =~ m/n/) { | |
| 244 error(_g('orig argument is empty (means no orig, no diff) ' . | |
| 245 'but source handling style -s%s wants something'), | |
| 246 $sourcestyle); | |
| 247 } | |
| 248 } | |
| 249 } elsif ($sourcestyle =~ m/[aA]/) { | |
| 250 # We have no explicit <orig-dir> or <orig-targz>, try to use | |
| 251 # a .orig tarball first, then a .orig directory and fall back to | |
| 252 # creating a native .tar.gz | |
| 253 if ($origtargz) { | |
| 254 $sourcestyle =~ y/aA/pP/; # .orig.tar.<ext> | |
| 255 } else { | |
| 256 if (stat($origdir)) { | |
| 257 unless (-d _) { | |
| 258 error(_g("unpacked orig `%s' exists but is not a directory")
, | |
| 259 $origdir); | |
| 260 } | |
| 261 $sourcestyle =~ y/aA/rR/; # .orig directory | |
| 262 } elsif ($! != ENOENT) { | |
| 263 syserr(_g("unable to stat putative unpacked orig `%s'"), $origdi
r); | |
| 264 } else { | |
| 265 $sourcestyle =~ y/aA/nn/; # Native tar.gz | |
| 266 } | |
| 267 } | |
| 268 } | |
| 269 | |
| 270 my ($dirname, $dirbase) = fileparse($dir); | |
| 271 if ($dirname ne $basedirname) { | |
| 272 warning(_g("source directory '%s' is not <sourcepackage>" . | |
| 273 "-<upstreamversion> '%s'"), $dir, $basedirname); | |
| 274 } | |
| 275 | |
| 276 my ($tarname, $tardirname, $tardirbase); | |
| 277 if ($sourcestyle ne 'n') { | |
| 278 my ($origdirname, $origdirbase) = fileparse($origdir); | |
| 279 | |
| 280 if ($origdirname ne "$basedirname.orig") { | |
| 281 warning(_g('.orig directory name %s is not <package>' . | |
| 282 '-<upstreamversion> (wanted %s)'), | |
| 283 $origdirname, "$basedirname.orig"); | |
| 284 } | |
| 285 $tardirbase = $origdirbase; | |
| 286 $tardirname = $origdirname; | |
| 287 | |
| 288 $tarname = $origtargz || "$basename.orig.tar.gz"; | |
| 289 unless ($tarname =~ /\Q$basename\E\.orig\.tar\.gz/) { | |
| 290 warning(_g('.orig.tar name %s is not <package>_<upstreamversion>' . | |
| 291 '.orig.tar (wanted %s)'), | |
| 292 $tarname, "$basename.orig.tar.gz"); | |
| 293 } | |
| 294 } | |
| 295 | |
| 296 if ($sourcestyle eq 'n') { | |
| 297 $self->{options}{ARGV} = []; # ensure we have no error | |
| 298 Dpkg::Source::Package::V3::Native::do_build($self, $dir); | |
| 299 } elsif ($sourcestyle =~ m/[nurUR]/) { | |
| 300 if (stat($tarname)) { | |
| 301 unless ($sourcestyle =~ m/[nUR]/) { | |
| 302 error(_g("tarfile `%s' already exists, not overwriting, " . | |
| 303 'giving up; use -sU or -sR to override'), $tarname); | |
| 304 } | |
| 305 } elsif ($! != ENOENT) { | |
| 306 syserr(_g("unable to check for existence of `%s'"), $tarname); | |
| 307 } | |
| 308 | |
| 309 info(_g('building %s in %s'), | |
| 310 $sourcepackage, $tarname); | |
| 311 | |
| 312 my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX", | |
| 313 DIR => getcwd(), UNLINK => 0); | |
| 314 my $tar = Dpkg::Source::Archive->new(filename => $newtar, | |
| 315 compression => compression_guess_from_filename($tarname), | |
| 316 compression_level => $self->{options}{comp_level}); | |
| 317 $tar->create(options => \@tar_ignore, chdir => $tardirbase); | |
| 318 $tar->add_directory($tardirname); | |
| 319 $tar->finish(); | |
| 320 rename($newtar, $tarname) | |
| 321 or syserr(_g("unable to rename `%s' (newly created) to `%s'"), | |
| 322 $newtar, $tarname); | |
| 323 chmod(0666 &~ umask(), $tarname) | |
| 324 or syserr(_g("unable to change permission of `%s'"), $tarname); | |
| 325 } else { | |
| 326 info(_g('building %s using existing %s'), | |
| 327 $sourcepackage, $tarname); | |
| 328 } | |
| 329 | |
| 330 $self->add_file($tarname) if $tarname; | |
| 331 | |
| 332 if ($sourcestyle =~ m/[kpKP]/) { | |
| 333 if (stat($origdir)) { | |
| 334 unless ($sourcestyle =~ m/[KP]/) { | |
| 335 error(_g("orig dir `%s' already exists, not overwriting, ". | |
| 336 'giving up; use -sA, -sK or -sP to override'), | |
| 337 $origdir); | |
| 338 } | |
| 339 push_exit_handler(sub { erasedir($origdir) }); | |
| 340 erasedir($origdir); | |
| 341 pop_exit_handler(); | |
| 342 } elsif ($! != ENOENT) { | |
| 343 syserr(_g("unable to check for existence of orig dir `%s'"), | |
| 344 $origdir); | |
| 345 } | |
| 346 | |
| 347 my $tar = Dpkg::Source::Archive->new(filename => $origtargz); | |
| 348 $tar->extract($origdir); | |
| 349 } | |
| 350 | |
| 351 my $ur; # Unrepresentable changes | |
| 352 if ($sourcestyle =~ m/[kpursKPUR]/) { | |
| 353 my $diffname = "$basenamerev.diff.gz"; | |
| 354 info(_g('building %s in %s'), | |
| 355 $sourcepackage, $diffname); | |
| 356 my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX", | |
| 357 DIR => getcwd(), UNLINK => 0); | |
| 358 push_exit_handler(sub { unlink($newdiffgz) }); | |
| 359 my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz, | |
| 360 compression => 'gzip'); | |
| 361 $diff->create(); | |
| 362 $diff->add_diff_directory($origdir, $dir, | |
| 363 basedirname => $basedirname, | |
| 364 diff_ignore_regex => $diff_ignore_regex, | |
| 365 options => []); # Force empty set of options to drop the | |
| 366 # default -p option | |
| 367 $diff->finish() || $ur++; | |
| 368 pop_exit_handler(); | |
| 369 | |
| 370 my $analysis = $diff->analyze($origdir); | |
| 371 my @files = grep { ! m{^debian/} } map { s{^[^/]+/+}{}; $_ } | |
| 372 sort keys %{$analysis->{filepatched}}; | |
| 373 if (scalar @files) { | |
| 374 warning(_g('the diff modifies the following upstream files: %s'), | |
| 375 "\n " . join("\n ", @files)); | |
| 376 info(_g("use the '3.0 (quilt)' format to have separate and " . | |
| 377 'documented changes to upstream files, see dpkg-source(1)'))
; | |
| 378 error(_g('aborting due to --abort-on-upstream-changes')) | |
| 379 if $self->{options}{abort_on_upstream_changes}; | |
| 380 } | |
| 381 | |
| 382 rename($newdiffgz, $diffname) | |
| 383 or syserr(_g("unable to rename `%s' (newly created) to `%s'"), | |
| 384 $newdiffgz, $diffname); | |
| 385 chmod(0666 &~ umask(), $diffname) | |
| 386 or syserr(_g("unable to change permission of `%s'"), $diffname); | |
| 387 | |
| 388 $self->add_file($diffname); | |
| 389 } | |
| 390 | |
| 391 if ($sourcestyle =~ m/[prPR]/) { | |
| 392 erasedir($origdir); | |
| 393 } | |
| 394 | |
| 395 if ($ur) { | |
| 396 printf { *STDERR } _g('%s: unrepresentable changes to source') . "\n", | |
| 397 $Dpkg::PROGNAME; | |
| 398 exit(1); | |
| 399 } | |
| 400 } | |
| 401 | |
| 402 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
