X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=396213475b9cc38ce8d8a63a44231ffe60e329b4;hp=c1723aaa9d86bfff154f9addd9aa3c2a6fe8288a;hb=27ecf86e831ab5a4908a2d0541e0e987e39da48e;hpb=0fff95723de605e7239934f05b506a01bfec9ec9 diff --git a/dgit b/dgit index c1723aaa..39621347 100755 --- a/dgit +++ b/dgit @@ -78,7 +78,7 @@ our $overwrite_version; # undef: not specified; '': check changelog our $quilt_mode; our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied'; our $dodep14tag; -our $split_brain_save; +our %internal_object_save; our $we_are_responder; our $we_are_initiator; our $initiator_tempdir; @@ -100,9 +100,6 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); our $suite_re = '[-+.0-9a-z]+'; our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none'; -our $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?}; -our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)'; -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'; @@ -129,6 +126,8 @@ our (@mergechanges) = qw(mergechanges -f); our (@gbp_build) = (''); our (@gbp_pq) = ('gbp pq'); our (@changesopts) = (''); +our (@pbuilder) = ("sudo -E pbuilder"); +our (@cowbuilder) = ("sudo -E cowbuilder"); our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'curl' => \@curl, @@ -148,7 +147,9 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'gbp-build' => \@gbp_build, 'gbp-pq' => \@gbp_pq, 'ch' => \@changesopts, - 'mergechanges' => \@mergechanges); + 'mergechanges' => \@mergechanges, + 'pbuilder' => \@pbuilder, + 'cowbuilder' => \@cowbuilder); our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1); our %opts_cfg_insertpos = map { @@ -197,15 +198,13 @@ sub lref () { return "refs/heads/".lbranch(); } sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); } sub rrref () { return server_ref($csuite); } -sub stripepoch ($) { - my ($vsn) = @_; - $vsn =~ s/^\d+\://; - return $vsn; -} - sub srcfn ($$) { - my ($vsn,$sfx) = @_; - return "${package}_".(stripepoch $vsn).$sfx + my ($vsn, $sfx) = @_; + return &source_file_leafname($package, $vsn, $sfx); +} +sub is_orig_file_of_vsn ($$) { + my ($f, $upstreamvsn) = @_; + return is_orig_file_of_p_v($f, $package, $upstreamvsn); } sub dscfn ($) { @@ -218,12 +217,6 @@ sub changespat ($;$) { return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes"; } -sub upstreamversion ($) { - my ($vsn) = @_; - $vsn =~ s/-[^-]+$//; - return $vsn; -} - our $us = 'dgit'; initdebug(''); @@ -296,6 +289,14 @@ sub bpd_abs () { return $r; } +sub get_tree_of_commit ($) { + my ($commitish) = @_; + my $cdata = cmdoutput @git, qw(cat-file commit), $commitish; + $cdata =~ m/\n\n/; $cdata = $`; + $cdata =~ m/^tree (\w+)$/m or confess "cdata $cdata ?"; + return $1; +} + sub branch_gdr_info ($$) { my ($symref, $head) = @_; my ($status, $msg, $current, $ffq_prev, $gdrlast) = @@ -307,21 +308,91 @@ sub branch_gdr_info ($$) { return ($ffq_prev, $gdrlast); } -sub branch_is_gdr ($$) { - my ($symref, $head) = @_; - my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head); - return 0 unless $ffq_prev || $gdrlast; - return 1; -} - sub branch_is_gdr_unstitched_ff ($$$) { my ($symref, $head, $ancestor) = @_; my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head); return 0 unless $ffq_prev; - return 0 unless is_fast_fwd $ancestor, $ffq_prev; + return 0 unless !defined $ancestor or is_fast_fwd $ancestor, $ffq_prev; return 1; } +sub branch_is_gdr ($) { + my ($head) = @_; + # This is quite like git-debrebase's keycommits. + # We have our own implementation because: + # - our algorighm can do fewer tests so is faster + # - it saves testing to see if gdr is installed + + # NB we use this jsut for deciding whether to run gdr make-patches + # Before reusing this algorithm for somthing else, its + # suitability should be reconsidered. + + my $walk = $head; + local $Debian::Dgit::debugcmd_when_debuglevel = 3; + printdebug "branch_is_gdr $head...\n"; + my $get_patches = sub { + my $t = git_cat_file "$_[0]:debian/patches", [qw(missing tree)]; + return $t // ''; + }; + my $tip_patches = $get_patches->($head); + WALK: + for (;;) { + my $cdata = git_cat_file $walk, 'commit'; + my ($hdrs,$msg) = $cdata =~ m{\n\n} ? ($`,$') : ($cdata,''); + if ($msg =~ m{^\[git-debrebase\ ( + anchor | changelog | make-patches | + merged-breakwater | pseudomerge + ) [: ] }mx) { + # no need to analyse this - it's sufficient + # (gdr classifications: Anchor, MergedBreakwaters) + # (made by gdr: Pseudomerge, Changelog) + printdebug "branch_is_gdr $walk gdr $1 YES\n"; + return 1; + } + my @parents = ($hdrs =~ m/^parent (\w+)$/gm); + if (@parents==2) { + my $walk_tree = get_tree_of_commit $walk; + foreach my $p (@parents) { + my $p_tree = get_tree_of_commit $p; + if ($p_tree eq $walk_tree) { # pseudomerge contriburor + # (gdr classification: Pseudomerge; not made by gdr) + printdebug "branch_is_gdr $walk unmarked pseudomerge\n" + if $debuglevel >= 2; + $walk = $p; + next WALK; + } + } + # some other non-gdr merge + # (gdr classification: VanillaMerge, DgitImportUnpatched, ?) + printdebug "branch_is_gdr $walk ?-2-merge NO\n"; + return 0; + } + if (@parents>2) { + # (gdr classification: ?) + printdebug "branch_is_gdr $walk ?-octopus NO\n"; + return 0; + } + if ($get_patches->($walk) ne $tip_patches) { + # Our parent added, removed, or edited patches, and wasn't + # a gdr make-patches commit. gdr make-patches probably + # won't do that well, then. + # (gdr classification of parent: AddPatches or ?) + printdebug "branch_is_gdr $walk ?-patches NO\n"; + return 0; + } + if ($tip_patches eq '' and + !defined git_cat_file "$walk:debian") { + # (gdr classification of parent: BreakwaterStart + printdebug "branch_is_gdr $walk unmarked BreakwaterStart YES\n"; + return 1; + } + # (gdr classification: Upstream Packaging Mixed Changelog) + printdebug "branch_is_gdr $walk plain\n" + if $debuglevel >= 2; + $walk = $parents[0]; + } +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -571,6 +642,7 @@ main usages: dgit [dgit-opts] fetch|pull [dgit-opts] [suite] dgit [dgit-opts] build [dpkg-buildpackage-opts] dgit [dgit-opts] sbuild [sbuild-opts] + dgit [dgit-opts] pbuilder|cowbuilder [debbuildopts] dgit [dgit-opts] push [dgit-opts] [suite] dgit [dgit-opts] push-source [dgit-opts] [suite] dgit [dgit-opts] rpush build-host:build-dir ... @@ -819,7 +891,8 @@ sub access_forpush () { } sub pushing () { - die "$access_forpush ?" if ($access_forpush // 1) ne 1; + confess 'internal error '.Dumper($access_forpush)," ?" if + defined $access_forpush and !$access_forpush; badcfg "pushing but distro is configured readonly" if access_forpush_config() eq '0'; $access_forpush = 1; @@ -1083,7 +1156,7 @@ sub canonicalise_suite_ftpmasterapi { } qw(codename name); push @matched, $entry; } - fail "unknown suite $isuite" unless @matched; + fail "unknown suite $isuite, maybe -d would help" unless @matched; my $cn; eval { @matched==1 or die "multiple matches for suite $isuite\n"; @@ -1861,13 +1934,6 @@ sub is_orig_file_in_dsc ($$) { return 1; } -sub is_orig_file_of_vsn ($$) { - my ($f, $upstreamvsn) = @_; - my $base = srcfn $upstreamvsn, ''; - return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/; - return 1; -} - # This function determines whether a .changes file is source-only from # the point of view of dak. Thus, it permits *_source.buildinfo # files. @@ -2003,28 +2069,6 @@ 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; - print Dumper($text) if $debuglevel > 1; - 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'; @@ -3198,10 +3242,7 @@ END # here we go, then: my $tree_commit = $mergeinputs[0]{Commit}; - my $tree = cmdoutput @git, qw(cat-file commit), $tree_commit; - $tree =~ m/\n\n/; $tree = $`; - $tree =~ m/^tree (\w+)$/m or die "$dsc_hash tree ?"; - $tree = $1; + my $tree = get_tree_of_commit $tree_commit;; # We use the changelog author of the package in question the # author of this pseudo-merge. This is (roughly) correct if @@ -3469,7 +3510,7 @@ END sub multisuite_suite_child ($$$) { - my ($tsuite, $merginputs, $fn) = @_; + my ($tsuite, $mergeinputs, $fn) = @_; # in child, sets things up, calls $fn->(), and returns undef # in parent, returns canonical suite name for $tsuite my $canonsuitefh = IO::File::new_tmpfile; @@ -3496,7 +3537,7 @@ sub multisuite_suite_child ($$$) { return $csuite; } printdebug "multisuite $tsuite ok (canon=$csuite)\n"; - push @$merginputs, { + push @$mergeinputs, { Ref => lrref, Info => $csuite, }; @@ -3540,7 +3581,6 @@ sub fork_for_multisuite ($) { fetch_one(); finish 0; }); - # xxx collecte the ref here $csubsuite =~ s/^\Q$cbasesuite\E-/-/; push @csuites, $csubsuite; @@ -3831,13 +3871,14 @@ sub madformat_wantfixup ($) { sub maybe_split_brain_save ($$$) { my ($headref, $dgitview, $msg) = @_; # => message fragment "$saved" describing disposition of $dgitview - return "commit id $dgitview" unless defined $split_brain_save; + my $save = $internal_object_save{'dgit-view'}; + return "commit id $dgitview" unless defined $save; my @cmd = (shell_cmd 'cd "$1"; shift', $maindir, git_update_ref_cmd "dgit --dgit-view-save $msg HEAD=$headref", - $split_brain_save, $dgitview); + $save, $dgitview); runcmd @cmd; - return "and left in $split_brain_save"; + return "and left in $save"; } # An "infopair" is a tuple [ $thing, $what ] @@ -4269,6 +4310,15 @@ END my $actualhead = git_rev_parse('HEAD'); if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) { + if (quiltmode_splitbrain()) { + my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $actualhead); + fail <= 4; + confess "internal error (protovsn=$protovsn)" + if defined $protovsn and $protovsn < 4; responder_send_command("param maint-view $maintviewhead"); } @@ -4509,9 +4560,8 @@ END supplementary_message(<<'END'); Push failed, while obtaining signatures on the .changes and .dsc. If it was just that the signature failed, you may try again by using -debsign by hand to sign the changes - $changesfile -and then dput to complete the upload. +debsign by hand to sign the changes file (see the command dgit tried, +above), and then dput that changes file to complete the upload. If you need to change the package, you must use a new version number. END if ($we_are_responder) { @@ -5261,29 +5311,7 @@ END my $dgitview = git_rev_parse 'HEAD'; changedir $maindir; - # When we no longer need to support squeeze, use --create-reflog - # instead of this: - ensuredir "$maindir_gitcommon/logs/refs/dgit-intern"; - my $makelogfh = new IO::File "$maindir_gitcommon/logs/refs/$splitbraincache", '>>' - or die $!; - - my $oldcache = git_get_ref "refs/$splitbraincache"; - if ($oldcache eq $dgitview) { - my $tree = cmdoutput qw(git rev-parse), "$dgitview:"; - # git update-ref doesn't always update, in this case. *sigh* - my $dummy = make_commit_text < 1000000000 +0000 -committer Dgit 1000000000 +0000 - -Dummy commit - do not use -END - runcmd @git, qw(update-ref -m), "dgit $our_version - dummy", - "refs/$splitbraincache", $dummy; - } - runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache", - $dgitview; + reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview; changedir "$playground/work"; @@ -5423,13 +5451,20 @@ sub quiltify ($$$$) { }; if ($quilt_mode eq 'linear') { print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n"; + my $all_gdr = !!@nots; foreach my $notp (@nots) { print STDERR "$us: ", $reportnot->($notp), "\n"; + $all_gdr &&= $notp->{Child} && + (git_cat_file $notp->{Child}{Commit}, 'commit') + =~ m{^\[git-debrebase(?! split[: ]).*\]$}m; } - print STDERR "$us: $_\n" foreach @$failsuggestion; + print STDERR "\n"; + $failsuggestion = + [ grep { $_->[0] ne 'quilt-mode' } @$failsuggestion ] + if $all_gdr; + print STDERR "$us: $_->[1]\n" foreach @$failsuggestion; fail - "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n". - "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch"; + "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n"; } elsif ($quilt_mode eq 'smash') { } elsif ($quilt_mode eq 'auto') { progress "quilt fixup cannot be linear, smashing..."; @@ -5583,7 +5618,7 @@ END if ($quilt_mode eq 'linear' && !$fopts->{'single-debian-patch'} - && branch_is_gdr($symref, $headref)) { + && branch_is_gdr($headref)) { # This is much faster. It also makes patches that gdr # likes better for future updates without laundering. # @@ -5730,6 +5765,31 @@ END close $fakedsc or die $!; } +sub quilt_fakedsc2unapplied ($$) { + my ($headref, $upstreamversion) = @_; + # must be run in the playground + # quilt_make_fake_dsc must have been called + + runcmd qw(sh -ec), + 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null'; + + my $fakexdir= $package.'-'.(stripepoch $upstreamversion); + rename $fakexdir, "fake" or die "$fakexdir $!"; + + changedir 'fake'; + + remove_stray_gits("source package"); + mktree_in_ud_here(); + + rmtree '.pc'; + + rmtree 'debian'; # git checkout commitish paths does not delete! + runcmd @git, qw(checkout -f), $headref, qw(-- debian); + my $unapplied=git_add_write_tree(); + printdebug "fake orig tree object $unapplied\n"; + return $unapplied; +} + sub quilt_check_splitbrain_cache ($$) { my ($headref, $upstreamversion) = @_; # Called only if we are in (potentially) split brain mode. @@ -5761,26 +5821,12 @@ sub quilt_check_splitbrain_cache ($$) { push @cachekey, $srcshash->hexdigest(); $splitbrain_cachekey = "@cachekey"; - my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs', - $splitbraincache); printdebug "splitbrain cachekey $splitbrain_cachekey\n"; - debugcmd "|(probably)",@cmd; - my $child = open GC, "-|"; defined $child or die $!; - if (!$child) { - chdir $maindir or die $!; - if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") { - $! == ENOENT or die $!; - printdebug ">(no reflog)\n"; - finish 0; - } - exec @cmd; die $!; - } - while () { - chomp; - printdebug ">| ", $_, "\n" if $debuglevel > 1; - next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey; - - my $cachehit = $1; + + my $cachehit = reflog_cache_lookup + "refs/$splitbraincache", $splitbrain_cachekey; + + if ($cachehit) { unpack_playtree_mkwork($headref); my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit"; if ($cachehit ne $headref) { @@ -5792,8 +5838,6 @@ sub quilt_check_splitbrain_cache ($$) { progress "dgit view: found cached, no changes required"; return ($headref, $splitbrain_cachekey); } - die $! if GC->error; - failedcmd unless close GC; printdebug "splitbrain cache miss\n"; return (undef, $splitbrain_cachekey); @@ -5883,24 +5927,7 @@ sub quilt_fixup_multipatch ($$$) { quilt_check_splitbrain_cache($headref, $upstreamversion); return if $cachehit; } - - runcmd qw(sh -ec), - 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null'; - - my $fakexdir= $package.'-'.(stripepoch $upstreamversion); - rename $fakexdir, "fake" or die "$fakexdir $!"; - - changedir 'fake'; - - remove_stray_gits("source package"); - mktree_in_ud_here(); - - rmtree '.pc'; - - rmtree 'debian'; # git checkout commitish paths does not delete! - runcmd @git, qw(checkout -f), $headref, qw(-- debian); - my $unapplied=git_add_write_tree(); - printdebug "fake orig tree object $unapplied\n"; + my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion); ensuredir '.pc'; @@ -5978,12 +6005,21 @@ END my @failsuggestion; if (!($diffbits->{O2H} & $diffbits->{O2A})) { - push @failsuggestion, "This might be a patches-unapplied branch."; - } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) { - push @failsuggestion, "This might be a patches-applied branch."; + push @failsuggestion, [ 'unapplied', + "This might be a patches-unapplied branch." ]; + } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) { + push @failsuggestion, [ 'applied', + "This might be a patches-applied branch." ]; } - push @failsuggestion, "Maybe you need to specify one of". - " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?"; + push @failsuggestion, [ 'quilt-mode', + "Maybe you need one of --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?" ]; + + push @failsuggestion, [ 'gitattrs', + "Warning: Tree has .gitattributes. See GITATTRIBUTES in dgit(7)." ] + if stat_exists '.gitattributes'; + + push @failsuggestion, [ 'origs', + "Maybe orig tarball(s) are not identical to git representation?" ]; if (quiltmode_splitbrain()) { quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree, @@ -6287,6 +6323,10 @@ sub postbuild_mergechanges_vanilla ($) { sub cmd_build { build_prep_early(); + $buildproductsdir eq '..' or print STDERR <ismember($signum) and die "$signame is blocked\n"; }