# dgit
# Integration between git and Debian-style archives
#
-# Copyright (C)2013-2016 Ian Jackson
+# Copyright (C)2013-2017 Ian Jackson
+# Copyright (C)2017 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
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
+END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
+use Debian::Dgit::ExitStatus;
+
use strict;
use Debian::Dgit qw(:DEFAULT :playground);
our $suite_re = '[-+.0-9a-z]+';
our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
-our $orig_f_comp_re = 'orig(?:-[-0-9a-z]+)?';
+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 (@sbuild) = qw(sbuild);
our (@ssh) = 'ssh';
our (@dgit) = qw(dgit);
+our (@git_debrebase) = qw(git-debrebase);
our (@aptget) = qw(apt-get);
our (@aptcache) = qw(apt-cache);
our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores);
'ssh' => \@ssh,
'dgit' => \@dgit,
'git' => \@git,
+ 'git-debrebase' => \@git_debrebase,
'apt-get' => \@aptget,
'apt-cache' => \@aptcache,
'dpkg-source' => \@dpkgsource,
sub setup_gitattrs(;$);
sub check_gitattrs($$);
+our $playground;
our $keyid;
autoflush STDOUT 1;
}
};
-sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
+sub badcfg { print STDERR "$us: invalid configuration: @_\n"; finish 12; }
sub forceable_fail ($$) {
my ($forceoptsl, $msg) = @_;
sub no_such_package () {
print STDERR "$us: package $package does not exist in suite $isuite\n";
- exit 4;
+ finish 4;
}
sub deliberately ($) {
our $dgit_privdir_made //= ensure_a_playground 'dgit';
}
+sub branch_gdr_info ($$) {
+ my ($symref, $head) = @_;
+ my ($status, $msg, $current, $ffq_prev, $gdrlast) =
+ gdr_ffq_prev_branchinfo($symref);
+ return () unless $status eq 'branch';
+ $ffq_prev = git_get_ref $ffq_prev;
+ $gdrlast = git_get_ref $gdrlast;
+ $gdrlast &&= is_fast_fwd $gdrlast, $head;
+ 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 1;
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
dgit [dgit-opts] build [dpkg-buildpackage-opts]
dgit [dgit-opts] sbuild [sbuild-opts]
dgit [dgit-opts] push [dgit-opts] [suite]
+ dgit [dgit-opts] push-source [dgit-opts] [suite]
dgit [dgit-opts] rpush build-host:build-dir ...
important dgit options:
-k<keyid> sign tag and package with <keyid> instead of default
sub badusage {
print STDERR "$us: @_\n", $helpmsg or die $!;
- exit 8;
+ finish 8;
}
sub nextarg {
}
sub cmd_help () {
print $helpmsg or die $!;
- exit 0;
+ finish 0;
}
our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
sub prep_ud () {
dgit_privdir(); # ensures that $dgit_privdir_made is based on $maindir
- fresh_playground 'dgit/unpack';
+ $playground = fresh_playground 'dgit/unpack';
}
sub mktree_in_ud_here () {
return $gai;
}
+our $gitattrs_ourmacro_re = qr{^\[attr\]dgit-defuse-attrs\s};
+
sub is_gitattrs_setup () {
+ # return values:
+ # trueish
+ # 1: gitattributes set up and should be left alone
+ # falseish
+ # 0: there is a dgit-defuse-attrs but it needs fixing
+ # undef: there is none
my $gai = open_main_gitattrs();
return 0 unless $gai;
while (<$gai>) {
- return 1 if m{^\[attr\]dgit-defuse-attrs\s};
+ next unless m{$gitattrs_ourmacro_re};
+ return 1 if m{\s-working-tree-encoding\s};
+ printdebug "is_gitattrs_setup: found old macro\n";
+ return 0;
}
$gai->error and die $!;
- return 0;
+ printdebug "is_gitattrs_setup: found nothing\n";
+ return undef;
}
sub setup_gitattrs (;$) {
my ($always) = @_;
return unless $always || access_cfg_bool(1, 'setup-gitattributes');
- if (is_gitattrs_setup()) {
+ my $already = is_gitattrs_setup();
+ if ($already) {
progress <<END;
-[attr]dgit-defuse-attrs already found in .git/info/attributes
+[attr]dgit-defuse-attrs already found, and proper, in .git/info/attributes
not doing further gitattributes setup
END
return;
}
+ my $new = "[attr]dgit-defuse-attrs $negate_harmful_gitattrs";
my $af = "$maindir_gitcommon/info/attributes";
ensuredir "$maindir_gitcommon/info";
+
open GAO, "> $af.new" or die $!;
- print GAO <<END or die $!;
+ print GAO <<END or die $! unless defined $already;
* dgit-defuse-attrs
-[attr]dgit-defuse-attrs $negate_harmful_gitattrs
+$new
# ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
END
my $gai = open_main_gitattrs();
if ($gai) {
while (<$gai>) {
+ if (m{$gitattrs_ourmacro_re}) {
+ die unless defined $already;
+ $_ = $new;
+ }
chomp;
print GAO $_, "\n" or die $!;
}
# oh dear, found one
print STDERR <<END;
dgit: warning: $what contains .gitattributes
-dgit: .gitattributes have not been defused. Recommended: dgit setup-new-tree.
+dgit: .gitattributes not (fully) defused. Recommended: dgit setup-new-tree.
END
close $gafl;
return;
sub {
@end = ();
fetch();
- exit 0;
+ finish 0;
});
# xxx collecte the ref here
return if $ignoredirty;
- my @cmd = (@git, qw(diff --quiet HEAD));
- debugcmd "+",@cmd;
- $!=0; $?=-1; system @cmd;
- return if !$?;
- if ($?==256) {
- fail "working tree is dirty (does not match HEAD)";
- } else {
- failedcmd @cmd;
- }
+ git_check_unmodified();
}
sub commit_admin ($) {
runcmd_ordryrun_local @git, qw(commit -m), $m;
}
+sub quiltify_nofix_bail ($$) {
+ my ($headinfo, $xinfo) = @_;
+ if ($quilt_mode eq 'nofix') {
+ fail "quilt fixup required but quilt mode is \`nofix'\n".
+ "HEAD commit".$headinfo." differs from tree implied by ".
+ " debian/patches".$xinfo;
+ }
+}
+
sub commit_quilty_patch () {
my $output = cmdoutput @git, qw(status --porcelain);
my %adds;
progress "nothing quilty to commit, ok.";
return;
}
+ quiltify_nofix_bail "", " (wanted to commit patch update)";
my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
runcmd_ordryrun_local @git, qw(add -f), @adds;
commit_admin <<END
: !length $overwrite_version ? " --overwrite"
: " --overwrite=".$overwrite_version;
+ # Contributing parent is the first parent - that makes
+ # git rev-list --first-parent DTRT.
my $pmf = dgit_privdir()."/pseudomerge";
open MC, ">", $pmf or die "$pmf $!";
print MC <<END or die $!;
my $format = getfield $dsc, 'Format';
printdebug "format $format\n";
+ my $symref = git_get_symref();
my $actualhead = git_rev_parse('HEAD');
+
+ if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
+ runcmd_ordryrun_local @git_debrebase, 'stitch';
+ $actualhead = git_rev_parse('HEAD');
+ }
+
my $dgithead = $actualhead;
my $maintviewhead = undef;
}
sub branchsuite () {
- my @cmd = (@git, qw(symbolic-ref -q HEAD));
- my $branch = cmdoutput_errok @cmd;
- if (!defined $branch) {
- $?==256 or failedcmd @cmd;
- return undef;
- }
- if ($branch =~ m#$lbranch_re#o) {
+ my $branch = git_get_symref();
+ if (defined $branch && $branch =~ m#$lbranch_re#o) {
return $1;
} else {
return undef;
parseopts();
fetchpullargs();
my $multi_fetched = fork_for_multisuite(sub { });
- exit 0 if $multi_fetched;
+ finish 0 if $multi_fetched;
fetch();
}
dopush();
}
+sub cmd_push_source {
+ prep_push();
+ 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_for_push();
+ }
+ dopush();
+}
+
#---------- remote commands' implementation ----------
sub pre_remote_push_build_host {
i_cleanup();
printdebug "all done\n";
- exit 0;
+ finish 0;
}
sub i_resp_file ($) {
last;
}
- if ($quilt_mode eq 'nofix') {
- fail "quilt fixup required but quilt mode is \`nofix'\n".
- "HEAD commit $c->{Commit} differs from tree implied by ".
- " debian/patches (tree object $oldtiptree)";
- }
+ quiltify_nofix_bail " $c->{Commit}", " (tree object $oldtiptree)";
if ($quilt_mode eq 'smash') {
printdebug " search quitting smash\n";
last;
my $clogp = parsechangelog();
my $headref = git_rev_parse('HEAD');
+ my $symref = git_get_symref();
+
+ if ($quilt_mode eq 'linear'
+ && !$fopts->{'single-debian-patch'}
+ && branch_is_gdr($symref, $headref)) {
+ # This is much faster. It also makes patches that gdr
+ # likes better for future updates without laundering.
+ #
+ # However, it can fail in some casses where we would
+ # succeed: if there are existing patches, which correspond
+ # to a prefix of the branch, but are not in gbp/gdr
+ # format, gdr will fail (exiting status 7), but we might
+ # be able to figure out where to start linearising. That
+ # will be slower so hopefully there's not much to do.
+ my @cmd = (@git_debrebase,
+ qw(--noop-ok -funclean-mixed -funclean-ordering
+ make-patches --quiet-would-amend));
+ # We tolerate soe snags that gdr wouldn't, by default.
+ if (act_local()) {
+ $!=0; $?=-1;
+ failedcmd @cmd if system @cmd and $?!=7;
+ } else {
+ dryrun_report @cmd;
+ }
+ $headref = git_rev_parse('HEAD');
+ }
prep_ud();
changedir $playground;
if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
$! == ENOENT or die $!;
printdebug ">(no reflog)\n";
- exit 0;
+ finish 0;
}
exec @cmd; die $!;
}
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";
}
I2->error and die $!;
close O or die $1;
- exit 0;
+ finish 0;
}
sub maybe_apply_patches_dirtily () {
}
sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
+sub build_source_for_push {
+ build_source();
+ maybe_unapply_patches_again();
+ $changesfile = $sourcechanges;
+}
+
sub build_source {
build_prep_early();
build_prep();
sub cmd_archive_api_query {
badusage "need only 1 subpath argument" unless @ARGV==1;
my ($subpath) = @ARGV;
+ local $isuite = 'DGIT-API-QUERY-CMD';
my @cmd = archive_api_query_cmd($subpath);
push @cmd, qw(-f);
debugcmd ">",@cmd;
sub cmd_version {
print "dgit version $our_version\n" or die $!;
- exit 0;
+ finish 0;
}
our (%valopts_long, %valopts_short);
if $dryrun_level == 1;
if (!@ARGV) {
print STDERR $helpmsg or die $!;
- exit 8;
+ finish 8;
}
$cmd = $subcommand = shift @ARGV;
$cmd =~ y/-/_/;
my $fn = ${*::}{"cmd_$cmd"};
$fn or badusage "unknown operation $cmd";
$fn->();
+
+finish 0;