X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=555e1c00905f30f0da4c18f54ac40c39b8d59ae8;hp=a95629f52605f4246cdf39abde2012a9b5ea290b;hb=3894237fb0ac3d9c9d3857ae2dfd628d331c0f49;hpb=f283022faa83ee21d5441aafd9c9f11be1aee6fe diff --git a/dgit b/dgit index a95629f5..555e1c00 100755 --- a/dgit +++ b/dgit @@ -69,6 +69,8 @@ our $rmchanges; 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 $dodep14tag_re = 'want|no|always'; our $split_brain_save; our $we_are_responder; our $initiator_tempdir; @@ -94,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); @@ -171,8 +174,7 @@ sub debiantag ($$) { sub debiantag_maintview ($$) { my ($v,$distro) = @_; - $v =~ y/~:/_%/; - return "$distro/$v"; + return "$distro/".dep14_version_mangle $v; } sub madformat ($) { $_[0] eq '3.0 (quilt)' } @@ -1010,6 +1012,8 @@ our %rmad; sub archive_query ($;@) { my ($method) = shift @_; + fail "this operation does not support multiple comma-separated suites" + if $isuite =~ m/,/; my $query = access_cfg('archive-query','RETURN-UNDEF'); $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; my $proto = $1; @@ -1162,7 +1166,7 @@ sub aptget_aptcache () { return @aptcache, qw(-c), $aptget_configpath; } sub aptget_cache_clean { runcmd_ordryrun_local qw(sh -ec), - 'cd "$1"; pwd; find -atime +30 -type f -print0 | xargs -0r echo rm --', + 'cd "$1"; find -atime +30 -type f -print0 | xargs -0r rm --', 'x', $aptget_base; } @@ -1518,6 +1522,15 @@ sub access_cfg_tagformats () { split /\,/, access_cfg('dgit-tag-format'); } +sub access_cfg_tagformats_can_splitbrain () { + my %y = map { $_ => 1 } access_cfg_tagformats; + foreach my $needtf (qw(new maint)) { + next if $y{$needtf}; + return 0; + } + return 1; +} + sub need_tagformat ($$) { my ($fmt, $why) = @_; fail "need to use tag format $fmt ($why) but also need". @@ -1691,7 +1704,13 @@ sub git_write_tree () { return $tree; } -sub remove_stray_gits () { +sub git_add_write_tree () { + runcmd @git, qw(add -Af .); + return git_write_tree(); +} + +sub remove_stray_gits ($) { + my ($what) = @_; my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; open GITS, "-|", @gitscmd or die $!; @@ -1699,7 +1718,7 @@ sub remove_stray_gits () { local $/="\0"; while () { chomp or die; - print STDERR "$us: warning: removing from source package: ", + print STDERR "$us: warning: removing from $what: ", (messagequote $_), "\n"; rmtree $_; } @@ -1707,8 +1726,8 @@ sub remove_stray_gits () { $!=0; $?=0; close GITS or failedcmd @gitscmd; } -sub mktree_in_ud_from_only_subdir (;$) { - my ($raw) = @_; +sub mktree_in_ud_from_only_subdir ($;$) { + my ($what,$raw) = @_; # changes into the subdir my (@dirs) = <*/.>; @@ -1717,7 +1736,7 @@ sub mktree_in_ud_from_only_subdir (;$) { my $dir = $1; changedir $dir; - remove_stray_gits(); + remove_stray_gits($what); mktree_in_ud_here(); if (!$raw) { my ($format, $fopts) = get_source_format(); @@ -1726,8 +1745,7 @@ sub mktree_in_ud_from_only_subdir (;$) { } } - runcmd @git, qw(add -Af); - my $tree=git_write_tree(); + my $tree=git_add_write_tree(); return ($tree,$dir); } @@ -1889,7 +1907,8 @@ END push @found_differ, "archive $h->{filename}: ".join "; ", @differ if @differ; } - print "origs $file f.same=$found_same #f._differ=$#found_differ\n"; + printdebug "origs $file f.same=$found_same". + " #f._differ=$#found_differ\n"; if (@found_differ && !$found_same) { fail join "\n", "archive contains $file with different checksum", @@ -2120,14 +2139,14 @@ sub generate_commits_from_dsc () { $input = $compr_fh; } - rmtree "../unpack-tar"; - mkdir "../unpack-tar" or die $!; + rmtree "_unpack-tar"; + mkdir "_unpack-tar" or die $!; my @tarcmd = qw(tar -x -f - --no-same-owner --no-same-permissions --no-acls --no-xattrs --no-selinux); my $tar_pid = fork // die $!; if (!$tar_pid) { - chdir "../unpack-tar" or die $!; + chdir "_unpack-tar" or die $!; open STDIN, "<&", $input or die $!; exec @tarcmd; die "dgit (child): exec $tarcmd[0]: $!"; @@ -2141,11 +2160,21 @@ sub generate_commits_from_dsc () { # finally, we have the results in "tarball", but maybe # with the wrong permissions - runcmd qw(chmod -R +rwX ../unpack-tar); - changedir "../unpack-tar"; - my ($tree) = mktree_in_ud_from_only_subdir(1); - changedir "../../unpack"; - rmtree "../unpack-tar"; + runcmd qw(chmod -R +rwX _unpack-tar); + changedir "_unpack-tar"; + remove_stray_gits($f); + mktree_in_ud_here(); + + my ($tree) = git_add_write_tree(); + my $tentries = cmdoutput @git, qw(ls-tree -z), $tree; + if ($tentries =~ m/^\d+ tree (\w+)\t[^\000]+\000$/s) { + $tree = $1; + printdebug "one subtree $1\n"; + } else { + printdebug "multiple subtrees\n"; + } + changedir ".."; + rmtree "_unpack-tar"; my $ent = [ $f, $tree ]; push @tartrees, { @@ -2184,7 +2213,7 @@ sub generate_commits_from_dsc () { push @cmd, qw(-x --), $dscfn; runcmd @cmd; - my ($tree,$dir) = mktree_in_ud_from_only_subdir(); + my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package"); if (madformat $dsc->{format}) { check_for_vendor_patches(); } @@ -2194,8 +2223,7 @@ sub generate_commits_from_dsc () { my @pcmd = qw(dpkg-source --before-build .); runcmd shell_cmd 'exec >/dev/null', @pcmd; rmtree '.pc'; - runcmd @git, qw(add -Af); - $dappliedtree = git_write_tree(); + $dappliedtree = git_add_write_tree(); } my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all); @@ -2340,6 +2368,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 $@; @@ -2356,11 +2386,12 @@ END die "only absurd git-apply!\n" if !$use_absurd && forceing [qw(import-gitapply-absurd)]; - local $ENV{PATH} = $path if $use_absurd; + local $ENV{DGIT_ABSURD_DEBUG} = $debuglevel if $use_absurd; + local $ENV{PATH} = $path if $use_absurd; my @showcmd = (gbp_pq, qw(import)); my @realcmd = shell_cmd - 'exec >/dev/null 2>../../gbp-pq-output', @showcmd; + 'exec >/dev/null 2>>../../gbp-pq-output', @showcmd; debugcmd "+",@realcmd; if (system @realcmd) { die +(shellquote @showcmd). @@ -2483,6 +2514,7 @@ sub git_fetch_us () { \&debiantag_new, \&debiantag_maintview) : debiantags('*',access_nomdistro)); push @specs, server_branch($csuite); + push @specs, $rewritemap; push @specs, qw(heads/*) if deliberately_not_fast_forward; # This is rather miserable: @@ -2694,6 +2726,18 @@ sub fetch_from_archive () { progress "no version available from the archive"; } + my $rewritemapdata = git_cat_file lrfetchrefs."/".$rewritemap.':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"; + } + } + # If the archive's .dsc has a Dgit field, there are three # relevant git commitids we need to choose between and/or merge # together: @@ -3072,6 +3116,167 @@ sub setup_new_tree () { setup_useremail(); } +sub multisuite_suite_child ($$$) { + my ($tsuite, $merginputs, $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; + my $pid = fork // die $!; + if (!$pid) { + $isuite = $tsuite; + $us .= " [$isuite]"; + $debugprefix .= " "; + progress "fetching $tsuite..."; + canonicalise_suite(); + print $canonsuitefh $csuite, "\n" or die $!; + close $canonsuitefh or die $!; + $fn->(); + return undef; + } + waitpid $pid,0 == $pid or die $!; + fail "failed to obtain $tsuite: ".waitstatusmsg() if $? && $?!=256*4; + seek $canonsuitefh,0,0 or die $!; + local $csuite = <$canonsuitefh>; + die $! unless defined $csuite && chomp $csuite; + if ($? == 256*4) { + printdebug "multisuite $tsuite missing\n"; + return $csuite; + } + printdebug "multisuite $tsuite ok (canon=$csuite)\n"; + push @$merginputs, { + Ref => lrref, + Info => $csuite, + }; + return $csuite; +} + +sub fork_for_multisuite ($) { + my ($before_fetch_merge) = @_; + # if nothing unusual, just returns '' + # + # if multisuite: + # returns 0 to caller in child, to do first of the specified suites + # in child, $csuite is not yet set + # + # returns 1 to caller in parent, to finish up anything needed after + # in parent, $csuite is set to canonicalised portmanteau + + my $org_isuite = $isuite; + my @suites = split /\,/, $isuite; + return '' unless @suites > 1; + printdebug "fork_for_multisuite: @suites\n"; + + my @mergeinputs; + + my $cbasesuite = multisuite_suite_child($suites[0], \@mergeinputs, + sub { }); + return 0 unless defined $cbasesuite; + + fail "package $package missing in (base suite) $cbasesuite" + unless @mergeinputs; + + my @csuites = ($cbasesuite); + + $before_fetch_merge->(); + + foreach my $tsuite (@suites[1..$#suites]) { + my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs, + sub { + @end = (); + fetch(); + exit 0; + }); + # xxx collecte the ref here + + $csubsuite =~ s/^\Q$cbasesuite\E-/-/; + push @csuites, $csubsuite; + } + + foreach my $mi (@mergeinputs) { + my $ref = git_get_ref $mi->{Ref}; + die "$mi->{Ref} ?" unless length $ref; + $mi->{Commit} = $ref; + } + + $csuite = join ",", @csuites; + + my $previous = git_get_ref lrref; + if ($previous) { + unshift @mergeinputs, { + Commit => $previous, + Info => "local combined tracking branch", + Warning => + "archive seems to have rewound: local tracking branch is ahead!", + }; + } + + foreach my $ix (0..$#mergeinputs) { + $mergeinputs[$ix]{Index} = $ix; + } + + @mergeinputs = sort { + -version_compare(mergeinfo_version $a, + mergeinfo_version $b) # highest version first + or + $a->{Index} <=> $b->{Index}; # earliest in spec first + } @mergeinputs; + + my @needed; + + NEEDED: + foreach my $mi (@mergeinputs) { + printdebug "multisuite merge check $mi->{Info}\n"; + foreach my $previous (@needed) { + next unless is_fast_fwd $mi->{Commit}, $previous->{Commit}; + printdebug "multisuite merge un-needed $previous->{Info}\n"; + next NEEDED; + } + push @needed, $mi; + printdebug "multisuite merge this-needed\n"; + $mi->{Character} = '+'; + } + + $needed[0]{Character} = '*'; + + my $output = $needed[0]{Commit}; + + if (@needed > 1) { + printdebug "multisuite merge nontrivial\n"; + my $tree = cmdoutput qw(git rev-parse), $needed[0]{Commit}.':'; + + my $commit = "tree $tree\n"; + my $msg = "Combine archive branches $csuite [dgit]\n\n". + "Input branches:\n"; + + foreach my $mi (sort { $a->{Index} <=> $b->{Index} } @mergeinputs) { + printdebug "multisuite merge include $mi->{Info}\n"; + $mi->{Character} //= ' '; + $commit .= "parent $mi->{Commit}\n"; + $msg .= sprintf " %s %-25s %s\n", + $mi->{Character}, + (mergeinfo_version $mi), + $mi->{Info}; + } + my $authline = clogp_authline mergeinfo_getclogp $needed[0]; + $msg .= "\nKey\n". + " * marks the highest version branch, which choose to use\n". + " + marks each branch which was not already an ancestor\n\n". + "[dgit multi-suite $csuite]\n"; + $commit .= + "author $authline\n". + "committer $authline\n\n"; + $output = make_commit_text $commit.$msg; + printdebug "multisuite merge generated $output\n"; + } + + fetch_from_archive_record_1($output); + fetch_from_archive_record_2($output); + + progress "calculated combined tracking suite $csuite"; + + return 1; +} + sub clone_set_head () { open H, "> .git/HEAD" or die $!; print H "ref: ".lref()."\n" or die $!; @@ -3083,7 +3288,7 @@ sub clone_finish ($) { runcmd qw(bash -ec), <<'END'; set -o pipefail git ls-tree -r --name-only -z HEAD | \ - xargs -0r touch -r . -- + xargs -0r touch -h -r . -- END printdone "ready for work in $dstdir"; } @@ -3091,6 +3296,19 @@ END sub clone ($) { my ($dstdir) = @_; badusage "dry run makes no sense with clone" unless act_local(); + + my $multi_fetched = fork_for_multisuite(sub { + printdebug "multi clone before fetch merge\n"; + changedir $dstdir; + }); + if ($multi_fetched) { + printdebug "multi clone after fetch merge\n"; + clone_set_head(); + clone_finish($dstdir); + exit 0; + } + printdebug "clone main body\n"; + canonicalise_suite(); my $hasgit = check_for_git(); mkdir $dstdir or fail "create \`$dstdir': $!"; @@ -3128,7 +3346,9 @@ sub fetch () { } sub pull () { - fetch(); + my $multi_fetched = fork_for_multisuite(sub { }); + fetch() unless $multi_fetched; # parent + return if $multi_fetched eq '0'; # child runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]", lrref(); printdone "fetched to ".lrref()." and merged into HEAD"; @@ -3332,7 +3552,7 @@ tree $tree parent $dgitview parent $archive_hash author $authline -commiter $authline +committer $authline $msg_msg @@ -3473,7 +3693,21 @@ sub push_tagwants ($$$$) { TfSuffix => '-maintview', View => 'maint', }; - } + } elsif ($dodep14tag eq 'no' ? 0 + : $dodep14tag eq 'want' ? access_cfg_tagformats_can_splitbrain + : $dodep14tag eq 'always' + ? (access_cfg_tagformats_can_splitbrain or fail < \&debiantag_maintview, + Objid => $dgithead, + TfSuffix => '-dgit', + View => 'dgit', + }; + }; foreach my $tw (@tagwants) { $tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro); $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; }; @@ -3620,7 +3854,7 @@ END my $dscpath = "$buildproductsdir/$dscfn"; stat_exists $dscpath or - fail "looked for .dsc $dscfn, but $!;". + fail "looked for .dsc $dscpath, but $!;". " maybe you forgot to build"; responder_send_file('dsc', $dscpath); @@ -3687,7 +3921,7 @@ END progress "checking that $dscfn corresponds to HEAD"; runcmd qw(dpkg-source -x --), $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath"; - my ($tree,$dir) = mktree_in_ud_from_only_subdir(); + my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package"); check_for_vendor_patches() if madformat($dsc->{format}); changedir '../../../..'; my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead); @@ -3803,8 +4037,12 @@ END runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); -Push failed, after updating the remote git repository. -If you want to try again, you must use a new version number. +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. +If you need to change the package, you must use a new version number. END if ($we_are_responder) { my $dryrunsuffix = act_local() ? "" : ".tmp"; @@ -3899,7 +4137,7 @@ sub fetchpullargs () { $package = getfield $sourcep, 'Source'; } if (@ARGV==0) { -# $isuite = branchsuite(); # this doesn't work because dak hates canons + $isuite = branchsuite(); if (!$isuite) { my $clogp = parsechangelog(); $isuite = getfield $clogp, 'Distribution'; @@ -3914,6 +4152,8 @@ sub fetchpullargs () { sub cmd_fetch { parseopts(); fetchpullargs(); + my $multi_fetched = fork_for_multisuite(sub { }); + exit 0 if $multi_fetched; fetch(); } @@ -4236,7 +4476,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; } } @@ -4271,17 +4511,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)" ]; } } @@ -4714,13 +4958,10 @@ sub build_maybe_quilt_fixup () { check_for_vendor_patches(); if (quiltmode_splitbrain) { - foreach my $needtf (qw(new maint)) { - next if grep { $_ eq $needtf } access_cfg_tagformats; - fail < $there"; - print STDERR Dumper($fi); +# print STDERR Dumper($fi); } my @mergeinputs = generate_commits_from_dsc(); die unless @mergeinputs == 1; @@ -5719,10 +5958,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 <