X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=a75a0711a2dcb48a0a3ac8a7f8f4468e1ea0b86b;hb=3940b368db5ffb18b61b6857c22498b46094fca1;hp=497687ac2b7932d34a4eb5f893a0bdb647339b81;hpb=f2a1ab46505797714043bb64897135972f9ffe09;p=dgit.git

diff --git a/dgit b/dgit
index 497687ac..a75a0711 100755
--- a/dgit
+++ b/dgit
@@ -45,6 +45,7 @@ our $ignoredirty = 0;
 our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
+our $changes_since_version;
 our $we_are_responder;
 our $initiator_tempdir;
 
@@ -113,8 +114,6 @@ sub dscfn ($) {
     return "${package}_".(stripepoch $vsn).".dsc";
 }
 
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
 our $us = 'dgit';
 our $debugprefix = '';
 
@@ -313,7 +312,8 @@ sub shellquote {
     local $_;
     foreach my $a (@_) {
 	$_ = $a;
-	if (s{['\\]}{\\$&}g || m{\s} || m{[^-_./0-9a-z]}i) {
+	if (m{[^-=_./0-9a-z]}i) {
+	    s{['\\]}{'\\$&'}g;
 	    push @out, "'$_'";
 	} else {
 	    push @out, $_;
@@ -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.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/');
 
@@ -572,9 +571,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 +584,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 +599,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 +617,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 +632,77 @@ 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,
+	       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) {
-	# madison canonicalises for us
 	progress "canonical suite name for $isuite is $csuite";
     }
 }
@@ -1504,16 +1551,6 @@ sub cmd_rpush {
 	};
 	i_method "i_resp", $icmd, $iargs;
     }
-
-    my $pid = $i_child_pid;
-    $i_child_pid = undef; # prevents killing some other process with same pid
-    printdebug "waiting for remote child $pid...";
-    my $got = waitpid $pid, 0;
-    die $! unless $got == $pid;
-    die "remote child failed $?" if $?;
-
-    i_cleanup();
-    exit 0;
 }
 
 sub i_resp_progress ($) {
@@ -1523,7 +1560,15 @@ sub i_resp_progress ($) {
 }
 
 sub i_resp_complete {
+    my $pid = $i_child_pid;
+    $i_child_pid = undef; # prevents killing some other process with same pid
+    printdebug "waiting for remote child $pid...\n";
+    my $got = waitpid $pid, 0;
+    die $! unless $got == $pid;
+    die "remote child failed $?" if $?;
+
     i_cleanup();
+    printdebug "all done\n";
     exit 0;
 }
 
@@ -1692,6 +1737,26 @@ sub build_prep () {
     build_maybe_quilt_fixup();
 }
 
+sub changesopts () {
+    my @opts =@changesopts[1..$#changesopts];
+    if (!defined $changes_since_version) {
+	my @vsns = archive_query('archive_query');
+	if (@vsns) {
+	    @vsns = map { $_->[0] } @vsns;
+	    @vsns = sort { version_compare_string($a, $b) } @vsns;
+	    $changes_since_version = $vsns[0];
+	    progress "changelog will contain changes since $vsns[0]";
+	} else {
+	    $changes_since_version = '_';
+	    progress "package seems new, not specifying -v<version>";
+	}
+    }
+    if ($changes_since_version ne '_') {
+	unshift @opts, "-v$changes_since_version";
+    }
+    return @opts;
+}
+
 sub cmd_build {
     badusage "dgit build implies --clean=dpkg-source"
 	if $cleanmode ne 'dpkg-source';
@@ -1761,7 +1826,14 @@ sub cmd_sbuild {
 	}
     }
     runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
-    runcmd_ordryrun_local @mergechanges, glob $pat;
+    my @changesfiles = glob $pat;
+    @changesfiles = sort {
+	($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
+	    or $a cmp $b
+    } @changesfiles;
+    fail "wrong number of different changes files (@changesfiles)"
+	unless @changesfiles;
+    runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (act_local()) {
 	stat $multichanges or fail "$multichanges: $!";
@@ -1813,6 +1885,9 @@ sub parseopts () {
 	    } elsif (m/^--new$/) {
 		push @ropts, $_;
 		$new_package=1;
+	    } elsif (m/^--since-version=([^_]+|_)$/) {
+		push @ropts, $_;
+		$changes_since_version = $1;
 	    } elsif (m/^--(\w+)=(.*)/s &&
 		     ($om = $opts_opt_map{$1}) &&
 		     length $om->[0]) {
@@ -1866,7 +1941,10 @@ sub parseopts () {
 		} elsif (s/^-N/-/) {
 		    push @ropts, $&;
 		    $new_package=1;
-		} elsif (m/^-[vm]/) {
+		} elsif (s/^-v([^_]+|_)$//s) {
+		    push @ropts, $&;
+		    $changes_since_version = $1;
+		} elsif (m/^-m/) {
 		    push @ropts, $&;
 		    push @changesopts, $_;
 		    $_ = '';