X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=51cac14844f120eba0b52ac8883dfa79891bdb30;hp=dfe0d155d4d1e6401d63bad0291b61934834f810;hb=e8ab02477159b5bd91a3566dc28367ed4a910b3a;hpb=7d91c1c8dc443ac42873e9833a909e47c63a49a1

diff --git a/dgit b/dgit
index dfe0d155..51cac148 100755
--- a/dgit
+++ b/dgit
@@ -78,7 +78,7 @@ 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 $split_brain_save;
+our %internal_object_save;
 our $we_are_responder;
 our $we_are_initiator;
 our $initiator_tempdir;
@@ -100,9 +100,6 @@ 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 = qr{orig(?:-$extra_orig_namepart_re)?};
-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';
@@ -201,15 +198,13 @@ sub lref () { return "refs/heads/".lbranch(); }
 sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
 sub rrref () { return server_ref($csuite); }
 
-sub stripepoch ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/^\d+\://;
-    return $vsn;
-}
-
 sub srcfn ($$) {
-    my ($vsn,$sfx) = @_;
-    return "${package}_".(stripepoch $vsn).$sfx
+    my ($vsn, $sfx) = @_;
+    return &source_file_leafname($package, $vsn, $sfx);
+}
+sub is_orig_file_of_vsn ($$) {
+    my ($f, $upstreamvsn) = @_;
+    return is_orig_file_of_p_v($f, $package, $upstreamvsn);
 }
 
 sub dscfn ($) {
@@ -222,12 +217,6 @@ sub changespat ($;$) {
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
-sub upstreamversion ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/-[^-]+$//;
-    return $vsn;
-}
-
 our $us = 'dgit';
 initdebug('');
 
@@ -824,7 +813,8 @@ sub access_forpush () {
 }
 
 sub pushing () {
-    die "$access_forpush ?" if ($access_forpush // 1) ne 1;
+    confess 'internal error '.Dumper($access_forpush)," ?" if
+	defined $access_forpush and !$access_forpush;
     badcfg "pushing but distro is configured readonly"
 	if access_forpush_config() eq '0';
     $access_forpush = 1;
@@ -1088,7 +1078,7 @@ sub canonicalise_suite_ftpmasterapi {
 	} qw(codename name);
 	push @matched, $entry;
     }
-    fail "unknown suite $isuite" unless @matched;
+    fail "unknown suite $isuite, maybe -d would help" unless @matched;
     my $cn;
     eval {
 	@matched==1 or die "multiple matches for suite $isuite\n";
@@ -1866,13 +1856,6 @@ sub is_orig_file_in_dsc ($$) {
     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;
-}
-
 # This function determines whether a .changes file is source-only from
 # the point of view of dak.  Thus, it permits *_source.buildinfo
 # files.
@@ -3474,7 +3457,7 @@ END
 
 
 sub multisuite_suite_child ($$$) {
-    my ($tsuite, $merginputs, $fn) = @_;
+    my ($tsuite, $mergeinputs, $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;
@@ -3501,7 +3484,7 @@ sub multisuite_suite_child ($$$) {
 	return $csuite;
     }
     printdebug "multisuite $tsuite ok (canon=$csuite)\n";
-    push @$merginputs, {
+    push @$mergeinputs, {
         Ref => lrref,
         Info => $csuite,
     };
@@ -3545,7 +3528,6 @@ sub fork_for_multisuite ($) {
             fetch_one();
 	    finish 0;
 	});
-	# xxx collecte the ref here
 
 	$csubsuite =~ s/^\Q$cbasesuite\E-/-/;
 	push @csuites, $csubsuite;
@@ -3836,13 +3818,14 @@ sub madformat_wantfixup ($) {
 sub maybe_split_brain_save ($$$) {
     my ($headref, $dgitview, $msg) = @_;
     # => message fragment "$saved" describing disposition of $dgitview
-    return "commit id $dgitview" unless defined $split_brain_save;
+    my $save = $internal_object_save{'dgit-view'};
+    return "commit id $dgitview" unless defined $save;
     my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
 	       git_update_ref_cmd
 	       "dgit --dgit-view-save $msg HEAD=$headref",
-	       $split_brain_save, $dgitview);
+	       $save, $dgitview);
     runcmd @cmd;
-    return "and left in $split_brain_save";
+    return "and left in $save";
 }
 
 # An "infopair" is a tuple [ $thing, $what ]
@@ -4439,7 +4422,8 @@ END
     responder_send_command("param isuite $isuite");
     responder_send_command("param tagformat $tagformat");
     if (defined $maintviewhead) {
-	die unless ($protovsn//4) >= 4;
+	confess "internal error (protovsn=$protovsn)"
+	    if defined $protovsn and $protovsn < 4;
 	responder_send_command("param maint-view $maintviewhead");
     }
 
@@ -5735,6 +5719,31 @@ END
     close $fakedsc or die $!;
 }
 
+sub quilt_fakedsc2unapplied ($$) {
+    my ($headref, $upstreamversion) = @_;
+    # must be run in the playground
+    # quilt_make_fake_dsc must have been called
+
+    runcmd qw(sh -ec),
+        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
+
+    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+    rename $fakexdir, "fake" or die "$fakexdir $!";
+
+    changedir 'fake';
+
+    remove_stray_gits("source package");
+    mktree_in_ud_here();
+
+    rmtree '.pc';
+
+    rmtree 'debian'; # git checkout commitish paths does not delete!
+    runcmd @git, qw(checkout -f), $headref, qw(-- debian);
+    my $unapplied=git_add_write_tree();
+    printdebug "fake orig tree object $unapplied\n";
+    return $unapplied;
+}    
+
 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.
@@ -5888,24 +5897,7 @@ sub quilt_fixup_multipatch ($$$) {
 	    quilt_check_splitbrain_cache($headref, $upstreamversion);
 	return if $cachehit;
     }
-
-    runcmd qw(sh -ec),
-        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
-
-    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
-    rename $fakexdir, "fake" or die "$fakexdir $!";
-
-    changedir 'fake';
-
-    remove_stray_gits("source package");
-    mktree_in_ud_here();
-
-    rmtree '.pc';
-
-    rmtree 'debian'; # git checkout commitish paths does not delete!
-    runcmd @git, qw(checkout -f), $headref, qw(-- debian);
-    my $unapplied=git_add_write_tree();
-    printdebug "fake orig tree object $unapplied\n";
+    my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion);
 
     ensuredir '.pc';
 
@@ -6292,6 +6284,10 @@ sub postbuild_mergechanges_vanilla ($) {
 
 sub cmd_build {
     build_prep_early();
+    $buildproductsdir eq '..' or print STDERR <<END;
+$us: warning: build-products-dir set, but not supported by dgit build
+$us: warning: things may go wrong or files may go to the wrong place
+END
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     build_prep($wantsrc);
@@ -6478,14 +6474,6 @@ sub cmd_push_source {
     dopush();
 }
 
-sub cmd_sbuild {
-    build_prep_early();
-    binary_builder(\@sbuild, <<END, qw(-d), $isuite, @ARGV, $dscfn);
-perhaps you need to pass -A ?  (sbuild's default is to build only
-arch-specific binaries; dgit 1.4 used to override that.)
-END
-}
-
 sub binary_builder {
     my ($bbuilder, $pbmc_msg, @args) = @_;
     build_prep(WANTSRC_SOURCE);
@@ -6505,6 +6493,14 @@ sub binary_builder {
     };
 }
 
+sub cmd_sbuild {
+    build_prep_early();
+    binary_builder(\@sbuild, <<END, qw(-d), $isuite, @ARGV, $dscfn);
+perhaps you need to pass -A ?  (sbuild's default is to build only
+arch-specific binaries; dgit 1.4 used to override that.)
+END
+}
+
 sub pbuilder ($) {
     my ($pbuilder) = @_;
     build_prep_early();
@@ -6543,6 +6539,24 @@ sub cmd_quilt_fixup {
     build_maybe_quilt_fixup();
 }
 
+sub cmd_print_unapplied_treeish {
+    badusage "incorrect arguments to dgit print-unapplied-treeish" if @ARGV;
+    my $headref = git_rev_parse('HEAD');
+    my $clogp = commit_getclogp $headref;
+    $package = getfield $clogp, 'Source';
+    $version = getfield $clogp, 'Version';
+    $isuite = getfield $clogp, 'Distribution';
+    $csuite = $isuite; # we want this to be offline!
+    notpushing();
+
+    prep_ud();
+    changedir $playground;
+    my $uv = upstreamversion $version;
+    quilt_make_fake_dsc($uv);
+    my $u = quilt_fakedsc2unapplied($headref, $uv);
+    print $u, "\n" or die $!;
+}
+
 sub import_dsc_result {
     my ($dstref, $newhash, $what_log, $what_msg) = @_;
     my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
@@ -6946,10 +6960,13 @@ sub parseopts () {
 	    } elsif (m/^--delayed=(\d+)$/s) {
 		push @ropts, $_;
 		push @dput, $_;
-	    } elsif (m/^--dgit-view-save=(.+)$/s) {
+	    } elsif (my ($k,$v) =
+		     m/^--save-(dgit-view)=(.+)$/s ||
+		     m/^--(dgit-view)-save=(.+)$/s
+		     ) {
 		push @ropts, $_;
-		$split_brain_save = $1;
-		$split_brain_save =~ s#^(?!refs/)#refs/heads/#;
+		$v =~ s#^(?!refs/)#refs/heads/#;
+		$internal_object_save{$k} = $v;
 	    } elsif (m/^--(no-)?rm-old-changes$/s) {
 		push @ropts, $_;
 		$rmchanges = !$1;
@@ -7049,8 +7066,8 @@ sub check_env_sanity () {
 	foreach my $name (qw(PIPE CHLD)) {
 	    my $signame = "SIG$name";
 	    my $signum = eval "POSIX::$signame" // die;
-	    ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or
-		die "$signame is set to something other than SIG_DFL\n";
+	    die "$signame is set to something other than SIG_DFL\n"
+		if defined $SIG{$name} and $SIG{$name} ne 'DEFAULT';
 	    $blocked->ismember($signum) and
 		die "$signame is blocked\n";
 	}