our $we_are_responder;
our $initiator_tempdir;
our $patches_applied_dirtily = 00;
+our $tagformat_want;
our $tagformat;
our $tagformatfn;
#
# > param head HEAD
# > param csuite SUITE
+# > param tagformat old|new
#
# > previously REFNAME=OBJNAME # if --deliberately-not-fast-forward
# # goes into tag, for replay prevention
return sort { -version_compare($a->[0],$b->[0]); } @rows;
}
+#---------- tag format handling ----------
+
+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) = split /\,/, access_cfg('dgit-tag-format');
+ 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 () {
}
}
-sub select_tagformat () {
- # sets $tagformatfn
- return if $tagformatfn && !$tagformat;
- die 'bug' if $tagformatfn && $tagformat;
- # ... $tagformat assigned after previous select_tagformat
-
- my (@supported) = split /\,/, access_cfg('dgit-tag-format');
- printdebug "select_tagformat supported @supported\n";
-
- $tagformat //= [ $supported[0], "distro access configuration", 0 ];
- printdebug "select_tagformat specified @$tagformat\n";
-
- my ($fmt,$why,$override) = @$tagformat;
-
- fail "target distro supports tag formats @supported".
- " but have to use $fmt ($why)"
- unless $override
- or grep { $_ eq $fmt } @supported;
-
- $tagformat = undef;
- $tagformatfn = ${*::}{"debiantag_$fmt"};
-
- fail "trying to use unknown tag format \`$fmt' ($why) !"
- unless $tagformatfn;
-}
-
our ($dsc_hash,$lastpush_hash);
our $ud = '.git/dgit/unpack';
}
sub push_mktag ($$$$$$$) {
- my ($head,$clogp,$tag,
+ my ($dgithead,$clogp,$dgittag,
$dscfn,
$changesfile,$changesfilewhat,
- $tfn) = @_;
+ $tfnbase) = @_;
- $dsc->{$ourdscfield[0]} = $head;
+ $dsc->{$ourdscfield[0]} = $dgithead;
$dsc->save("$dscfn.tmp") or die $!;
my $changes = parsecontrol($changesfile,$changesfilewhat);
my $authline = clogp_authline $clogp;
my $delibs = join(" ", "",@deliberatelies);
my $declaredistro = access_basedistro();
- open TO, '>', $tfn->('.tmp') or die $!;
- print TO <<END or die $!;
+
+ my $mktag = sub {
+ my ($tfn, $head, $tag) = @_;
+
+ open TO, '>', $tfn->('.tmp') or die $!;
+ print TO <<END or die $!;
object $head
type commit
tag $tag
$package release $cversion for $clogsuite ($csuite) [dgit]
[dgit distro=$declaredistro$delibs]
END
- foreach my $ref (sort keys %previously) {
- print TO <<END or die $!;
+ foreach my $ref (sort keys %previously) {
+ print TO <<END or die $!;
[dgit previously:$ref=$previously{$ref}]
END
- }
+ }
- close TO or die $!;
+ close TO or die $!;
- my $tagobjfn = $tfn->('.tmp');
- if ($sign) {
- if (!defined $keyid) {
- $keyid = access_cfg('keyid','RETURN-UNDEF');
- }
- if (!defined $keyid) {
- $keyid = getfield $clogp, 'Maintainer';
- }
- unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
- my @sign_cmd = (@gpg, qw(--detach-sign --armor));
- push @sign_cmd, qw(-u),$keyid if defined $keyid;
- push @sign_cmd, $tfn->('.tmp');
- runcmd_ordryrun @sign_cmd;
- if (act_scary()) {
- $tagobjfn = $tfn->('.signed.tmp');
- runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
- $tfn->('.tmp'), $tfn->('.tmp.asc');
+ my $tagobjfn = $tfn->('.tmp');
+ if ($sign) {
+ if (!defined $keyid) {
+ $keyid = access_cfg('keyid','RETURN-UNDEF');
+ }
+ if (!defined $keyid) {
+ $keyid = getfield $clogp, 'Maintainer';
+ }
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+ my @sign_cmd = (@gpg, qw(--detach-sign --armor));
+ push @sign_cmd, qw(-u),$keyid if defined $keyid;
+ push @sign_cmd, $tfn->('.tmp');
+ runcmd_ordryrun @sign_cmd;
+ if (act_scary()) {
+ $tagobjfn = $tfn->('.signed.tmp');
+ runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
+ $tfn->('.tmp'), $tfn->('.tmp.asc');
+ }
}
- }
+ return $tagobjfn;
+ };
- return ($tagobjfn);
+ my @r;
+ push @r, $mktag->($tfnbase, $dgithead, $dgittag);
+ return @r;
}
sub sign_changes ($) {
responder_send_file('changes',$changesfile);
responder_send_command("param head $head");
responder_send_command("param csuite $csuite");
+ responder_send_command("param tagformat $tagformat");
if (deliberately_not_fast_forward) {
git_for_each_ref(lrfetchrefs, sub {
$tagobjfn = $tfn->('.signed.tmp');
responder_receive_files('signed-tag', $tagobjfn);
} else {
- $tagobjfn =
+ ($tagobjfn) =
push_mktag($head,$clogp,$tag,
$dscpath,
$changesfile,$changesfile,
if ($protovsn < 4) {
fail "rpush negotiated protocol version $protovsn".
" which supports old tag format only".
- " but trying to use new format (".$tagformat->[1].")"
- if $tagformat && $tagformat->[0] ne 'old';
- $tagformat = ['old', "rpush negotiated protocol $protovsn", 0];
+ " but trying to use new format (".$tagformat_want->[1].")"
+ if $tagformat_want && $tagformat_want->[0] ne 'old';
+ $tagformat_want = ['old', "rpush negotiated protocol $protovsn", 0];
}
select_tagformat();
}
my $head = $i_param{'head'};
die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+ select_tagformat();
+ if ($protovsn >= 4) {
+ my $p = $i_param{'tagformat'} // '<undef>';
+ $p eq $tagformat
+ or badproto \*RO, "tag format mismatch: $p vs. $tagformat";
+ }
+
die unless $i_param{'csuite'} =~ m/^$suite_re$/;
$csuite = $&;
push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
- my $tagobjfn =
+ my ($tagobjfn) =
push_mktag $head, $i_clogp, $i_tag,
$i_dscfn,
$i_changesfn, 'remote changes',
die "$quilt_mode ?";
}
- my $time = time;
+ my $time = $ENV{'GIT_COMMITTER_DATE'} || time;
+ $time =~ s/\s.*//; # trim timezone from GIT_COMMITTER_DATE
my $ncommits = 3;
my $msg = cmdoutput @git, qw(log), "-n$ncommits";
} elsif (m/^--dgit-tag-format=(old|new)$/s) {
# undocumented, for testing
push @ropts, $_;
- $tagformat = [ $1, 'command line', 1 ];
+ $tagformat_want = [ $1, 'command line', 1 ];
# 1 menas overrides distro configuration
} elsif (m/^--always-split-source-build$/s) {
# undocumented, for testing