X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=4c80280523bd9f3506220622d61eef2a847a9cdb;hb=2d32065922bf75bab3ae460457d474c2d08bb1de;hp=54337f73a20cb2d8c61c74326e8b68f81730c59e;hpb=691b12e13974d68966a397186cc5e310e5582f0f;p=dgit.git

diff --git a/dgit b/dgit
index 54337f73..4c802805 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;
@@ -77,6 +77,9 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
 our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
+our $orig_f_comp_re = 'orig(?:-[-0-9a-z]+)?';
+our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
+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';
@@ -150,6 +153,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(); }
@@ -1372,20 +1377,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 +1432,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_f_tail_re$/o;
+    return 1;
+}
+
+sub is_orig_file_of_vsn ($$) {
+    my ($f, $upstreamvsn) = @_;
+    my $base = srcfn $upstreamvsn, '';
+    return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
+    return 1;
 }
 
 sub make_commit ($) {
@@ -1435,6 +1453,28 @@ 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;
+    print Dumper($text) if $debuglevel > 1;
+    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 +1556,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,48 +1568,292 @@ 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 $!";
 	}
     }
 
+    # We unpack and record the orig tarballs first, so that we only
+    # need disk space for one private copy of the unpacked source.
+    # But we can't make them into commits until we have the metadata
+    # from the debian/changelog, so we record the tree objects now and
+    # make them into commits later.
+    my @tartrees;
+    my $upstreamv = $dsc->{version};
+    $upstreamv =~ s/-[^-]+$//;
+    my $orig_f_base = srcfn $upstreamv, '';
+
+    foreach my $fi (@dfi) {
+	# We actually import, and record as a commit, every tarball
+	# (unless there is only one file, in which case there seems
+	# little point.
+
+	my $f = $fi->{Filename};
+	printdebug "import considering $f ";
+	(printdebug "only one dfi\n"), next if @dfi == 1;
+	(printdebug "not tar\n"), next unless $f =~ m/\.tar(\.\w+)?$/;
+	(printdebug "signature\n"), next if $f =~ m/$orig_f_sig_re$/o;
+	my $compr_ext = $1;
+
+	my ($orig_f_part) =
+	    $f =~ m/^\Q$orig_f_base\E\.([^._]+)?\.tar(?:\.\w+)?$/;
+
+	printdebug "Y ", (join ' ', map { $_//"(none)" }
+			  $compr_ext, $orig_f_part
+			 ), "\n";
+
+	my $input = new IO::File $f, '<' or die "$f $!";
+	my $compr_pid;
+	my @compr_cmd;
+
+	if (defined $compr_ext) {
+	    my $cname =
+		Dpkg::Compression::compression_guess_from_filename $f;
+	    fail "Dpkg::Compression cannot handle file $f in source package"
+		if defined $compr_ext && !defined $cname;
+	    my $compr_proc =
+		new Dpkg::Compression::Process compression => $cname;
+	    my @compr_cmd = $compr_proc->get_uncompress_cmdline();
+	    my $compr_fh = new IO::Handle;
+	    my $compr_pid = open $compr_fh, "-|" // die $!;
+	    if (!$compr_pid) {
+		open STDIN, "<&", $input or die $!;
+		exec @compr_cmd;
+		die "dgit (child): exec $compr_cmd[0]: $!\n";
+	    }
+	    $input = $compr_fh;
+	}
+
+	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 $!;
+	    open STDIN, "<&", $input or die $!;
+	    exec @tarcmd;
+	    die "dgit (child): exec $tarcmd[0]: $!";
+	}
+	$!=0; (waitpid $tar_pid, 0) == $tar_pid or die $!;
+	!$? or failedcmd @tarcmd;
+
+	close $input or
+	    (@compr_cmd ? failedcmd @compr_cmd
+	     : die $!);
+	# 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";
+
+	my $ent = [ $f, $tree ];
+	push @tartrees, {
+            Orig => !!$orig_f_part,
+            Sort => (!$orig_f_part         ? 2 :
+		     $orig_f_part =~ m/-/g ? 1 :
+		                             0),
+            F => $f,
+            Tree => $tree,
+        };
+    }
+
+    @tartrees = sort {
+	# put any without "_" first (spec is not clear whether files
+	# are always in the usual order).  Tarballs without "_" are
+	# the main orig or the debian tarball.
+	$a->{Sort} <=> $b->{Sort} or
+	$a->{F}    cmp $b->{F}
+    } @tartrees;
+
+    my $any_orig = grep { $_->{Orig} } @tartrees;
+
     my $dscfn = "$package.dsc";
 
+    my $treeimporthow = 'package';
+
     open D, ">", $dscfn or die "$dscfn: $!";
     print D $dscdata or die "$dscfn: $!";
     close D or die "$dscfn: $!";
     my @cmd = qw(dpkg-source);
     push @cmd, '--no-check' if $dsc_checked;
+    if (madformat $dsc->{format}) {
+	push @cmd, '--skip-patches';
+	$treeimporthow = 'unpatched';
+    }
     push @cmd, qw(-x --), $dscfn;
     runcmd @cmd;
 
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
-    check_for_vendor_patches() if madformat($dsc->{format});
-    runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
-    my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
+    if (madformat $dsc->{format}) { 
+	check_for_vendor_patches();
+    }
+
+    my $dappliedtree;
+    if (madformat $dsc->{format}) {
+	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();
+    }
+
+    my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
+    debugcmd "|",@clogcmd;
+    open CLOGS, "-|", @clogcmd or die $!;
+
+    my $clogp;
+    my $r1clogp;
+
+    printdebug "import clog search...\n";
+
+    for (;;) {
+	my $stanzatext = do { local $/=""; <CLOGS>; };
+	printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1;
+	last if !defined $stanzatext;
+
+	my $desc = "package changelog, entry no.$.";
+	open my $stanzafh, "<", \$stanzatext or die;
+	my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;
+	$clogp //= $thisstanza;
+
+	printdebug "import clog $thisstanza->{version} $desc...\n";
+
+	last if !$any_orig; # we don't need $r1clogp
+
+	# We look for the first (most recent) changelog entry whose
+	# version number is lower than the upstream version of this
+	# package.  Then the last (least recent) previous changelog
+	# entry is treated as the one which introduced this upstream
+	# version and used for the synthetic commits for the upstream
+	# tarballs.
+
+	# One might think that a more sophisticated algorithm would be
+	# necessary.  But: we do not want to scan the whole changelog
+	# file.  Stopping when we see an earlier version, which
+	# necessarily then is an earlier upstream version, is the only
+	# realistic way to do that.  Then, either the earliest
+	# changelog entry we have seen so far is indeed the earliest
+	# upload of this upstream version; or there are only changelog
+	# entries relating to later upstream versions (which is not
+	# possible unless the changelog and .dsc disagree about the
+	# version).  Then it remains to choose between the physically
+	# last entry in the file, and the one with the lowest version
+	# number.  If these are not the same, we guess that the
+	# versions were created in a non-monotic order rather than
+	# that the changelog entries have been misordered.
+
+	printdebug "import clog $thisstanza->{version} vs $upstreamv...\n";
+
+	last if version_compare($thisstanza->{version}, $upstreamv) < 0;
+	$r1clogp = $thisstanza;
+
+	printdebug "import clog $r1clogp->{version} becomes r1\n";
+    }
+    die $! if CLOGS->error;
+    close CLOGS or $?==(SIGPIPE<<8) or failedcmd @clogcmd;
+
+    $clogp or fail "package changelog has no entries!";
+
     my $authline = clogp_authline $clogp;
     my $changes = getfield $clogp, 'Changes';
+    my $cversion = getfield $clogp, 'Version';
+
+    if (@tartrees) {
+	$r1clogp //= $clogp; # maybe there's only one entry;
+	my $r1authline = clogp_authline $r1clogp;
+	# Strictly, r1authline might now be wrong if it's going to be
+	# unused because !$any_orig.  Whatever.
+
+	printdebug "import tartrees authline   $authline\n";
+	printdebug "import tartrees r1authline $r1authline\n";
+
+	foreach my $tt (@tartrees) {
+	    printdebug "import tartree $tt->{F} $tt->{Tree}\n";
+
+	    $tt->{Commit} = make_commit_text($tt->{Orig} ? <<END_O : <<END_T);
+tree $tt->{Tree}
+author $r1authline
+committer $r1authline
+
+Import $tt->{F}
+
+[dgit import orig $tt->{F}]
+END_O
+tree $tt->{Tree}
+author $authline
+committer $authline
+
+Import $tt->{F}
+
+[dgit import tarball $package $cversion $tt->{F}]
+END_T
+	}
+    }
+
+    printdebug "import main commit\n";
+
     open C, ">../commit.tmp" or die $!;
     print C <<END or die $!;
 tree $tree
+END
+    print C <<END or die $! foreach @tartrees;
+parent $_->{Commit}
+END
+    print C <<END or die $!;
 author $authline
 committer $authline
 
 $changes
 
-# imported from the archive
+[dgit import $treeimporthow $package $cversion]
 END
+
     close C or die $!;
     my $rawimport_hash = make_commit qw(../commit.tmp);
-    my $cversion = getfield $clogp, 'Version';
+
+    if (madformat $dsc->{format}) {
+	printdebug "import apply patches...\n";
+
+	# regularise the state of the working tree so that
+	# the checkout of $rawimport_hash works nicely.
+	my $dappliedcommit = make_commit_text(<<END);
+tree $dappliedtree
+author $authline
+committer $authline
+
+[dgit dummy commit]
+END
+	runcmd @git, qw(checkout -q -b dapplied), $dappliedcommit;
+
+	runcmd @git, qw(checkout -q -b unpa), $rawimport_hash;
+	runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import);
+	my $gapplied = git_rev_parse('HEAD');
+	my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+	$gappliedtree eq $dappliedtree or
+	    fail <<END;
+gbp-pq import and dpkg-source disagree!
+ gbp-pq import gave commit $gapplied
+ gbp-pq import gave tree $gappliedtree
+ dpkg-source --before-build gave tree $dappliedtree
+END
+	$rawimport_hash = $gapplied;
+    }
+
+    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 +1921,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;
     }
@@ -2119,7 +2405,7 @@ END
     } else {
 	$hash = $mergeinputs[0]{Commit};
     }
-    progress "fetch hash=$hash\n";
+    printdebug "fetch hash=$hash\n";
 
     my $chkff = sub {
 	my ($lasth, $what) = @_;
@@ -2346,7 +2632,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 +2690,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 +2727,7 @@ sub pseudomerge_make_commit ($$$$ $$) {
     chomp $msg_msg;
     $msg_cmd .=
 	!defined $overwrite_version ? ""
+	: !length  $overwrite_version ? " --overwrite"
 	: " --overwrite=".$overwrite_version;
 
     mkpath '.git/dgit';
@@ -2731,7 +3036,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 +3977,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 +4033,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 +4061,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 +4879,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) {