use LWP::UserAgent;
use Dpkg::Control::Hash;
use File::Path;
+use File::Temp qw(tempdir);
use File::Basename;
use Dpkg::Version;
use POSIX;
use IPC::Open2;
-use File::Temp;
our $our_version = 'UNRELEASED'; ###substituted###
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);
'ch' => \@changesopts,
'mergechanges' => \@mergechanges);
+our %opts_opt_cmdonly = ('gpg' => 1);
+
our $keyid;
our $debug = 0;
# remote push initiator/responder protocol:
# < dgit-remote-push-ready [optional extra info ignored by old initiators]
#
-# > file begin parsed-changelog
+# > file parsed-changelog
# [indicates that output of dpkg-parsechangelog follows]
# > data-block NBYTES
# > [NBYTES bytes of data (no newline)]
# [maybe some more blocks]
# > data-end
#
-# > file begin dsc
+# > file dsc
# [etc]
#
-# > file begin changes
+# > file changes
# [etc]
#
# > param head HEAD
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";
- return if &$match;
+ if (wantarray) {
+ my @r = &$match;
+ return @r if @r;
+ } else {
+ my $r = &$match;
+ return $r if $r;
+ }
badproto $fh, "\`$_'";
}
my ($fh, $ourfn) = @_;
open PF, ">", $ourfn or die "$ourfn: $!";
for (;;) {
- protocol_expect \*STDIN, { m/^data-block (.*})$|data-end$/ };
- length $1 or last;
+ my ($y,$l) = protocol_expect {
+ m/^data-block (.*})$|data-end$/;
+ length $1 ? (1,$1) : (0);
+ } \*STDIN;
+ last unless $y;
my $d = protocol_read_bytes \*STDIN, $1;
print PF $d or die $!;
}
sub responder_send_file ($$) {
my ($keyword, $ourfn) = @_;
return unless $we_are_responder;
- responder_send_command "file-begin $keyword";
+ responder_send_command "file $keyword";
protocol_send_file \*STDOUT, $ourfn;
}
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 ----------
push @out, $_;
}
}
- return join '', @out;
+ return join ' ', @out;
}
sub printcmd {
my $fh = shift @_;
my $intro = shift @_;
- print $fh $intro or die $!;
+ print $fh $intro," " or die $!;
print $fh shellquote @_ or die $!;
print $fh "\n" or die $!;
}
dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
dgit [dgit-opts] build [git-buildpackage-opts|dpkg-buildpackage-opts]
dgit [dgit-opts] push [dgit-opts] [suite]
+ dgit [dgit-opts] rpush build-host:build-dir ...
important dgit options:
-k<keyid> sign tag and package with <keyid> instead of default
--dry-run -n do not change anything, but go through the motions
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');
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);
}
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;".
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;
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 {
return ($clogp, $cversion, $tag, $dscfn);
}
-sub push_parse_dsc ($$) {
+sub push_parse_dsc ($$$) {
my ($dscfn,$dscfnwhat, $cversion) = @_;
$dsc = parsecontrol($dscfn,$dscfnwhat);
my $dversion = getfield $dsc, 'Version';
" does not match changelog \`$clogp->{$field}'";
}
+ my $cversion = getfield $clogp, 'Version';
+
# We make the git tag by hand because (a) that makes it easier
# to control the "tagger" (b) we can do remote signing
my $authline = clogp_authline $clogp;
if ($sign) {
my @debsign_cmd = @debsign;
push @debsign_cmd, "-k$keyid" if defined $keyid;
+ push @debsign_cmd, "-p$gpg[0]" if $gpg[0] ne 'gpg';
push @debsign_cmd, $changesfile;
runcmd_ordryrun @debsign_cmd;
}
}
}
- responder_send_file('changes',$changesfn);
+ responder_send_file('changes',$changesfile);
my $tfn = sub { ".git/dgit/tag$_[0]"; };
my ($tagobjfn) =
my $dryrunsuffix = $dryrun ? ".tmp" : "";
responder_receive_files('signed-dsc-changes',
"../$dscfn$dryrunsuffix",
- "$changesfile$dryrupnsuffix");
+ "$changesfile$dryrunsuffix");
} else {
sign_changes $changesfile;
}
die unless @rargs;
my ($dir) = @rargs;
chdir $dir or die "$dir: $!";
- $we_are_remote = 1;
+ $we_are_responder = 1;
$|=1;
responder_send_command("dgit-remote-push-ready");
&cmd_push;
$dir =~ s{^-}{./-};
my @rargs = ($dir);
my @rdgit;
- push @rdgit, @dgit
+ push @rdgit, @dgit;
push @rdgit, @ropts;
- push @rdgit, (scalar @rargs), @rargs;
+ push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
- my $pid = open2(\*RO, \*RI, @cmd);
+ printcmd \*DEBUG,"+",@cmd;
eval {
$i_tmp = tempdir();
+ my $pid = open2(\*RO, \*RI, @cmd);
chdir $i_tmp or die "$i_tmp $!";
initiator_expect { m/^dgit-remote-push-ready/ };
for (;;) {
- initiator_expect { m/^(\S+)(?: (.*))?$/ };
- my ($icmd,$iargs) = ($1, $2);
- i_method "i_resp_", $icmd, $iargs;
+ my ($icmd,$iargs) = initiator_expect {
+ m/^(\S+)(?: (.*))?$/;
+ ($1,$2);
+ };
+ i_method "i_resp", $icmd, $iargs;
}
};
i_cleanup();
sub i_resp_file ($) {
my ($keyword) = @_;
- my $localname = i_method "i_localname_", $keyword;
+ my $localname = i_method "i_localname", $keyword;
my $localpath = "$i_tmp/$localname";
stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
protocol_receive_file \*RO, $localpath;
sub i_resp_want ($) {
my ($keyword) = @_;
- my @localpaths = i_method "i_want_", $keyword;
+ die "$keyword ?" if $i_wanted{$keyword}++;
+ my @localpaths = i_method "i_want", $keyword;
foreach my $localpath (@localpaths) {
protocol_send_file \*RI, $localpath;
}
($i_clogp, $i_version, $i_tag, $i_dscfn) =
push_parse_changelog 'remote-changelog.822';
die if $i_dscfn =~ m#/|^\W#;
- return $dscfn;
+ return $i_dscfn;
+}
+
+sub i_want_signed_tag {
+ defined $i_param{'head'} && defined $i_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. ----------
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;
push @ropts, $_;
$om->[0] = $2;
} elsif (m/^--(\w+):(.*)/s &&
+ !$opts_opt_cmdonly{$1} &&
($om = $opts_opt_map{$1})) {
push @ropts, $_;
push @$om, $2;
} elsif (s/^-h/-/) {
cmd_help();
} elsif (s/^-D/-/) {
- push @ropts, $_;
+ push @ropts, $&;
open DEBUG, ">&STDERR" or die $!;
$debug++;
} elsif (s/^-N/-/) {
- push @ropts, $_;
+ push @ropts, $&;
$new_package=1;
} elsif (m/^-[vm]/) {
- push @ropts, $_;
+ push @ropts, $&;
push @changesopts, $_;
$_ = '';
} elsif (s/^-c(.*=.*)//s) {
- push @ropts, $_;
+ push @ropts, $&;
push @git, '-c', $1;
} elsif (s/^-d(.*)//s) {
- push @ropts, $_;
+ push @ropts, $&;
$idistro = $1;
} elsif (s/^-C(.*)//s) {
- push @ropts, $_;
+ push @ropts, $&;
$changesfile = $1;
} elsif (s/^-k(.*)//s) {
$keyid=$1;
} elsif (s/^-wn//s) {
- push @ropts, $_;
+ push @ropts, $&;
$cleanmode = 'none';
} elsif (s/^-wg//s) {
- push @ropts, $_;
+ push @ropts, $&;
$cleanmode = 'git';
} elsif (s/^-wd//s) {
- push @ropts, $_;
+ push @ropts, $&;
$cleanmode = 'dpkg-source';
} else {
badusage "unknown short option \`$_'";
~ianmdlvl / dgit.git / blobdiff