# dgit
# Integration between git and Debian-style archives
#
-# Copyright (C)2013-2018 Ian Jackson
-# Copyright (C)2017-2018 Sean Whitton
+# Copyright (C)2013-2019 Ian Jackson
+# Copyright (C)2017-2019 Sean Whitton
+# Copyright (C)2019 Matthew Vernon / Genome Research Limited
#
# 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
our $our_version = 'UNRELEASED'; ###substituted###
our $absurdity = undef; ###substituted###
-our @rpushprotovsn_support = qw(4 5); # 5 drops tag format specification
+our @rpushprotovsn_support = qw(6 5 4); # Reverse order!
our $protovsn;
our $cmd;
our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
-our $suite_re = '[-+.0-9a-z]+';
our $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )?
| (?: git | git-ff ) (?: ,always )?
| check (?: ,ignores )?
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));
our (@dput) = qw(dput);
# > param head DGIT-VIEW-HEAD
# > param csuite SUITE
# > param tagformat new # $protovsn == 4
+# > param splitbrain 0|1 # $protovsn >= 6
# > param maint-view MAINT-VIEW-HEAD
#
# > param buildinfo-filename P_V_X.buildinfo # zero or more times
'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
'dgit-distro.ubuntu.git-check' => 'false',
'dgit-distro.ubuntu.mirror' => 'http://archive.ubuntu.com/ubuntu',
+ 'dgit-distro.ubuntucloud.git-check' => 'false',
+ 'dgit-distro.ubuntucloud.nominal-distro' => 'ubuntu',
+ 'dgit-distro.ubuntucloud.archive-query' => 'aptget:',
+ 'dgit-distro.ubuntucloud.mirror' => 'http://ubuntu-cloud.archive.canonical.com/ubuntu',
+ 'dgit-distro.ubuntucloud.aptget-suite-map' => 's#^([^-]+):([^:]+)$#${1}-updates/$2#; s#^(.+)-(.+):(.+)#$1-$2/$3#;',
+ 'dgit-distro.ubuntucloud.aptget-suite-rmap' => 's#/(.+)$#-$1#',
'dgit-distro.test-dummy.ssh' => "$td/ssh",
'dgit-distro.test-dummy.username' => "alice",
'dgit-distro.test-dummy.git-check' => "ssh-cmd",
parseopts_late_defaults();
}
-sub determine_whether_split_brain () {
- my ($format,) = get_source_format();
-
+sub determine_whether_split_brain ($) {
+ my ($format) = @_;
{
local $access_forpush;
default_from_access_cfg(\$splitview_mode, 'split-view', 'auto',
$do_split_brain = 1;
}
$do_split_brain //= 0;
-
- return ($format);
}
sub supplementary_message ($) {
return @cmd;
}
-sub api_query ($$;$) {
- use JSON;
+sub api_query_raw ($$;$) {
my ($data, $subpath, $ok404) = @_;
badcfg __ "ftpmasterapi archive query method takes no data part"
if length $data;
return undef if $code eq '404' && $ok404;
fail f_ "fetch of %s gave HTTP code %s", $url, $code
unless $url =~ m#^file://# or $code =~ m/^2/;
+ return $json;
+}
+
+sub api_query ($$;$) {
+ my ($data, $subpath, $ok404) = @_;
+ use JSON;
+ my $json = api_query_raw $data, $subpath, $ok404;
+ return undef unless defined $json;
return decode_json($json);
}
my $val = $release->{$name};
if (defined $val) {
printdebug "release file $name: $val\n";
+ cfg_apply_map(\$val, 'suite rmap',
+ access_cfg('aptget-suite-rmap', 'RETURN-UNDEF'));
$val =~ m/^$suite_re$/o or fail f_
"Release file (%s) specifies intolerable %s",
$aptget_releasefile, $name;
- cfg_apply_map(\$val, 'suite rmap',
- access_cfg('aptget-suite-rmap', 'RETURN-UNDEF'));
return $val
}
}
}
sub mktree_in_ud_here () {
- playtree_setup $gitcfgs{local};
+ playtree_setup();
}
sub git_write_tree () {
record_maindir();
setup_new_tree();
clone_set_head();
- my $giturl = access_giturl(1);
- if (defined $giturl) {
- runcmd @git, qw(remote add), 'origin', $giturl;
- }
if ($hasgit) {
progress __ "fetching existing git history";
git_fetch_us();
- runcmd_ordryrun_local @git, qw(fetch origin);
} else {
progress __ "starting new git history";
}
my $cversion = getfield $clogp, 'Version';
my $clogsuite = getfield $clogp, 'Distribution';
+ my $format = getfield $dsc, 'Format';
# We make the git tag by hand because (a) that makes it easier
# to control the "tagger" (b) we can do remote signing
my $authline = clogp_authline $clogp;
- my @dtxinfo = @deliberatelies;
my $mktag = sub {
my ($tw) = @_;
tagger $authline
END
- if ($tw->{View} eq 'dgit') {
- print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite
-%s release %s for %s (%s) [dgit]
-ENDT
- or confess "$!";
- my $dtxinfo = join(" ", "",@dtxinfo);
- print TO <<END or confess "$!";
+
+ my @dtxinfo = @deliberatelies;
+ unshift @dtxinfo, "--quilt=$quilt_mode" if madformat($format);
+ unshift @dtxinfo, do_split_brain() ? "split" : "no-split"
+ # rpush protocol 5 and earlier don't tell us
+ unless $we_are_initiator && $protovsn < 6;
+ my $dtxinfo = join(" ", "",@dtxinfo);
+ my $tag_metadata = <<END;
[dgit distro=$declaredistro$dtxinfo]
END
- foreach my $ref (sort keys %previously) {
- print TO <<END or confess "$!";
+ foreach my $ref (sort keys %previously) {
+ $tag_metadata .= <<END or confess "$!";
[dgit previously:$ref=$previously{$ref}]
END
- }
+ }
+
+ if ($tw->{View} eq 'dgit') {
+ print TO sprintf <<ENDT, $package, $cversion, $clogsuite, $csuite
+%s release %s for %s (%s) [dgit]
+ENDT
+ or confess "$!";
} elsif ($tw->{View} eq 'maint') {
- print TO f_ <<END, $package, $cversion, $clogsuite, $csuite,
+ print TO sprintf <<END, $package, $cversion, $clogsuite, $csuite;
%s release %s for %s (%s)
+
+END
+ print TO f_ <<END,
(maintainer view tag generated by dgit --quilt=%s)
END
$quilt_mode
} else {
confess Dumper($tw)."?";
}
+ print TO "\n", $tag_metadata;
close TO or confess "$!";
responder_send_command("param csuite $csuite");
responder_send_command("param isuite $isuite");
responder_send_command("param tagformat new"); # needed in $protovsn==4
+ responder_send_command("param splitbrain $do_split_brain");
if (defined $maintviewhead) {
responder_send_command("param maint-view $maintviewhead");
}
sub cmd_pull {
parseopts();
fetchpullargs();
- determine_whether_split_brain();
+ determine_whether_split_brain get_source_format();
if (do_split_brain()) {
my ($format, $fopts) = get_source_format();
madformat($format) and fail f_ <<END, $quilt_mode
}
our %i_wanted;
+our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
sub i_resp_want ($) {
my ($keyword) = @_;
$isuite = $i_param{'isuite'} // $i_param{'csuite'};
die unless $isuite =~ m/^$suite_re$/;
- pushing();
- rpush_handle_protovsn_bothends();
+ if (!defined $dsc) {
+ pushing();
+ rpush_handle_protovsn_bothends();
+ push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
+ if ($protovsn >= 6) {
+ determine_whether_split_brain getfield $dsc, 'Format';
+ $do_split_brain eq ($i_param{'splitbrain'} // '<unsent>')
+ or badproto \*RO,
+ "split brain mismatch, $do_split_brain != $i_param{'split_brain'}";
+ printdebug "rpush split brain $do_split_brain\n";
+ }
+ }
my @localpaths = i_method "i_want", $keyword;
printdebug "[[ $keyword @localpaths\n";
print RI "files-end\n" or confess "$!";
}
-our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
-
sub i_localname_parsed_changelog {
return "remote-changelog.822";
}
die unless $i_param{'csuite'} =~ m/^$suite_re$/;
$csuite = $&;
- push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
+ defined $dsc or badproto \*RO, "dsc (before parsed-changelog)";
my @tagwants = push_tagwants $i_version, $head, $maintview, "tag";
sub build_or_push_prep_early () {
our $build_or_push_prep_early_done //= 0;
return if $build_or_push_prep_early_done++;
- badusage f_ "-p is not allowed with dgit %s", $subcommand
- if defined $package;
my $clogp = parsechangelog();
$isuite = getfield $clogp, 'Distribution';
- $package = getfield $clogp, 'Source';
+ my $gotpackage = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
+ $package //= $gotpackage;
+ if ($package ne $gotpackage) {
+ fail f_ "-p specified package %s, but changelog says %s",
+ $package, $gotpackage;
+ }
$dscfn = dscfn($version);
}
sub build_or_push_prep_modes () {
- my ($format,) = determine_whether_split_brain();
+ my ($format) = get_source_format();
+ determine_whether_split_brain($format);
fail __ "dgit: --include-dirty is not supported with split view".
" (including with view-splitting quilt modes)"