# dgit
# Integration between git and Debian-style archives
#
-# Copyright (C)2013-2017 Ian Jackson
-# Copyright (C)2017 Sean Whitton
+# Copyright (C)2013-2018 Ian Jackson
+# Copyright (C)2017-2018 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
our $quilt_mode;
our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';
our $dodep14tag;
-our $split_brain_save;
+our %internal_object_save;
our $we_are_responder;
our $we_are_initiator;
our $initiator_tempdir;
our $suite_re = '[-+.0-9a-z]+';
our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
-our $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
-our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
-our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
our $splitbraincache = 'dgit-intern/quilt-cache';
our (@dput) = qw(dput);
our (@debsign) = qw(debsign);
our (@gpg) = qw(gpg);
-our (@sbuild) = qw(sbuild);
+our (@sbuild) = (qw(sbuild --no-source));
our (@ssh) = 'ssh';
our (@dgit) = qw(dgit);
our (@git_debrebase) = qw(git-debrebase);
our (@gbp_build) = ('');
our (@gbp_pq) = ('gbp pq');
our (@changesopts) = ('');
+our (@pbuilder) = ("sudo -E pbuilder");
+our (@cowbuilder) = ("sudo -E cowbuilder");
our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
'curl' => \@curl,
'gbp-build' => \@gbp_build,
'gbp-pq' => \@gbp_pq,
'ch' => \@changesopts,
- 'mergechanges' => \@mergechanges);
+ 'mergechanges' => \@mergechanges,
+ 'pbuilder' => \@pbuilder,
+ 'cowbuilder' => \@cowbuilder);
our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1);
our %opts_cfg_insertpos = map {
autoflush STDOUT 1;
our $supplementary_message = '';
-our $need_split_build_invocation = 1;
our $split_brain = 0;
END {
sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
sub rrref () { return server_ref($csuite); }
-sub stripepoch ($) {
- my ($vsn) = @_;
- $vsn =~ s/^\d+\://;
- return $vsn;
-}
-
sub srcfn ($$) {
- my ($vsn,$sfx) = @_;
- return "${package}_".(stripepoch $vsn).$sfx
+ my ($vsn, $sfx) = @_;
+ return &source_file_leafname($package, $vsn, $sfx);
+}
+sub is_orig_file_of_vsn ($$) {
+ my ($f, $upstreamvsn) = @_;
+ return is_orig_file_of_p_v($f, $package, $upstreamvsn);
}
sub dscfn ($) {
return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
}
-sub upstreamversion ($) {
- my ($vsn) = @_;
- $vsn =~ s/-[^-]+$//;
- return $vsn;
-}
-
our $us = 'dgit';
initdebug('');
}
sub opts_opt_multi_cmd {
+ my $extra = shift;
my @cmd;
push @cmd, split /\s+/, shift @_;
+ push @cmd, @$extra;
push @cmd, @_;
@cmd;
}
sub gbp_pq {
- return opts_opt_multi_cmd @gbp_pq;
+ return opts_opt_multi_cmd [], @gbp_pq;
}
sub dgit_privdir () {
return $r;
}
+sub get_tree_of_commit ($) {
+ my ($commitish) = @_;
+ my $cdata = cmdoutput @git, qw(cat-file commit), $commitish;
+ $cdata =~ m/\n\n/; $cdata = $`;
+ $cdata =~ m/^tree (\w+)$/m or confess "cdata $cdata ?";
+ return $1;
+}
+
sub branch_gdr_info ($$) {
my ($symref, $head) = @_;
my ($status, $msg, $current, $ffq_prev, $gdrlast) =
return ($ffq_prev, $gdrlast);
}
-sub branch_is_gdr ($$) {
- my ($symref, $head) = @_;
- my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
- return 0 unless $ffq_prev || $gdrlast;
- return 1;
-}
-
sub branch_is_gdr_unstitched_ff ($$$) {
my ($symref, $head, $ancestor) = @_;
my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
return 0 unless $ffq_prev;
- return 0 unless is_fast_fwd $ancestor, $ffq_prev;
+ return 0 unless !defined $ancestor or is_fast_fwd $ancestor, $ffq_prev;
return 1;
}
+sub branch_is_gdr ($) {
+ my ($head) = @_;
+ # This is quite like git-debrebase's keycommits.
+ # We have our own implementation because:
+ # - our algorighm can do fewer tests so is faster
+ # - it saves testing to see if gdr is installed
+
+ # NB we use this jsut for deciding whether to run gdr make-patches
+ # Before reusing this algorithm for somthing else, its
+ # suitability should be reconsidered.
+
+ my $walk = $head;
+ local $Debian::Dgit::debugcmd_when_debuglevel = 3;
+ printdebug "branch_is_gdr $head...\n";
+ my $get_patches = sub {
+ my $t = git_cat_file "$_[0]:debian/patches", [qw(missing tree)];
+ return $t // '';
+ };
+ my $tip_patches = $get_patches->($head);
+ WALK:
+ for (;;) {
+ my $cdata = git_cat_file $walk, 'commit';
+ my ($hdrs,$msg) = $cdata =~ m{\n\n} ? ($`,$') : ($cdata,'');
+ if ($msg =~ m{^\[git-debrebase\ (
+ anchor | changelog | make-patches |
+ merged-breakwater | pseudomerge
+ ) [: ] }mx) {
+ # no need to analyse this - it's sufficient
+ # (gdr classifications: Anchor, MergedBreakwaters)
+ # (made by gdr: Pseudomerge, Changelog)
+ printdebug "branch_is_gdr $walk gdr $1 YES\n";
+ return 1;
+ }
+ my @parents = ($hdrs =~ m/^parent (\w+)$/gm);
+ if (@parents==2) {
+ my $walk_tree = get_tree_of_commit $walk;
+ foreach my $p (@parents) {
+ my $p_tree = get_tree_of_commit $p;
+ if ($p_tree eq $walk_tree) { # pseudomerge contriburor
+ # (gdr classification: Pseudomerge; not made by gdr)
+ printdebug "branch_is_gdr $walk unmarked pseudomerge\n"
+ if $debuglevel >= 2;
+ $walk = $p;
+ next WALK;
+ }
+ }
+ # some other non-gdr merge
+ # (gdr classification: VanillaMerge, DgitImportUnpatched, ?)
+ printdebug "branch_is_gdr $walk ?-2-merge NO\n";
+ return 0;
+ }
+ if (@parents>2) {
+ # (gdr classification: ?)
+ printdebug "branch_is_gdr $walk ?-octopus NO\n";
+ return 0;
+ }
+ if ($get_patches->($walk) ne $tip_patches) {
+ # Our parent added, removed, or edited patches, and wasn't
+ # a gdr make-patches commit. gdr make-patches probably
+ # won't do that well, then.
+ # (gdr classification of parent: AddPatches or ?)
+ printdebug "branch_is_gdr $walk ?-patches NO\n";
+ return 0;
+ }
+ if ($tip_patches eq '' and
+ !defined git_cat_file "$walk:debian") {
+ # (gdr classification of parent: BreakwaterStart
+ printdebug "branch_is_gdr $walk unmarked BreakwaterStart YES\n";
+ return 1;
+ }
+ # (gdr classification: Upstream Packaging Mixed Changelog)
+ printdebug "branch_is_gdr $walk plain\n"
+ if $debuglevel >= 2;
+ $walk = $parents[0];
+ }
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
dgit [dgit-opts] build [dpkg-buildpackage-opts]
dgit [dgit-opts] sbuild [sbuild-opts]
+ dgit [dgit-opts] pbuilder|cowbuilder [debbuildopts]
dgit [dgit-opts] push [dgit-opts] [suite]
dgit [dgit-opts] push-source [dgit-opts] [suite]
dgit [dgit-opts] rpush build-host:build-dir ...
}
sub pushing () {
- die "$access_forpush ?" if ($access_forpush // 1) ne 1;
+ confess 'internal error '.Dumper($access_forpush)," ?" if
+ defined $access_forpush and !$access_forpush;
badcfg "pushing but distro is configured readonly"
if access_forpush_config() eq '0';
$access_forpush = 1;
} qw(codename name);
push @matched, $entry;
}
- fail "unknown suite $isuite" unless @matched;
+ fail "unknown suite $isuite, maybe -d would help" unless @matched;
my $cn;
eval {
@matched==1 or die "multiple matches for suite $isuite\n";
return 1;
}
-sub is_orig_file_of_vsn ($$) {
- my ($f, $upstreamvsn) = @_;
- my $base = srcfn $upstreamvsn, '';
- return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
- return 1;
-}
-
# This function determines whether a .changes file is source-only from
# the point of view of dak. Thus, it permits *_source.buildinfo
# files.
return cmdoutput @git, qw(hash-object -w -t commit), $file;
}
-sub make_commit_text ($) {
- my ($text) = @_;
- my ($out, $in);
- my @cmd = (@git, qw(hash-object -w -t commit --stdin));
- debugcmd "|",@cmd;
- print Dumper($text) if $debuglevel > 1;
- my $child = open2($out, $in, @cmd) or die $!;
- my $h;
- eval {
- print $in $text or die $!;
- close $in or die $!;
- $h = <$out>;
- $h =~ m/^\w+$/ or die;
- $h = $&;
- printdebug "=> $h\n";
- };
- close $out;
- waitpid $child, 0 == $child or die "$child $!";
- $? and failedcmd @cmd;
- return $h;
-}
-
sub clogp_authline ($) {
my ($clogp) = @_;
my $author = getfield $clogp, 'Maintainer';
# here we go, then:
my $tree_commit = $mergeinputs[0]{Commit};
- my $tree = cmdoutput @git, qw(cat-file commit), $tree_commit;
- $tree =~ m/\n\n/; $tree = $`;
- $tree =~ m/^tree (\w+)$/m or die "$dsc_hash tree ?";
- $tree = $1;
+ my $tree = get_tree_of_commit $tree_commit;;
# We use the changelog author of the package in question the
# author of this pseudo-merge. This is (roughly) correct if
sub multisuite_suite_child ($$$) {
- my ($tsuite, $merginputs, $fn) = @_;
+ my ($tsuite, $mergeinputs, $fn) = @_;
# in child, sets things up, calls $fn->(), and returns undef
# in parent, returns canonical suite name for $tsuite
my $canonsuitefh = IO::File::new_tmpfile;
return $csuite;
}
printdebug "multisuite $tsuite ok (canon=$csuite)\n";
- push @$merginputs, {
+ push @$mergeinputs, {
Ref => lrref,
Info => $csuite,
};
fetch_one();
finish 0;
});
- # xxx collecte the ref here
$csubsuite =~ s/^\Q$cbasesuite\E-/-/;
push @csuites, $csubsuite;
sub maybe_split_brain_save ($$$) {
my ($headref, $dgitview, $msg) = @_;
# => message fragment "$saved" describing disposition of $dgitview
- return "commit id $dgitview" unless defined $split_brain_save;
+ my $save = $internal_object_save{'dgit-view'};
+ return "commit id $dgitview" unless defined $save;
my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
git_update_ref_cmd
"dgit --dgit-view-save $msg HEAD=$headref",
- $split_brain_save, $dgitview);
+ $save, $dgitview);
runcmd @cmd;
- return "and left in $split_brain_save";
+ return "and left in $save";
}
# An "infopair" is a tuple [ $thing, $what ]
my $actualhead = git_rev_parse('HEAD');
if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
+ if (quiltmode_splitbrain()) {
+ my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $actualhead);
+ fail <<END;
+Branch is managed by git-debrebase ($ffq_prev
+exists), but quilt mode ($quilt_mode) implies a split view.
+Pass the right --quilt option or adjust your git config.
+Or, maybe, run git-debrebase forget-was-ever-debrebase.
+END
+ }
runcmd_ordryrun_local @git_debrebase, 'stitch';
$actualhead = git_rev_parse('HEAD');
}
responder_send_command("param isuite $isuite");
responder_send_command("param tagformat $tagformat");
if (defined $maintviewhead) {
- die unless ($protovsn//4) >= 4;
+ confess "internal error (protovsn=$protovsn)"
+ if defined $protovsn and $protovsn < 4;
responder_send_command("param maint-view $maintviewhead");
}
supplementary_message(<<'END');
Push failed, while obtaining signatures on the .changes and .dsc.
If it was just that the signature failed, you may try again by using
-debsign by hand to sign the changes
- $changesfile
-and then dput to complete the upload.
+debsign by hand to sign the changes file (see the command dgit tried,
+above), and then dput that changes file to complete the upload.
If you need to change the package, you must use a new version number.
END
if ($we_are_responder) {
dopush();
}
-our $sourcechanges;
-
-sub cmd_push_source {
- prep_push();
- fail "dgit push-source: --include-dirty/--ignore-dirty does not make".
- "sense with push-source!" if $includedirty;
- clean_tree();
- build_maybe_quilt_fixup();
- if ($changesfile) {
- my $changes = parsecontrol("$buildproductsdir/$changesfile",
- "source changes file");
- unless (test_source_only_changes($changes)) {
- fail "user-specified changes file is not source-only";
- }
- } else {
- # Building a source package is very fast, so just do it
- build_source();
- die "er, patches are applied dirtily but shouldn't be.."
- if $patches_applied_dirtily;
- $changesfile = $sourcechanges;
- }
- dopush();
-}
-
#---------- remote commands' implementation ----------
sub pre_remote_push_build_host {
#---------- building etc. ----------
our $version;
+our $sourcechanges;
our $dscfn;
#----- `3.0 (quilt)' handling -----
my $dgitview = git_rev_parse 'HEAD';
changedir $maindir;
- # When we no longer need to support squeeze, use --create-reflog
- # instead of this:
- ensuredir "$maindir_gitcommon/logs/refs/dgit-intern";
- my $makelogfh = new IO::File "$maindir_gitcommon/logs/refs/$splitbraincache", '>>'
- or die $!;
-
- my $oldcache = git_get_ref "refs/$splitbraincache";
- if ($oldcache eq $dgitview) {
- my $tree = cmdoutput qw(git rev-parse), "$dgitview:";
- # git update-ref doesn't always update, in this case. *sigh*
- my $dummy = make_commit_text <<END;
-tree $tree
-parent $dgitview
-author Dgit <dgit\@example.com> 1000000000 +0000
-committer Dgit <dgit\@example.com> 1000000000 +0000
-
-Dummy commit - do not use
-END
- runcmd @git, qw(update-ref -m), "dgit $our_version - dummy",
- "refs/$splitbraincache", $dummy;
- }
- runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
- $dgitview;
+ reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview;
changedir "$playground/work";
};
if ($quilt_mode eq 'linear') {
print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n";
+ my $all_gdr = !!@nots;
foreach my $notp (@nots) {
print STDERR "$us: ", $reportnot->($notp), "\n";
+ $all_gdr &&= $notp->{Child} &&
+ (git_cat_file $notp->{Child}{Commit}, 'commit')
+ =~ m{^\[git-debrebase(?! split[: ]).*\]$}m;
}
- print STDERR "$us: $_\n" foreach @$failsuggestion;
+ print STDERR "\n";
+ $failsuggestion =
+ [ grep { $_->[0] ne 'quilt-mode' } @$failsuggestion ]
+ if $all_gdr;
+ print STDERR "$us: $_->[1]\n" foreach @$failsuggestion;
fail
- "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n".
- "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
+ "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n";
} elsif ($quilt_mode eq 'smash') {
} elsif ($quilt_mode eq 'auto') {
progress "quilt fixup cannot be linear, smashing...";
if ($quilt_mode eq 'linear'
&& !$fopts->{'single-debian-patch'}
- && branch_is_gdr($symref, $headref)) {
+ && branch_is_gdr($headref)) {
# This is much faster. It also makes patches that gdr
# likes better for future updates without laundering.
#
quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
}
- die 'bug' if $split_brain && !$need_split_build_invocation;
-
changedir $maindir;
runcmd_ordryrun_local
@git, qw(pull --ff-only -q), "$playground/work", qw(master);
close $fakedsc or die $!;
}
+sub quilt_fakedsc2unapplied ($$) {
+ my ($headref, $upstreamversion) = @_;
+ # must be run in the playground
+ # quilt_make_fake_dsc must have been called
+
+ runcmd qw(sh -ec),
+ 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
+
+ my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+ rename $fakexdir, "fake" or die "$fakexdir $!";
+
+ changedir 'fake';
+
+ remove_stray_gits("source package");
+ mktree_in_ud_here();
+
+ rmtree '.pc';
+
+ rmtree 'debian'; # git checkout commitish paths does not delete!
+ runcmd @git, qw(checkout -f), $headref, qw(-- debian);
+ my $unapplied=git_add_write_tree();
+ printdebug "fake orig tree object $unapplied\n";
+ return $unapplied;
+}
+
sub quilt_check_splitbrain_cache ($$) {
my ($headref, $upstreamversion) = @_;
# Called only if we are in (potentially) split brain mode.
push @cachekey, $srcshash->hexdigest();
$splitbrain_cachekey = "@cachekey";
- my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs',
- $splitbraincache);
printdebug "splitbrain cachekey $splitbrain_cachekey\n";
- debugcmd "|(probably)",@cmd;
- my $child = open GC, "-|"; defined $child or die $!;
- if (!$child) {
- chdir $maindir or die $!;
- if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
- $! == ENOENT or die $!;
- printdebug ">(no reflog)\n";
- finish 0;
- }
- exec @cmd; die $!;
- }
- while (<GC>) {
- chomp;
- printdebug ">| ", $_, "\n" if $debuglevel > 1;
- next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
-
- my $cachehit = $1;
+
+ my $cachehit = reflog_cache_lookup
+ "refs/$splitbraincache", $splitbrain_cachekey;
+
+ if ($cachehit) {
unpack_playtree_mkwork($headref);
my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
if ($cachehit ne $headref) {
progress "dgit view: found cached, no changes required";
return ($headref, $splitbrain_cachekey);
}
- die $! if GC->error;
- failedcmd unless close GC;
printdebug "splitbrain cache miss\n";
return (undef, $splitbrain_cachekey);
quilt_check_splitbrain_cache($headref, $upstreamversion);
return if $cachehit;
}
-
- runcmd qw(sh -ec),
- 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
-
- my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
- rename $fakexdir, "fake" or die "$fakexdir $!";
-
- changedir 'fake';
-
- remove_stray_gits("source package");
- mktree_in_ud_here();
-
- rmtree '.pc';
-
- rmtree 'debian'; # git checkout commitish paths does not delete!
- runcmd @git, qw(checkout -f), $headref, qw(-- debian);
- my $unapplied=git_add_write_tree();
- printdebug "fake orig tree object $unapplied\n";
+ my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion);
ensuredir '.pc';
my @failsuggestion;
if (!($diffbits->{O2H} & $diffbits->{O2A})) {
- push @failsuggestion, "This might be a patches-unapplied branch.";
- } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
- push @failsuggestion, "This might be a patches-applied branch.";
+ push @failsuggestion, [ 'unapplied',
+ "This might be a patches-unapplied branch." ];
+ } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
+ push @failsuggestion, [ 'applied',
+ "This might be a patches-applied branch." ];
}
- push @failsuggestion, "Maybe you need to specify one of".
- " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
+ push @failsuggestion, [ 'quilt-mode',
+ "Maybe you need one of --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?" ];
+
+ push @failsuggestion, [ 'gitattrs',
+ "Warning: Tree has .gitattributes. See GITATTRIBUTES in dgit(7)." ]
+ if stat_exists '.gitattributes';
+
+ push @failsuggestion, [ 'origs',
+ "Maybe orig tarball(s) are not identical to git representation?" ];
if (quiltmode_splitbrain()) {
quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree,
$isuite = getfield $clogp, 'Distribution';
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
+ $dscfn = dscfn($version);
}
sub build_prep_early () {
sub massage_dbp_args ($;$) {
my ($cmd,$xargs) = @_;
- # We need to:
- #
- # - if we're going to split the source build out so we can
- # do strange things to it, massage the arguments to dpkg-buildpackage
- # so that the main build doessn't build source (or add an argument
- # to stop it building source by default).
- #
- # - add -nc to stop dpkg-source cleaning the source tree,
- # unless we're not doing a split build and want dpkg-source
- # as cleanmode, in which case we can do nothing
- #
+ # Since we split the source build out so we can do strange things
+ # to it, massage the arguments to dpkg-buildpackage so that the
+ # main build doessn't build source (or add an argument to stop it
+ # building source by default).
debugcmd '#massaging#', @$cmd if $debuglevel>1;
-#print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation);
- if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) {
- $clean_using_builder = 1;
- return WANTSRC_BUILDER;
- }
# -nc has the side effect of specifying -b if nothing else specified
# and some combinations of -S, -b, et al, are errors, rather than
# later simply overriding earlie. So we need to:
my $dmode = '-F';
foreach my $l ($cmd, $xargs) {
next unless $l;
- @$l = grep { !(m/^-[SgGFABb]$/s and $dmode=$_) } @$l;
+ @$l = grep { !(m/^-[SgGFABb]$|^--build=/s and $dmode=$_) } @$l;
}
push @$cmd, '-nc';
#print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
my $r = WANTSRC_BUILDER;
- if ($need_split_build_invocation) {
- printdebug "massage split $dmode.\n";
- $r = $dmode =~ m/[S]/ ? WANTSRC_SOURCE :
- $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER :
- $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER :
- die "$dmode ?";
+ printdebug "massage split $dmode.\n";
+ if ($dmode =~ s/^--build=//) {
+ $r = 0;
+ my @d = split /,/, $dmode;
+ $r |= WANTSRC_SOURCE if grep { s/^full$/binary/ } @d;
+ $r |= WANTSRC_SOURCE if grep { s/^source$// } @d;
+ $r |= WANTSRC_BUILDER if grep { m/./ } @d;
+ fail "Wanted to build nothing!" unless $r;
+ $dmode = '--build='. join ',', grep m/./, @d;
+ } else {
+ $r =
+ $dmode =~ m/[S]/ ? WANTSRC_SOURCE :
+ $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER :
+ $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER :
+ die "$dmode ?";
}
printdebug "massage done $r $dmode.\n";
push @$cmd, $dmode;
sub cmd_build {
build_prep_early();
+ $buildproductsdir eq '..' or print STDERR <<END;
+$us: warning: build-products-dir set, but not supported by dpkg-buildpackage
+$us: warning: build-products-dir will be ignored; files will go to ..
+END
+ $buildproductsdir = '..';
my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
my $wantsrc = massage_dbp_args \@dbp;
build_prep($wantsrc);
if ($gbp_make_orig) {
clean_tree();
$cleanmode = 'none'; # don't do it again
- $need_split_build_invocation = 1;
}
my @dbp = @dpkgbuildpackage;
$gbp_build[0] = 'gbp buildpackage';
}
}
- my @cmd = opts_opt_multi_cmd @gbp_build;
+ my @cmd = opts_opt_multi_cmd [], @gbp_build;
push @cmd, (qw(-us -uc --git-no-sign-tags),
"--git-builder=".(shellquote @dbp));
}
sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
-sub move_dsc_to_bpd ($) {
- my ($dscfn) = @_;
- printdebug "moving $dscfn and all referenced files to ".bpd_abs()."\n";
- $dsc = parsecontrol($dscfn, "source package");
- foreach my $l (split /\n/, getfield $dsc, 'Files') {
- $l =~ m/\S+$/ or next;
- $l =~ s/.* //;
- printdebug "found $l - renaming\n";
- rename "$l", bpd_abs()."/$l"
- or fail "put in place new source file ($l): $!";
- }
- printdebug "moving $dscfn to ".bpd_abs()."/$dscfn\n";
- rename "$dscfn", bpd_abs()."/$dscfn"
- or fail "put in place new source file ($dscfn): $!";
-}
-
sub building_source_in_playtree {
# If $includedirty, we have to build the source package from the
# working tree, not a playtree, so that uncommitted changes are
unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
or fail "remove $sourcechanges: $!";
}
- $dscfn = dscfn($version);
my @cmd = (@dpkgsource, qw(-b --));
my $leafdir;
if (building_source_in_playtree()) {
'exec >../$1; shift; exec "$@"','x', $sourcechanges,
@dpkggenchanges, qw(-S), changesopts();
changedir '..';
- move_dsc_to_bpd($dscfn);
- rename "$sourcechanges", bpd_abs()."/$sourcechanges"
- or fail "put in place source changes file ($sourcechanges): $!";
+
+ printdebug "moving $dscfn, $sourcechanges, etc. to ".bpd_abs()."\n";
+ $dsc = parsecontrol($dscfn, "source package");
+
+ my $mv = sub {
+ my ($why, $l) = @_;
+ printdebug " renaming ($why) $l\n";
+ rename "$l", bpd_abs()."/$l"
+ or fail "put in place new built file ($l): $!";
+ };
+ foreach my $l (split /\n/, getfield $dsc, 'Files') {
+ $l =~ m/\S+$/ or next;
+ $mv->('Files', $&);
+ }
+ $mv->('dsc', $dscfn);
+ $mv->('changes', $sourcechanges);
+
changedir $maindir;
}
printdone "source built, results in $dscfn and $sourcechanges";
}
-sub cmd_sbuild {
- build_prep(WANTSRC_SOURCE); # not BUILDER because sbuild uses the .dsc
+sub cmd_push_source {
+ prep_push();
+ fail "dgit push-source: --include-dirty/--ignore-dirty does not make".
+ "sense with push-source!" if $includedirty;
+ build_maybe_quilt_fixup();
+ if ($changesfile) {
+ my $changes = parsecontrol("$buildproductsdir/$changesfile",
+ "source changes file");
+ unless (test_source_only_changes($changes)) {
+ fail "user-specified changes file is not source-only";
+ }
+ } else {
+ # Building a source package is very fast, so just do it
+ build_source();
+ die "er, patches are applied dirtily but shouldn't be.."
+ if $patches_applied_dirtily;
+ $changesfile = $sourcechanges;
+ }
+ dopush();
+}
+
+sub binary_builder {
+ my ($bbuilder, $pbmc_msg, @args) = @_;
+ build_prep(WANTSRC_SOURCE);
build_source();
midbuild_checkchanges();
in_bpd {
if (act_local()) {
- stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+ stat_exists $dscfn or fail "$dscfn (in build products dir): $!";
stat_exists $sourcechanges
- or fail "$sourcechanges (in parent directory): $!";
+ or fail "$sourcechanges (in build products dir): $!";
}
- runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
+ runcmd_ordryrun_local @$bbuilder, @args;
};
maybe_unapply_patches_again();
in_bpd {
- postbuild_mergechanges(<<END);
+ postbuild_mergechanges($pbmc_msg);
+ };
+}
+
+sub cmd_sbuild {
+ build_prep_early();
+ binary_builder(\@sbuild, <<END, qw(-d), $isuite, @ARGV, $dscfn);
perhaps you need to pass -A ? (sbuild's default is to build only
arch-specific binaries; dgit 1.4 used to override that.)
END
- };
-}
+}
+
+sub pbuilder ($) {
+ my ($pbuilder) = @_;
+ build_prep_early();
+ # @ARGV is allowed to contain only things that should be passed to
+ # pbuilder under debbuildopts; just massage those
+ my $wantsrc = massage_dbp_args \@ARGV;
+ fail "you asked for a builder but your debbuildopts didn't ask for".
+ " any binaries -- is this really what you meant?"
+ unless $wantsrc & WANTSRC_BUILDER;
+ fail "we must build a .dsc to pass to the builder but your debbuiltopts".
+ " forbids the building of a source package; cannot continue"
+ unless $wantsrc & WANTSRC_SOURCE;
+ # We do not want to include the verb "build" in @pbuilder because
+ # the user can customise @pbuilder and they shouldn't be required
+ # to include "build" in their customised value. However, if the
+ # user passes any additional args to pbuilder using the dgit
+ # option --pbuilder:foo, such args need to come after the "build"
+ # verb. opts_opt_multi_cmd does all of that.
+ binary_builder([opts_opt_multi_cmd ["build"], @$pbuilder], undef,
+ qw(--debbuildopts), "@ARGV", qw(--distribution), $isuite,
+ $dscfn);
+}
+
+sub cmd_pbuilder {
+ pbuilder(\@pbuilder);
+}
+
+sub cmd_cowbuilder {
+ pbuilder(\@cowbuilder);
+}
sub cmd_quilt_fixup {
badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
build_maybe_quilt_fixup();
}
+sub cmd_print_unapplied_treeish {
+ badusage "incorrect arguments to dgit print-unapplied-treeish" if @ARGV;
+ my $headref = git_rev_parse('HEAD');
+ my $clogp = commit_getclogp $headref;
+ $package = getfield $clogp, 'Source';
+ $version = getfield $clogp, 'Version';
+ $isuite = getfield $clogp, 'Distribution';
+ $csuite = $isuite; # we want this to be offline!
+ notpushing();
+
+ prep_ud();
+ changedir $playground;
+ my $uv = upstreamversion $version;
+ quilt_make_fake_dsc($uv);
+ my $u = quilt_fakedsc2unapplied($headref, $uv);
+ print $u, "\n" or die $!;
+}
+
sub import_dsc_result {
my ($dstref, $newhash, $what_log, $what_msg) = @_;
my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
} elsif (m/^--delayed=(\d+)$/s) {
push @ropts, $_;
push @dput, $_;
- } elsif (m/^--dgit-view-save=(.+)$/s) {
+ } elsif (my ($k,$v) =
+ m/^--save-(dgit-view)=(.+)$/s ||
+ m/^--(dgit-view)-save=(.+)$/s
+ ) {
push @ropts, $_;
- $split_brain_save = $1;
- $split_brain_save =~ s#^(?!refs/)#refs/heads/#;
+ $v =~ s#^(?!refs/)#refs/heads/#;
+ $internal_object_save{$k} = $v;
} elsif (m/^--(no-)?rm-old-changes$/s) {
push @ropts, $_;
$rmchanges = !$1;
push @ropts, $_;
$tagformat_want = [ $1, 'command line', 1 ];
# 1 menas overrides distro configuration
- } elsif (m/^--always-split-source-build$/s) {
- # undocumented, was once for testing, now a no-op
- push @ropts, $_;
- $need_split_build_invocation = 1;
} elsif (m/^--config-lookup-explode=(.+)$/s) {
# undocumented, for testing
push @ropts, $_;
foreach my $name (qw(PIPE CHLD)) {
my $signame = "SIG$name";
my $signum = eval "POSIX::$signame" // die;
- ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or
- die "$signame is set to something other than SIG_DFL\n";
+ die "$signame is set to something other than SIG_DFL\n"
+ if defined $SIG{$name} and $SIG{$name} ne 'DEFAULT';
$blocked->ismember($signum) and
die "$signame is blocked\n";
}
$$vr = $v;
}
- $need_split_build_invocation ||= quiltmode_splitbrain();
-
fail "dgit: --include-dirty is not supported in split view quilt mode"
if $split_brain && $includedirty;
~ianmdlvl / dgit.git / blobdiff