X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=9b895b0350a7bc0cbf8b635b6c60779e648a1b24;hp=d74dd85b681c32357628472a12b7291f11995e4a;hb=dd869ec82e37459dcc52a3843f02c9fcceade085;hpb=08b5daae7971c7ab730471d58d665ef087573791

diff --git a/dgit b/dgit
index d74dd85b..9b895b03 100755
--- a/dgit
+++ b/dgit
@@ -441,6 +441,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',
@@ -450,11 +452,21 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
 	       'dgit-distro.debian.git-check' => 'ssh-cmd',
 	       'dgit-distro.debian.git-create' => 'ssh-cmd',
-	       'dgit-distro.debian.sshdakls-host' => 'coccia.debian.org',
-	       'dgit-distro.debian.sshdakls-dir' =>
-	           '/srv/ftp-master.debian.org/ftp/dists',
+	       '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 (@_) {
@@ -564,6 +576,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 ($) {
@@ -572,9 +601,9 @@ sub archive_query ($) {
     if (!defined $query) {
 	my $distro = access_distro();
 	if ($distro eq 'debian') {
-	    $query = "sshdakls:".
-		access_someuserhost('sshdakls').':'.
-	        access_cfg('sshdakls-dir');
+	    $query = "sshpsql:".
+		access_someuserhost('sshpsql').':'.
+	        access_cfg('sshpsql-dbname');
 	} else {
 	    $query = "madison:$distro";
 	}
@@ -585,6 +614,12 @@ sub archive_query ($) {
     { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); }
 }
 
+sub pool_dsc_subpath ($$) {
+    my ($vsn,$component) = @_; # $package is implict arg
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    return "/pool/$component/$prefix/$package/".dscfn($vsn);
+}
+
 sub archive_query_madison ($$) {
     my ($proto,$data) = @_;
     die unless $proto eq 'madison';
@@ -594,28 +629,6 @@ sub archive_query_madison ($$) {
     return madison_parse($rmad);
 }
 
-sub archive_query_sshdakls ($$) {
-    my ($proto,$data) = @_;
-    $data =~ s/:.*// or badcfg "invalid sshdakls method string \`$data'";
-    my $dakls = cmdoutput
-	access_cfg_ssh, $data, qw(dak ls -asource),"-s$isuite",$package;
-    return madison_parse($dakls);
-}
-
-sub canonicalise_suite_sshdakls ($$) {
-    my ($proto,$data) = @_;
-    $data =~ m/:/ or badcfg "invalid sshdakls method string \`$data'";
-    my @cmd =
-	(access_cfg_ssh, $`,
-	 "set -e; cd $';".
-	 " if test -h $isuite; then readlink $isuite; exit 0; fi;".
-	 " if test -d $isuite; then echo $isuite; exit 0; fi;".
-	 " exit 1");
-    my $dakls = cmdoutput @cmd;
-    failedcmd @cmd unless $dakls =~ m/^\w/;
-    return $dakls;
-}
-
 sub madison_parse ($) {
     my ($rmad) = @_;
     my @out;
@@ -634,14 +647,13 @@ sub madison_parse ($) {
 	    $component = access_cfg('archive-query-default-component');
 	}
 	$5 eq 'source' or die "$rmad ?";
-	my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-	my $subpath = "/pool/$component/$prefix/$package/".dscfn($vsn);
-	push @out, [$vsn,$subpath,$newsuite];
+	push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
     }
     return sort { -version_compare_string($a->[0],$b->[0]); } @out;
 }
 
 sub canonicalise_suite_madison ($$) {
+    # madison canonicalises for us
     my @r = archive_query_madison($_[0],$_[1]);
     @r or fail
 	"unable to canonicalise suite using package $package".
@@ -650,12 +662,116 @@ sub canonicalise_suite_madison ($$) {
     return $r[0][2];
 }
 
+sub sshpsql ($$) {
+    my ($data,$sql) = @_;
+    $data =~ m/:/ or badcfg "invalid sshpsql method string \`$data'";
+    my ($userhost,$dbname) = ($`,$'); #';
+    my @rows;
+    my @cmd = (access_cfg_ssh, $userhost,
+	       "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>) {
+	chomp or die;
+	printdebug("$debugprefix>|$_|\n");
+	push @rows, $_;
+    }
+    $!=0; $?=0; close P or die "$! $?";
+    @rows or die;
+    my $nrows = pop @rows;
+    $nrows =~ s/^\((\d+) rows?\)$/$1/ or die "$nrows ?";
+    @rows == $nrows+1 or die "$nrows ".(scalar @rows)." ?";
+    @rows = map { [ split /\|/, $_ ] } @rows;
+    my $ncols = scalar @{ shift @rows };
+    die if grep { scalar @$_ != $ncols } @rows;
+    return @rows;
+}
+
+sub sql_injection_check {
+    foreach (@_) { die "$_ $& ?" if m/[']/; }
+}
+
+sub archive_query_sshpsql ($$) {
+    my ($proto,$data) = @_;
+    sql_injection_check $isuite, $package;
+    my @rows = sshpsql($data, <<END);
+        SELECT source.version, component.name, files.filename
+          FROM source
+          JOIN src_associations ON source.id = src_associations.source
+          JOIN suite ON suite.id = src_associations.suite
+          JOIN dsc_files ON dsc_files.source = source.id
+          JOIN files_archive_map ON files_archive_map.file_id = dsc_files.file
+          JOIN component ON component.id = files_archive_map.component_id
+          JOIN files ON files.id = dsc_files.file
+         WHERE ( suite.suite_name='$isuite' OR suite.codename='$isuite' )
+           AND source.source='$package'
+           AND files.filename LIKE '%.dsc';
+END
+    @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    @rows = map {
+	my ($vsn,$component,$filename) = @$_;
+	[ $vsn, "/pool/$component/$filename" ];
+    } @rows;
+    return @rows;
+}
+
+sub canonicalise_suite_sshpsql ($$) {
+    my ($proto,$data) = @_;
+    sql_injection_check $isuite;
+    my @rows = sshpsql($data, <<END);
+        SELECT suite.codename
+          FROM suite where suite_name='$isuite' or codename='$isuite';
+END
+    @rows = map { $_->[0] } @rows;
+    fail "unknown suite $isuite" unless @rows;
+    die "ambiguous $isuite: @rows ?" if @rows>1;
+    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';
     $csuite = archive_query('canonicalise_suite');
     if ($isuite ne $csuite) {
-	# madison canonicalises for us
 	progress "canonical suite name for $isuite is $csuite";
     }
 }
@@ -936,22 +1052,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();
@@ -1412,7 +1519,7 @@ sub cmd_push {
 	is_fast_fwd(lrref(), 'HEAD') or
 	    fail "dgit push: HEAD is not a descendant".
 	        " of the archive's version.\n".
-		"$us: To overwrite it, use git-merge -s ours ".lrref().".";
+		"$us: To overwrite it, use git merge -s ours ".lrref().".";
     } else {
 	$new_package or
 	    fail "package appears to be new in this suite;".
@@ -1841,12 +1948,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, $_;