finish support and docs for DGIT_SSH etc. config

[dgit.git] / dgit

diff --git a/dgit b/dgit
index eb6f01de3deecef20da7707daf375e0f3d1015b8..6a3f7b7626c97c91150d8ebf329f6bd8b11b850f 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -55,7 +55,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 +76,8 @@ our %opts_opt_map = ('dget' => \@dget,
                      'ch' => \@changesopts,
                      'mergechanges' => \@mergechanges);
 
+our %opts_opt_cmdonly = ('gpg' => 1);
+
 our $keyid;
 
 our $debug = 0;
@@ -144,6 +146,8 @@ sub fetchspec () {
 #  > file begin changes
 #  [etc]
 #
+#  > param head HEAD
+#
 #  > want signed-tag
 #  [indicates that signed tag is wanted]
 #  < data-block NBYTES
@@ -152,11 +156,11 @@ sub fetchspec () {
 #  < data-end
 #  < files-end
 #
-#  > want signed-changes-dsc
-#  < data-block NBYTES    [transfer of signed changes]
-#  [etc]
+#  > want signed-dsc-changes
 #  < data-block NBYTES    [transfer of signed dsc]
 #  [etc]
+#  < data-block NBYTES    [transfer of signed changes]
+#  [etc]
 #  < files-end
 #
 #  > complete
@@ -443,6 +447,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');
@@ -534,7 +556,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);
 }
 
@@ -542,7 +564,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;".
@@ -623,7 +645,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;
@@ -638,7 +660,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 {
@@ -1127,6 +1149,17 @@ END
     return ($tagobjfn);
 }
 
+sub sign_changes ($) {
+    my ($changesfile) = @_;
+    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;
+    }
+}
+
 sub dopush () {
     print DEBUG "actually entering push\n";
     prep_ud();
@@ -1222,19 +1255,15 @@ sub dopush () {
        }
     }
 
-    if ($sign) {
-       if ($we_are_responder) {
-           my $dryrunsuffix = $dryrun ? ".tmp" : "";
-           responder_receive_files('signed-changes-dsc',
-                                   "$changesfile$dryrunsuffix",
-                                   "../$dscfn$dryrunsuffix");
-       } else {
-           my @debsign_cmd = @debsign;
-           push @debsign_cmd, "-k$keyid" if defined $keyid;
-           push @debsign_cmd, $changesfile;
-           runcmd_ordryrun @debsign_cmd;
-       }
+    if ($we_are_responder) {
+       my $dryrunsuffix = $dryrun ? ".tmp" : "";
+       responder_receive_files('signed-dsc-changes',
+                               "../$dscfn$dryrunsuffix",
+                               "$changesfile$dryrupnsuffix");
+    } else {
+       sign_changes $changesfile;
     }
+
     runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
     my $host = access_cfg('upload-host','RETURN-UNDEF');
     my @hostarg = defined($host) ? ($host,) : ();
@@ -1427,8 +1456,18 @@ sub i_resp_file ($) {
     protocol_receive_file \*RO, $localpath;
 }
 
+our %i_param;
+
+sub i_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/;
+    $i_param{$1} = $2;
+}
+
+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;
@@ -1436,6 +1475,39 @@ sub i_resp_want ($) {
     print RI "end-files\n" or die $!;
 }
 
+our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+
+sub i_localname_parsed_changelog { return "remote-changelog.822"; }
+sub i_localname_changes { return "remote.changes"; }
+sub i_localname_dsc {
+    ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+       push_parse_changelog 'remote-changelog.822';
+    die if $i_dscfn =~ m#/|^\W#;
+    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;
@@ -1615,6 +1687,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;
@@ -1639,6 +1718,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;