X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=00da67d7ed6af8988d265ee039bbe0d62cfd45d9;hp=17e4fadb360affeaa85a2988692750c90180c778;hb=53d416f00482f3e004cb81e51de2ee111fee8d9e;hpb=f90d29c48dd4183174dd08f36d03e9db81636eb0 diff --git a/dgit b/dgit index 17e4fadb..00da67d7 100755 --- a/dgit +++ b/dgit @@ -18,6 +18,9 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . +END { $? = $Debian::Dgit::ExitStatus::desired // -1; }; +use Debian::Dgit::ExitStatus; + use strict; use Debian::Dgit qw(:DEFAULT :playground); @@ -114,6 +117,7 @@ our (@gpg) = qw(gpg); our (@sbuild) = qw(sbuild); our (@ssh) = 'ssh'; our (@dgit) = qw(dgit); +our (@git_debrebase) = qw(git-debrebase); our (@aptget) = qw(apt-get); our (@aptcache) = qw(apt-cache); our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores); @@ -133,6 +137,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'ssh' => \@ssh, 'dgit' => \@dgit, 'git' => \@git, + 'git-debrebase' => \@git_debrebase, 'apt-get' => \@aptget, 'apt-cache' => \@aptcache, 'dpkg-source' => \@dpkgsource, @@ -236,7 +241,7 @@ END { } }; -sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; } +sub badcfg { print STDERR "$us: invalid configuration: @_\n"; finish 12; } sub forceable_fail ($$) { my ($forceoptsl, $msg) = @_; @@ -254,7 +259,7 @@ sub forceing ($) { sub no_such_package () { print STDERR "$us: package $package does not exist in suite $isuite\n"; - exit 4; + finish 4; } sub deliberately ($) { @@ -287,6 +292,32 @@ sub dgit_privdir () { our $dgit_privdir_made //= ensure_a_playground 'dgit'; } +sub branch_gdr_info ($$) { + my ($symref, $head) = @_; + my ($status, $msg, $current, $ffq_prev, $gdrlast) = + gdr_ffq_prev_branchinfo($symref); + return () unless $status eq 'branch'; + $ffq_prev = git_get_ref $ffq_prev; + $gdrlast = git_get_ref $gdrlast; + $gdrlast &&= is_fast_fwd $gdrlast, $head; + 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 1; +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -530,11 +561,6 @@ sub runcmd_ordryrun_local { } } -sub shell_cmd { - my ($first_shell, @cmd) = @_; - return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd; -} - our $helpmsg = < 'debian', 'dgit.dsc-url-proto-ok.http' => 'true', 'dgit.dsc-url-proto-ok.https' => 'true', 'dgit.dsc-url-proto-ok.git' => 'true', + 'dgit.vcs-git.suites', => 'sid', # ;-separated '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" @@ -1948,12 +1975,12 @@ END if ($found_same) { # in archive, delete from .changes if it's there $changed{$file} = "removed" if - $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m; - } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) { + $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m; + } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/m) { # not in archive, but it's here in the .changes } else { my $dsc_data = getfield $dsc, $fname; - $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?"; + $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?"; my $extra = $1; $extra =~ s/ \d+ /$&$placementinfo / or die "$fname $extra >$dsc_data< ?" @@ -2731,6 +2758,11 @@ END my $want = $wantr{$rrefname}; next if $got eq $want; if (!defined $objgot{$want}) { + fail <) { - return 1 if m{^\[attr\]dgit-defuse-attrs\s}; + next unless m{$gitattrs_ourmacro_re}; + return 1 if m{\s-working-tree-encoding\s}; + printdebug "is_gitattrs_setup: found old macro\n"; + return 0; } $gai->error and die $!; - return 0; + printdebug "is_gitattrs_setup: found nothing\n"; + return undef; } sub setup_gitattrs (;$) { my ($always) = @_; return unless $always || access_cfg_bool(1, 'setup-gitattributes'); - if (is_gitattrs_setup()) { + my $already = is_gitattrs_setup(); + if ($already) { progress < $af.new" or die $!; - print GAO <) { + if (m{$gitattrs_ourmacro_re}) { + die unless defined $already; + $_ = $new; + } chomp; print GAO $_, "\n" or die $!; } @@ -3428,7 +3478,7 @@ sub check_gitattrs ($$) { # oh dear, found one print STDERR <{'Vcs-Git'}; + if (length $vcsgiturl and + (grep { $csuite eq $_ } + split /\;/, + cfg 'dgit.vcs-git.suites')) { + my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF'; + if (defined $current && $current ne $vcsgiturl) { + print STDERR < message fragment "$saved" describing disposition of $dgitview return "commit id $dgitview" unless defined $split_brain_save; my @cmd = (shell_cmd 'cd "$1"; shift', $maindir, - @git, qw(update-ref -m), + git_update_ref_cmd "dgit --dgit-view-save $msg HEAD=$headref", $split_brain_save, $dgitview); runcmd @cmd; @@ -3875,6 +3953,8 @@ sub pseudomerge_make_commit ($$$$ $$) { : !length $overwrite_version ? " --overwrite" : " --overwrite=".$overwrite_version; + # Contributing parent is the first parent - that makes + # git rev-list --first-parent DTRT. my $pmf = dgit_privdir()."/pseudomerge"; open MC, ">", $pmf or die "$pmf $!"; print MC <[0] into your HEAD."; return $r; @@ -4203,7 +4285,14 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; + my $symref = git_get_symref(); my $actualhead = git_rev_parse('HEAD'); + + if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) { + runcmd_ordryrun_local @git_debrebase, 'stitch'; + $actualhead = git_rev_parse('HEAD'); + } + my $dgithead = $actualhead; my $maintviewhead = undef; @@ -4232,7 +4321,8 @@ END } } - if (defined $overwrite_version && !defined $maintviewhead) { + if (defined $overwrite_version && !defined $maintviewhead + && $archive_hash) { $dgithead = plain_overwrite_pseudomerge($clogp, $dgithead, $archive_hash); @@ -4411,7 +4501,7 @@ END runcmd_ordryrun @git, qw(-c push.followTags=false push), access_giturl(), @pushrefs; - runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; + runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); Push failed, while obtaining signatures on the .changes and .dsc. @@ -4511,11 +4601,15 @@ sub branchsuite () { } } -sub fetchpullargs () { +sub package_from_d_control () { if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; } +} + +sub fetchpullargs () { + package_from_d_control(); if (@ARGV==0) { $isuite = branchsuite(); if (!$isuite) { @@ -4534,9 +4628,7 @@ sub fetchpullargs () { sub cmd_fetch { parseopts(); fetchpullargs(); - my $multi_fetched = fork_for_multisuite(sub { }); - exit 0 if $multi_fetched; - fetch(); + dofetch(); } sub cmd_pull { @@ -4551,6 +4643,86 @@ END pull(); } +sub cmd_checkout { + parseopts(); + package_from_d_control(); + @ARGV==1 or badusage "dgit checkout needs a suite argument"; + ($isuite) = @ARGV; + notpushing(); + + foreach my $canon (qw(0 1)) { + if (!$canon) { + $csuite= $isuite; + } else { + undef $csuite; + canonicalise_suite(); + } + if (length git_get_ref lref()) { + # local branch already exists, yay + last; + } + if (!length git_get_ref lrref()) { + if (!$canon) { + # nope + next; + } + dofetch(); + } + # now lrref exists + runcmd (@git, qw(update-ref), lref(), lrref(), ''); + last; + } + local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg + "dgit checkout $isuite"; + runcmd (@git, qw(checkout), lbranch()); +} + +sub cmd_update_vcs_git () { + my $specsuite; + if (@ARGV==0 || $ARGV[0] =~ m/^-/) { + ($specsuite,) = split /\;/, cfg 'dgit.vcs-git.suites'; + } else { + ($specsuite) = (@ARGV); + shift @ARGV; + } + my $dofetch=1; + if (@ARGV) { + if ($ARGV[0] eq '-') { + $dofetch = 0; + } elsif ($ARGV[0] eq '-') { + shift; + } + } + + package_from_d_control(); + my $ctrl; + if ($specsuite eq '.') { + $ctrl = parsecontrol 'debian/control', 'debian/control'; + } else { + $isuite = $specsuite; + get_archive_dsc(); + $ctrl = $dsc; + } + my $url = getfield $ctrl, 'Vcs-Git'; + + my @cmd; + my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF'; + if (!defined $orgurl) { + print STDERR "setting up vcs-git: $url\n"; + @cmd = (@git, qw(remote add vcs-git), $url); + } elsif ($orgurl eq $url) { + print STDERR "vcs git already configured: $url\n"; + } else { + print STDERR "changing vcs-git url to: $url\n"; + @cmd = (@git, qw(remote set-url vcs-git), $url); + } + runcmd_ordryrun_local @cmd; + if ($dofetch) { + print "fetching (@ARGV)\n"; + runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV; + } +} + sub prep_push () { parseopts(); build_or_push_prep_early(); @@ -4744,7 +4916,7 @@ sub i_resp_complete { i_cleanup(); printdebug "all done\n"; - exit 0; + finish 0; } sub i_resp_file ($) { @@ -4998,13 +5170,15 @@ sub quiltify_splitbrain_needed () { } } -sub quiltify_splitbrain ($$$$$$) { - my ($clogp, $unapplied, $headref, $diffbits, +sub quiltify_splitbrain ($$$$$$$) { + my ($clogp, $unapplied, $headref, $oldtiptree, $diffbits, $editedignores, $cachekey) = @_; + my $gitignore_special = 1; if ($quilt_mode !~ m/gbp|dpm/) { # treat .gitignore just like any other upstream file $diffbits = { %$diffbits }; $_ = !!$_ foreach values %$diffbits; + $gitignore_special = 0; } # We would like any commits we generate to be reproducible my @authline = clogp_authline($clogp); @@ -5015,11 +5189,19 @@ sub quiltify_splitbrain ($$$$$$) { local $ENV{GIT_AUTHOR_EMAIL} = $authline[1]; local $ENV{GIT_AUTHOR_DATE} = $authline[2]; + my $fulldiffhint = sub { + my ($x,$y) = @_; + my $cmd = "git diff $x $y -- :/ ':!debian'"; + $cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special; + return "\nFor full diff showing the problem(s), type:\n $cmd\n"; + }; + if ($quilt_mode =~ m/gbp|unapplied/ && ($diffbits->{O2H} & 01)) { my $msg = "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n". " but git tree differs from orig in upstream files."; + $msg .= $fulldiffhint->($unapplied, 'HEAD'); if (!stat_exists "debian/patches") { $msg .= "\n ... debian/patches is missing; perhaps this is a patch queue branch?"; @@ -5028,7 +5210,7 @@ sub quiltify_splitbrain ($$$$$$) { } if ($quilt_mode =~ m/dpm/ && ($diffbits->{H2A} & 01)) { - fail <($oldtiptree,'HEAD'); --quilt=$quilt_mode specified, implying patches-applied git tree but git tree differs from result of applying debian/patches to upstream END @@ -5044,7 +5226,7 @@ END } if ($quilt_mode =~ m/gbp|dpm/ && ($diffbits->{O2A} & 02)) { - fail <{Commit} differs from tree implied by ". - " debian/patches (tree object $oldtiptree)"; - } + quiltify_nofix_bail " $c->{Commit}", " (tree object $oldtiptree)"; if ($quilt_mode eq 'smash') { printdebug " search quitting smash\n"; last; @@ -5256,12 +5434,13 @@ sub quiltify ($$$$) { return $s; }; if ($quilt_mode eq 'linear') { - print STDERR "$us: quilt fixup cannot be linear. Stopped at:\n"; + print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n"; foreach my $notp (@nots) { print STDERR "$us: ", $reportnot->($notp), "\n"; } print STDERR "$us: $_\n" foreach @$failsuggestion; - fail "quilt fixup naive history linearisation failed.\n". + 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"; } elsif ($quilt_mode eq 'smash') { } elsif ($quilt_mode eq 'auto') { @@ -5412,6 +5591,33 @@ END my $clogp = parsechangelog(); my $headref = git_rev_parse('HEAD'); + my $symref = git_get_symref(); + + if ($quilt_mode eq 'linear' + && !$fopts->{'single-debian-patch'} + && branch_is_gdr($symref, $headref)) { + # This is much faster. It also makes patches that gdr + # likes better for future updates without laundering. + # + # However, it can fail in some casses where we would + # succeed: if there are existing patches, which correspond + # to a prefix of the branch, but are not in gbp/gdr + # format, gdr will fail (exiting status 7), but we might + # be able to figure out where to start linearising. That + # will be slower so hopefully there's not much to do. + my @cmd = (@git_debrebase, + qw(--noop-ok -funclean-mixed -funclean-ordering + make-patches --quiet-would-amend)); + # We tolerate soe snags that gdr wouldn't, by default. + if (act_local()) { + debugcmd "+",@cmd; + $!=0; $?=-1; + failedcmd @cmd if system @cmd and $?!=7*256; + } else { + dryrun_report @cmd; + } + $headref = git_rev_parse('HEAD'); + } prep_ud(); changedir $playground; @@ -5575,7 +5781,7 @@ sub quilt_check_splitbrain_cache ($$) { if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") { $! == ENOENT or die $!; printdebug ">(no reflog)\n"; - exit 0; + finish 0; } exec @cmd; die $!; } @@ -5701,6 +5907,7 @@ sub quilt_fixup_multipatch ($$$) { 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"; @@ -5789,7 +5996,7 @@ END " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?"; if (quiltmode_splitbrain()) { - quiltify_splitbrain($clogp, $unapplied, $headref, + quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree, $diffbits, \%editedignores, $splitbrain_cachekey); return; @@ -5827,7 +6034,7 @@ sub quilt_fixup_editor () { } I2->error and die $!; close O or die $1; - exit 0; + finish 0; } sub maybe_apply_patches_dirtily () { @@ -5931,13 +6138,21 @@ sub changesopts_initial () { sub changesopts_version () { if (!defined $changes_since_version) { - my @vsns = archive_query('archive_query'); - my @quirk = access_quirk(); - if ($quirk[0] eq 'backports') { - local $isuite = $quirk[2]; - local $csuite; - canonicalise_suite(); - push @vsns, archive_query('archive_query'); + my @vsns; + unless (eval { + @vsns = archive_query('archive_query'); + my @quirk = access_quirk(); + if ($quirk[0] eq 'backports') { + local $isuite = $quirk[2]; + local $csuite; + canonicalise_suite(); + push @vsns, archive_query('archive_query'); + } + 1; + }) { + print STDERR $@; + fail + "archive query failed (queried because --since-version not specified)"; } if (@vsns) { @vsns = map { $_->[0] } @vsns; @@ -6263,7 +6478,7 @@ sub cmd_quilt_fixup { sub import_dsc_result { my ($dstref, $newhash, $what_log, $what_msg) = @_; - my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash); + my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash); runcmd @cmd; check_gitattrs($newhash, "source tree"); @@ -6517,7 +6732,7 @@ sub cmd_setup_new_tree { sub cmd_version { print "dgit version $our_version\n" or die $!; - exit 0; + finish 0; } our (%valopts_long, %valopts_short); @@ -6869,7 +7084,7 @@ print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; if (!@ARGV) { print STDERR $helpmsg or die $!; - exit 8; + finish 8; } $cmd = $subcommand = shift @ARGV; $cmd =~ y/-/_/; @@ -6883,3 +7098,5 @@ git_slurp_config(); my $fn = ${*::}{"cmd_$cmd"}; $fn or badusage "unknown operation $cmd"; $fn->(); + +finish 0;