X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=b9b47eb3cde5cd4ab19b02b5378d698294038ffd;hb=d2cfebaad77a978ef2849cddc96740aef39c2d32;hp=5dfd97c7fdc45d3a0f4b9f2f53d67669845d8681;hpb=1d74cb1f1941d3a95a9fb0b9180c796f16c0d5b1;p=dgit.git diff --git a/dgit b/dgit index 5dfd97c7..b9b47eb3 100755 --- a/dgit +++ b/dgit @@ -63,7 +63,7 @@ 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|dpm|unapplied'; our $we_are_responder; @@ -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(); } @@ -537,11 +539,13 @@ our %defcfg = ('dgit.default.distro' => 'debian', # 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', @@ -870,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 $!; @@ -1370,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); @@ -1420,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 ($) { @@ -1433,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'; @@ -1514,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$#; @@ -1525,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 $!"; @@ -1561,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'; @@ -1634,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; } @@ -2344,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; @@ -2395,6 +2437,72 @@ $anc->[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 @@ -2411,20 +2519,13 @@ sub splitbrain_pseudomerge ($$$$) { # this: $dgitview' # - 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"; + printdebug "splitbrain_pseudomerge...\n"; + + my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); return $dgitview unless defined $archive_hash; - if (defined $overwrite_version) { - progress "Declaring that HEAD inciudes all changes in archive..."; - progress "Checking that $overwrite_version does so..."; - infopair_cond_equal([ $overwrite_version, '--overwrite= version' ], - $i_arch_v); - } else { + if (!defined $overwrite_version) { progress "Checking that HEAD inciudes all changes in archive..."; } @@ -2442,38 +2543,49 @@ sub splitbrain_pseudomerge ($$$$) { 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 (defined $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) = @_; @@ -2678,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}; @@ -2702,6 +2814,12 @@ END } } + if (defined $overwrite_version && !defined $maintviewhead) { + $dgithead = plain_overwrite_pseudomerge($clogp, + $dgithead, + $archive_hash); + } + check_not_dirty(); my $forceflag = ''; @@ -2713,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."; } } @@ -3613,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); @@ -3687,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(); } @@ -4505,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;