X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=b9b47eb3cde5cd4ab19b02b5378d698294038ffd;hb=d2cfebaad77a978ef2849cddc96740aef39c2d32;hp=0dea96c8f1a678ad9c6d223197caa66e57cb2c0c;hpb=a840640baebaa11079b64be2ae5f89a111648985;p=dgit.git

diff --git a/dgit b/dgit
index 0dea96c8..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(); }
@@ -872,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 $!;
@@ -1372,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);
@@ -1422,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 ($) {
@@ -1435,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';
@@ -1516,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$#;
 
@@ -1527,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 $!";
@@ -1563,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';
@@ -1636,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;
     }
@@ -2346,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;
@@ -2404,8 +2444,26 @@ sub pseudomerge_version_check ($$) {
     my $i_arch_v = [ (getfield $arch_clogp, 'Version'),
 		     'version currently in archive' ];
     if (defined $overwrite_version) {
-	infopair_cond_equal([ $overwrite_version, '--overwrite= version' ],
-			    $i_arch_v);
+	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";
@@ -2423,6 +2481,7 @@ sub pseudomerge_make_commit ($$$$ $$) {
     chomp $msg_msg;
     $msg_cmd .=
 	!defined $overwrite_version ? ""
+	: !length  $overwrite_version ? " --overwrite"
 	: " --overwrite=".$overwrite_version;
 
     mkpath '.git/dgit';
@@ -2506,7 +2565,7 @@ sub plain_overwrite_pseudomerge ($$$) {
 
     my @tagformats = access_cfg_tagformats();
     my @t_overwr =
-	map { $_->($overwrite_version, access_basedistro) }
+	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";
@@ -2516,7 +2575,7 @@ sub plain_overwrite_pseudomerge ($$$) {
 
     return $head if is_fast_fwd $archive_hash, $head;
 
-    my $m = "Declare fast forward from $overwrite_version";
+    my $m = "Declare fast forward from $i_arch_v->[0]";
 
     my $r = pseudomerge_make_commit
 	$clogp, $head, $archive_hash, $i_arch_v,
@@ -2731,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};
@@ -3672,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 <<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');
 
@@ -3718,7 +3787,7 @@ sub quilt_fixup_linkorigs ($$) {
 	    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);
@@ -3746,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();
 }
 
@@ -4564,7 +4633,10 @@ sub parseopts () {
 	    } elsif (m/^--no-rm-on-error$/s) {
 		push @ropts, $_;
 		$rmonerror = 0;
-	    } elsif (m/^--overwrite=(.*)$/s) {
+	    } elsif (m/^--overwrite$/s) {
+		push @ropts, $_;
+		$overwrite_version = '';
+	    } elsif (m/^--overwrite=(.+)$/s) {
 		push @ropts, $_;
 		$overwrite_version = $1;
 	    } elsif (m/^--(no-)?rm-old-changes$/s) {