our $our_version = 'UNRELEASED'; ###substituted###
our $absurdity = undef; ###substituted###
-our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
+our @rpushprotovsn_support = qw(4 5); # 5 drops tag format specification
our $protovsn;
our $cmd;
our $we_are_initiator;
our $initiator_tempdir;
our $patches_applied_dirtily = 00;
-our $tagformat_want;
-our $tagformat;
-our $tagformatfn;
our $chase_dsc_distro=1;
our %forceopts = map { $_=>0 }
sub debiantag ($$) {
my ($v,$distro) = @_;
- return $tagformatfn->($v, $distro);
+ return debiantag_new($v, $distro);
}
sub madformat ($) { $_[0] eq '3.0 (quilt)' }
# > progress NBYTES
# [NBYTES message]
#
-# > supplementary-message NBYTES # $protovsn >= 3
+# > supplementary-message NBYTES
# [NBYTES message]
#
# main sequence:
#
# > param head DGIT-VIEW-HEAD
# > param csuite SUITE
-# > param tagformat old|new
+# > param tagformat new # $protovsn == 4
# > param maint-view MAINT-VIEW-HEAD
#
# > param buildinfo-filename P_V_X.buildinfo # zero or more times
'dgit.default.archive-query' => 'madison:',
'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',
return $access_forpush;
}
+sub default_from_access_cfg ($$$;$) {
+ my ($var, $keybase, $defval, $permit_re) = @_;
+ return if defined $$var;
+
+ $$var = access_cfg("$keybase-newer", 'RETURN-UNDEF');
+ $$var = undef if $$var && $$var !~ m/^$permit_re$/;
+
+ $$var //= access_cfg($keybase, 'RETURN-UNDEF');
+ $$var //= $defval;
+
+ badcfg f_ "unknown %s \`%s'", $keybase, $$var
+ if defined $permit_re and $$var !~ m/$permit_re/;
+}
+
sub pushing () {
confess +(__ 'internal error').' '.Dumper($access_forpush)," ?" if
defined $access_forpush and !$access_forpush;
if (!$we_are_responder) {
$supplementary_message = $msg;
return;
- } elsif ($protovsn >= 3) {
+ } else {
responder_send_command "supplementary-message ".length($msg)
or confess "$!";
print PO $msg or confess "$!";
sub file_in_archive_dummycat () { return undef; }
sub package_not_wholly_new_dummycat () { return undef; }
-#---------- tag format handling ----------
-# (untranslated, because everything should be new tag format by now)
-
-sub access_cfg_tagformats () {
- split /\,/, access_cfg('dgit-tag-format');
-}
-
-sub access_cfg_tagformats_can_splitbrain () {
- my %y = map { $_ => 1 } access_cfg_tagformats;
- foreach my $needtf (qw(new maint)) {
- next if $y{$needtf};
- return 0;
- }
- return 1;
-}
-
-sub need_tagformat ($$) {
- my ($fmt, $why) = @_;
- fail "need to use tag format $fmt ($why) but also need".
- " to use tag format $tagformat_want->[0] ($tagformat_want->[1])".
- " - no way to proceed"
- if $tagformat_want && $tagformat_want->[0] ne $fmt;
- $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0];
-}
-
-sub select_tagformat () {
- # sets $tagformatfn
- return if $tagformatfn && !$tagformat_want;
- die 'bug' if $tagformatfn && $tagformat_want;
- # ... $tagformat_want assigned after previous select_tagformat
-
- my (@supported) = grep { $_ =~ m/^(?:old|new)$/ } access_cfg_tagformats();
- printdebug "select_tagformat supported @supported\n";
-
- $tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
- printdebug "select_tagformat specified @$tagformat_want\n";
-
- my ($fmt,$why,$override) = @$tagformat_want;
-
- fail "target distro supports tag formats @supported".
- " but have to use $fmt ($why)"
- unless $override
- or grep { $_ eq $fmt } @supported;
-
- $tagformat_want = undef;
- $tagformat = $fmt;
- $tagformatfn = ${*::}{"debiantag_$fmt"};
-
- fail "trying to use unknown tag format \`$fmt' ($why) !"
- unless $tagformatfn;
-}
-
#---------- archive query entrypoints and rest of program ----------
sub canonicalise_suite () {
$cd = $gf->('Distribution');
};
if ($@) {
+ $@ =~ s/^\n//s;
$@ =~ s/^dgit: //gm;
fail "$@".
f_ "Perhaps debian/changelog does not mention %s ?", $v;
TfSuffix => '-maintview',
View => 'maint',
};
- } elsif ($dodep14tag eq 'no' ? 0
- : $dodep14tag eq 'want' ? access_cfg_tagformats_can_splitbrain
- : $dodep14tag eq 'always'
- ? (access_cfg_tagformats_can_splitbrain or fail <<END)
---dep14tag-always (or equivalent in config) means server must support
- both "new" and "maint" tag formats, but config says it doesn't.
-END
- : die "$dodep14tag ?") {
+ } elsif ($dodep14tag ne 'no') {
push @tagwants, {
TagFn => \&debiantag_maintview,
Objid => $dgithead,
You can retry the push, after fixing the problem, if you like.
END
- need_tagformat 'new', "quilt mode $quilt_mode"
- if quiltmode_splitbrain;
-
prep_ud();
access_giturl(); # check that success is vaguely likely
rpush_handle_protovsn_bothends() if $we_are_initiator;
- select_tagformat();
my $clogpfn = dgit_privdir()."/changelog.822.tmp";
runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
}
}
+ confess unless !!$made_split_brain == !!$do_split_brain;
+
changedir $playground;
progress f_ "checking that %s corresponds to HEAD", $dscfn;
runcmd qw(dpkg-source -x --),
my $r = system @diffcmd;
if ($r) {
if ($r==256) {
- confess unless !!$made_split_brain == !!$do_split_brain;
my $referent = $made_split_brain ? $dgithead : 'HEAD';
my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead;
responder_send_command("param head $dgithead");
responder_send_command("param csuite $csuite");
responder_send_command("param isuite $isuite");
- responder_send_command("param tagformat $tagformat");
+ responder_send_command("param tagformat new"); # needed in $protovsn==4
if (defined $maintviewhead) {
- confess "internal error (protovsn=$protovsn)"
- if defined $protovsn and $protovsn < 4;
responder_send_command("param maint-view $maintviewhead");
}
# a good error message)
sub rpush_handle_protovsn_bothends () {
- if ($protovsn < 4) {
- need_tagformat 'old', "rpush negotiated protocol $protovsn";
- }
- select_tagformat();
}
our $i_tmp;
changedir $i_tmp;
($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ };
die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
- $supplementary_message = '' unless $protovsn >= 3;
for (;;) {
my ($icmd,$iargs) = initiator_expect {
pushing();
rpush_handle_protovsn_bothends();
- fail f_ "rpush negotiated protocol version %s".
- " which does not support quilt mode %s",
- $protovsn, $quilt_mode
- if quiltmode_splitbrain && $protovsn < 4;
-
my @localpaths = i_method "i_want", $keyword;
printdebug "[[ $keyword @localpaths\n";
foreach my $localpath (@localpaths) {
my $maintview = $i_param{'maint-view'};
die if defined $maintview && $maintview =~ m/[^0-9a-f]/;
- select_tagformat();
- if ($protovsn >= 4) {
+ if ($protovsn == 4) {
my $p = $i_param{'tagformat'} // '<undef>';
- $p eq $tagformat
- or badproto \*RO, "tag format mismatch: $p vs. $tagformat";
+ $p eq 'new'
+ or badproto \*RO, "tag format mismatch: $p vs. new";
}
die unless $i_param{'csuite'} =~ m/^$suite_re$/;
[dgit ($our_version) update-gitignore-quilt-fixup]
ENDU
}
-
- my $dgitview = git_rev_parse 'HEAD';
-
- changedir $maindir;
- reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview;
-
- changedir "$playground/work";
-
- my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted";
- progress f_ "dgit view: created (%s)", $saved;
}
sub quiltify ($$$$) {
runcmd @git, qw(checkout -q), $cc, qw(debian/changelog);
}
-
- runcmd @git, qw(checkout -q master);
}
sub build_maybe_quilt_fixup () {
# remain dgit-view, rather than master, so subsequent calls to
# unpack_playtree_need_cd_work
# will DTRT, resetting dgit-view.
- die if $made_split_brain;
+ confess if $made_split_brain;
$made_split_brain = 1;
}
chdir '..';
$splitbrain_cachekey);
}
+ if ($do_split_brain) {
+ my $dgitview = git_rev_parse 'HEAD';
+
+ changedir $maindir;
+ reflog_cache_insert "refs/$splitbraincache",
+ $splitbrain_cachekey, $dgitview;
+
+ changedir "$playground/work";
+
+ my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted";
+ progress f_ "dgit view: created (%s)", $saved;
+ }
+
changedir $maindir;
runcmd_ordryrun_local
@git, qw(pull --ff-only -q), "$playground/work", qw(master);
sub build_check_quilt_splitbrain () {
build_maybe_quilt_fixup();
-
- if ($do_split_brain) {
- fail <<END unless access_cfg_tagformats_can_splitbrain;
-quilt mode $quilt_mode requires split view so server needs to support
- both "new" and "maint" tag formats, but config says it doesn't.
-END
- }
}
sub unpack_playtree_need_cd_work ($) {
progress f_ "starting quiltify (multiple patches, %s mode)", $quilt_mode;
quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
+ runcmd @git, qw(checkout -q), (qw(master dgit-view)[!!$do_split_brain]);
if (!open P, '>>', ".pc/applied-patches") {
$!==&ENOENT or confess "$!";
unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
or fail f_ "remove %s: %s", $sourcechanges, $!;
}
+# confess unless !!$made_split_brain == !!$do_split_brain;
+
my @cmd = (@dpkgsource, qw(-b --));
my $leafdir;
if (building_source_in_playtree()) {
# 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
- confess unless !!$made_split_brain == !!$do_split_brain;
prep_ud() unless $made_split_brain;
changedir $playground;
unless ($made_split_brain) {
} elsif (m/^--delayed=(\d+)$/s) {
push @ropts, $_;
push @dput, $_;
- } elsif (my ($k,$v) =
- m/^--save-(dgit-view)=(.+)$/s ||
+ } elsif (m/^--save-(dgit-view)=(.+)$/s ||
m/^--(dgit-view)-save=(.+)$/s
) {
+ my ($k,$v) = ($1,$2);
push @ropts, $_;
$v =~ s#^(?!refs/)#refs/heads/#;
$internal_object_save{$k} = $v;
f_ "%s: warning: ignoring unknown force option %s\n",
$us, $_;
$_='';
- } elsif (m/^--dgit-tag-format=(old|new)$/s) {
- # undocumented, for testing
- push @ropts, $_;
- $tagformat_want = [ $1, 'command line', 1 ];
- # 1 menas overrides distro configuration
} elsif (m/^--config-lookup-explode=(.+)$/s) {
# undocumented, for testing
push @ropts, $_;
$$vr = $v;
}
- if (!defined $cleanmode) {
+ {
local $access_forpush;
- $cleanmode = access_cfg('clean-mode-newer', 'RETURN-UNDEF');
- $cleanmode = undef if $cleanmode && $cleanmode !~ m/^$cleanmode_re$/;
-
- $cleanmode //= access_cfg('clean-mode', 'RETURN-UNDEF');
- $cleanmode //= 'dpkg-source';
-
- badcfg f_ "unknown clean-mode \`%s'", $cleanmode unless
- $cleanmode =~ m/$cleanmode_re/;
+ default_from_access_cfg(\$cleanmode, 'clean-mode', 'dpkg-source',
+ $cleanmode_re);
}
$buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
~ianmdlvl / dgit.git / blobdiff