X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=af9b182fcf5e7952479d8778f517f6da53e4f272;hp=5f37c1143c7a91ac4866414b265aa5b3b4d5121e;hb=2b9520f48d257c2a1d2c5a66d47ac711d1d45908;hpb=d9e7b9820d1c5cfeea2c5f41ee2aa704080af52c diff --git a/dgit b/dgit index 5f37c114..af9b182f 100755 --- a/dgit +++ b/dgit @@ -78,6 +78,7 @@ our $patches_applied_dirtily = 00; our $tagformat_want; our $tagformat; our $tagformatfn; +our $chase_dsc_distro=1; #xxx configurable our %forceopts = map { $_=>0 } qw(unrepresentable unsupported-source-format @@ -572,6 +573,10 @@ our %defcfg = ('dgit.default.distro' => 'debian', '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" @@ -677,7 +682,10 @@ sub cfg { 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"; @@ -2512,7 +2520,14 @@ sub lrfetchref_used ($) { } sub git_lrfetch_sane { - my (@specs) = @_; + 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 *, @@ -2536,30 +2551,33 @@ sub git_lrfetch_sane { # 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; @@ -2585,13 +2603,14 @@ END "+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 { @@ -2600,6 +2619,10 @@ END $objgot{$objid} = 1; }); + if ($supplementary) { + last; + } + foreach my $lrefname (sort keys %lrfetchrefs_f) { my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs); if (!exists $wantr{$rrefname}) { @@ -2641,7 +2664,7 @@ END } 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); } @@ -2659,7 +2682,7 @@ sub git_fetch_us () { push @specs, $rewritemap; push @specs, qw(heads/*) if deliberately_not_fast_forward; - git_lrfetch_sane @specs; + git_lrfetch_sane 0, @specs; my %here; my @tagpats = debiantags('*',access_nomdistro); @@ -2745,16 +2768,85 @@ sub resolve_dsc_field_commit ($$) { return unless defined $dsc_hash; - my $rewritemapdata = git_cat_file $already_mapref.':map'; - if (defined $rewritemapdata - && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) { - progress "server's git history rewrite map contains a relevant entry!"; + my $mapref = + $already_distro eq $dsc_distro || !$chase_dsc_distro + ? $already_mapref : undef; - $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"; + 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 <("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 <{Filename};