our $tagformat_want;
our $tagformat;
our $tagformatfn;
+our $chase_dsc_distro=1; #xxx configurable
our %forceopts = map { $_=>0 }
qw(unrepresentable unsupported-source-format
sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
sub rrref () { return server_ref($csuite); }
-sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
-sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
-
-# We fetch some parts of lrfetchrefs/*. Ideally we delete these
-# locally fetched refs because they have unhelpful names and clutter
-# up gitk etc. So we track whether we have "used up" head ref (ie,
-# whether we have made another local ref which refers to this object).
-#
-# (If we deleted them unconditionally, then we might end up
-# re-fetching the same git objects each time dgit fetch was run.)
-#
-# So, leach use of lrfetchrefs needs to be accompanied by arrangements
-# in git_fetch_us to fetch the refs in question, and possibly a call
-# to lrfetchref_used.
-
-our (%lrfetchrefs_f, %lrfetchrefs_d);
-# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
-
-sub lrfetchref_used ($) {
- my ($fullrefname) = @_;
- my $objid = $lrfetchrefs_f{$fullrefname};
- $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
-}
-
sub stripepoch ($) {
my ($vsn) = @_;
$vsn =~ s/^\d+\://;
'dgit.default.sshpsql-dbname' => 'service=projectb',
'dgit.default.aptget-components' => 'main',
'dgit.default.dgit-tag-format' => 'new,old,maint',
+ 'dgit.dsc-url-proto-ok.http' => 'true',
+ 'dgit.dsc-url-proto-ok.https' => 'true',
+ 'dgit.dsc-url-proto-ok.git' => 'true',
+ '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"
# maint means "repo server accepts split brain pushes"
my ($c) = @_;
foreach my $src (@gitcfgsources) {
my $l = $gitcfgs{$src}{$c};
- printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+ printdebug"C $c ".(defined $l ?
+ join " ", map { messagequote "'$_'" } @$l :
+ "undef")."\n"
if $debuglevel >= 4;
$l or next;
@$l==1 or badcfg "multiple values for $c".
my $v = git_get_config($c);
return $v if defined $v;
my $dv = $defcfg{$c};
- return $dv if defined $dv;
+ if (defined $dv) {
+ printdebug "CD $c $dv\n" if $debuglevel >= 4;
+ return $dv;
+ }
}
badcfg "need value for one of: @_\n".
"$us: distro or suite appears not to be (properly) supported";
}
our ($dsc_hash,$lastpush_mergeinput);
+our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
our $ud = '.git/dgit/unpack';
}
}
-sub git_fetch_us () {
- # Want to fetch only what we are going to use, unless
- # deliberately-not-ff, in which case we must fetch everything.
+#---------- git fetch ----------
- my @specs = deliberately_not_fast_forward ? qw(tags/*) :
- map { "tags/$_" }
- (quiltmode_splitbrain
- ? (map { $_->('*',access_nomdistro) }
- \&debiantag_new, \&debiantag_maintview)
- : debiantags('*',access_nomdistro));
- push @specs, server_branch($csuite);
- push @specs, $rewritemap;
- push @specs, qw(heads/*) if deliberately_not_fast_forward;
+sub lrfetchrefs () { return "refs/dgit-fetch/".access_basedistro(); }
+sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
+
+# We fetch some parts of lrfetchrefs/*. Ideally we delete these
+# locally fetched refs because they have unhelpful names and clutter
+# up gitk etc. So we track whether we have "used up" head ref (ie,
+# whether we have made another local ref which refers to this object).
+#
+# (If we deleted them unconditionally, then we might end up
+# re-fetching the same git objects each time dgit fetch was run.)
+#
+# So, leach use of lrfetchrefs needs to be accompanied by arrangements
+# in git_fetch_us to fetch the refs in question, and possibly a call
+# to lrfetchref_used.
+
+our (%lrfetchrefs_f, %lrfetchrefs_d);
+# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
+
+sub lrfetchref_used ($) {
+ my ($fullrefname) = @_;
+ my $objid = $lrfetchrefs_f{$fullrefname};
+ $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
+}
+
+sub git_lrfetch_sane {
+ my ($supplementary, @specs) = @_;
+ # Make a 'refs/'.lrfetchrefs.'/*' be just like on server,
+ # at least as regards @specs. Also leave the results in
+ # %lrfetchrefs_f, and arrange for lrfetchref_used to be
+ # able to clean these up.
+ #
+ # With $supplementary==1, @specs must not contain wildcards
+ # and we add to our previous fetches (non-atomically).
# This is rather miserable:
# When git fetch --prune is passed a fetchspec ending with a *,
# git fetch to try to generate it. If we don't manage to generate
# the target state, we try again.
- printdebug "git_fetch_us specs @specs\n";
+ my $url = access_giturl();
+
+ printdebug "git_lrfetch_sane suppl=$supplementary specs @specs\n";
my $specre = join '|', map {
my $x = $_;
$x =~ s/\W/\\$&/g;
- $x =~ s/\\\*$/.*/;
+ my $wildcard = $x =~ s/\\\*$/.*/;
+ die if $wildcard && $supplementary;
"(?:refs/$x)";
} @specs;
- printdebug "git_fetch_us specre=$specre\n";
+ printdebug "git_lrfetch_sane specre=$specre\n";
my $wanted_rref = sub {
local ($_) = @_;
- return m/^(?:$specre)$/o;
+ return m/^(?:$specre)$/;
};
my $fetch_iteration = 0;
FETCH_ITERATION:
for (;;) {
- printdebug "git_fetch_us iteration $fetch_iteration\n";
+ printdebug "git_lrfetch_sane iteration $fetch_iteration\n";
if (++$fetch_iteration > 10) {
fail "too many iterations trying to get sane fetch!";
}
my @look = map { "refs/$_" } @specs;
- my @lcmd = (@git, qw(ls-remote -q --refs), access_giturl(), @look);
+ my @lcmd = (@git, qw(ls-remote -q --refs), $url, @look);
debugcmd "|",@lcmd;
my %wantr;
"+refs/$_:".lrfetchrefs."/$_";
} @specs;
- printdebug "git_fetch_us fspecs @fspecs\n";
+ printdebug "git_lrfetch_sane fspecs @fspecs\n";
- my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
- runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),
- @fspecs;
+ my @fcmd = (@git, qw(fetch -p -n -q), $url, @fspecs);
+ runcmd_ordryrun_local @fcmd if @fspecs;
- %lrfetchrefs_f = ();
+ if (!$supplementary) {
+ %lrfetchrefs_f = ();
+ }
my %objgot;
git_for_each_ref(lrfetchrefs, sub {
$objgot{$objid} = 1;
});
+ if ($supplementary) {
+ last;
+ }
+
foreach my $lrefname (sort keys %lrfetchrefs_f) {
my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs);
if (!exists $wantr{$rrefname}) {
}
last;
}
- printdebug "git_fetch_us: git fetch --no-insane emulation complete\n",
+ printdebug "git_lrfetch_sane: git fetch --no-insane emulation complete\n",
Dumper(\%lrfetchrefs_f);
+}
+
+sub git_fetch_us () {
+ # Want to fetch only what we are going to use, unless
+ # deliberately-not-ff, in which case we must fetch everything.
+
+ my @specs = deliberately_not_fast_forward ? qw(tags/*) :
+ map { "tags/$_" }
+ (quiltmode_splitbrain
+ ? (map { $_->('*',access_nomdistro) }
+ \&debiantag_new, \&debiantag_maintview)
+ : debiantags('*',access_nomdistro));
+ push @specs, server_branch($csuite);
+ push @specs, $rewritemap;
+ push @specs, qw(heads/*) if deliberately_not_fast_forward;
+
+ git_lrfetch_sane 0, @specs;
my %here;
my @tagpats = debiantags('*',access_nomdistro);
});
}
+#---------- dsc and archive handling ----------
+
sub mergeinfo_getclogp ($) {
# Ensures thit $mi->{Clogp} exists and returns it
my ($mi) = @_;
}
if (!defined $f) {
progress "$what: NO git hash";
- } elsif ($f =~ m/^\w+/) {
+ } elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url)
+ = $f =~ m/^(\w+) ($distro_re) ($versiontag_re) (\S+)(?:\s|$)/) {
+ progress "$what: specified git info ($dsc_distro)";
+ $dsc_hint_tag = [ $dsc_hint_tag ];
+ } elsif ($f =~ m/^\w+\s*$/) {
$dsc_hash = $&;
+ $dsc_distro //= 'debian';
+ $dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'),
+ $dsc_distro ];
progress "$what: specified git hash";
} else {
fail "$what: invalid Dgit info";
}
}
+sub resolve_dsc_field_commit ($$) {
+ my ($already_distro, $already_mapref) = @_;
+
+ return unless defined $dsc_hash;
+
+ my $mapref =
+ $already_distro eq $dsc_distro || !$chase_dsc_distro
+ ? $already_mapref : undef;
+
+ my $do_fetch;
+ $do_fetch = sub {
+ my ($what, @fetch) = @_;
+
+ local $idistro = $dsc_distro;
+ my $lrf = lrfetchrefs;
+
+ if (!$chase_dsc_distro) {
+ progress
+ "not chasing .dsc distro $dsc_distro: not fetching $what";
+ return 0;
+ }
+
+ progress
+ ".dsc names distro $dsc_distro: fetching $what";
+
+ my $url = access_giturl();
+ if (!defined $url) {
+ defined $dsc_hint_url or fail <<END;
+.dsc Dgit metadata is in context of distro $dsc_distro
+for which we have no configured url and .dsc provides no hint
+END
+ my $proto =
+ $dsc_hint_url =~ m#^([-+0-9a-zA-Z]+):# ? $1 :
+ $dsc_hint_url =~ m#^/# ? 'file' : 'bad-syntax';
+ parse_cfg_bool "dsc-url-proto-ok", 'false',
+ cfg("dgit.dsc-url-proto-ok.$proto",
+ "dgit.default.dsc-url-proto-ok")
+ or fail <<END;
+.dsc Dgit metadata is in context of distro $dsc_distro
+for which we have no configured url;
+.dsc provices hinted url with protocol $proto which is unsafe.
+(can be overridden by config - consult documentation)
+END
+ $url = $dsc_hint_url;
+ }
+
+ git_lrfetch_sane 1, @fetch;
+
+ return $lrf;
+ };
+
+ if (parse_cfg_bool 'rewrite-map-enable', 'true',
+ access_cfg('rewrite-map-enable', 'RETURN-UNDEF')) {
+ my $lrf = $do_fetch->("rewrite map", $rewritemap) or return;
+ $mapref = $lrf.'/'.$rewritemap;
+ my $rewritemapdata = git_cat_file $mapref.':map';
+ if (defined $rewritemapdata
+ && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) {
+ progress
+ "server's git history rewrite map contains a relevant entry!";
+
+ $dsc_hash = $1;
+ if (defined $dsc_hash) {
+ progress "using rewritten git hash in place of .dsc value";
+ } else {
+ progress "server data says .dsc hash is to be disregarded";
+ }
+ }
+ }
+
+ if (!defined git_cat_file $dsc_hash) {
+ my @tags = map { "tags/".$_ } @$dsc_hint_tag;
+ my $lrf = $do_fetch->("additional commits", @tags) &&
+ defined git_cat_file $dsc_hash
+ or fail <<END;
+.dsc Dgit metadata requires commit $dsc_hash
+but we could not obtain that object anywhere.
+END
+ foreach my $t (@tags) {
+ my $fullrefname = $lrf.'/'.$t;
+ print STDERR "CHK $t $fullrefname ".Dumper(\%lrfetchrefs_f);
+ next unless $lrfetchrefs_f{$fullrefname};
+ next unless is_fast_fwd "$fullrefname~0", $dsc_hash;
+ lrfetchref_used $fullrefname;
+ }
+ }
+}
+
sub fetch_from_archive () {
ensure_setup_existing_tree();
if ($dsc) {
parse_dsc_field($dsc, 'last upload to archive');
+ resolve_dsc_field_commit access_basedistro,
+ lrfetchrefs."/".$rewritemap
} else {
progress "no version available from the archive";
}
- my $rewritemapdata = git_cat_file lrfetchrefs."/".$rewritemap.':map';
- if (defined $rewritemapdata
- && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) {
- progress "server's git history rewrite map contains a relevant entry!";
- $dsc_hash = $1;
- if (defined $dsc_hash) {
- progress "using rewritten git hash in place of .dsc value";
- } else {
- progress "server data says .dsc hash is to be disregarded";
- }
- }
-
# If the archive's .dsc has a Dgit field, there are three
# relevant git commitids we need to choose between and/or merge
# together:
~ianmdlvl / dgit.git / blobdiff