X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=08ecca6ffcf3175f856a3029020d09671cec735b;hb=b3fb546c9bf124badecfa85a460f64c0c763f895;hp=b4de99a19cd90a1c51ab9d5990754ac1f1c7d215;hpb=c0d21118db89e8d02d5d3a196b64a1496789cf8a;p=dgit.git

diff --git a/dgit b/dgit
index b4de99a1..08ecca6f 100755
--- a/dgit
+++ b/dgit
@@ -28,7 +28,6 @@ use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
-use File::Temp;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
@@ -55,7 +54,7 @@ our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
 our (@sbuild) = qw(sbuild -A);
-our (@ssh) = qw(ssh);
+our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
 our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
@@ -76,6 +75,8 @@ our %opts_opt_map = ('dget' => \@dget,
                      'ch' => \@changesopts,
                      'mergechanges' => \@mergechanges);
 
+our %opts_opt_cmdonly = ('gpg' => 1);
+
 our $keyid;
 
 our $debug = 0;
@@ -170,8 +171,8 @@ sub badproto ($$) {
     fail "protocol violation; $m not expected";
 }
 
-sub protocol_expect ($&) {
-    my ($fh, $match) = @_;
+sub protocol_expect (&$) {
+    my ($match, $fh) = @_;
     local $_;
     $_ = <$fh>;
     defined && chomp or badproto $fh, "eof";
@@ -207,7 +208,7 @@ sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
-	protocol_expect \*STDIN, { m/^data-block (.*})$|data-end$/ };
+	protocol_expect { m/^data-block (.*})$|data-end$/ } \*STDIN;
 	length $1 or last;
 	my $d = protocol_read_bytes \*STDIN, $1;
 	print PF $d or die $!;
@@ -238,14 +239,14 @@ sub responder_receive_files ($@) {
     foreach my $fn (@ourfns) {
 	protocol_receive_file \*STDIN, $fn;
     }
-    protocol_expect \*STDIN, { m/^files-end$/ };
+    protocol_expect { m/^files-end$/ } \*STDIN;
 }
 
 #---------- remote protocol support, initiator ----------
 
 sub initiator_expect (&) {
     my ($match) = @_;
-    protocol_expect \*RO, &$match;
+    protocol_expect { &$match } \*RO;
 }
 
 #---------- end remote code ----------
@@ -445,6 +446,24 @@ sub access_cfg (@) {
     return $value;
 }
 
+sub string_to_ssh ($) {
+    my ($spec) = @_;
+    if ($spec =~ m/\s/) {
+	return qw(sh -ec), 'exec '.$spec.' "$@"', 'x';
+    } else {
+	return ($spec);
+    }
+}
+
+sub access_cfg_ssh () {
+    my $gitssh = access_cfg('ssh', 'RETURN-UNDEF');
+    if (!defined $gitssh) {
+	return @ssh;
+    } else {
+	return string_to_ssh $gitssh;
+    }
+}
+
 sub access_someuserhost ($) {
     my ($some) = @_;
     my $user = access_cfg("$some-user",'username');
@@ -536,7 +555,7 @@ 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;
+	access_cfg_ssh, $data, qw(dak ls -asource),"-s$isuite",$package;
     return madison_parse($dakls);
 }
 
@@ -544,7 +563,7 @@ sub canonicalise_suite_sshdakls ($$) {
     my ($proto,$data) = @_;
     $data =~ m/:/ or badcfg "invalid sshdakls method string \`$data'";
     my @cmd =
-	(access_cfg('ssh'), $`,
+	(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;".
@@ -625,7 +644,7 @@ sub check_for_git () {
     my $how = access_cfg('git-check');
     if ($how eq 'ssh-cmd') {
 	my @cmd =
-	    (access_cfg('ssh'),access_gituserhost(),
+	    (access_cfg_ssh, access_gituserhost(),
 	     " set -e; cd ".access_cfg('git-path').";".
 	     " if test -d $package.git; then echo 1; else echo 0; fi");
 	my $r= cmdoutput @cmd;
@@ -640,7 +659,7 @@ sub create_remote_git_repo () {
     my $how = access_cfg('git-create');
     if ($how eq 'ssh-cmd') {
 	runcmd_ordryrun
-	    (access_cfg('ssh'),access_gituserhost(),
+	    (access_cfg_ssh, access_gituserhost(),
 	     "set -e; cd ".access_cfg('git-path').";".
 	     " cp -a _template $package.git");
     } else {
@@ -1134,6 +1153,7 @@ sub sign_changes ($) {
     if ($sign) {
 	my @debsign_cmd = @debsign;
 	push @debsign_cmd, "-k$keyid" if defined $keyid;
+	push @debsign_cmd, "-p$pgp[0]" if $pgp[0] ne 'gpg';
 	push @debsign_cmd, $changesfile;
 	runcmd_ordryrun @debsign_cmd;
     }
@@ -1446,6 +1466,7 @@ our %i_wanted;
 
 sub i_resp_want ($) {
     my ($keyword) = @_;
+    die "$keyword ?" if $i_wanted{$keyword}++;
     my @localpaths = i_method "i_want_", $keyword;
     foreach my $localpath (@localpaths) {
 	protocol_send_file \*RI, $localpath;
@@ -1464,6 +1485,28 @@ sub i_localname_dsc {
     return $dscfn;
 }
 
+sub i_want_signed_tag {
+    defined $i_param{'head'} && defined $dscfn
+	or badproto \*RO, "sequencing error";
+    my $head = $i_param{'head'};
+    die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+
+    push_parse_dsc $i_dscfn, 'remote dsc', 
+
+    push_mktag $head, $i_clogp, $i_tag,
+        $dsc, $i_dscfn,
+        'remote.changes', 'remote changes',
+        'tag.tag';
+
+    return 'tag.tag';
+}
+
+sub i_want_signed_dsc_changes {
+    rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
+    sign_changes 'remote.changes';
+    return ($i_dscfn, 'remote.changes');
+}
+
 #---------- building etc. ----------
 
 our $version;
@@ -1643,6 +1686,13 @@ sub cmd_version {
 
 sub parseopts () {
     my $om;
+
+    if (defined $ENV{'DGIT_SSH'}) {
+	@ssh = string_to_ssh $ENV{'DGIT_SSH'};
+    } elsif (defined $ENV{'GIT_SSH'}) {
+	@ssh = ($ENV{'GIT_SSH'});
+    }
+
     while (@ARGV) {
 	last unless $ARGV[0] =~ m/^-/;
 	$_ = shift @ARGV;
@@ -1667,6 +1717,7 @@ sub parseopts () {
 		push @ropts, $_;
 		$om->[0] = $2;
 	    } elsif (m/^--(\w+):(.*)/s &&
+		     !$opts_opt_cmdonly{$1} &&
 		     ($om = $opts_opt_map{$1})) {
 		push @ropts, $_;
 		push @$om, $2;