X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=777532ebf2bf7d8caa0a6999a66d4ea5066454a2;hp=573f39ad07f7251adbc1fdfa41429e8c7232ac40;hb=e59fb2f70123dc40f515f60d707c4f99653d6d07;hpb=942637ea633f1c9dc0be2534a660296a76b87e27
diff --git a/dgit b/dgit
index 573f39ad..777532eb 100755
--- a/dgit
+++ b/dgit
@@ -2,8 +2,8 @@
# 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
@@ -18,6 +18,9 @@
# 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 qw(:DEFAULT :playground);
@@ -60,9 +63,10 @@ our @ropts;
our $sign = 1;
our $dryrun_level = 0;
our $changesfile;
-our $buildproductsdir = '..';
+our $buildproductsdir;
+our $bpd_glob;
our $new_package = 0;
-our $ignoredirty = 0;
+our $includedirty = 0;
our $rmonerror = 1;
our @deliberatelies;
our %previously;
@@ -74,7 +78,7 @@ our $overwrite_version; # undef: not specified; '': check changelog
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;
@@ -87,6 +91,7 @@ our $chase_dsc_distro=1;
our %forceopts = map { $_=>0 }
qw(unrepresentable unsupported-source-format
dsc-changes-mismatch changes-origs-exactly
+ uploading-binaries uploading-source-only
import-gitapply-absurd
import-gitapply-no-absurd
import-dsc-with-dgit-field);
@@ -114,6 +119,7 @@ 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), @dpkg_source_ignores);
@@ -123,6 +129,8 @@ our (@mergechanges) = qw(mergechanges -f);
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,
@@ -133,6 +141,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,
@@ -141,7 +150,9 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
'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 {
@@ -159,7 +170,6 @@ our $keyid;
autoflush STDOUT 1;
our $supplementary_message = '';
-our $need_split_build_invocation = 0;
our $split_brain = 0;
END {
@@ -183,11 +193,6 @@ sub debiantag ($$) {
return $tagformatfn->($v, $distro);
}
-sub debiantag_maintview ($$) {
- my ($v,$distro) = @_;
- return "$distro/".dep14_version_mangle $v;
-}
-
sub madformat ($) { $_[0] eq '3.0 (quilt)' }
sub lbranch () { return "$branchprefix/$csuite"; }
@@ -236,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) = @_;
@@ -254,7 +259,7 @@ sub forceing ($) {
sub no_such_package () {
print STDERR "$us: package $package does not exist in suite $isuite\n";
- exit 4;
+ finish 4;
}
sub deliberately ($) {
@@ -273,20 +278,54 @@ sub quiltmode_splitbrain () {
}
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 () {
our $dgit_privdir_made //= ensure_a_playground 'dgit';
}
+sub bpd_abs () {
+ my $r = $buildproductsdir;
+ $r = "$maindir/$r" unless $r =~ m{^/};
+ return $r;
+}
+
+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:
@@ -530,17 +569,13 @@ sub runcmd_ordryrun_local {
}
}
-sub shell_cmd {
- my ($first_shell, @cmd) = @_;
- return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd;
-}
-
our $helpmsg = < 'debian',
'dgit.default.sshpsql-dbname' => 'service=projectb',
'dgit.default.aptget-components' => 'main',
'dgit.default.dgit-tag-format' => 'new,old,maint',
+ 'dgit.default.source-only-uploads' => 'ok',
'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"
@@ -601,6 +638,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
'dgit-distro.debian.git-check' => 'url',
'dgit-distro.debian.git-check-suffix' => '/info/refs',
'dgit-distro.debian.new-private-pushers' => 't',
+ 'dgit-distro.debian.source-only-uploads' => 'not-wholly-new',
'dgit-distro.debian/push.git-url' => '',
'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org',
'dgit-distro.debian/push.git-user-force' => 'dgit',
@@ -786,7 +824,8 @@ sub access_forpush () {
}
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;
@@ -932,59 +971,6 @@ sub access_giturl (;$) {
return "$url/$package$suffix";
}
-sub parsecontrolfh ($$;$) {
- my ($fh, $desc, $allowsigned) = @_;
- our $dpkgcontrolhash_noissigned;
- my $c;
- for (;;) {
- my %opts = ('name' => $desc);
- $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
- $c = Dpkg::Control::Hash->new(%opts);
- $c->parse($fh,$desc) or die "parsing of $desc failed";
- last if $allowsigned;
- last if $dpkgcontrolhash_noissigned;
- my $issigned= $c->get_option('is_pgp_signed');
- if (!defined $issigned) {
- $dpkgcontrolhash_noissigned= 1;
- seek $fh, 0,0 or die "seek $desc: $!";
- } elsif ($issigned) {
- fail "control file $desc is (already) PGP-signed. ".
- " Note that dgit push needs to modify the .dsc and then".
- " do the signature itself";
- } else {
- last;
- }
- }
- return $c;
-}
-
-sub parsecontrol {
- my ($file, $desc, $allowsigned) = @_;
- my $fh = new IO::Handle;
- open $fh, '<', $file or die "$file: $!";
- my $c = parsecontrolfh($fh,$desc,$allowsigned);
- $fh->error and die $!;
- close $fh;
- return $c;
-}
-
-sub getfield ($$) {
- my ($dctrl,$field) = @_;
- my $v = $dctrl->{$field};
- return $v if defined $v;
- fail "missing field $field in ".$dctrl->get_option('name');
-}
-
-sub parsechangelog {
- my $c = Dpkg::Control::Hash->new(name => 'parsed changelog');
- my $p = new IO::Handle;
- my @cmd = (qw(dpkg-parsechangelog), @_);
- open $p, '-|', @cmd or die $!;
- $c->parse($p);
- $?=0; $!=0; close $p or failedcmd @cmd;
- return $c;
-}
-
sub commit_getclogp ($) {
# Returns the parsed changelog hashref for a particular commit
my ($objid) = @_;
@@ -1152,6 +1138,12 @@ sub file_in_archive_ftpmasterapi {
my $info = api_query($data, "file_in_archive/$pat", 1);
}
+sub package_not_wholly_new_ftpmasterapi {
+ my ($proto,$data,$pkg) = @_;
+ my $info = api_query($data,"madison?package=${pkg}&f=json");
+ return !!@$info;
+}
+
#---------- `aptget' archive query method ----------
our $aptget_base;
@@ -1259,7 +1251,14 @@ END
}
my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
@releasefiles = @inreleasefiles if @inreleasefiles;
- die "apt updated wrong number of Release files (@releasefiles), erk"
+ if (!@releasefiles) {
+ fail <) {
- chomp or die;
- printdebug "| $_\n";
- m/^(\w+) (\S+)$/ or die "$_ ?";
- push @out, { sha256sum => $1, filename => $2 };
- }
- close FIA or die failedcmd @cmd;
+ my $r = $fn->();
+ close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
+ return $r;
+}
+
+sub file_in_archive_dummycatapi ($$$) {
+ my ($proto,$data,$filename) = @_;
+ my @out;
+ dummycatapi_run_in_mirror '
+ find -name "$1" -print0 |
+ xargs -0r sha256sum
+ ', [$filename], sub {
+ while () {
+ chomp or die;
+ printdebug "| $_\n";
+ m/^(\w+) (\S+)$/ or die "$_ ?";
+ push @out, { sha256sum => $1, filename => $2 };
+ }
+ };
return \@out;
}
+sub package_not_wholly_new_dummycatapi {
+ my ($proto,$data,$pkg) = @_;
+ dummycatapi_run_in_mirror "
+ find -name ${pkg}_*.dsc
+ ", [], sub {
+ local $/ = undef;
+ !!;
+ };
+}
+
#---------- `madison' archive query method ----------
sub archive_query_madison {
@@ -1393,6 +1413,7 @@ sub canonicalise_suite_madison {
}
sub file_in_archive_madison { return undef; }
+sub package_not_wholly_new_madison { return undef; }
#---------- `sshpsql' archive query method ----------
@@ -1470,6 +1491,7 @@ END
}
sub file_in_archive_sshpsql ($$$) { return undef; }
+sub package_not_wholly_new_sshpsql ($$$) { return undef; }
#---------- `dummycat' archive query method ----------
@@ -1514,6 +1536,7 @@ sub archive_query_dummycat ($$) {
}
sub file_in_archive_dummycat () { return undef; }
+sub package_not_wholly_new_dummycat () { return undef; }
#---------- tag format handling ----------
@@ -1948,12 +1971,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< ?"
@@ -2103,7 +2126,7 @@ sub generate_commits_from_dsc () {
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- my $upper_f = "$maindir/../$f";
+ my $upper_f = (bpd_abs()."/$f");
printdebug "considering reusing $f: ";
@@ -2111,12 +2134,12 @@ sub generate_commits_from_dsc () {
printdebug "linked (using ...,fetch).\n";
} elsif ((printdebug "($!) "),
$! != ENOENT) {
- fail "accessing ../$f,fetch: $!";
+ fail "accessing $buildproductsdir/$f,fetch: $!";
} elsif (link_ltarget $upper_f, $f) {
printdebug "linked.\n";
} elsif ((printdebug "($!) "),
$! != ENOENT) {
- fail "accessing ../$f: $!";
+ fail "accessing $buildproductsdir/$f: $!";
} else {
printdebug "absent.\n";
}
@@ -2131,14 +2154,14 @@ sub generate_commits_from_dsc () {
printdebug "linked.\n";
} elsif ((printdebug "($!) "),
$! != EEXIST) {
- fail "saving ../$f: $!";
+ fail "saving $buildproductsdir/$f: $!";
} elsif (!$refetched) {
printdebug "no need.\n";
} elsif (link $f, "$upper_f,fetch") {
printdebug "linked (using ...,fetch).\n";
} elsif ((printdebug "($!) "),
$! != EEXIST) {
- fail "saving ../$f,fetch: $!";
+ fail "saving $buildproductsdir/$f,fetch: $!";
} else {
printdebug "cannot.\n";
}
@@ -2282,22 +2305,14 @@ sub generate_commits_from_dsc () {
}
my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
- debugcmd "|",@clogcmd;
- open CLOGS, "-|", @clogcmd or die $!;
-
my $clogp;
my $r1clogp;
printdebug "import clog search...\n";
+ parsechangelog_loop \@clogcmd, "package changelog", sub {
+ my ($thisstanza, $desc) = @_;
+ no warnings qw(exiting);
- for (;;) {
- my $stanzatext = do { local $/=""; ; };
- printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1;
- last if !defined $stanzatext;
-
- my $desc = "package changelog, entry no.$.";
- open my $stanzafh, "<", \$stanzatext or die;
- my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;
$clogp //= $thisstanza;
printdebug "import clog $thisstanza->{version} $desc...\n";
@@ -2323,7 +2338,7 @@ sub generate_commits_from_dsc () {
# version). Then it remains to choose between the physically
# last entry in the file, and the one with the lowest version
# number. If these are not the same, we guess that the
- # versions were created in a non-monotic order rather than
+ # versions were created in a non-monotonic order rather than
# that the changelog entries have been misordered.
printdebug "import clog $thisstanza->{version} vs $upstreamv...\n";
@@ -2332,9 +2347,7 @@ sub generate_commits_from_dsc () {
$r1clogp = $thisstanza;
printdebug "import clog $r1clogp->{version} becomes r1\n";
- }
- die $! if CLOGS->error;
- close CLOGS or $?==SIGPIPE or failedcmd @clogcmd;
+ };
$clogp or fail "package changelog has no entries!";
@@ -2575,7 +2588,7 @@ sub ensure_we_have_orig () {
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
next unless is_orig_file_in_dsc($f, \@dfi);
- complete_file_from_dsc('..', $fi)
+ complete_file_from_dsc($buildproductsdir, $fi)
or next;
}
}
@@ -2731,6 +2744,11 @@ END
my $want = $wantr{$rrefname};
next if $got eq $want;
if (!defined $objgot{$want}) {
+ fail <) {
- 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 $!;
}
@@ -3428,7 +3464,7 @@ sub check_gitattrs ($$) {
# oh dear, found one
print STDERR <{'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 $save = $internal_object_save{'dgit-view'};
+ return "commit id $dgitview" unless defined $save;
my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
- @git, qw(update-ref -m),
+ 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 ]
@@ -3883,6 +3940,8 @@ sub pseudomerge_make_commit ($$$$ $$) {
: !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 <[0] into your HEAD.";
return $r;
@@ -4211,7 +4272,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;
@@ -4240,7 +4308,8 @@ END
}
}
- if (defined $overwrite_version && !defined $maintviewhead) {
+ if (defined $overwrite_version && !defined $maintviewhead
+ && $archive_hash) {
$dgithead = plain_overwrite_pseudomerge($clogp,
$dgithead,
$archive_hash);
@@ -4336,6 +4405,29 @@ END
files_compare_inputs($dsc, $changes)
unless forceing [qw(dsc-changes-mismatch)];
+ # Check whether this is a source only upload
+ my $hasdebs = $changes->{Files} =~ m{\.deb$}m;
+ my $sourceonlypolicy = access_cfg 'source-only-uploads';
+ if ($sourceonlypolicy eq 'ok') {
+ } elsif ($sourceonlypolicy eq 'always') {
+ forceable_fail [qw(uploading-binaries)],
+ "uploading binaries, although distroy policy is source only"
+ if $hasdebs;
+ } elsif ($sourceonlypolicy eq 'never') {
+ forceable_fail [qw(uploading-source-only)],
+ "source-only upload, although distroy policy requires .debs"
+ if !$hasdebs;
+ } elsif ($sourceonlypolicy eq 'not-wholly-new') {
+ forceable_fail [qw(uploading-source-only)],
+ "source-only upload, even though package is entirely NEW\n".
+ "(this is contrary to policy in ".(access_nomdistro()).")"
+ if !$hasdebs
+ && $new_package
+ && !(archive_query('package_not_wholly_new', $package) // 1);
+ } else {
+ badcfg "unknown source-only-uploads policy \`$sourceonlypolicy'";
+ }
+
# Perhaps adjust .dsc to contain right set of origs
changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
$changesfile)
@@ -4349,7 +4441,8 @@ END
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");
}
@@ -4419,7 +4512,7 @@ END
runcmd_ordryrun @git,
qw(-c push.followTags=false push), access_giturl(), @pushrefs;
- runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
+ runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead;
supplementary_message(<<'END');
Push failed, while obtaining signatures on the .changes and .dsc.
@@ -4519,11 +4612,15 @@ sub branchsuite () {
}
}
-sub fetchpullargs () {
+sub package_from_d_control () {
if (!defined $package) {
my $sourcep = parsecontrol('debian/control','debian/control');
$package = getfield $sourcep, 'Source';
}
+}
+
+sub fetchpullargs () {
+ package_from_d_control();
if (@ARGV==0) {
$isuite = branchsuite();
if (!$isuite) {
@@ -4542,9 +4639,7 @@ sub fetchpullargs () {
sub cmd_fetch {
parseopts();
fetchpullargs();
- my $multi_fetched = fork_for_multisuite(sub { });
- exit 0 if $multi_fetched;
- fetch();
+ dofetch();
}
sub cmd_pull {
@@ -4559,6 +4654,86 @@ END
pull();
}
+sub cmd_checkout {
+ parseopts();
+ package_from_d_control();
+ @ARGV==1 or badusage "dgit checkout needs a suite argument";
+ ($isuite) = @ARGV;
+ notpushing();
+
+ foreach my $canon (qw(0 1)) {
+ if (!$canon) {
+ $csuite= $isuite;
+ } else {
+ undef $csuite;
+ canonicalise_suite();
+ }
+ if (length git_get_ref lref()) {
+ # local branch already exists, yay
+ last;
+ }
+ if (!length git_get_ref lrref()) {
+ if (!$canon) {
+ # nope
+ next;
+ }
+ dofetch();
+ }
+ # now lrref exists
+ runcmd (@git, qw(update-ref), lref(), lrref(), '');
+ last;
+ }
+ local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg
+ "dgit checkout $isuite";
+ runcmd (@git, qw(checkout), lbranch());
+}
+
+sub cmd_update_vcs_git () {
+ my $specsuite;
+ if (@ARGV==0 || $ARGV[0] =~ m/^-/) {
+ ($specsuite,) = split /\;/, cfg 'dgit.vcs-git.suites';
+ } else {
+ ($specsuite) = (@ARGV);
+ shift @ARGV;
+ }
+ my $dofetch=1;
+ if (@ARGV) {
+ if ($ARGV[0] eq '-') {
+ $dofetch = 0;
+ } elsif ($ARGV[0] eq '-') {
+ shift;
+ }
+ }
+
+ package_from_d_control();
+ my $ctrl;
+ if ($specsuite eq '.') {
+ $ctrl = parsecontrol 'debian/control', 'debian/control';
+ } else {
+ $isuite = $specsuite;
+ get_archive_dsc();
+ $ctrl = $dsc;
+ }
+ my $url = getfield $ctrl, 'Vcs-Git';
+
+ my @cmd;
+ my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+ if (!defined $orgurl) {
+ print STDERR "setting up vcs-git: $url\n";
+ @cmd = (@git, qw(remote add vcs-git), $url);
+ } elsif ($orgurl eq $url) {
+ print STDERR "vcs git already configured: $url\n";
+ } else {
+ print STDERR "changing vcs-git url to: $url\n";
+ @cmd = (@git, qw(remote set-url vcs-git), $url);
+ }
+ runcmd_ordryrun_local @cmd;
+ if ($dofetch) {
+ print "fetching (@ARGV)\n";
+ runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;
+ }
+}
+
sub prep_push () {
parseopts();
build_or_push_prep_early();
@@ -4590,21 +4765,6 @@ sub cmd_push {
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 {
@@ -4752,7 +4912,7 @@ sub i_resp_complete {
i_cleanup();
printdebug "all done\n";
- exit 0;
+ finish 0;
}
sub i_resp_file ($) {
@@ -5006,13 +5166,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);
@@ -5023,11 +5185,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?";
@@ -5036,7 +5206,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
@@ -5052,7 +5222,7 @@ END
}
if ($quilt_mode =~ m/gbp|dpm/ &&
($diffbits->{O2A} & 02)) {
- fail <{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;
@@ -5264,12 +5430,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') {
@@ -5420,6 +5587,33 @@ 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 $playground;
@@ -5432,14 +5626,12 @@ END
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);
}
-sub quilt_fixup_mkwork ($) {
+sub unpack_playtree_mkwork ($) {
my ($headref) = @_;
mkdir "work" or die $!;
@@ -5448,12 +5640,14 @@ sub quilt_fixup_mkwork ($) {
runcmd @git, qw(reset -q --hard), $headref;
}
-sub quilt_fixup_linkorigs ($$) {
+sub unpack_playtree_linkorigs ($$) {
my ($upstreamversion, $fn) = @_;
# calls $fn->($leafname);
- foreach my $f (<$maindir/../*>) { #/){
- my $b=$f; $b =~ s{.*/}{};
+ my $bpd_abs = bpd_abs();
+ opendir QFD, $bpd_abs or fail "buildproductsdir: $bpd_abs: $!";
+ while ($!=0, defined(my $b = readdir QFD)) {
+ my $f = bpd_abs()."/".$b;
{
local ($debuglevel) = $debuglevel-1;
printdebug "QF linkorigs $b, $f ?\n";
@@ -5463,6 +5657,8 @@ sub quilt_fixup_linkorigs ($$) {
link_ltarget $f, $b or die "$b $!";
$fn->($b);
}
+ die "$buildproductsdir: $!" if $!;
+ closedir QFD;
}
sub quilt_fixup_delete_pc () {
@@ -5484,8 +5680,8 @@ sub quilt_fixup_singlepatch ($$$) {
# get it to generate debian/patches/debian-changes, it is
# necessary to build the source package.
- quilt_fixup_linkorigs($upstreamversion, sub { });
- quilt_fixup_mkwork($headref);
+ unpack_playtree_linkorigs($upstreamversion, sub { });
+ unpack_playtree_mkwork($headref);
rmtree("debian/patches");
@@ -5525,7 +5721,7 @@ END
print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
};
- quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
+ unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
my @files=qw(debian/source/format debian/rules
debian/control debian/changelog);
@@ -5542,6 +5738,31 @@ END
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.
@@ -5583,7 +5804,7 @@ sub quilt_check_splitbrain_cache ($$) {
if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
$! == ENOENT or die $!;
printdebug ">(no reflog)\n";
- exit 0;
+ finish 0;
}
exec @cmd; die $!;
}
@@ -5593,7 +5814,7 @@ sub quilt_check_splitbrain_cache ($$) {
next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
my $cachehit = $1;
- quilt_fixup_mkwork($headref);
+ unpack_playtree_mkwork($headref);
my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
if ($cachehit ne $headref) {
progress "dgit view: found cached ($saved)";
@@ -5695,23 +5916,7 @@ sub quilt_fixup_multipatch ($$$) {
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';
-
- 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';
@@ -5723,13 +5928,13 @@ sub quilt_fixup_multipatch ($$$) {
failed to apply your git tree's patch stack (from debian/patches/) to
the corresponding upstream tarball(s). Your source tree and .orig
are probably too inconsistent. dgit can only fix up certain kinds of
- anomaly (depending on the quilt mode). See --quilt= in dgit(1).
+ anomaly (depending on the quilt mode). Please see --quilt= in dgit(1).
END
}
changedir '..';
- quilt_fixup_mkwork($headref);
+ unpack_playtree_mkwork($headref);
my $mustdeletepc=0;
if (stat_exists ".pc") {
@@ -5797,7 +6002,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;
@@ -5835,7 +6040,7 @@ sub quilt_fixup_editor () {
}
I2->error and die $!;
close O or die $1;
- exit 0;
+ finish 0;
}
sub maybe_apply_patches_dirtily () {
@@ -5901,6 +6106,10 @@ sub cmd_clean () {
maybe_unapply_patches_again();
}
+# return values from massage_dbp_args are one or both of these flags
+sub WANTSRC_SOURCE () { 01; } # caller should build source (separately)
+sub WANTSRC_BUILDER () { 02; } # caller should run dpkg-buildpackage
+
sub build_or_push_prep_early () {
our $build_or_push_prep_early_done //= 0;
return if $build_or_push_prep_early_done++;
@@ -5909,6 +6118,7 @@ sub build_or_push_prep_early () {
$isuite = getfield $clogp, 'Distribution';
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
+ $dscfn = dscfn($version);
}
sub build_prep_early () {
@@ -5917,9 +6127,12 @@ sub build_prep_early () {
check_not_dirty();
}
-sub build_prep () {
+sub build_prep ($) {
+ my ($wantsrc) = @_;
build_prep_early();
- clean_tree();
+ # clean the tree if we're trying to include dirty changes in the
+ # source package, or we are running the builder in $maindir
+ clean_tree() if $includedirty || ($wantsrc & WANTSRC_BUILDER);
build_maybe_quilt_fixup();
if ($rmchanges) {
my $pat = changespat $version;
@@ -5939,13 +6152,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;
@@ -5970,28 +6191,11 @@ sub changesopts () {
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
- #
- # return values:
- # 0 - source will NOT need to be built separately by caller
- # +1 - source will need to be built separately by caller
- # +2 - source will need to be built separately by caller AND
- # dpkg-buildpackage should not in fact be run at all!
+ # 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 0;
- }
# -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:
@@ -6006,35 +6210,34 @@ sub massage_dbp_args ($;$) {
}
push @$cmd, '-nc';
#print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
- my $r = 0;
- if ($need_split_build_invocation) {
- printdebug "massage split $dmode.\n";
- $r = $dmode =~ m/[S]/ ? +2 :
- $dmode =~ y/gGF/ABb/ ? +1 :
- $dmode =~ m/[ABb]/ ? 0 :
- die "$dmode ?";
- }
+ my $r = WANTSRC_BUILDER;
+ 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 done $r $dmode.\n";
push @$cmd, $dmode;
#print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
return $r;
}
-sub in_parent (&) {
+sub in_bpd (&) {
my ($fn) = @_;
my $wasdir = must_getcwd();
- changedir "..";
+ changedir $buildproductsdir;
$fn->();
changedir $wasdir;
}
-sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+# this sub must run with CWD=$buildproductsdir (eg in in_bpd)
+sub postbuild_mergechanges ($) {
my ($msg_if_onlyone) = @_;
# If there is only one .changes file, fail with $msg_if_onlyone,
# or if that is undef, be a no-op.
# Returns the changes file to report to the user.
my $pat = changespat $version;
- my @changesfiles = glob $pat;
+ my @changesfiles = grep { !m/_multi\.changes/ } glob $pat;
@changesfiles = sort {
($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
or $a cmp $b
@@ -6070,8 +6273,11 @@ END
sub midbuild_checkchanges () {
my $pat = changespat $version;
return if $rmchanges;
- my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
- @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
+ my @unwanted = map { s#.*/##; $_; } glob "$bpd_glob/$pat";
+ @unwanted = grep {
+ $_ ne changespat $version,'source' and
+ $_ ne changespat $version,'multi'
+ } @unwanted;
fail < 0) {
+ build_prep($wantsrc);
+ if ($wantsrc & WANTSRC_SOURCE) {
build_source();
midbuild_checkchanges_vanilla $wantsrc;
- } else {
- build_prep();
}
- if ($wantsrc < 2) {
+ if ($wantsrc & WANTSRC_BUILDER) {
push @dbp, changesopts_version();
maybe_apply_patches_dirtily();
runcmd_ordryrun_local @dbp;
@@ -6129,12 +6338,11 @@ sub cmd_gbp_build {
# orig is absent.
my $upstreamversion = upstreamversion $version;
my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';
- my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat");
+ my $gbp_make_orig = $version =~ m/-/ && !(() = glob "$bpd_glob/$origfnpat");
if ($gbp_make_orig) {
clean_tree();
$cleanmode = 'none'; # don't do it again
- $need_split_build_invocation = 1;
}
my @dbp = @dpkgbuildpackage;
@@ -6148,7 +6356,7 @@ sub cmd_gbp_build {
$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));
@@ -6172,17 +6380,17 @@ sub cmd_gbp_build {
}
}
- if ($wantsrc > 0) {
+ build_prep($wantsrc);
+ if ($wantsrc & WANTSRC_SOURCE) {
build_source();
midbuild_checkchanges_vanilla $wantsrc;
} else {
if (!$clean_using_builder) {
push @cmd, '--git-cleaner=true';
}
- build_prep();
}
maybe_unapply_patches_again();
- if ($wantsrc < 2) {
+ if ($wantsrc & WANTSRC_BUILDER) {
push @cmd, changesopts();
runcmd_ordryrun_local @cmd, @ARGV;
}
@@ -6190,77 +6398,158 @@ 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 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
+ # included (copying or hardlinking them into the playtree could
+ # cause trouble).
+ #
+ # Note that if we are building a source package in split brain
+ # mode we do not support including uncommitted changes, because
+ # that makes quilt fixup too hard. I.e. ($split_brain && (dgit is
+ # building a source package)) => !$includedirty
+ return !$includedirty;
}
sub build_source {
- build_prep_early();
- build_prep();
$sourcechanges = changespat $version,'source';
if (act_local()) {
- unlink "../$sourcechanges" or $!==ENOENT
+ unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
or fail "remove $sourcechanges: $!";
}
- $dscfn = dscfn($version);
my @cmd = (@dpkgsource, qw(-b --));
- if ($split_brain) {
+ my $leafdir;
+ if (building_source_in_playtree()) {
+ $leafdir = 'work';
+ my $headref = git_rev_parse('HEAD');
+ # If we are in split brain, there is already a playtree with
+ # the thing we should package into a .dsc (thanks to quilt
+ # fixup). If not, make a playtree
+ prep_ud() unless $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): $!";
+ unless ($split_brain) {
+ my $upstreamversion = upstreamversion $version;
+ unpack_playtree_linkorigs($upstreamversion, sub { });
+ unpack_playtree_mkwork($headref);
+ changedir '..';
}
} else {
- my $pwd = must_getcwd();
- my $leafdir = basename $pwd;
- changedir "..";
- runcmd_ordryrun_local @cmd, $leafdir;
- changedir $pwd;
+ $leafdir = basename $maindir;
+ changedir '..';
}
+ runcmd_ordryrun_local @cmd, $leafdir;
+
+ changedir $leafdir;
runcmd_ordryrun_local qw(sh -ec),
- 'exec >$1; shift; exec "$@"','x',
- "../$sourcechanges",
+ 'exec >../$1; shift; exec "$@"','x', $sourcechanges,
@dpkggenchanges, qw(-S), changesopts();
+ changedir '..';
+
+ 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;
}
sub cmd_build_source {
- build_prep_early();
badusage "build-source takes no additional arguments" if @ARGV;
+ build_prep(WANTSRC_SOURCE);
build_source();
maybe_unapply_patches_again();
printdone "source built, results in $dscfn and $sourcechanges";
}
-sub cmd_sbuild {
+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_parent {
+ 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_parent {
- postbuild_mergechanges(<{Filename};
- my $here = "../$f";
+ my $here = "$buildproductsdir/$f";
if (lstat $here) {
next if stat $here;
fail "lstat $here works but stat gives $! !";
@@ -6525,7 +6814,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);
@@ -6651,9 +6940,9 @@ sub parseopts () {
} elsif (m/^--(gbp|dpm)$/s) {
push @ropts, "--quilt=$1";
$quilt_mode = $1;
- } elsif (m/^--ignore-dirty$/s) {
+ } elsif (m/^--(?:ignore|include)-dirty$/s) {
push @ropts, $_;
- $ignoredirty = 1;
+ $includedirty = 1;
} elsif (m/^--no-quilt-fixup$/s) {
push @ropts, $_;
$quilt_mode = 'nocheck';
@@ -6672,10 +6961,13 @@ sub parseopts () {
} 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;
@@ -6695,10 +6987,6 @@ sub parseopts () {
push @ropts, $_;
$tagformat_want = [ $1, 'command line', 1 ];
# 1 menas overrides distro configuration
- } elsif (m/^--always-split-source-build$/s) {
- # undocumented, for testing
- push @ropts, $_;
- $need_split_build_invocation = 1;
} elsif (m/^--config-lookup-explode=(.+)$/s) {
# undocumented, for testing
push @ropts, $_;
@@ -6779,8 +7067,8 @@ sub check_env_sanity () {
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";
}
@@ -6852,7 +7140,8 @@ sub parseopts_late_defaults () {
$$vr = $v;
}
- $need_split_build_invocation ||= quiltmode_splitbrain();
+ fail "dgit: --include-dirty is not supported in split view quilt mode"
+ if $split_brain && $includedirty;
if (!defined $cleanmode) {
local $access_forpush;
@@ -6862,6 +7151,11 @@ sub parseopts_late_defaults () {
badcfg "unknown clean-mode \`$cleanmode'" unless
$cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
}
+
+ $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
+ $buildproductsdir //= '..';
+ $bpd_glob = $buildproductsdir;
+ $bpd_glob =~ s#[][\\{}*?~]#\\$&#g;
}
if ($ENV{$fakeeditorenv}) {
@@ -6877,7 +7171,7 @@ 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;
}
$cmd = $subcommand = shift @ARGV;
$cmd =~ y/-/_/;
@@ -6891,3 +7185,5 @@ git_slurp_config();
my $fn = ${*::}{"cmd_$cmd"};
$fn or badusage "unknown operation $cmd";
$fn->();
+
+finish 0;