X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=45eef630367ae6a1ba7d4fa6ab1b5255671f2515;hp=66349e45b0847deefc94eabcd2afd281de76f7a1;hb=2fe42d36da42a62e8082d0d1c4c35943e8281e9e;hpb=5d84e41a236c4e53e12e02418b5ef2d17acb3a2e diff --git a/dgit b/dgit index 66349e45..45eef630 100755 --- a/dgit +++ b/dgit @@ -64,6 +64,7 @@ our $quilt_mode; our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|unapplied'; our $we_are_responder; our $initiator_tempdir; +our $patches_applied_dirtily = 00; our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); @@ -101,6 +102,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'dpkg-source' => \@dpkgsource, 'dpkg-buildpackage' => \@dpkgbuildpackage, 'dpkg-genchanges' => \@dpkggenchanges, + 'gbp' => \@gbp, 'ch' => \@changesopts, 'mergechanges' => \@mergechanges); @@ -130,6 +132,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; our $instead_distro; +sub debiantag ($$) { + my ($v,$distro) = @_; + return debiantag_old $v, $distro; +} + sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } @@ -211,6 +218,16 @@ sub quiltmode_splitbrain () { # where is ,... ... # < dgit-remote-push-ready # +# occasionally: +# +# > progress NBYTES +# [NBYTES message] +# +# > supplementary-message NBYTES # $protovsn >= 3 +# [NBYTES message] +# +# main sequence: +# # > file parsed-changelog # [indicates that output of dpkg-parsechangelog follows] # > data-block NBYTES @@ -225,6 +242,10 @@ sub quiltmode_splitbrain () { # [etc] # # > param head HEAD +# > param csuite SUITE +# +# > previously REFNAME=OBJNAME # if --deliberately-not-fast-forward +# # goes into tag, for replay prevention # # > want signed-tag # [indicates that signed tag is wanted] @@ -396,7 +417,7 @@ our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); sub runcmd { debugcmd "+",@_; - $!=0; $?=0; + $!=0; $?=-1; failedcmd @_ if system @_; } @@ -531,7 +552,7 @@ sub git_slurp_config () { my @cmd = (@git, qw(config -z --get-regexp .*)); debugcmd "|",@cmd; - open GITS, "-|", @cmd or failedcmd @cmd; + open GITS, "-|", @cmd or die $!; while () { chomp or die; printdebug "=> ", (messagequote $_), "\n"; @@ -1158,7 +1179,7 @@ sub check_for_git () { " set -e; cd ".access_cfg('git-path').";". " if test -d $package.git; then echo 1; else echo 0; fi"); my $r= cmdoutput @cmd; - if ($r =~ m/^divert (\w+)$/) { + if (defined $r and $r =~ m/^divert (\w+)$/) { my $divert=$1; my ($usedistro,) = access_distros(); # NB that if we are pushing, $usedistro will be $distro/push @@ -1167,7 +1188,7 @@ sub check_for_git () { progress "diverting to $divert (using config for $instead_distro)"; return check_for_git(); } - failedcmd @cmd unless $r =~ m/^[01]$/; + failedcmd @cmd unless defined $r and $r =~ m/^[01]$/; return $r+0; } elsif ($how eq 'url') { my $prefix = access_cfg('git-check-url','git-url'); @@ -1241,7 +1262,7 @@ sub git_write_tree () { sub remove_stray_gits () { my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; - open GITS, "-|", @gitscmd or failedcmd @gitscmd; + open GITS, "-|", @gitscmd or die $!; { local $/="\0"; while () { @@ -1257,7 +1278,7 @@ sub remove_stray_gits () { sub mktree_in_ud_from_only_subdir () { # changes into the subdir my (@dirs) = <*/.>; - die unless @dirs==1; + die "@dirs ?" unless @dirs==1; $dirs[0] =~ m#^([^/]+)/\.$# or die; my $dir = $1; changedir $dir; @@ -1446,7 +1467,7 @@ END my $cversion = getfield $clogp, 'Version'; progress "synthesised git commit from .dsc $cversion"; if ($lastpush_hash) { - runcmd @git, qw(reset --hard), $lastpush_hash; + runcmd @git, qw(reset -q --hard), $lastpush_hash; runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp'; my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog'); my $oversion = getfield $oldclogp, 'Version'; @@ -1780,9 +1801,9 @@ sub check_not_dirty () { my @cmd = (@git, qw(diff --quiet HEAD)); debugcmd "+",@cmd; - $!=0; $?=0; system @cmd; - return if !$! && !$?; - if (!$! && $?==256) { + $!=0; $?=-1; system @cmd; + return if !$?; + if ($?==256) { fail "working tree is dirty (does not match HEAD)"; } else { failedcmd @cmd; @@ -1848,11 +1869,15 @@ sub get_source_format () { sub madformat ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; + our $quilt_mode_warned; if ($quilt_mode eq 'nocheck') { - progress "Not doing any fixup of \`$format' due to --no-quilt-fixup"; + progress "Not doing any fixup of \`$format' due to". + " ----no-quilt-fixup or --quilt=nocheck" + unless $quilt_mode_warned++; return 0; } - progress "Format \`$format', checking/updating patch stack"; + progress "Format \`$format', need to check/update patch stack" + unless $quilt_mode_warned++; return 1; } @@ -1989,9 +2014,26 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; + my $head = git_rev_parse('HEAD'); + if (madformat($format)) { # user might have not used dgit build, so maybe do this now: - commit_quilty_patch(); + if (quiltmode_splitbrain()) { + my $upstreamversion = $clogp->{Version}; + $upstreamversion =~ s/-[^-]*$//; + changedir $ud; + quilt_make_fake_dsc($upstreamversion); + my ($dgitview, $cachekey) = + quilt_check_splitbrain_cache($head, $upstreamversion); + $dgitview or fail + "--quilt=$quilt_mode but no cached dgit view: + perhaps tree changed since dgit build[-source] ?"; + $split_brain = 1; + changedir '../../../..'; + prep_ud(); # so _only_subdir() works, below + } else { + commit_quilty_patch(); + } } die 'xxx fast forward (should not depend on quilt mode, but will always be needed if we did $split_brain)' if $split_brain; @@ -2007,7 +2049,7 @@ END my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet'; my @diffcmd = (@git, qw(diff), $diffopt, $tree); debugcmd "+",@diffcmd; - $!=0; $?=0; + $!=0; $?=-1; my $r = system @diffcmd; if ($r) { if ($r==256) { @@ -2019,7 +2061,6 @@ END failedcmd @diffcmd; } } - my $head = git_rev_parse('HEAD'); if (!$changesfile) { my $pat = changespat $cversion; my @cs = glob "$buildproductsdir/$pat"; @@ -2555,11 +2596,11 @@ sub quiltify_tree_sentinelfiles ($) { qw(-- debian/rules debian/control); $r =~ s/\n/,/g; return $r; - } +} sub quiltify_splitbrain_needed () { if (!$split_brain) { - progress "creating dgit view"; + progress "dgit view: changes are required..."; runcmd @git, qw(checkout -q -b dgit-view); $split_brain = 1; } @@ -2593,7 +2634,7 @@ sub quiltify_splitbrain ($$$$$$) { if ($quilt_mode =~ m/gbp|unapplied/ && ($diffbits->{O2A} & 01)) { # some patches quiltify_splitbrain_needed(); - progress "creating patches-applied version using gbp pq"; + progress "dgit view: creating patches-applied version using gbp pq"; runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import); # gbp pq import creates a fresh branch; push back to dgit-view runcmd @git, qw(update-ref refs/heads/dgit-view HEAD); @@ -2602,7 +2643,7 @@ sub quiltify_splitbrain ($$$$$$) { if (($diffbits->{H2O} & 02) && # user has modified .gitignore !($diffbits->{O2A} & 02)) { # patches do not change .gitignore quiltify_splitbrain_needed(); - progress "creating patch to represent .gitignore changes"; + progress "dgit view: creating patch to represent .gitignore changes"; ensuredir "debian/patches"; my $gipatch = "debian/patches/auto-gitignore"; open GIPATCH, ">>", "$gipatch" or die "$gipatch: $!"; @@ -2642,6 +2683,8 @@ END runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache", $dgitview; + progress "dgit view: created (commit id $dgitview)"; + changedir '.git/dgit/unpack/work'; } @@ -2939,14 +2982,123 @@ sub quilt_fixup_singlepatch ($$$) { chdir "work"; commit_quilty_patch(); +} + +sub quilt_make_fake_dsc ($) { + my ($upstreamversion) = @_; + + my $fakeversion="$upstreamversion-~~DGITFAKE"; + my $fakedsc=new IO::File 'fake.dsc', '>' or die $!; + print $fakedsc <addfile($fh); + print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; + }; + + quilt_fixup_linkorigs($upstreamversion, $dscaddfile); + + my @files=qw(debian/source/format debian/rules + debian/control debian/changelog); + foreach my $maybe (qw(debian/patches debian/source/options + debian/tests/control)) { + next unless stat_exists "../../../$maybe"; + push @files, $maybe; + } + + my $debtar= srcfn $fakeversion,'.debian.tar.gz'; + runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C ../../..), @files; + + $dscaddfile->($debtar); + close $fakedsc or die $!; +} + +sub quilt_check_splitbrain_cache ($$) { + my ($headref, $upstreamversion) = @_; + # Called only if we are in (potentially) split brain mode. + # Called in $ud. + # Computes the cache key and looks in the cache. + # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey) + + my $splitbrain_cachekey; + progress + "dgit: split brain (separate dgit view) may be needed (--quilt=$quilt_mode)."; + # we look in the reflog of dgit-intern/quilt-cache + # we look for an entry whose message is the key for the cache lookup + my @cachekey = (qw(dgit), $our_version); + push @cachekey, $upstreamversion; + push @cachekey, $quilt_mode; + push @cachekey, $headref; + + push @cachekey, hashfile('fake.dsc'); + + my $srcshash = Digest::SHA->new(256); + my %sfs = ( %INC, '$0(dgit)' => $0 ); + foreach my $sfk (sort keys %sfs) { + next unless m/^\$0\b/ || m{^Debian/Dgit\b}; + $srcshash->add($sfk," "); + $srcshash->add(hashfile($sfs{$sfk})); + $srcshash->add("\n"); + } + push @cachekey, $srcshash->hexdigest(); + $splitbrain_cachekey = "@cachekey"; + + my @cmd = (@git, qw(reflog), '--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 '../../..' or die $!; + if (!stat ".git/logs/refs/$splitbraincache") { + $! == ENOENT or die $!; + printdebug ">(no reflog)\n"; + exit 0; + } + exec @cmd; die $!; + } + while () { + chomp; + printdebug ">| ", $_, "\n" if $debuglevel > 1; + next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey; + + my $cachehit = $1; + quilt_fixup_mkwork($headref); + if ($cachehit ne $headref) { + progress "dgit view: found cached (commit id $cachehit)"; + runcmd @git, qw(checkout -q -b dgit-view), $cachehit; + $split_brain = 1; + return ($cachehit, $splitbrain_cachekey); + } + 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); } sub quilt_fixup_multipatch ($$$) { my ($clogp, $headref, $upstreamversion) = @_; - progress "starting quiltify (multiple patches, $quilt_mode mode)"; + progress "examining quilt state (multiple patches, $quilt_mode mode)"; # Our objective is: # - honour any existing .pc in case it has any strangeness @@ -3017,101 +3169,15 @@ sub quilt_fixup_multipatch ($$$) { # afterwards with dpkg-source --before-build. That lets us save a # tree object corresponding to .origs. - my $fakeversion="$upstreamversion-~~DGITFAKE"; - - my $fakedsc=new IO::File 'fake.dsc', '>' or die $!; - print $fakedsc <addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; - }; - - quilt_fixup_linkorigs($upstreamversion, $dscaddfile); - - my @files=qw(debian/source/format debian/rules - debian/control debian/changelog); - foreach my $maybe (qw(debian/patches debian/source/options - debian/tests/control)) { - next unless stat_exists "../../../$maybe"; - push @files, $maybe; - } + my $splitbrain_cachekey; - my $debtar= srcfn $fakeversion,'.debian.tar.gz'; - runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files; + quilt_make_fake_dsc($upstreamversion); - $dscaddfile->($debtar); - close $fakedsc or die $!; - - my $splitbrain_cachekey; if (quiltmode_splitbrain()) { - # we look in the reflog of dgit-intern/quilt-cache - # we look for an entry whose message is the key for the cache lookup - my @cachekey = (qw(dgit), $our_version); - push @cachekey, $upstreamversion; - push @cachekey, $quilt_mode; - push @cachekey, $headref; - - push @cachekey, hashfile('fake.dsc'); - - my $srcshash = Digest::SHA->new(256); - my %sfs = ( %INC, '$0(dgit)' => $0 ); - foreach my $sfk (sort keys %sfs) { - $srcshash->add($sfk," "); - $srcshash->add(hashfile($sfs{$sfk})); - $srcshash->add("\n"); - } - push @cachekey, $srcshash->hexdigest(); - $splitbrain_cachekey = "@cachekey"; - - my @cmd = (@git, qw(reflog), '--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 '../../..' or die $!; - if (!stat ".git/logs/refs/$splitbraincache") { - $! == ENOENT or die $!; - printdebug ">(no reflog)\n"; - exit 0; - } - exec @cmd; die $!; - } - while () { - chomp; - printdebug ">| ", $_, "\n" if $debuglevel > 1; - next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey; - - my $cachehit = $1; - quilt_fixup_mkwork($headref); - if ($cachehit ne $headref) { - progress "quilt fixup ($quilt_mode mode) found cached tree"; - runcmd @git, qw(checkout -q -b dgit-view), $cachehit; - $split_brain = 1; - return; - } - progress "quilt fixup ($quilt_mode mode)". - " found cached indication that no changes needed"; - return; - } - die $! if GC->error; - failedcmd unless close GC; - - printdebug "splitbrain cache miss\n"; + my $cachehit; + ($cachehit, $splitbrain_cachekey) = + quilt_check_splitbrain_cache($headref, $upstreamversion); + return if $cachehit; } runcmd qw(sh -ec), @@ -3200,6 +3266,7 @@ END return; } + progress "starting quiltify (multiple patches, $quilt_mode mode)"; quiltify($clogp,$headref,$oldtiptree,\@failsuggestion); if (!open P, '>>', ".pc/applied-patches") { @@ -3234,6 +3301,29 @@ sub quilt_fixup_editor () { exit 0; } +sub maybe_apply_patches_dirtily () { + return unless $quilt_mode =~ m/gbp|unapplied/; + print STDERR <