X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=5b99ed1cde43acf7e58f89886542bda82fd0005f;hp=b8922dae0c76c9970446eb59fa4ea98deaf01420;hb=95cce6041df774f7909b28c110417881f1d4792a;hpb=85eb1b447f987dc7da3960dd0d078ad6b7d6dd6f

diff --git a/dgit b/dgit
index b8922dae..5b99ed1c 100755
--- a/dgit
+++ b/dgit
@@ -40,6 +40,7 @@ our @ropts;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;
+our $buildproductsdir = '..';
 our $new_package = 0;
 our $ignoredirty = 0;
 our $noquilt = 0;
@@ -441,6 +442,8 @@ sub cmd_help () {
     exit 0;
 }
 
+our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
+
 our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit.default.username' => '',
 	       'dgit.default.archive-query-default-component' => 'main',
@@ -453,7 +456,18 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.debian.sshpsql-host' => 'coccia.debian.org',
 	       'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
 	       'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
-	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
+	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
+	       'dgit-distro.test-dummy.ssh' => "$td/ssh",
+	       'dgit-distro.test-dummy.username' => "alice",
+	       'dgit-distro.test-dummy.git-check' => "ssh-cmd",
+	       'dgit-distro.test-dummy.git-create' => "ssh-cmd",
+	       'dgit-distro.test-dummy.git-url' => "$td/git",
+	       'dgit-distro.test-dummy.git-host' => "git",
+	       'dgit-distro.test-dummy.git-path' => "$td/git",
+	       'dgit-distro.test-dummy.archive-query' => "dummycat:$td/aq",
+	       'dgit-distro.test-dummy.mirror' => "file://$td/mirror/",
+	       'dgit-distro.test-dummy.upload-host' => 'test-dummy',
+               );
 
 sub cfg {
     foreach my $c (@_) {
@@ -563,6 +577,23 @@ sub parsechangelog {
     return $c;
 }
 
+sub git_get_ref ($) {
+    my ($refname) = @_;
+    my $got = cmdoutput_errok @git, qw(show-ref --), $refname;
+    if (!defined $got) {
+	$?==256 or fail "git show-ref failed (status $?)";
+	printdebug "ref $refname= [show-ref exited 1]\n";
+	return '';
+    }
+    if ($got =~ m/^(\w+) \Q$refname\E$/m) {
+	printdebug "ref $refname=$1\n";
+	return $1;
+    } else {
+	printdebug "ref $refname= [no match]\n";
+	return '';
+    }
+}
+
 our %rmad;
 
 sub archive_query ($) {
@@ -606,7 +637,7 @@ sub madison_parse ($) {
 	$l =~ m{^ \s*( [^ \t|]+ )\s* \|
                   \s*( [^ \t|]+ )\s* \|
                   \s*( [^ \t|/]+ )(?:/([^ \t|/]+))? \s* \|
-                  \s*( [^ \t|]+ )\s* }x or die "$rmad $?";
+                  \s*( [^ \t|]+ )\s* }x or die "$rmad ?";
 	$1 eq $package or die "$rmad $package ?";
 	my $vsn = $2;
 	my $newsuite = $3;
@@ -638,7 +669,7 @@ sub sshpsql ($$) {
     my ($userhost,$dbname) = ($`,$'); #';
     my @rows;
     my @cmd = (access_cfg_ssh, $userhost,
-	       shellquote qw(psql -A), $dbname, qw(-c), $sql);
+	       "export LANG=C; ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
     printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0;
     open P, "-|", @cmd or die $!;
     while (<P>) {
@@ -646,7 +677,7 @@ sub sshpsql ($$) {
 	printdebug("$debugprefix>|$_|\n");
 	push @rows, $_;
     }
-    $!=0; $?=0; close P or die "$! $?";
+    $!=0; $?=0; close P or failedcmd @cmd;
     @rows or die;
     my $nrows = pop @rows;
     $nrows =~ s/^\((\d+) rows?\)$/$1/ or die "$nrows ?";
@@ -698,6 +729,45 @@ END
     return $rows[0];
 }
 
+sub canonicalise_suite_dummycat ($$) {
+    my ($proto,$data) = @_;
+    my $dpath = "$data/suite.$isuite";
+    if (!open C, "<", $dpath) {
+	$!==ENOENT or die "$dpath: $!";
+	printdebug "dummycat canonicalise_suite $isuite $dpath ENOENT\n";
+	return $isuite;
+    }
+    $!=0; $_ = <C>;
+    chomp or die "$dpath: $!";
+    close C;
+    printdebug "dummycat canonicalise_suite $isuite $dpath = $_\n";
+    return $_;
+}
+
+sub archive_query_dummycat ($$) {
+    my ($proto,$data) = @_;
+    canonicalise_suite();
+    my $dpath = "$data/package.$csuite.$package";
+    if (!open C, "<", $dpath) {
+	$!==ENOENT or die "$dpath: $!";
+	printdebug "dummycat query $csuite $package $dpath ENOENT\n";
+	return ();
+    }
+    my @rows;
+    while (<C>) {
+	next if m/^\#/;
+	next unless m/\S/;
+	die unless chomp;
+	printdebug "dummycat query $csuite $package $dpath | $_\n";
+	my @row = split /\s+/, $_;
+	@row==2 or die "$dpath: $_ ?";
+	push @rows, \@row;
+    }
+    C->error and die "$dpath: $!";
+    close C;
+    return sort { -version_compare_string($a->[0],$b->[0]); } @rows;
+}
+
 sub canonicalise_suite () {
     return if defined $csuite;
     fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
@@ -983,22 +1053,13 @@ sub fetch_from_archive () {
 	progress "no version available from the archive";
     }
 
-    my $lrref_fn = ".git/".lrref();
-    if (open H, $lrref_fn) {
-	$lastpush_hash = <H>;
-	chomp $lastpush_hash;
-	die "$lrref_fn $lastpush_hash ?" unless $lastpush_hash =~ m/^\w+$/;
-    } elsif ($! == &ENOENT) {
-	$lastpush_hash = '';
-    } else {
-	die "$lrref_fn $!";
-    }
+    $lastpush_hash = git_get_ref(lrref());
     printdebug "previous reference hash=$lastpush_hash\n";
     my $hash;
     if (defined $dsc_hash) {
-	fail "missing git history even though dsc has hash -".
-	    " could not find commit $dsc_hash".
-	    " (should be in ".access_giturl()."#".rrref().")"
+	fail "missing remote git history even though dsc has hash -".
+	    " could not find ref ".lrref().
+	    " (should have been fetched from ".access_giturl()."#".rrref().")"
 	    unless $lastpush_hash;
 	$hash = $dsc_hash;
 	ensure_we_have_orig();
@@ -1259,13 +1320,14 @@ sub dopush () {
     my ($clogp, $cversion, $tag, $dscfn) =
 	push_parse_changelog("$clogpfn");
 
-    stat "../$dscfn" or
+    my $dscpath = "$buildproductsdir/$dscfn";
+    stat $dscpath or
 	fail "looked for .dsc $dscfn, but $!;".
 	    " maybe you forgot to build";
 
-    responder_send_file('dsc', "../$dscfn");
+    responder_send_file('dsc', $dscpath);
 
-    push_parse_dsc("../$dscfn", $dscfn, $cversion);
+    push_parse_dsc($dscpath, $dscfn, $cversion);
 
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
@@ -1275,7 +1337,8 @@ sub dopush () {
     check_not_dirty();
     changedir $ud;
     progress "checking that $dscfn corresponds to HEAD";
-    runcmd qw(dpkg-source -x --), "../../../../$dscfn";
+    runcmd qw(dpkg-source -x --),
+        $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
     changedir '../../../..';
     my @diffcmd = (@git, qw(diff --exit-code), $tree);
@@ -1297,19 +1360,22 @@ sub dopush () {
 #        (uploadbranch());
     my $head = rev_parse('HEAD');
     if (!$changesfile) {
-	my $multi = "../${package}_".(stripepoch $cversion)."_multi.changes";
+	my $multi = "$buildproductsdir/".
+	    "${package}_".(stripepoch $cversion)."_multi.changes";
 	if (stat "$multi") {
 	    $changesfile = $multi;
 	} else {
 	    $!==&ENOENT or die "$multi: $!";
 	    my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
-	    my @cs = glob "../$pat";
+	    my @cs = glob "$buildproductsdir/$pat";
 	    fail "failed to find unique changes file".
-		" (looked for $pat in .., or $multi);".
+		" (looked for $pat in $buildproductsdir, or $multi);".
 		" perhaps you need to use dgit -C"
 		unless @cs==1;
 	    ($changesfile) = @cs;
 	}
+    } else {
+	$changesfile = "$buildproductsdir/$changesfile";
     }
 
     responder_send_file('changes',$changesfile);
@@ -1324,7 +1390,7 @@ sub dopush () {
     } else {
 	$tagobjfn =
 	    push_mktag($head,$clogp,$tag,
-		       "../$dscfn",
+		       $dscpath,
 		       $changesfile,$changesfile,
 		       $tfn);
     }
@@ -1342,16 +1408,16 @@ sub dopush () {
 
     if (!$we_are_responder) {
 	if (act_local()) {
-	    rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
+	    rename "$dscpath.tmp",$dscpath or die "$dscfn $!";
 	} else {
-	    progress "[new .dsc left in $dscfn.tmp]";
+	    progress "[new .dsc left in $dscpath.tmp]";
 	}
     }
 
     if ($we_are_responder) {
 	my $dryrunsuffix = act_local() ? "" : ".tmp";
 	responder_receive_files('signed-dsc-changes',
-				"../$dscfn$dryrunsuffix",
+				"$dscpath$dryrunsuffix",
 				"$changesfile$dryrunsuffix");
     } else {
 	sign_changes $changesfile;
@@ -1743,7 +1809,7 @@ sub changesopts () {
 	my @vsns = archive_query('archive_query');
 	if (@vsns) {
 	    @vsns = map { $_->[0] } @vsns;
-	    @vsns = sort { version_compare_string($a, $b) } @vsns;
+	    @vsns = sort { -version_compare_string($a, $b) } @vsns;
 	    $changes_since_version = $vsns[0];
 	    progress "changelog will contain changes since $vsns[0]";
 	} else {
@@ -1888,12 +1954,12 @@ sub parseopts () {
 	    } elsif (m/^--since-version=([^_]+|_)$/) {
 		push @ropts, $_;
 		$changes_since_version = $1;
-	    } elsif (m/^--(\w+)=(.*)/s &&
+	    } elsif (m/^--([-0-9a-z]+)=(.*)/s &&
 		     ($om = $opts_opt_map{$1}) &&
 		     length $om->[0]) {
 		push @ropts, $_;
 		$om->[0] = $2;
-	    } elsif (m/^--(\w+):(.*)/s &&
+	    } elsif (m/^--([-0-9a-z]+):(.*)/s &&
 		     !$opts_opt_cmdonly{$1} &&
 		     ($om = $opts_opt_map{$1})) {
 		push @ropts, $_;
@@ -1909,6 +1975,9 @@ sub parseopts () {
 	    } elsif (m/^--distro=(.*)/s) {
 		push @ropts, $_;
 		$idistro = $1;
+	    } elsif (m/^--build-products-dir=(.*)/s) {
+		push @ropts, $_;
+		$buildproductsdir = $1;
 	    } elsif (m/^--clean=(dpkg-source|git|none)$/s) {
 		push @ropts, $_;
 		$cleanmode = $1;
@@ -1957,6 +2026,9 @@ sub parseopts () {
 		} elsif (s/^-C(.*)//s) {
 		    push @ropts, $&;
 		    $changesfile = $1;
+		    if ($changesfile =~ s#^(.*)/##) {
+			$buildproductsdir = $1;
+		    }
 		} elsif (s/^-k(.*)//s) {
 		    $keyid=$1;
 		} elsif (s/^-wn//s) {