X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=b9b47eb3cde5cd4ab19b02b5378d698294038ffd;hb=d2cfebaad77a978ef2849cddc96740aef39c2d32;hp=39efa04a2189491f45441039c45f2320c1a22ad4;hpb=bd57c194e497ba2c327dde5400e14b573733c21a;p=dgit.git diff --git a/dgit b/dgit index 39efa04a..b9b47eb3 100755 --- a/dgit +++ b/dgit @@ -63,9 +63,9 @@ our $existing_package = 'dpkg'; our $cleanmode; our $changes_since_version; our $rmchanges; -our $overwrite_version; +our $overwrite_version; # undef: not specified; '': check changelog our $quilt_mode; -our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|unapplied'; +our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied'; our $we_are_responder; our $initiator_tempdir; our $patches_applied_dirtily = 00; @@ -150,6 +150,8 @@ sub debiantag_maintview ($$) { return "$distro/$v"; } +sub madformat ($) { $_[0] eq '3.0 (quilt)' } + sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } @@ -534,11 +536,16 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', 'dgit.default.dgit-tag-format' => 'old,new,maint', + # 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" + # hist means "repo server may have old pushes without new tag" + # ("hist" is implied by "old") 'dgit-distro.debian.archive-query' => 'ftpmasterapi:', 'dgit-distro.debian.git-check' => 'url', 'dgit-distro.debian.git-check-suffix' => '/info/refs', 'dgit-distro.debian.new-private-pushers' => 't', - 'dgit-distro.debian.dgit-tag-format' => 'old', + 'dgit-distro.debian.dgit-tag-format' => 'new', 'dgit-distro.debian/push.git-url' => '', 'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org', 'dgit-distro.debian/push.git-user-force' => 'dgit', @@ -867,11 +874,11 @@ sub getfield ($$) { my ($dctrl,$field) = @_; my $v = $dctrl->{$field}; return $v if defined $v; - fail "missing field $field in ".$v->get_option('name'); + fail "missing field $field in ".$dctrl->get_option('name'); } sub parsechangelog { - my $c = Dpkg::Control::Hash->new(); + my $c = Dpkg::Control::Hash->new(name => 'parsed changelog'); my $p = new IO::Handle; my @cmd = (qw(dpkg-parsechangelog), @_); open $p, '-|', @cmd or die $!; @@ -1194,7 +1201,7 @@ sub select_tagformat () { die 'bug' if $tagformatfn && $tagformat_want; # ... $tagformat_want assigned after previous select_tagformat - my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats(); + my (@supported) = grep { $_ =~ m/^(?:old|new)$/ } access_cfg_tagformats(); printdebug "select_tagformat supported @supported\n"; $tagformat_want //= [ $supported[0], "distro access configuration", 0 ]; @@ -1340,6 +1347,7 @@ sub prep_ud (;$) { sub mktree_in_ud_here () { runcmd qw(git init -q); + runcmd qw(git config gc.auto 0); rmtree('.git/objects'); symlink '../../../../objects','.git/objects' or die $!; } @@ -1366,20 +1374,25 @@ sub remove_stray_gits () { $!=0; $?=0; close GITS or failedcmd @gitscmd; } -sub mktree_in_ud_from_only_subdir () { +sub mktree_in_ud_from_only_subdir (;$) { + my ($raw) = @_; + # changes into the subdir my (@dirs) = <*/.>; - die "@dirs ?" unless @dirs==1; + die "expected one subdir but found @dirs ?" unless @dirs==1; $dirs[0] =~ m#^([^/]+)/\.$# or die; my $dir = $1; changedir $dir; remove_stray_gits(); mktree_in_ud_here(); - my ($format, $fopts) = get_source_format(); - if (madformat($format)) { - rmtree '.pc'; + if (!$raw) { + my ($format, $fopts) = get_source_format(); + if (madformat($format)) { + rmtree '.pc'; + } } + runcmd @git, qw(add -Af); my $tree=git_write_tree(); return ($tree,$dir); @@ -1416,12 +1429,20 @@ sub dsc_files () { map { $_->{Filename} } dsc_files_info(); } -sub is_orig_file ($;$) { - local ($_) = $_[0]; - my $base = $_[1]; - m/\.orig(?:-\w+)?\.tar\.\w+$/ or return 0; - defined $base or return 1; - return $` eq $base; +sub is_orig_file_in_dsc ($$) { + my ($f, $dsc_files_info) = @_; + return 0 if @$dsc_files_info <= 1; + # One file means no origs, and the filename doesn't have a "what + # part of dsc" component. (Consider versions ending `.orig'.) + return 0 unless $f =~ m/\.orig(?:-\w+)?\.tar(?:\.\w+)?$/; + return 1; +} + +sub is_orig_file_of_vsn ($$) { + my ($f, $upstreamvsn) = @_; + my $base = srcfn $upstreamvsn, ''; + return 0 unless $f =~ m/^\Q$base\E\.orig(?:-\w+)?\.tar(?:\.\w+)?$/; + return 1; } sub make_commit ($) { @@ -1429,6 +1450,27 @@ sub make_commit ($) { return cmdoutput @git, qw(hash-object -w -t commit), $file; } +sub make_commit_text ($) { + my ($text) = @_; + my ($out, $in); + my @cmd = (@git, qw(hash-object -w -t commit --stdin)); + debugcmd "|",@cmd; + my $child = open2($out, $in, @cmd) or die $!; + my $h; + eval { + print $in $text or die $!; + close $in or die $!; + $h = <$out>; + $h =~ m/^\w+$/ or die; + $h = $&; + printdebug "=> $h\n"; + }; + close $out; + waitpid $child, 0 == $child or die "$child $!"; + $? and failedcmd @cmd; + return $h; +} + sub clogp_authline ($) { my ($clogp) = @_; my $author = getfield $clogp, 'Maintainer'; @@ -1510,7 +1552,8 @@ sub generate_commits_from_dsc () { prep_ud(); changedir $ud; - foreach my $fi (dsc_files_info()) { + my @dfi = dsc_files_info(); + foreach my $fi (@dfi) { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; @@ -1521,7 +1564,7 @@ sub generate_commits_from_dsc () { complete_file_from_dsc('.', $fi) or next; - if (is_orig_file($f)) { + if (is_orig_file_in_dsc($f, \@dfi)) { link $f, "../../../../$f" or $!==&EEXIST or die "$f $!"; @@ -1557,12 +1600,14 @@ END close C or die $!; my $rawimport_hash = make_commit qw(../commit.tmp); my $cversion = getfield $clogp, 'Version'; + progress "synthesised git commit from .dsc $cversion"; + my $rawimport_mergeinput = { Commit => $rawimport_hash, Info => "Import of source package", }; my @output = ($rawimport_mergeinput); - progress "synthesised git commit from .dsc $cversion"; + if ($lastpush_mergeinput) { my $oldclogp = mergeinfo_getclogp($lastpush_mergeinput); my $oversion = getfield $oldclogp, 'Version'; @@ -1630,9 +1675,10 @@ sub complete_file_from_dsc ($$) { } sub ensure_we_have_orig () { - foreach my $fi (dsc_files_info()) { + my @dfi = dsc_files_info(); + foreach my $fi (@dfi) { my $f = $fi->{Filename}; - next unless is_orig_file($f); + next unless is_orig_file_in_dsc($f, \@dfi); complete_file_from_dsc('..', $fi) or next; } @@ -1895,7 +1941,7 @@ sub fetch_from_archive () { # Finally: we do not necessarily reify the public view (as # described above). This is so that we do not end up stacking two # pseudo-merges. So what we actually do is figure out the inputs - # to any public view psuedo-merge and put them in @mergeinputs. + # to any public view pseudo-merge and put them in @mergeinputs. my @mergeinputs; # $mergeinputs[]{Commit} @@ -2340,7 +2386,7 @@ sub get_source_format () { return ($_, \%options); } -sub madformat ($) { +sub madformat_wantfixup ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; our $quilt_mode_warned; @@ -2355,6 +2401,108 @@ sub madformat ($) { return 1; } +# An "infopair" is a tuple [ $thing, $what ] +# (often $thing is a commit hash; $what is a description) + +sub infopair_cond_equal ($$) { + my ($x,$y) = @_; + $x->[0] eq $y->[0] or fail <[1] ($x->[0]) not equal to $y->[1] ($y->[0]) +END +}; + +sub infopair_lrf_tag_lookup ($$) { + my ($tagnames, $what) = @_; + # $tagname may be an array ref + my @tagnames = ref $tagnames ? @$tagnames : ($tagnames); + printdebug "infopair_lrfetchref_tag_lookup $what @tagnames\n"; + foreach my $tagname (@tagnames) { + my $lrefname = lrfetchrefs."/tags/$tagname"; + my $tagobj = $lrfetchrefs_f{$lrefname}; + next unless defined $tagobj; + printdebug "infopair_lrfetchref_tag_lookup $tagobj $tagname $what\n"; + return [ git_rev_parse($tagobj), $what ]; + } + fail @tagnames==1 ? <[0], $desc->[0]) or fail <[1] ($anc->[0]) .. $desc->[1] ($desc->[0]) is not fast forward +END +}; + +sub pseudomerge_version_check ($$) { + my ($clogp, $archive_hash) = @_; + + my $arch_clogp = commit_getclogp $archive_hash; + my $i_arch_v = [ (getfield $arch_clogp, 'Version'), + 'version currently in archive' ]; + if (defined $overwrite_version) { + if (length $overwrite_version) { + infopair_cond_equal([ $overwrite_version, + '--overwrite= version' ], + $i_arch_v); + } else { + my $v = $i_arch_v->[0]; + progress "Checking package changelog for archive version $v ..."; + eval { + my @xa = ("-f$v", "-t$v"); + my $vclogp = parsechangelog @xa; + my $cv = [ (getfield $vclogp, 'Version'), + "Version field from dpkg-parsechangelog @xa" ]; + infopair_cond_equal($i_arch_v, $cv); + }; + if ($@) { + $@ =~ s/^dgit: //gm; + fail "$@". + "Perhaps debian/changelog does not mention $v ?"; + } + } + } + + printdebug "pseudomerge_version_check i_arch_v @$i_arch_v\n"; + return $i_arch_v; +} + +sub pseudomerge_make_commit ($$$$ $$) { + my ($clogp, $dgitview, $archive_hash, $i_arch_v, + $msg_cmd, $msg_msg) = @_; + progress "Declaring that HEAD inciudes all changes in $i_arch_v->[0]..."; + + my $tree = cmdoutput qw(git rev-parse), "${dgitview}:"; + my $authline = clogp_authline $clogp; + + chomp $msg_msg; + $msg_cmd .= + !defined $overwrite_version ? "" + : !length $overwrite_version ? " --overwrite" + : " --overwrite=".$overwrite_version; + + mkpath '.git/dgit'; + my $pmf = ".git/dgit/pseudomerge"; + open MC, ">", $pmf or die "$pmf $!"; + print MC < $merged_dgitview @@ -2371,97 +2519,73 @@ sub splitbrain_pseudomerge ($$$$) { # this: $dgitview' # - # We work with tuples [ $thing, $what ] - # (often $thing is a commit hash; $what is a description) - - my $tag_lookup = sub { - my ($tagname, $what) = @_; - printdebug "splitbrain_pseudomerge tag_lookup $what\n"; - my $lrefname = lrfetchrefs."/tags/$tagname"; - my $tagobj = $lrfetchrefs_f{$lrefname}; - defined $tagobj or fail <[0] eq $y->[0] or fail <[1] ($x->[0]) not equal to $y->[1] ($y->[0]) -END - }; - my $cond_ff = sub { - my ($anc,$desc) = @_; - is_fast_fwd($anc->[0], $desc->[0]) or fail <[1] ($anc->[0]) .. $desc->[1] ($desc->[0]) is not fast forward -END - }; + printdebug "splitbrain_pseudomerge...\n"; - my $arch_clogp = commit_getclogp $archive_hash; - my $i_arch_v = [ (getfield $arch_clogp, 'Version'), - 'version currently in archive' ]; - - printdebug "splitbrain_pseudomerge i_arch_v @$i_arch_v\n"; + my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); return $dgitview unless defined $archive_hash; - if ($overwrite_version) { - progress "Declaring that HEAD inciudes all changes in archive..."; - progress "Checking that $overwrite_version does so..."; - $cond_equal->([ $overwrite_version, '--overwrite= version' ], - $i_arch_v); - } else { + if (!defined $overwrite_version) { progress "Checking that HEAD inciudes all changes in archive..."; } return $dgitview if is_fast_fwd $archive_hash, $dgitview; my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; - my $i_dep14 = $tag_lookup->($t_dep14, "maintainer view tag"); + my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; - my $i_dgit = $tag_lookup->($t_dgit, "dgit view tag"); + my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); my $i_archive = [ $archive_hash, "current archive contents" ]; printdebug "splitbrain_pseudomerge i_archive @$i_archive\n"; - $cond_equal->($i_dgit, $i_archive); - $cond_ff->($i_dep14, $i_dgit); - $overwrite_version or $cond_ff->($i_dep14, [ $maintview, 'HEAD' ]); + infopair_cond_equal($i_dgit, $i_archive); + infopair_cond_ff($i_dep14, $i_dgit); + $overwrite_version // infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); - my $tree = cmdoutput qw(git rev-parse), "${dgitview}:"; - my $authline = clogp_authline $clogp; + my $r = pseudomerge_make_commit + $clogp, $dgitview, $archive_hash, $i_arch_v, + "dgit --quilt=$quilt_mode", + (defined $overwrite_version ? <[0] +END_MAKEFF - mkpath '.git/dgit'; - my $pmf = ".git/dgit/pseudomerge"; - open MC, ">", $pmf or die "$pmf $!"; - print MC <[0] into dgit view."; + return $r; +} -END - if ($overwrite_version) { - print MC <[0] + printdebug "plain_overwrite_pseudomerge..."; -[dgit --quilt=$quilt_mode] -END - } - close MC or die $!; + my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); - progress "Making pseudo-merge of $i_arch_v->[0] into dgit view."; - return make_commit($pmf); -} + my @tagformats = access_cfg_tagformats(); + my @t_overwr = + map { $_->($i_arch_v->[0], access_basedistro) } + (grep { m/^(?:old|hist)$/ } @tagformats) + ? \&debiantags : \&debiantag_new; + my $i_overwr = infopair_lrf_tag_lookup \@t_overwr, "previous version tag"; + my $i_archive = [ $archive_hash, "current archive contents" ]; + + infopair_cond_equal($i_overwr, $i_archive); + + return $head if is_fast_fwd $archive_hash, $head; + + my $m = "Declare fast forward from $i_arch_v->[0]"; + + my $r = pseudomerge_make_commit + $clogp, $head, $archive_hash, $i_arch_v, + "dgit", $m; + + runcmd @git, qw(update-ref -m), $m, 'HEAD', $r, $head; + + progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD."; + return $r; +} sub push_parse_changelog ($) { my ($clogpfn) = @_; @@ -2666,7 +2790,7 @@ END my $dgithead = $actualhead; my $maintviewhead = undef; - if (madformat($format)) { + if (madformat_wantfixup($format)) { # user might have not used dgit build, so maybe do this now: if (quiltmode_splitbrain()) { my $upstreamversion = $clogp->{Version}; @@ -2690,6 +2814,12 @@ END } } + if (defined $overwrite_version && !defined $maintviewhead) { + $dgithead = plain_overwrite_pseudomerge($clogp, + $dgithead, + $archive_hash); + } + check_not_dirty(); my $forceflag = ''; @@ -2701,10 +2831,10 @@ END } else { fail "dgit push: HEAD is not a descendant". " of the archive's version.\n". - "dgit: To overwrite its contents,". - " use git merge -s ours ".lrref().".\n". - "dgit: To rewind history, if permitted by the archive,". - " use --deliberately-not-fast-forward"; + "To overwrite the archive's contents,". + " pass --overwrite[=VERSION].\n". + "To rewind history, if permitted by the archive,". + " use --deliberately-not-fast-forward."; } } @@ -2748,7 +2878,7 @@ END responder_send_command("param head $dgithead"); responder_send_command("param csuite $csuite"); responder_send_command("param tagformat $tagformat"); - if (quiltmode_splitbrain) { + if (defined $maintviewhead) { die unless ($protovsn//4) >= 4; responder_send_command("param maint-view $maintviewhead"); } @@ -3315,6 +3445,13 @@ sub quiltify_splitbrain ($$$$$$) { } fail $msg; } + if ($quilt_mode =~ m/dpm/ && + ($diffbits->{H2A} & 01)) { + fail <{O2A} & 01)) { # some patches quiltify_splitbrain_needed(); @@ -3324,6 +3461,14 @@ sub quiltify_splitbrain ($$$$$$) { runcmd @git, qw(update-ref refs/heads/dgit-view HEAD); runcmd @git, qw(checkout -q dgit-view); } + if ($quilt_mode =~ m/gbp|dpm/ && + ($diffbits->{O2A} & 02)) { + fail <{H2O} & 02) && # user has modified .gitignore !($diffbits->{O2A} & 02)) { # patches do not change .gitignore quiltify_splitbrain_needed(); @@ -3586,11 +3731,21 @@ sub quiltify ($$$$) { sub build_maybe_quilt_fixup () { my ($format,$fopts) = get_source_format; - return unless madformat $format; + return unless madformat_wantfixup $format; # sigh check_for_vendor_patches(); + if (quiltmode_splitbrain) { + foreach my $needtf (qw(new maint)) { + next if grep { $_ eq $needtf } access_cfg_tagformats; + fail <($b); @@ -3660,12 +3815,12 @@ sub quilt_fixup_singlepatch ($$$) { rmtree("debian/patches"); runcmd @dpkgsource, qw(-b .); - chdir ".."; + changedir ".."; runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc"); rename srcfn("$upstreamversion", "/debian/patches"), "work/debian/patches"; - chdir "work"; + changedir "work"; commit_quilty_patch(); } @@ -4478,6 +4633,12 @@ sub parseopts () { } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; + } elsif (m/^--overwrite$/s) { + push @ropts, $_; + $overwrite_version = ''; + } elsif (m/^--overwrite=(.+)$/s) { + push @ropts, $_; + $overwrite_version = $1; } elsif (m/^--(no-)?rm-old-changes$/s) { push @ropts, $_; $rmchanges = !$1;