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|unapplied';
+our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';
our $we_are_responder;
our $initiator_tempdir;
our $patches_applied_dirtily = 00;
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(); }
'dgit.default.archive-query' => 'madison:',
'dgit.default.sshpsql-dbname' => 'service=projectb',
'dgit.default.dgit-tag-format' => 'old,new,maint',
+ # 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',
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 $!;
die 'bug' if $tagformatfn && $tagformat_want;
# ... $tagformat_want assigned after previous select_tagformat
- my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
+ my (@supported) = grep { $_ =~ m/^(?:old|new)$/ } access_cfg_tagformats();
printdebug "select_tagformat supported @supported\n";
$tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
$!=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);
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 ($) {
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';
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$#;
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 $!";
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';
}
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;
}
# Finally: we do not necessarily reify the public view (as
# described above). This is so that we do not end up stacking two
# pseudo-merges. So what we actually do is figure out the inputs
- # to any public view psuedo-merge and put them in @mergeinputs.
+ # to any public view pseudo-merge and put them in @mergeinputs.
my @mergeinputs;
# $mergeinputs[]{Commit}
return ($_, \%options);
}
-sub madformat ($) {
+sub madformat_wantfixup ($) {
my ($format) = @_;
return 0 unless $format eq '3.0 (quilt)';
our $quilt_mode_warned;
return 1;
}
+# An "infopair" is a tuple [ $thing, $what ]
+# (often $thing is a commit hash; $what is a description)
+
+sub infopair_cond_equal ($$) {
+ my ($x,$y) = @_;
+ $x->[0] eq $y->[0] or fail <<END;
+$x->[1] ($x->[0]) not equal to $y->[1] ($y->[0])
+END
+};
+
+sub infopair_lrf_tag_lookup ($$) {
+ my ($tagnames, $what) = @_;
+ # $tagname may be an array ref
+ my @tagnames = ref $tagnames ? @$tagnames : ($tagnames);
+ printdebug "infopair_lrfetchref_tag_lookup $what @tagnames\n";
+ foreach my $tagname (@tagnames) {
+ my $lrefname = lrfetchrefs."/tags/$tagname";
+ my $tagobj = $lrfetchrefs_f{$lrefname};
+ next unless defined $tagobj;
+ printdebug "infopair_lrfetchref_tag_lookup $tagobj $tagname $what\n";
+ return [ git_rev_parse($tagobj), $what ];
+ }
+ fail @tagnames==1 ? <<END : <<END;
+Wanted tag $what (@tagnames) on dgit server, but not found
+END
+Wanted tag $what (one of: @tagnames) on dgit server, but not found
+END
+}
+
+sub infopair_cond_ff ($$) {
+ my ($anc,$desc) = @_;
+ is_fast_fwd($anc->[0], $desc->[0]) or fail <<END;
+$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 <<END or die $!;
+tree $tree
+parent $dgitview
+parent $archive_hash
+author $authline
+commiter $authline
+
+$msg_msg
+
+[$msg_cmd]
+END
+ close MC or die $!;
+
+ return make_commit($pmf);
+}
+
sub splitbrain_pseudomerge ($$$$) {
my ($clogp, $maintview, $dgitview, $archive_hash) = @_;
# => $merged_dgitview
# this: $dgitview'
#
- # We work with tuples [ $thing, $what ]
- # (often $thing is a commit hash; $what is a description)
-
- my $tag_lookup = sub {
- my ($tagname, $what) = @_;
- printdebug "splitbrain_pseudomerge tag_lookup $what\n";
- my $lrefname = lrfetchrefs."/tags/$tagname";
- my $tagobj = $lrfetchrefs_f{$lrefname};
- defined $tagobj or fail <<END;
-Wanted tag $tagname ($what) on dgit server, but not found
-END
- printdebug "splitbrain_pseudomerge tag_lookup $tagobj $what\n";
- return [ git_rev_parse($tagobj), $what ];
- };
-
- my $cond_equal = sub {
- my ($x,$y) = @_;
- $x->[0] eq $y->[0] or fail <<END;
-$x->[1] ($x->[0]) not equal to $y->[1] ($y->[0])
-END
- };
- my $cond_ff = sub {
- my ($anc,$desc) = @_;
- is_fast_fwd($anc->[0], $desc->[0]) or fail <<END;
-$anc->[1] ($anc->[0]) .. $desc->[1] ($desc->[0]) is not fast forward
-END
- };
+ printdebug "splitbrain_pseudomerge...\n";
- 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";
+ my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
return $dgitview unless defined $archive_hash;
- if ($overwrite_version) {
- progress "Declaring that HEAD inciudes all changes in archive...";
- progress "Checking that $overwrite_version does so...";
- $cond_equal->([ $overwrite_version, '--overwrite= version' ],
- $i_arch_v);
- } else {
+ if (!defined $overwrite_version) {
progress "Checking that HEAD inciudes all changes in archive...";
}
return $dgitview if is_fast_fwd $archive_hash, $dgitview;
my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
- my $i_dep14 = $tag_lookup->($t_dep14, "maintainer view tag");
+ my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
- my $i_dgit = $tag_lookup->($t_dgit, "dgit view tag");
+ my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
my $i_archive = [ $archive_hash, "current archive contents" ];
printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
- $cond_equal->($i_dgit, $i_archive);
- $cond_ff->($i_dep14, $i_dgit);
- $overwrite_version or $cond_ff->($i_dep14, [ $maintview, 'HEAD' ]);
+ infopair_cond_equal($i_dgit, $i_archive);
+ 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 ? <<END_OVERWR : <<END_MAKEFF);
+Declare fast forward from $overwrite_version
+END_OVERWR
+Make fast forward from $i_arch_v->[0]
+END_MAKEFF
- mkpath '.git/dgit';
- my $pmf = ".git/dgit/pseudomerge";
- open MC, ">", $pmf or die "$pmf $!";
- print MC <<END or die $!;
-tree $tree
-parent $dgitview
-parent $archive_hash
-author $authline
-commiter $authline
+ progress "Made pseudo-merge of $i_arch_v->[0] into dgit view.";
+ return $r;
+}
-END
- if ($overwrite_version) {
- print MC <<END;
-Declare fast forward from $overwrite_version
+sub plain_overwrite_pseudomerge ($$$) {
+ my ($clogp, $head, $archive_hash) = @_;
-[dgit --quilt=$quilt_mode --overwrite-version=$overwrite_version]
-END
- } else {
- print MC <<END;
-Make fast forward from $i_arch_v->[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) = @_;
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};
}
}
+ if (defined $overwrite_version && !defined $maintviewhead) {
+ $dgithead = plain_overwrite_pseudomerge($clogp,
+ $dgithead,
+ $archive_hash);
+ }
+
check_not_dirty();
my $forceflag = '';
} 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.";
}
}
responder_send_command("param head $dgithead");
responder_send_command("param csuite $csuite");
responder_send_command("param tagformat $tagformat");
- if (quiltmode_splitbrain) {
+ if (defined $maintviewhead) {
die unless ($protovsn//4) >= 4;
responder_send_command("param maint-view $maintviewhead");
}
}
fail $msg;
}
+ if ($quilt_mode =~ m/dpm/ &&
+ ($diffbits->{H2A} & 01)) {
+ fail <<END;
+--quilt=$quilt_mode specified, implying patches-applied git tree
+ but git tree differs from result of applying debian/patches to upstream
+END
+ }
if ($quilt_mode =~ m/gbp|unapplied/ &&
($diffbits->{O2A} & 01)) { # some patches
quiltify_splitbrain_needed();
runcmd @git, qw(update-ref refs/heads/dgit-view HEAD);
runcmd @git, qw(checkout -q dgit-view);
}
+ if ($quilt_mode =~ m/gbp|dpm/ &&
+ ($diffbits->{O2A} & 02)) {
+ fail <<END
+--quilt=$quilt_mode specified, implying that HEAD is for use with a
+ tool which does not create patches for changes to upstream
+ .gitignores: but, such patches exist in debian/patches.
+END
+ }
if (($diffbits->{H2O} & 02) && # user has modified .gitignore
!($diffbits->{O2A} & 02)) { # patches do not change .gitignore
quiltify_splitbrain_needed();
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 <<END
+quilt mode $quilt_mode requires split view so server needs to support
+ both "new" and "maint" tag formats, but config says it doesn't.
+END
+ }
+ }
+
my $clogp = parsechangelog();
my $headref = git_rev_parse('HEAD');
local ($debuglevel) = $debuglevel-1;
printdebug "QF linkorigs $b, $f ?\n";
}
- next unless is_orig_file $b, srcfn $upstreamversion,'';
+ next unless is_orig_file_of_vsn $b, $upstreamversion;
printdebug "QF linkorigs $b, $f Y\n";
link_ltarget $f, $b or die "$b $!";
$fn->($b);
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();
}
} 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;
~ianmdlvl / dgit.git / blobdiff