X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=9393bdd9c329350709e91709faf59c850414eb96;hp=1502ddff922109ec771f25eecf09f3648b0bb57d;hb=c35d643a5117ac3ed2d4966a0db0427266e924b9;hpb=815eb9d89a743bcd20e566eaabbfd2233109b24b diff --git a/dgit b/dgit index 1502ddff..9393bdd9 100755 --- a/dgit +++ b/dgit @@ -96,6 +96,7 @@ our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?"; our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$'; our $splitbraincache = 'dgit-intern/quilt-cache'; +our $rewritemap = 'dgit-rewrite/map'; our (@git) = qw(git); our (@dget) = qw(dget); @@ -141,7 +142,7 @@ our %opts_cfg_insertpos = map { scalar @{ $opts_opt_map{$_} } } keys %opts_opt_map; -sub finalise_opts_opts(); +sub parseopts_late_defaults(); our $keyid; @@ -184,30 +185,6 @@ sub lref () { return "refs/heads/".lbranch(); } 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+\://; @@ -682,7 +659,9 @@ sub git_get_config ($) { 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". @@ -698,7 +677,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"; @@ -726,7 +708,10 @@ sub access_basedistro () { sub access_nomdistro () { my $base = access_basedistro(); - return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base; + my $r = cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base; + $r =~ m/^$distro_re$/ or badcfg + "bad syntax for (nominal) distro \`$r' (does not match /^$distro_re$/)"; + return $r; } sub access_quirk () { @@ -790,11 +775,11 @@ sub pushing () { Push failed, before we got started. You can retry the push, after fixing the problem, if you like. END - finalise_opts_opts(); + parseopts_late_defaults(); } sub notpushing () { - finalise_opts_opts(); + parseopts_late_defaults(); } sub supplementary_message ($) { @@ -1679,6 +1664,7 @@ sub create_remote_git_repo () { } our ($dsc_hash,$lastpush_mergeinput); +our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url); our $ud = '.git/dgit/unpack'; @@ -2367,6 +2353,8 @@ END my $path = $ENV{PATH} or die; foreach my $use_absurd (qw(0 1)) { + runcmd @git, qw(checkout -q unpa); + runcmd @git, qw(update-ref -d refs/heads/patch-queue/unpa); local $ENV{PATH} = $path; if ($use_absurd) { chomp $@; @@ -2500,18 +2488,34 @@ sub ensure_we_have_orig () { } } -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, 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 (@specs) = @_; # This is rather miserable: # When git fetch --prune is passed a fetchspec ending with a *, @@ -2535,7 +2539,7 @@ sub git_fetch_us () { # 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"; + printdebug "git_lrfetch_sane specs @specs\n"; my $specre = join '|', map { my $x = $_; @@ -2543,7 +2547,7 @@ sub git_fetch_us () { $x =~ s/\\\*$/.*/; "(?: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; @@ -2552,7 +2556,7 @@ sub git_fetch_us () { 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!"; } @@ -2584,11 +2588,12 @@ 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; + @fspecs + if @fspecs; %lrfetchrefs_f = (); my %objgot; @@ -2640,8 +2645,25 @@ 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); +} + +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 @specs; my %here; my @tagpats = debiantags('*',access_nomdistro); @@ -2668,6 +2690,8 @@ END }); } +#---------- dsc and archive handling ---------- + sub mergeinfo_getclogp ($) { # Ensures thit $mi->{Clogp} exists and returns it my ($mi) = @_; @@ -2696,6 +2720,49 @@ sub fetch_from_archive_record_2 ($) { } } +sub parse_dsc_field ($$) { + my ($dsc, $what) = @_; + my $f; + foreach my $field (@ourdscfield) { + $f = $dsc->{$field}; + last if defined $f; + } + if (!defined $f) { + progress "$what: NO git hash"; + } 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 $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!"; + + $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"; + } + } +} + sub fetch_from_archive () { ensure_setup_existing_tree(); @@ -2707,17 +2774,9 @@ sub fetch_from_archive () { get_archive_dsc(); if ($dsc) { - foreach my $field (@ourdscfield) { - $dsc_hash = $dsc->{$field}; - last if defined $dsc_hash; - } - if (defined $dsc_hash) { - $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'"; - $dsc_hash = $&; - progress "last upload to archive specified git hash"; - } else { - progress "last upload to archive has NO git hash"; - } + parse_dsc_field($dsc, 'last upload to archive'); + resolve_dsc_field_commit access_basedistro, + lrfetchrefs."/".$rewritemap } else { progress "no version available from the archive"; } @@ -3536,7 +3595,7 @@ tree $tree parent $dgitview parent $archive_hash author $authline -commiter $authline +committer $authline $msg_msg @@ -3707,7 +3766,11 @@ sub push_mktags ($$ $$ $) { die unless $tagwants->[0]{View} eq 'dgit'; - $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid}; + my $declaredistro = access_nomdistro(); + my $reader_giturl = do { local $access_forpush=0; access_giturl(); }; + $dsc->{$ourdscfield[0]} = join " ", + $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag}, + $reader_giturl; $dsc->save("$dscfn.tmp") or die $!; my $changes = parsecontrol($changesfile,$changesfilewhat); @@ -3724,7 +3787,6 @@ sub push_mktags ($$ $$ $) { # to control the "tagger" (b) we can do remote signing my $authline = clogp_authline $clogp; my $delibs = join(" ", "",@deliberatelies); - my $declaredistro = access_nomdistro(); my $mktag = sub { my ($tw) = @_; @@ -4060,7 +4122,6 @@ END sub cmd_clone { parseopts(); - notpushing(); my $dstdir; badusage "-p is not allowed with clone; specify as argument instead" if defined $package; @@ -4075,8 +4136,9 @@ sub cmd_clone { } else { badusage "incorrect arguments to dgit clone"; } - $dstdir ||= "$package"; + notpushing(); + $dstdir ||= "$package"; if (stat_exists $dstdir) { fail "$dstdir already exists"; } @@ -4115,7 +4177,6 @@ sub branchsuite () { } sub fetchpullargs () { - notpushing(); if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; @@ -4131,6 +4192,7 @@ sub fetchpullargs () { } else { badusage "incorrect arguments to dgit fetch or dgit pull"; } + notpushing(); } sub cmd_fetch { @@ -4460,7 +4522,7 @@ END local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; local $ENV{'VISUAL'} = $ENV{'EDITOR'}; local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn; - runcmd @dpkgsource, qw(--commit .), $patchname; + runcmd @dpkgsource, qw(--commit --include-removal .), $patchname; } } @@ -4495,17 +4557,21 @@ sub quiltify_trees_differ ($$;$$$) { if ($unrepres) { eval { - die "deleted\n" unless $newmode =~ m/[^0]/; - die "not a plain file\n" unless $newmode =~ m/^10\d{4}$/; - if ($oldmode =~ m/[^0]/) { + die "not a plain file\n" + unless $newmode =~ m/^10\d{4}$/ || + $oldmode =~ m/^10\d{4}$/; + if ($oldmode =~ m/[^0]/ && + $newmode =~ m/[^0]/) { die "mode changed\n" if $oldmode ne $newmode; } else { - die "non-default mode\n" unless $newmode =~ m/^100644$/; + die "non-default mode\n" + unless $newmode =~ m/^100644$/ || + $oldmode =~ m/^100644$/; } }; if ($@) { local $/="\n"; chomp $@; - push @$unrepres, [ $f, $@ ]; + push @$unrepres, [ $f, "$@ ($oldmode->$newmode)" ]; } } @@ -5617,6 +5683,7 @@ sub postbuild_mergechanges_vanilla ($) { } sub cmd_build { + build_prep_early(); my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV); my $wantsrc = massage_dbp_args \@dbp; if ($wantsrc > 0) { @@ -5709,6 +5776,7 @@ sub cmd_gbp_build { sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0 sub build_source { + build_prep_early(); my $our_cleanmode = $cleanmode; if ($need_split_build_invocation) { # Pretend that clean is being done some other way. This @@ -5769,6 +5837,7 @@ sub build_source { } sub cmd_build_source { + build_prep_early(); badusage "build-source takes no additional arguments" if @ARGV; build_source(); maybe_unapply_patches_again(); @@ -5797,10 +5866,7 @@ END sub cmd_quilt_fixup { badusage "incorrect arguments to dgit quilt-fixup" if @ARGV; - my $clogp = parsechangelog(); - $version = getfield $clogp, 'Version'; - $package = getfield $clogp, 'Source'; - check_not_dirty(); + build_prep_early(); clean_tree(); build_maybe_quilt_fixup(); } @@ -5868,30 +5934,30 @@ sub cmd_import_dsc { parse_dscdata(); - my $dgit_commit = $dsc->{$ourdscfield[0]}; - if (defined $dgit_commit && - !forceing [qw(import-dsc-with-dgit-field)]) { - $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc"; + parse_dsc_field($dsc, "Dgit metadata in .dsc"); + + if (defined $dsc_hash + && !forceing [qw(import-dsc-with-dgit-field)]) { progress "dgit: import-dsc of .dsc with Dgit field, using git hash"; my @cmd = (qw(sh -ec), - "echo $dgit_commit | git cat-file --batch-check"); + "echo $dsc_hash | git cat-file --batch-check"); my $objgot = cmdoutput @cmd; if ($objgot =~ m#^\w+ missing\b#) { fail < 0) { progress "Not fast forward, forced update."; } else { - fail "Not fast forward to $dgit_commit"; + fail "Not fast forward to $dsc_hash"; } } @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info", - $dstbranch, $dgit_commit); + $dstbranch, $dsc_hash); runcmd @cmd; progress "dgit: import-dsc updated git ref $dstbranch"; return 0; @@ -5938,10 +6004,14 @@ END progress "Import, merging."; my $tree = cmdoutput @git, qw(rev-parse), "$newhash:"; my $version = getfield $dsc, 'Version'; + my $clogp = commit_getclogp $newhash; + my $authline = clogp_authline $clogp; $newhash = make_commit_text <() if $pre_fn; -if (!defined $rmchanges) { - local $access_forpush; - $rmchanges = access_cfg_bool(0, 'rm-old-changes'); -} - -if (!defined $quilt_mode) { - local $access_forpush; - $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF') - // access_cfg('quilt-mode', 'RETURN-UNDEF') - // 'linear'; - $quilt_mode =~ m/^($quilt_modes_re)$/ - or badcfg "unknown quilt-mode \`$quilt_mode'"; - $quilt_mode = $1; -} - -if (!defined $dodep14tag) { - local $access_forpush; - $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want'; - $dodep14tag =~ m/^($dodep14tag_re)$/ - or badcfg "unknown dep14tag setting \`$dodep14tag'"; - $dodep14tag = $1; -} - -$need_split_build_invocation ||= quiltmode_splitbrain(); - -if (!defined $cleanmode) { - local $access_forpush; - $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF'); - $cleanmode //= 'dpkg-source'; - - badcfg "unknown clean-mode \`$cleanmode'" unless - $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s; -} - my $fn = ${*::}{"cmd_$cmd"}; $fn or badusage "unknown operation $cmd"; $fn->();