5 # Copyright © 1996 Ian Jackson <ijackson@chiark.greenend.org.uk>
6 # Copyright © 1997 Klee Dienes <klee@debian.org>
7 # Copyright © 1999-2003 Wichert Akkerman <wakkerma@debian.org>
8 # Copyright © 1999 Ben Collins <bcollins@debian.org>
9 # Copyright © 2000-2003 Adam Heath <doogie@debian.org>
10 # Copyright © 2005 Brendan O'Dea <bod@debian.org>
11 # Copyright © 2006-2008 Frank Lichtenheld <djpig@debian.org>
12 # Copyright © 2006-2009,2012 Guillem Jover <guillem@debian.org>
13 # Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
15 # This program is free software; you can redistribute it and/or modify
16 # it under the terms of the GNU General Public License as published by
17 # the Free Software Foundation; either version 2 of the License, or
18 # (at your option) any later version.
20 # This program is distributed in the hope that it will be useful,
21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 # GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License
26 # along with this program. If not, see <https://www.gnu.org/licenses/>.
37 use Dpkg
::ErrorHandling
;
38 use Dpkg
::Util
qw(:list
);
39 use Dpkg
::Arch
qw(:operators
);
41 use Dpkg
::Compression
;
43 use Dpkg
::Control
::Info
;
44 use Dpkg
::Control
::Tests
;
45 use Dpkg
::Control
::Fields
;
50 use Dpkg
::Changelog
::Parse
;
51 use Dpkg
::Source
::Package
qw(get_default_diff_ignore_regex
52 set_default_diff_ignore_regex
53 get_default_tar_ignore_pattern
);
54 use Dpkg
::Vendor
qw(run_vendor_hook
);
56 textdomain
('dpkg-dev');
66 diff_ignore_regex
=> '',
68 copy_orig_tarballs
=> 1,
70 no_overwrite_dir
=> 1,
71 require_valid_signature
=> 0,
72 require_strong_checksums
=> 0,
75 # Fields to remove/override
79 my $substvars = Dpkg
::Substvars
->new();
80 my $tar_ignore_default_pattern_done;
81 my $diff_ignore_regex = get_default_diff_ignore_regex
();
85 while (@ARGV && $ARGV[0] =~ m/^-/) {
86 my $arg = shift @ARGV;
88 if ($arg eq '-b' or $arg eq '--build') {
90 } elsif ($arg eq '-x' or $arg eq '--extract') {
92 } elsif ($arg eq '--before-build') {
93 setopmode
('before-build');
94 } elsif ($arg eq '--after-build') {
95 setopmode
('after-build');
96 } elsif ($arg eq '--commit') {
98 } elsif ($arg eq '--print-format') {
99 setopmode
('print-format');
100 report_options
(info_fh
=> \
*STDERR
); # Avoid clutter on STDOUT
107 if (defined($options{opmode
}) &&
108 $options{opmode
} =~ /^(build|print-format|(before|after)-build|commit)$/) {
109 if (not scalar(@ARGV)) {
110 usageerr
(g_
('--%s needs a directory'), $options{opmode
})
111 unless $1 eq 'commit';
114 $dir = File
::Spec
->catdir(shift(@ARGV));
116 stat($dir) or syserr
(g_
('cannot stat directory %s'), $dir);
118 error
(g_
('directory argument %s is not a directory'), $dir);
121 # . is never correct, adjust automatically
122 $dir = basename
(cwd
());
123 chdir '..' or syserr
(g_
("unable to chdir to '%s'"), '..');
125 # --format options are not allowed, they would take precedence
126 # over real command line options, debian/source/format should be used
128 # --unapply-patches is only allowed in local-options as it's a matter
129 # of personal taste and the default should be to keep patches applied
130 my $forbidden_opts_re = {
131 'options' => qr/^--(?:format=|unapply-patches$|abort-on-upstream-changes$)/,
132 'local-options' => qr/^--format=/,
134 foreach my $filename ('local-options', 'options') {
135 my $conf = Dpkg
::Conf
->new();
136 my $optfile = File
::Spec
->catfile($dir, 'debian', 'source', $filename);
137 next unless -f
$optfile;
138 $conf->load($optfile);
139 $conf->filter(remove
=> sub { $_[0] =~ $forbidden_opts_re->{$filename} });
141 info
(g_
('using options from %s: %s'), $optfile, join(' ', @
$conf))
142 unless $options{opmode
} eq 'print-format';
143 unshift @options, @
$conf;
149 $_ = shift(@options);
150 if (m/^--format=(.*)$/) {
151 $build_format //= $1;
152 } elsif (m/^-(?:Z|-compression=)(.*)$/) {
153 my $compression = $1;
154 $options{compression
} = $compression;
155 usageerr
(g_
('%s is not a supported compression'), $compression)
156 unless compression_is_supported
($compression);
157 compression_set_default
($compression);
158 } elsif (m/^-(?:z|-compression-level=)(.*)$/) {
160 $options{comp_level
} = $comp_level;
161 usageerr
(g_
('%s is not a compression level'), $comp_level)
162 unless compression_is_valid_level
($comp_level);
163 compression_set_default_level
($comp_level);
164 } elsif (m/^-c(.*)$/) {
166 } elsif (m/^-l(.*)$/) {
168 } elsif (m/^-F([0-9a-z]+)$/) {
169 $changelogformat = $1;
170 } elsif (m/^-D([^\=:]+)[=:](.*)$/s) {
172 } elsif (m/^-U([^\=:]+)$/) {
174 } elsif (m/^-(?:i|-diff-ignore(?:$|=))(.*)$/) {
175 $options{diff_ignore_regex
} = $1 ?
$1 : $diff_ignore_regex;
176 } elsif (m/^--extend-diff-ignore=(.+)$/) {
177 $diff_ignore_regex .= "|$1";
178 if ($options{diff_ignore_regex
}) {
179 $options{diff_ignore_regex
} .= "|$1";
181 set_default_diff_ignore_regex
($diff_ignore_regex);
182 } elsif (m/^-(?:I|-tar-ignore=)(.+)$/) {
183 push @
{$options{tar_ignore
}}, $1;
184 } elsif (m/^-(?:I|-tar-ignore)$/) {
185 unless ($tar_ignore_default_pattern_done) {
186 push @
{$options{tar_ignore
}}, get_default_tar_ignore_pattern
();
187 # Prevent adding multiple times
188 $tar_ignore_default_pattern_done = 1;
190 } elsif (m/^--no-copy$/) {
191 $options{copy_orig_tarballs
} = 0;
192 } elsif (m/^--no-check$/) {
193 $options{no_check
} = 1;
194 } elsif (m/^--no-overwrite-dir$/) {
195 $options{no_overwrite_dir
} = 1;
196 } elsif (m/^--require-valid-signature$/) {
197 $options{require_valid_signature
} = 1;
198 } elsif (m/^--require-strong-checksums$/) {
199 $options{require_strong_checksums
} = 1;
200 } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:](.*)$/s) {
201 $substvars->set($1, $2);
202 } elsif (m/^-T(.*)$/) {
203 $substvars->load($1) if -e
$1;
204 } elsif (m/^-(?:\?|-help)$/) {
207 } elsif (m/^--version$/) {
210 } elsif (m/^-[EW]$/) {
212 warning
(g_
('-E and -W are deprecated, they are without effect'));
214 report_options
(quiet_warnings
=> 1);
219 push @cmdline_options, $_;
223 unless (defined($options{opmode
})) {
224 usageerr
(g_
('need an action option'));
227 if ($options{opmode
} =~ /^(build|print-format|(before|after)-build|commit)$/) {
229 $options{ARGV
} = \
@ARGV;
231 $changelogfile ||= "$dir/debian/changelog";
232 $controlfile ||= "$dir/debian/control";
234 my %ch_options = (file
=> $changelogfile);
235 $ch_options{changelogformat
} = $changelogformat if $changelogformat;
236 my $changelog = changelog_parse
(%ch_options);
237 my $control = Dpkg
::Control
::Info
->new($controlfile);
239 # <https://reproducible-builds.org/specs/source-date-epoch/>
240 $ENV{SOURCE_DATE_EPOCH
} ||= $changelog->{timestamp
} || time;
242 my $srcpkg = Dpkg
::Source
::Package
->new(options
=> \
%options);
243 my $fields = $srcpkg->{fields
};
249 # Scan control info of source package
250 my $src_fields = $control->get_source();
251 error
(g_
("%s doesn't contain any information about the source package"),
252 $controlfile) unless defined $src_fields;
253 my $src_sect = $src_fields->{'Section'} || 'unknown';
254 my $src_prio = $src_fields->{'Priority'} || 'unknown';
255 foreach (keys %{$src_fields}) {
256 my $v = $src_fields->{$_};
258 set_source_package
($v);
260 } elsif (m/^Uploaders$/i) {
261 ($fields->{$_} = $v) =~ s/\s*[\r\n]\s*/ /g; # Merge in a single-line
262 } elsif (m/^Build-(?:Depends|Conflicts)(?:-Arch|-Indep)?$/i) {
264 my $type = field_get_dep_type
($_);
265 $dep = deps_parse
($v, build_dep
=> 1, union
=> $type eq 'union');
266 error
(g_
('error occurred while parsing %s'), $_) unless defined $dep;
267 my $facts = Dpkg
::Deps
::KnownFacts
->new();
268 $dep->simplify_deps($facts);
269 $dep->sort() if $type eq 'union';
270 $fields->{$_} = $dep->output();
272 field_transfer_single
($src_fields, $fields);
276 # Scan control info of binary packages
278 foreach my $pkg ($control->get_packages()) {
279 my $p = $pkg->{'Package'};
280 my $sect = $pkg->{'Section'} || $src_sect;
281 my $prio = $pkg->{'Priority'} || $src_prio;
282 my $type = $pkg->{'Package-Type'} ||
283 $pkg->get_custom_field('Package-Type') || 'deb';
284 my $arch = $pkg->{'Architecture'};
285 my $profile = $pkg->{'Build-Profiles'};
287 my $pkg_summary = sprintf('%s %s %s %s', $p, $type, $sect, $prio);
289 $pkg_summary .= ' arch=' . join ',', split /\s+/, $arch;
291 if (defined $profile) {
292 # If the string does not contain brackets then it is using the
293 # old syntax. Emit a fatal error.
294 if ($profile !~ m/^\s*<.*>\s*$/) {
295 error
(g_
('binary package stanza %s is using an obsolete ' .
296 'Build-Profiles field syntax'), $p);
299 # Instead of splitting twice and then joining twice, we just do
300 # simple string replacements:
302 # Remove the enclosing <>
303 $profile =~ s/^\s*<(.*)>\s*$/$1/;
304 # Join lists with a plus (OR)
305 $profile =~ s/>\s+</+/g;
306 # Join their elements with a comma (AND)
307 $profile =~ s/\s+/,/g;
308 $pkg_summary .= " profile=$profile";
311 if (defined $pkg->{'Essential'} and $pkg->{'Essential'} eq 'yes') {
312 $pkg_summary .= ' essential=yes';
315 push @pkglist, $pkg_summary;
316 push @binarypackages, $p;
317 foreach (keys %{$pkg}) {
319 if (m/^Architecture$/) {
320 # Gather all binary architectures in one set. 'any' and 'all'
321 # are special-cased as they need to be the only ones in the
322 # current stanza if present.
323 if (debarch_eq
($v, 'any') || debarch_eq
($v, 'all')) {
324 push(@sourcearch, $v) unless $archadded{$v}++;
326 for my $a (split(/\s+/, $v)) {
327 error
(g_
("'%s' is not a legal architecture string"), $a)
328 if debarch_is_illegal
($a);
329 error
(g_
('architecture %s only allowed on its ' .
330 "own (list for package %s is '%s')"),
332 if $a eq 'any' or $a eq 'all';
333 push(@sourcearch, $a) unless $archadded{$a}++;
336 } elsif (m/^Homepage$/) {
337 # Do not overwrite the same field from the source entry
339 field_transfer_single
($pkg, $fields);
343 unless (scalar(@pkglist)) {
344 error
(g_
("%s doesn't list any binary package"), $controlfile);
346 if (any
{ $_ eq 'any' } @sourcearch) {
347 # If we encounter one 'any' then the other arches become insignificant
348 # except for 'all' that must also be kept
349 if (any
{ $_ eq 'all' } @sourcearch) {
350 @sourcearch = qw(any all
);
352 @sourcearch = qw(any
);
355 # Minimize arch list, by removing arches already covered by wildcards
356 my @arch_wildcards = grep { debarch_is_wildcard
($_) } @sourcearch;
357 my @mini_sourcearch = @arch_wildcards;
358 foreach my $arch (@sourcearch) {
359 if (none
{ debarch_is
($arch, $_) } @arch_wildcards) {
360 push @mini_sourcearch, $arch;
363 @sourcearch = @mini_sourcearch;
365 $fields->{'Architecture'} = join(' ', @sourcearch);
366 $fields->{'Package-List'} = "\n" . join("\n", sort @pkglist);
368 # Check if we have a testsuite, and handle manual and automatic values.
369 set_testsuite_fields
($fields, @binarypackages);
371 # Scan fields of dpkg-parsechangelog
372 foreach (keys %{$changelog}) {
373 my $v = $changelog->{$_};
376 set_source_package
($v);
378 } elsif (m/^Version$/) {
379 my ($ok, $error) = version_check
($v);
380 error
($error) unless $ok;
382 } elsif (m/^Binary-Only$/) {
383 error
(g_
('building source for a binary-only release'))
384 if $v eq 'yes' and $options{opmode
} eq 'build';
385 } elsif (m/^Maintainer$/i) {
386 # Do not replace the field coming from the source entry
388 field_transfer_single
($changelog, $fields);
392 $fields->{'Binary'} = join(', ', @binarypackages);
393 # Avoid overly long line by splitting over multiple lines
394 if (length($fields->{'Binary'}) > 980) {
395 $fields->{'Binary'} =~ s/(.{0,980}), ?/$1,\n/g;
398 # Select the format to use
399 if (not defined $build_format) {
400 if (-e
"$dir/debian/source/format") {
401 open(my $format_fh, '<', "$dir/debian/source/format")
402 or syserr
(g_
('cannot read %s'), "$dir/debian/source/format");
403 $build_format = <$format_fh>;
404 chomp($build_format) if defined $build_format;
405 error
(g_
('%s is empty'), "$dir/debian/source/format")
406 unless defined $build_format and length $build_format;
409 warning
(g_
('no source format specified in %s, ' .
410 'see dpkg-source(1)'), 'debian/source/format')
411 if $options{opmode
} eq 'build';
412 $build_format = '1.0';
415 $fields->{'Format'} = $build_format;
416 $srcpkg->upgrade_object_type(); # Fails if format is unsupported
417 # Parse command line options
418 $srcpkg->init_options();
419 $srcpkg->parse_cmdline_options(@cmdline_options);
421 if ($options{opmode
} eq 'print-format') {
422 print $fields->{'Format'} . "\n";
424 } elsif ($options{opmode
} eq 'before-build') {
425 $srcpkg->before_build($dir);
427 } elsif ($options{opmode
} eq 'after-build') {
428 $srcpkg->after_build($dir);
430 } elsif ($options{opmode
} eq 'commit') {
431 $srcpkg->commit($dir);
435 # Verify pre-requisites are met
436 my ($res, $msg) = $srcpkg->can_build($dir);
437 error
(g_
("can't build with source format '%s': %s"), $build_format, $msg) unless $res;
440 info
(g_
("using source format '%s'"), $fields->{'Format'});
441 run_vendor_hook
('before-source-build', $srcpkg);
442 # Build the files (.tar.gz, .diff.gz, etc)
443 $srcpkg->build($dir);
446 my $dscname = $srcpkg->get_basename(1) . '.dsc';
447 info
(g_
('building %s in %s'), get_source_package
(), $dscname);
448 $srcpkg->write_dsc(filename
=> $dscname,
450 override
=> \
%override,
451 substvars
=> $substvars);
454 } elsif ($options{opmode
} eq 'extract') {
457 unless (scalar(@ARGV)) {
458 usageerr
(g_
('--%s needs at least one argument, the .dsc'),
461 if (scalar(@ARGV) > 2) {
462 usageerr
(g_
('--%s takes no more than two arguments'), $options{opmode
});
464 my $dsc = shift(@ARGV);
466 usageerr
(g_
('--%s needs the .dsc file as first argument, not a directory'),
470 # Create the object that does everything
471 my $srcpkg = Dpkg
::Source
::Package
->new(filename
=> $dsc,
472 options
=> \
%options);
474 # Parse command line options
475 $srcpkg->parse_cmdline_options(@cmdline_options);
477 # Decide where to unpack
478 my $newdirectory = $srcpkg->get_basename();
479 $newdirectory =~ s/_/-/g;
481 $newdirectory = File
::Spec
->catdir(shift(@ARGV));
482 if (-e
$newdirectory) {
483 error
(g_
('unpack target exists: %s'), $newdirectory);
487 # Various checks before unpacking
488 unless ($options{no_check
}) {
489 if ($srcpkg->is_signed()) {
490 $srcpkg->check_signature();
492 if ($options{require_valid_signature
}) {
493 error
(g_
("%s doesn't contain a valid OpenPGP signature"), $dsc);
495 warning
(g_
('extracting unsigned source package (%s)'), $dsc);
498 $srcpkg->check_checksums();
501 # Unpack the source package (delegated to Dpkg::Source::Package::*)
502 info
(g_
('extracting %s in %s'), $srcpkg->{fields
}{'Source'}, $newdirectory);
503 $srcpkg->extract($newdirectory);
508 sub set_testsuite_fields
510 my ($fields, @binarypackages) = @_;
512 my $testsuite_field = $fields->{'Testsuite'} // '';
513 my %testsuite = map { $_ => 1 } split /\s*,\s*/, $testsuite_field;
514 if (-e
"$dir/debian/tests/control") {
515 error
(g_
('test control %s is not a regular file'),
516 'debian/tests/control') unless -f _
;
517 $testsuite{autopkgtest
} = 1;
519 my $tests = Dpkg
::Control
::Tests
->new();
520 $tests->load("$dir/debian/tests/control");
522 set_testsuite_triggers_field
($tests, $fields, @binarypackages);
523 } elsif ($testsuite{autopkgtest
}) {
524 warning
(g_
('%s field contains value %s, but no tests control file %s'),
525 'Testsuite', 'autopkgtest', 'debian/tests/control');
526 delete $testsuite{autopkgtest
};
528 $fields->{'Testsuite'} = join ', ', sort keys %testsuite;
531 sub set_testsuite_triggers_field
533 my ($tests, $fields, @binarypackages) = @_;
536 # Never overwrite a manually defined field.
537 return if $fields->{'Testsuite-Triggers'};
539 foreach my $test ($tests->get()) {
540 next unless $test->{Depends
};
542 my $deps = deps_parse
($test->{Depends
}, use_arch
=> 0, tests_dep
=> 1);
543 deps_iterate
($deps, sub { $testdeps{$_[0]->{package}} = 1 });
546 # Remove our own binaries and meta-depends.
547 foreach my $pkg (@binarypackages, qw(@
@builddeps@
)) {
548 delete $testdeps{$pkg};
550 $fields->{'Testsuite-Triggers'} = join ', ', sort keys %testdeps;
556 if (defined($options{opmode
})) {
557 usageerr
(g_
('two commands specified: --%s and --%s'),
558 $options{opmode
}, $opmode);
560 $options{opmode
} = $opmode;
567 if (length $opt->{name
} > 25) {
568 $help .= sprintf " %-25s\n%s%s.\n", $opt->{name
}, ' ' x
27, $opt->{help
};
570 $help .= sprintf " %-25s%s.\n", $opt->{name
}, $opt->{help
};
574 sub get_format_help
{
575 $build_format //= '1.0';
577 my $srcpkg = Dpkg
::Source
::Package
->new();
578 $srcpkg->{fields
}->{'Format'} = $build_format;
579 $srcpkg->upgrade_object_type(); # Fails if format is unsupported
581 my @cmdline = $srcpkg->describe_cmdline_options();
583 my $help_build = my $help_extract = '';
586 foreach my $opt (@cmdline) {
587 $help_build .= print_option
($opt) if $opt->{when} eq 'build';
588 $help_extract .= print_option
($opt) if $opt->{when} eq 'extract';
593 $help .= "Build format $build_format options:\n";
594 $help .= $help_build || C_
('source options', '<none>');
598 $help .= "Extract format $build_format options:\n";
599 $help .= $help_extract || C_
('source options', '<none>');
606 printf g_
("Debian %s version %s.\n"), $Dpkg::PROGNAME
, $Dpkg::PROGVERSION
;
609 This is free software; see the GNU General Public License version 2 or
610 later for copying conditions. There is NO warranty.
616 'Usage: %s [<option>...] <command>')
619 -x, --extract <filename>.dsc [<output-dir>]
620 extract source package.
621 -b, --build <dir> build source package.
622 --print-format <dir> print the format to be used for the source package.
623 --before-build <dir> run the corresponding source package format hook.
624 --after-build <dir> run the corresponding source package format hook.
625 --commit [<dir> [<patch-name>]]
626 store upstream changes in a new patch.')
629 -c<control-file> get control info from this file.
630 -l<changelog-file> get per-version info from this file.
631 -F<changelog-format> force changelog format.
632 --format=<source-format> set the format to be used for the source package.
633 -V<name>=<value> set a substitution variable.
634 -T<substvars-file> read variables here.
635 -D<field>=<value> override or add a .dsc field and value.
636 -U<field> remove a field.
637 -i, --diff-ignore[=<regex>]
638 filter out files to ignore diffs of
640 -I, --tar-ignore[=<pattern>]
641 filter out files when building tarballs
643 -Z, --compression=<compression>
644 select compression to use (defaults to '%s',
646 -z, --compression-level=<level>
647 compression level to use (defaults to '%d',
648 supported are: '1'-'9', 'best', 'fast')")
651 --no-copy don't copy .orig tarballs
652 --no-check don't check signature and checksums before unpacking
653 --no-overwrite-dir do not overwrite directory on extraction
654 --require-valid-signature abort if the package doesn't have a valid signature
655 --require-strong-checksums
656 abort if the package contains no strong checksums
657 --ignore-bad-version allow bad source package versions.")
663 -?, --help show this help message.
664 --version show the version.')
666 'Source format specific build and extract options are available;
667 use --format with --help to see them.') . "\n",
669 get_default_diff_ignore_regex
(),
670 join(' ', map { "-I$_" } get_default_tar_ignore_pattern
()),
671 compression_get_default
(),
672 join(' ', compression_get_list
()),
673 compression_get_default_level
();