X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=bfc168c253c9423805902428fc7bd43ca9c0e1ec;hb=3ba94c7664e86e773d2feca4f9fc06b4e1791b19;hp=be277f3e48e6daca67eec32aa30e7317cda8f194;hpb=814fa4dc0dbf43f7b2ec57803a155d03ba136a9b;p=dgit.git
diff --git a/dgit b/dgit
index be277f3e..bfc168c2 100755
--- a/dgit
+++ b/dgit
@@ -2,7 +2,8 @@
# 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
@@ -17,9 +18,12 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
+END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
+use Debian::Dgit::ExitStatus;
+
use strict;
-use Debian::Dgit;
+use Debian::Dgit qw(:DEFAULT :playground);
setup_sigwarn();
use IO::Handle;
@@ -30,6 +34,8 @@ use File::Path;
use File::Temp qw(tempdir);
use File::Basename;
use Dpkg::Version;
+use Dpkg::Compression;
+use Dpkg::Compression::Process;
use POSIX;
use IPC::Open2;
use Digest::SHA;
@@ -47,6 +53,8 @@ our $absurdity = undef; ###substituted###
our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
our $protovsn;
+our $cmd;
+our $subcommand;
our $isuite;
our $idistro;
our $package;
@@ -90,7 +98,7 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
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)?";
@@ -98,6 +106,8 @@ our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
our $splitbraincache = 'dgit-intern/quilt-cache';
our $rewritemap = 'dgit-rewrite/map';
+our @dpkg_source_ignores = qw(-i(?:^|/)\.git(?:/|$) -I.git);
+
our (@git) = qw(git);
our (@dget) = qw(dget);
our (@curl) = (qw(curl --proto-redir), '-all,http,https', qw(-L));
@@ -107,10 +117,11 @@ our (@gpg) = qw(gpg);
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 -i\.git/ -I.git);
-our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
+our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores);
+our (@dpkgsource) = (qw(dpkg-source), @dpkg_source_ignores);
our (@dpkggenchanges) = qw(dpkg-genchanges);
our (@mergechanges) = qw(mergechanges -f);
our (@gbp_build) = ('');
@@ -126,6 +137,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
'ssh' => \@ssh,
'dgit' => \@dgit,
'git' => \@git,
+ 'git-debrebase' => \@git_debrebase,
'apt-get' => \@aptget,
'apt-cache' => \@aptcache,
'dpkg-source' => \@dpkgsource,
@@ -146,6 +158,7 @@ sub parseopts_late_defaults();
sub setup_gitattrs(;$);
sub check_gitattrs($$);
+our $playground;
our $keyid;
autoflush STDOUT 1;
@@ -228,7 +241,7 @@ END {
}
};
-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) = @_;
@@ -246,13 +259,7 @@ sub forceing ($) {
sub no_such_package () {
print STDERR "$us: package $package does not exist in suite $isuite\n";
- exit 4;
-}
-
-sub changedir ($) {
- my ($newdir) = @_;
- printdebug "CD $newdir\n";
- chdir $newdir or confess "chdir: $newdir: $!";
+ finish 4;
}
sub deliberately ($) {
@@ -281,6 +288,36 @@ sub gbp_pq {
return opts_opt_multi_cmd @gbp_pq;
}
+sub dgit_privdir () {
+ 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:
@@ -493,12 +530,6 @@ sub url_get {
our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
-sub runcmd {
- debugcmd "+",@_;
- $!=0; $?=-1;
- failedcmd @_ if system @_;
-}
-
sub act_local () { return $dryrun_level <= 1; }
sub act_scary () { return !$dryrun_level; }
@@ -530,11 +561,6 @@ sub runcmd_ordryrun_local {
}
}
-sub shell_cmd {
- my ($first_shell, @cmd) = @_;
- return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd;
-}
-
our $helpmsg = < sign tag and package with instead of default
@@ -558,7 +585,7 @@ END
sub badusage {
print STDERR "$us: @_\n", $helpmsg or die $!;
- exit 8;
+ finish 8;
}
sub nextarg {
@@ -567,11 +594,11 @@ sub nextarg {
}
sub pre_help () {
- no_local_git_cfg();
+ not_necessarily_a_tree();
}
sub cmd_help () {
print $helpmsg or die $!;
- exit 0;
+ finish 0;
}
our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
@@ -590,6 +617,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
'dgit.dsc-url-proto-ok.http' => 'true',
'dgit.dsc-url-proto-ok.https' => 'true',
'dgit.dsc-url-proto-ok.git' => 'true',
+ 'dgit.vcs-git.suites', => 'sid', # ;-separated
'dgit.default.dsc-url-proto-ok' => 'false',
# old means "repo server accepts pushes with old dgit tags"
# new means "repo server accepts pushes with new dgit tags"
@@ -645,32 +673,17 @@ our %defcfg = ('dgit.default.distro' => 'debian',
our %gitcfgs;
our @gitcfgsources = qw(cmdline local global system);
+our $invoked_in_git_tree = 1;
sub git_slurp_config () {
- local ($debuglevel) = $debuglevel-2;
- local $/="\0";
-
# This algoritm is a bit subtle, but this is needed so that for
# options which we want to be single-valued, we allow the
# different config sources to override properly. See #835858.
foreach my $src (@gitcfgsources) {
next if $src eq 'cmdline';
# we do this ourselves since git doesn't handle it
-
- my @cmd = (@git, qw(config -z --get-regexp), "--$src", qw(.*));
- debugcmd "|",@cmd;
- open GITS, "-|", @cmd or die $!;
- while () {
- chomp or die;
- printdebug "=> ", (messagequote $_), "\n";
- m/\n/ or die "$_ ?";
- push @{ $gitcfgs{$src}{$`} }, $'; #';
- }
- $!=0; $?=0;
- close GITS
- or ($!==0 && $?==256)
- or failedcmd @cmd;
+ $gitcfgs{$src} = git_slurp_config_src $src;
}
}
@@ -707,9 +720,10 @@ sub cfg {
"$us: distro or suite appears not to be (properly) supported";
}
-sub no_local_git_cfg () {
+sub not_necessarily_a_tree () {
# needs to be called from pre_*
@gitcfgsources = grep { $_ ne 'local' } @gitcfgsources;
+ $invoked_in_git_tree = 0;
}
sub access_basedistro__noalias () {
@@ -1004,19 +1018,13 @@ sub commit_getclogp ($) {
our %commit_getclogp_memo;
my $memo = $commit_getclogp_memo{$objid};
return $memo if $memo;
- mkpath '.git/dgit';
- my $mclog = ".git/dgit/clog-$objid";
+
+ my $mclog = dgit_privdir()."clog";
runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
"$objid:debian/changelog";
$commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
}
-sub must_getcwd () {
- my $d = getcwd();
- defined $d or fail "getcwd failed: $!";
- return $d;
-}
-
sub parse_dscdata () {
my $dscfh = new IO::File \$dscdata, '<' or die $!;
printdebug Dumper($dscdata) if $debuglevel>1;
@@ -1700,30 +1708,14 @@ sub create_remote_git_repo () {
our ($dsc_hash,$lastpush_mergeinput);
our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
-our $ud = '.git/dgit/unpack';
-sub prep_ud (;$) {
- my ($d) = @_;
- $d //= $ud;
- rmtree($d);
- mkpath '.git/dgit';
- mkdir $d or die $!;
+sub prep_ud () {
+ dgit_privdir(); # ensures that $dgit_privdir_made is based on $maindir
+ $playground = fresh_playground 'dgit/unpack';
}
sub mktree_in_ud_here () {
- runcmd qw(git init -q);
- runcmd qw(git config gc.auto 0);
- foreach my $copy (qw(user.email user.name user.useConfigOnly
- core.sharedRepository
- core.compression core.looseCompression
- core.bigFileThreshold core.fsyncObjectFiles)) {
- my $v = $gitcfgs{local}{$copy};
- next unless $v;
- runcmd qw(git config), $copy, $_ foreach @$v;
- }
- rmtree('.git/objects');
- symlink '../../../../objects','.git/objects' or die $!;
- setup_gitattrs(1);
+ playtree_setup $gitcfgs{local};
}
sub git_write_tree () {
@@ -1756,8 +1748,8 @@ sub remove_stray_gits ($) {
sub mktree_in_ud_from_only_subdir ($;$) {
my ($what,$raw) = @_;
-
# changes into the subdir
+
my (@dirs) = <*/.>;
die "expected one subdir but found @dirs ?" unless @dirs==1;
$dirs[0] =~ m#^([^/]+)/\.$# or die;
@@ -1886,6 +1878,40 @@ sub is_orig_file_of_vsn ($$) {
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.
+#
+# It does not, however, permit any other buildinfo files. After a
+# source-only upload, the buildds will try to upload files like
+# foo_1.2.3_amd64.buildinfo. If the package maintainer included files
+# named like this in their (otherwise) source-only upload, the uploads
+# of the buildd can be rejected by dak. Fixing the resultant
+# situation can require manual intervention. So we block such
+# .buildinfo files when the user tells us to perform a source-only
+# upload (such as when using the push-source subcommand with the -C
+# option, which calls this function).
+#
+# Note, though, that when dgit is told to prepare a source-only
+# upload, such as when subcommands like build-source and push-source
+# without -C are used, dgit has a more restrictive notion of
+# source-only .changes than dak: such uploads will never include
+# *_source.buildinfo files. This is because there is no use for such
+# files when using a tool like dgit to produce the source package, as
+# dgit ensures the source is identical to git HEAD.
+sub test_source_only_changes ($) {
+ my ($changes) = @_;
+ foreach my $l (split /\n/, getfield $changes, 'Files') {
+ $l =~ m/\S+$/ or next;
+ # \.tar\.[a-z0-9]+ covers orig.tar and the tarballs in native packages
+ unless ($& =~ m/(?:\.dsc|\.diff\.gz|\.tar\.[a-z0-9]+|_source\.buildinfo)$/) {
+ print "purportedly source-only changes polluted by $&\n";
+ return 0;
+ }
+ }
+ return 1;
+}
+
sub changes_update_origs_from_dsc ($$$$) {
my ($dsc, $changes, $upstreamvsn, $changesfile) = @_;
my %changes_f;
@@ -1949,12 +1975,12 @@ END
if ($found_same) {
# in archive, delete from .changes if it's there
$changed{$file} = "removed" if
- $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m;
- } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) {
+ $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m;
+ } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/m) {
# not in archive, but it's here in the .changes
} else {
my $dsc_data = getfield $dsc, $fname;
- $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?";
+ $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?";
my $extra = $1;
$extra =~ s/ \d+ /$&$placementinfo /
or die "$fname $extra >$dsc_data< ?"
@@ -2098,13 +2124,13 @@ sub generate_commits_from_dsc () {
# See big comment in fetch_from_archive, below.
# See also README.dsc-import.
prep_ud();
- changedir $ud;
+ changedir $playground;
my @dfi = dsc_files_info();
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- my $upper_f = "../../../../$f";
+ my $upper_f = "$maindir/../$f";
printdebug "considering reusing $f: ";
@@ -2424,6 +2450,10 @@ END
my $path = $ENV{PATH} or die;
+ # we use ../../gbp-pq-output, which (given that we are in
+ # $playground/PLAYTREE, and $playground is .git/dgit/unpack,
+ # is .git/dgit.
+
foreach my $use_absurd (qw(0 1)) {
runcmd @git, qw(checkout -q unpa);
runcmd @git, qw(update-ref -d refs/heads/patch-queue/unpa);
@@ -2508,8 +2538,8 @@ END
@output = $lastpush_mergeinput;
}
}
- changedir '../../../..';
- rmtree($ud);
+ changedir $maindir;
+ rmtree $playground;
return @output;
}
@@ -2728,6 +2758,11 @@ END
my $want = $wantr{$rrefname};
next if $got eq $want;
if (!defined $objgot{$want}) {
+ fail <", $mcf or die "$mcf $!";
print MC <", "$attrs.new" or die "$attrs.new $!";
if (!open ATTRS, "<", $attrs) {
@@ -3351,44 +3385,65 @@ sub ensure_setup_existing_tree () {
set_local_git_config $k, 'true';
}
-sub open_gitattrs () {
- my $gai = new IO::File ".git/info/attributes"
+sub open_main_gitattrs () {
+ confess 'internal error no maindir' unless defined $maindir;
+ my $gai = new IO::File "$maindir_gitcommon/info/attributes"
or $!==ENOENT
- or die "open .git/info/attributes: $!";
+ or die "open $maindir_gitcommon/info/attributes: $!";
return $gai;
}
+our $gitattrs_ourmacro_re = qr{^\[attr\]dgit-defuse-attrs\s};
+
sub is_gitattrs_setup () {
- my $gai = open_gitattrs();
+ # 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 < $af.new" or die $!;
- print GAO <) {
+ if (m{$gitattrs_ourmacro_re}) {
+ die unless defined $already;
+ $_ = $new;
+ }
chomp;
print GAO $_, "\n" or die $!;
}
@@ -3423,7 +3478,7 @@ sub check_gitattrs ($$) {
# oh dear, found one
print STDERR <();
foreach my $tsuite (@suites[1..$#suites]) {
+ $tsuite =~ s/^-/$cbasesuite-/;
my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
sub {
@end = ();
fetch();
- exit 0;
+ finish 0;
});
# xxx collecte the ref here
@@ -3612,18 +3668,22 @@ END
}
sub clone ($) {
+ # in multisuite, returns twice!
+ # once in parent after first suite fetched,
+ # and then again in child after everything is finished
my ($dstdir) = @_;
badusage "dry run makes no sense with clone" unless act_local();
my $multi_fetched = fork_for_multisuite(sub {
printdebug "multi clone before fetch merge\n";
changedir $dstdir;
+ record_maindir();
});
if ($multi_fetched) {
printdebug "multi clone after fetch merge\n";
clone_set_head();
clone_finish($dstdir);
- exit 0;
+ return;
}
printdebug "clone main body\n";
@@ -3632,6 +3692,7 @@ sub clone ($) {
mkdir $dstdir or fail "create \`$dstdir': $!";
changedir $dstdir;
runcmd @git, qw(init -q);
+ record_maindir();
setup_new_tree();
clone_set_head();
my $giturl = access_giturl(1);
@@ -3660,6 +3721,20 @@ sub fetch () {
git_fetch_us();
}
fetch_from_archive() or no_such_package();
+
+ my $vcsgiturl = $dsc && $dsc->{'Vcs-Git'};
+ if (length $vcsgiturl and
+ (grep { $csuite eq $_ }
+ split /\;/,
+ cfg 'dgit.vcs-git.suites')) {
+ my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+ if (defined $current && $current ne $vcsgiturl) {
+ print STDERR < message fragment "$saved" describing disposition of $dgitview
return "commit id $dgitview" unless defined $split_brain_save;
- my @cmd = (shell_cmd "cd ../../../..",
- @git, qw(update-ref -m),
+ my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
+ git_update_ref_cmd
"dgit --dgit-view-save $msg HEAD=$headref",
$split_brain_save, $dgitview);
runcmd @cmd;
@@ -3872,8 +3949,9 @@ sub pseudomerge_make_commit ($$$$ $$) {
: !length $overwrite_version ? " --overwrite"
: " --overwrite=".$overwrite_version;
- mkpath '.git/dgit';
- my $pmf = ".git/dgit/pseudomerge";
+ # 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 <[0] into your HEAD.";
return $r;
@@ -4180,7 +4261,7 @@ END
rpush_handle_protovsn_bothends() if $we_are_initiator;
select_tagformat();
- my $clogpfn = ".git/dgit/changelog.822.tmp";
+ my $clogpfn = dgit_privdir()."/changelog.822.tmp";
runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
responder_send_file('parsed-changelog', $clogpfn);
@@ -4200,7 +4281,14 @@ END
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;
@@ -4209,27 +4297,28 @@ END
if (madformat_wantfixup($format)) {
# user might have not used dgit build, so maybe do this now:
if (quiltmode_splitbrain()) {
- changedir $ud;
+ changedir $playground;
quilt_make_fake_dsc($upstreamversion);
my $cachekey;
($dgithead, $cachekey) =
quilt_check_splitbrain_cache($actualhead, $upstreamversion);
$dgithead or fail
"--quilt=$quilt_mode but no cached dgit view:
- perhaps tree changed since dgit build[-source] ?";
+ perhaps HEAD changed since dgit build[-source] ?";
$split_brain = 1;
$dgithead = splitbrain_pseudomerge($clogp,
$actualhead, $dgithead,
$archive_hash);
$maintviewhead = $actualhead;
- changedir '../../../..';
+ changedir $maindir;
prep_ud(); # so _only_subdir() works, below
} else {
commit_quilty_patch();
}
}
- if (defined $overwrite_version && !defined $maintviewhead) {
+ if (defined $overwrite_version && !defined $maintviewhead
+ && $archive_hash) {
$dgithead = plain_overwrite_pseudomerge($clogp,
$dgithead,
$archive_hash);
@@ -4253,26 +4342,55 @@ END
}
}
- changedir $ud;
+ changedir $playground;
progress "checking that $dscfn corresponds to HEAD";
runcmd qw(dpkg-source -x --),
- $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
+ $dscpath =~ m#^/# ? $dscpath : "$maindir/$dscpath";
my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");
check_for_vendor_patches() if madformat($dsc->{format});
- changedir '../../../..';
+ changedir $maindir;
my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
debugcmd "+",@diffcmd;
$!=0; $?=-1;
my $r = system @diffcmd;
if ($r) {
if ($r==256) {
+ my $referent = $split_brain ? $dgithead : 'HEAD';
my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead;
- fail <', $descfn or die "$descfn: $!";
$msg =~ s/\n+/\n\n/;
@@ -4886,7 +5062,7 @@ sub quiltify_trees_differ ($$;$$$) {
# a list of unrepresentable changes (removals of upstream files
# (as messages)
local $/=undef;
- my @cmd = (@git, qw(diff-tree -z));
+ my @cmd = (@git, qw(diff-tree -z --no-renames));
push @cmd, qw(--name-only) unless $unrepres;
push @cmd, qw(-r) if $finegrained || $unrepres;
push @cmd, $x, $y;
@@ -4905,16 +5081,23 @@ sub quiltify_trees_differ ($$;$$$) {
if ($unrepres) {
eval {
- die "not a plain file\n"
- unless $newmode =~ m/^10\d{4}$/ ||
- $oldmode =~ m/^10\d{4}$/;
+ die "not a plain file or symlink\n"
+ unless $newmode =~ m/^(?:10|12)\d{4}$/ ||
+ $oldmode =~ m/^(?:10|12)\d{4}$/;
if ($oldmode =~ m/[^0]/ &&
$newmode =~ m/[^0]/) {
- die "mode changed\n" if $oldmode ne $newmode;
+ # both old and new files exist
+ die "mode or type changed\n" if $oldmode ne $newmode;
+ die "modified symlink\n" unless $newmode =~ m/^10/;
+ } elsif ($oldmode =~ m/[^0]/) {
+ # deletion
+ die "deletion of symlink\n"
+ unless $oldmode =~ m/^10/;
} else {
- die "non-default mode\n"
- unless $newmode =~ m/^100644$/ ||
- $oldmode =~ m/^100644$/;
+ # creation
+ die "creation with non-default mode\n"
+ unless $newmode =~ m/^100644$/ or
+ $newmode =~ m/^120000$/;
}
};
if ($@) {
@@ -4948,13 +5131,15 @@ sub quiltify_splitbrain_needed () {
}
}
-sub quiltify_splitbrain ($$$$$$) {
- my ($clogp, $unapplied, $headref, $diffbits,
+sub quiltify_splitbrain ($$$$$$$) {
+ my ($clogp, $unapplied, $headref, $oldtiptree, $diffbits,
$editedignores, $cachekey) = @_;
+ my $gitignore_special = 1;
if ($quilt_mode !~ m/gbp|dpm/) {
# treat .gitignore just like any other upstream file
$diffbits = { %$diffbits };
$_ = !!$_ foreach values %$diffbits;
+ $gitignore_special = 0;
}
# We would like any commits we generate to be reproducible
my @authline = clogp_authline($clogp);
@@ -4965,11 +5150,19 @@ sub quiltify_splitbrain ($$$$$$) {
local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
local $ENV{GIT_AUTHOR_DATE} = $authline[2];
+ my $fulldiffhint = sub {
+ my ($x,$y) = @_;
+ my $cmd = "git diff $x $y -- :/ ':!debian'";
+ $cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special;
+ return "\nFor full diff showing the problem(s), type:\n $cmd\n";
+ };
+
if ($quilt_mode =~ m/gbp|unapplied/ &&
($diffbits->{O2H} & 01)) {
my $msg =
"--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
" but git tree differs from orig in upstream files.";
+ $msg .= $fulldiffhint->($unapplied, 'HEAD');
if (!stat_exists "debian/patches") {
$msg .=
"\n ... debian/patches is missing; perhaps this is a patch queue branch?";
@@ -4978,7 +5171,7 @@ sub quiltify_splitbrain ($$$$$$) {
}
if ($quilt_mode =~ m/dpm/ &&
($diffbits->{H2A} & 01)) {
- fail <($oldtiptree,'HEAD');
--quilt=$quilt_mode specified, implying patches-applied git tree
but git tree differs from result of applying debian/patches to upstream
END
@@ -4994,7 +5187,7 @@ END
}
if ($quilt_mode =~ m/gbp|dpm/ &&
($diffbits->{O2A} & 02)) {
- fail <>'
+ 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";
@@ -5065,7 +5258,7 @@ END
runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
$dgitview;
- changedir '.git/dgit/unpack/work';
+ changedir "$playground/work";
my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
progress "dgit view: created ($saved)";
@@ -5144,11 +5337,7 @@ sub quiltify ($$$$) {
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;
@@ -5206,12 +5395,13 @@ sub quiltify ($$$$) {
return $s;
};
if ($quilt_mode eq 'linear') {
- print STDERR "$us: quilt fixup cannot be linear. Stopped at:\n";
+ print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n";
foreach my $notp (@nots) {
print STDERR "$us: ", $reportnot->($notp), "\n";
}
print STDERR "$us: $_\n" foreach @$failsuggestion;
- fail "quilt fixup naive history linearisation failed.\n".
+ 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";
} elsif ($quilt_mode eq 'smash') {
} elsif ($quilt_mode eq 'auto') {
@@ -5269,6 +5459,7 @@ sub quiltify ($$$$) {
die "contains unexpected slashes\n" if m{//} || m{/$};
die "contains leading punctuation\n" if m{^\W} || m{/\W};
die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+ die "is series file\n" if m{$series_filename_re}o;
die "too long" if length > 200;
};
return $_ unless $@;
@@ -5307,6 +5498,7 @@ sub quiltify ($$$$) {
$patchname =~ y/-a-z0-9_.+=~//cd;
$patchname =~ s/^\W/x-$&/;
$patchname = substr($patchname,0,40);
+ $patchname .= ".patch";
}
if (!defined $patchdir) {
$patchdir = '';
@@ -5360,9 +5552,36 @@ END
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()) {
+ debugcmd "+",@cmd;
+ $!=0; $?=-1;
+ failedcmd @cmd if system @cmd and $?!=7*256;
+ } else {
+ dryrun_report @cmd;
+ }
+ $headref = git_rev_parse('HEAD');
+ }
prep_ud();
- changedir $ud;
+ changedir $playground;
my $upstreamversion = upstreamversion $version;
@@ -5374,9 +5593,9 @@ END
die 'bug' if $split_brain && !$need_split_build_invocation;
- changedir '../../../..';
+ changedir $maindir;
runcmd_ordryrun_local
- @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
+ @git, qw(pull --ff-only -q), "$playground/work", qw(master);
}
sub quilt_fixup_mkwork ($) {
@@ -5392,7 +5611,7 @@ sub quilt_fixup_linkorigs ($$) {
my ($upstreamversion, $fn) = @_;
# calls $fn->($leafname);
- foreach my $f (<../../../../*>) { #/){
+ foreach my $f (<$maindir/../*>) { #/){
my $b=$f; $b =~ s{.*/}{};
{
local ($debuglevel) = $debuglevel-1;
@@ -5471,12 +5690,12 @@ END
debian/control debian/changelog);
foreach my $maybe (qw(debian/patches debian/source/options
debian/tests/control)) {
- next unless stat_exists "../../../$maybe";
+ next unless stat_exists "$maindir/$maybe";
push @files, $maybe;
}
my $debtar= srcfn $fakeversion,'.debian.tar.gz';
- runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C ../../..), @files;
+ runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files;
$dscaddfile->($debtar);
close $fakedsc or die $!;
@@ -5485,7 +5704,7 @@ END
sub quilt_check_splitbrain_cache ($$) {
my ($headref, $upstreamversion) = @_;
# Called only if we are in (potentially) split brain mode.
- # Called in $ud.
+ # Called in playground.
# Computes the cache key and looks in the cache.
# Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
@@ -5519,11 +5738,11 @@ sub quilt_check_splitbrain_cache ($$) {
debugcmd "|(probably)",@cmd;
my $child = open GC, "-|"; defined $child or die $!;
if (!$child) {
- chdir '../../..' or die $!;
- if (!stat ".git/logs/refs/$splitbraincache") {
+ chdir $maindir or die $!;
+ if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
$! == ENOENT or die $!;
printdebug ">(no reflog)\n";
- exit 0;
+ finish 0;
}
exec @cmd; die $!;
}
@@ -5649,6 +5868,7 @@ sub quilt_fixup_multipatch ($$$) {
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";
@@ -5737,7 +5957,7 @@ END
" --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
if (quiltmode_splitbrain()) {
- quiltify_splitbrain($clogp, $unapplied, $headref,
+ quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree,
$diffbits, \%editedignores,
$splitbrain_cachekey);
return;
@@ -5775,7 +5995,7 @@ sub quilt_fixup_editor () {
}
I2->error and die $!;
close O or die $1;
- exit 0;
+ finish 0;
}
sub maybe_apply_patches_dirtily () {
@@ -5841,14 +6061,18 @@ sub cmd_clean () {
maybe_unapply_patches_again();
}
-sub build_prep_early () {
- our $build_prep_early_done //= 0;
- return if $build_prep_early_done++;
- badusage "-p is not allowed when building" if defined $package;
+sub build_or_push_prep_early () {
+ our $build_or_push_prep_early_done //= 0;
+ return if $build_or_push_prep_early_done++;
+ badusage "-p is not allowed with dgit $subcommand" if defined $package;
my $clogp = parsechangelog();
$isuite = getfield $clogp, 'Distribution';
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
+}
+
+sub build_prep_early () {
+ build_or_push_prep_early();
notpushing();
check_not_dirty();
}
@@ -5875,13 +6099,21 @@ sub changesopts_initial () {
sub changesopts_version () {
if (!defined $changes_since_version) {
- my @vsns = archive_query('archive_query');
- my @quirk = access_quirk();
- if ($quirk[0] eq 'backports') {
- local $isuite = $quirk[2];
- local $csuite;
- canonicalise_suite();
- push @vsns, archive_query('archive_query');
+ my @vsns;
+ unless (eval {
+ @vsns = archive_query('archive_query');
+ my @quirk = access_quirk();
+ if ($quirk[0] eq 'backports') {
+ local $isuite = $quirk[2];
+ local $csuite;
+ canonicalise_suite();
+ push @vsns, archive_query('archive_query');
+ }
+ 1;
+ }) {
+ print STDERR $@;
+ fail
+ "archive query failed (queried because --since-version not specified)";
}
if (@vsns) {
@vsns = map { $_->[0] } @vsns;
@@ -6086,15 +6318,17 @@ sub cmd_gbp_build {
}
my @cmd = opts_opt_multi_cmd @gbp_build;
- push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
+ push @cmd, (qw(-us -uc --git-no-sign-tags),
+ "--git-builder=".(shellquote @dbp));
if ($gbp_make_orig) {
- ensuredir '.git/dgit';
- my $ok = '.git/dgit/origs-gen-ok';
+ my $priv = dgit_privdir();
+ my $ok = "$priv/origs-gen-ok";
unlink $ok or $!==&ENOENT or die $!;
my @origs_cmd = @cmd;
push @origs_cmd, qw(--git-cleaner=true);
- push @origs_cmd, "--git-prebuild=touch $ok .git/dgit/no-such-dir/ok";
+ push @origs_cmd, "--git-prebuild=".
+ "touch ".(shellquote $ok)." ".(shellquote "$priv/no-such-dir/ok");
push @origs_cmd, @ARGV;
if (act_local()) {
debugcmd @origs_cmd;
@@ -6124,21 +6358,14 @@ sub cmd_gbp_build {
}
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();
- my $our_cleanmode = $cleanmode;
- if ($need_split_build_invocation) {
- # Pretend that clean is being done some other way. This
- # forces us not to try to use dpkg-buildpackage to clean and
- # build source all in one go; and instead we run dpkg-source
- # (and build_prep() will do the clean since $clean_using_builder
- # is false).
- $our_cleanmode = 'ELSEWHERE';
- }
- if ($our_cleanmode =~ m/^dpkg-source/) {
- # dpkg-source invocation (below) will clean, so build_prep shouldn't
- $clean_using_builder = 1;
- }
build_prep();
$sourcechanges = changespat $version,'source';
if (act_local()) {
@@ -6146,43 +6373,33 @@ sub build_source {
or fail "remove $sourcechanges: $!";
}
$dscfn = dscfn($version);
- if ($our_cleanmode eq 'dpkg-source') {
- maybe_apply_patches_dirtily();
- runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
- changesopts();
- } elsif ($our_cleanmode eq 'dpkg-source-d') {
- maybe_apply_patches_dirtily();
- runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
- changesopts();
+ my @cmd = (@dpkgsource, qw(-b --));
+ if ($split_brain) {
+ changedir $playground;
+ runcmd_ordryrun_local @cmd, "work";
+ my @udfiles = <${package}_*>;
+ changedir $maindir;
+ foreach my $f (@udfiles) {
+ printdebug "source copy, found $f\n";
+ next unless
+ $f eq $dscfn or
+ ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
+ $f eq srcfn($version, $&));
+ printdebug "source copy, found $f - renaming\n";
+ rename "$playground/$f", "../$f" or $!==ENOENT
+ or fail "put in place new source file ($f): $!";
+ }
} else {
- my @cmd = (@dpkgsource, qw(-b --));
- if ($split_brain) {
- changedir $ud;
- runcmd_ordryrun_local @cmd, "work";
- my @udfiles = <${package}_*>;
- changedir "../../..";
- foreach my $f (@udfiles) {
- printdebug "source copy, found $f\n";
- next unless
- $f eq $dscfn or
- ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
- $f eq srcfn($version, $&));
- printdebug "source copy, found $f - renaming\n";
- rename "$ud/$f", "../$f" or $!==ENOENT
- or fail "put in place new source file ($f): $!";
- }
- } else {
- my $pwd = must_getcwd();
- my $leafdir = basename $pwd;
- changedir "..";
- runcmd_ordryrun_local @cmd, $leafdir;
- changedir $pwd;
- }
- runcmd_ordryrun_local qw(sh -ec),
- 'exec >$1; shift; exec "$@"','x',
- "../$sourcechanges",
- @dpkggenchanges, qw(-S), changesopts();
+ my $pwd = must_getcwd();
+ my $leafdir = basename $pwd;
+ changedir "..";
+ runcmd_ordryrun_local @cmd, $leafdir;
+ changedir $pwd;
}
+ runcmd_ordryrun_local qw(sh -ec),
+ 'exec >$1; shift; exec "$@"','x',
+ "../$sourcechanges",
+ @dpkggenchanges, qw(-S), changesopts();
}
sub cmd_build_source {
@@ -6222,7 +6439,7 @@ sub cmd_quilt_fixup {
sub import_dsc_result {
my ($dstref, $newhash, $what_log, $what_msg) = @_;
- my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash);
+ my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
runcmd @cmd;
check_gitattrs($newhash, "source tree");
@@ -6342,7 +6559,10 @@ END
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
my $here = "../$f";
- next if lstat $here;
+ if (lstat $here) {
+ next if stat $here;
+ fail "lstat $here works but stat gives $! !";
+ }
fail "stat $here: $!" unless $! == ENOENT;
my $there = $dscfn;
if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
@@ -6353,8 +6573,10 @@ END
fail "cannot import $dscfn which seems to be inside working tree!";
}
$there =~ s#/+[^/]+$## or
- fail "cannot import $dscfn which seems to not have a basename";
+ fail "import $dscfn requires ../$f, but it does not exist";
$there .= "/$f";
+ my $test = $there =~ m{^/} ? $there : "../$there";
+ stat $test or fail "import $dscfn requires $test, but: $!";
symlink $there, $here or fail "symlink $there to $here: $!";
progress "made symlink $here -> $there";
# print STDERR Dumper($fi);
@@ -6393,11 +6615,12 @@ END
}
sub pre_archive_api_query () {
- no_local_git_cfg();
+ not_necessarily_a_tree();
}
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;
@@ -6412,7 +6635,7 @@ sub repos_server_url () {
}
sub pre_clone_dgit_repos_server () {
- no_local_git_cfg();
+ not_necessarily_a_tree();
}
sub cmd_clone_dgit_repos_server {
badusage "need destination argument" unless @ARGV==1;
@@ -6424,7 +6647,7 @@ sub cmd_clone_dgit_repos_server {
}
sub pre_print_dgit_repos_server_source_url () {
- no_local_git_cfg();
+ not_necessarily_a_tree();
}
sub cmd_print_dgit_repos_server_source_url {
badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
@@ -6433,6 +6656,15 @@ sub cmd_print_dgit_repos_server_source_url {
print $url, "\n" or die $!;
}
+sub pre_print_dpkg_source_ignores {
+ not_necessarily_a_tree();
+}
+sub cmd_print_dpkg_source_ignores {
+ badusage "no arguments allowed to dgit print-dpkg-source-ignores"
+ if @ARGV;
+ print "@dpkg_source_ignores\n" or die $!;
+}
+
sub cmd_setup_mergechangelogs {
badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
local $isuite = 'DGIT-SETUP-TREE';
@@ -6461,7 +6693,7 @@ sub cmd_setup_new_tree {
sub cmd_version {
print "dgit version $our_version\n" or die $!;
- exit 0;
+ finish 0;
}
our (%valopts_long, %valopts_short);
@@ -6813,16 +7045,19 @@ print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
if $dryrun_level == 1;
if (!@ARGV) {
print STDERR $helpmsg or die $!;
- exit 8;
+ finish 8;
}
-my $cmd = shift @ARGV;
+$cmd = $subcommand = shift @ARGV;
$cmd =~ y/-/_/;
my $pre_fn = ${*::}{"pre_$cmd"};
$pre_fn->() if $pre_fn;
+record_maindir if $invoked_in_git_tree;
git_slurp_config();
my $fn = ${*::}{"cmd_$cmd"};
$fn or badusage "unknown operation $cmd";
$fn->();
+
+finish 0;