Abolish the sshdakls method and replace it with sshpsql: that is, ssh (to coccia...

[dgit.git] / dgit

diff --git a/dgit b/dgit
index e5dbabba281d4d4a2d6e1a4acada688c69f766bb..a75a0711a2dcb48a0a3ac8a7f8f4468e1ea0b86b 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -450,9 +450,8 @@ 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.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.upload-host' => 'ftp-master', # for dput
               'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
 


@@ -572,9 +571,9 @@ sub archive_query ($) {
     if (!defined $query) {
        my $distro = access_distro();
        if ($distro eq 'debian') {
     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";
        }
        } else {
            $query = "madison:$distro";
        }


@@ -600,28 +599,6 @@ sub archive_query_madison ($$) {
     return madison_parse($rmad);
 }
 
     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;
 sub madison_parse ($) {
     my ($rmad) = @_;
     my @out;


@@ -646,6 +623,7 @@ sub madison_parse ($) {
 }
 
 sub canonicalise_suite_madison ($$) {
 }
 
 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".
     my @r = archive_query_madison($_[0],$_[1]);
     @r or fail
        "unable to canonicalise suite using package $package".


@@ -654,12 +632,77 @@ sub canonicalise_suite_madison ($$) {
     return $r[0][2];
 }
 
     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,
+              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 () {
     return if defined $csuite;
     fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
     $csuite = archive_query('canonicalise_suite');
     if ($isuite ne $csuite) {
 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";
     }
 }
        progress "canonical suite name for $isuite is $csuite";
     }
 }