our $noquilt = 0;
our $existing_package = 'dpkg';
our $cleanmode = 'dpkg-source';
+our $changes_since_version;
our $we_are_responder;
our $initiator_tempdir;
return "${package}_".(stripepoch $vsn).".dsc";
}
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
our $us = 'dgit';
our $debugprefix = '';
sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
-sub fail { die "$us: @_\n"; }
+sub fail {
+ die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+}
sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
sub badproto ($$) {
my ($fh, $m) = @_;
fail "connection lost: $!" if $fh->error;
- fail "connection terminated" if $fh->eof;
fail "protocol violation; $m not expected";
}
die "$ourfn: $!" unless defined $got;
last if !$got;
print $fh "data-block ".length($d)."\n" or die $!;
- print $d or die $!;
+ print $fh $d or die $!;
}
- PF->eof or die "$ourfn $!";
PF->error and die "$ourfn $!";
print $fh "data-end\n" or die $!;
close PF;
sub protocol_receive_file ($$) {
my ($fh, $ourfn) = @_;
+ printdebug "() $ourfn\n";
open PF, ">", $ourfn or die "$ourfn: $!";
for (;;) {
my ($y,$l) = protocol_expect {
print PF $d or die $!;
}
close PF or die $!;
- printdebug "() $ourfn\n";
}
#---------- remote protocol support, responder ----------
my ($command) = @_;
return unless $we_are_responder;
# called even without $we_are_responder
- printdebug "<< $command\n";
- print $command, "\n" or die $!;
+ printdebug ">> $command\n";
+ print PO $command, "\n" or die $!;
}
sub responder_send_file ($$) {
my ($keyword, $ourfn) = @_;
return unless $we_are_responder;
- printdebug "[[ $keyword $ourfn\n";
+ printdebug "]] $keyword $ourfn\n";
responder_send_command "file $keyword";
- protocol_send_file \*STDOUT, $ourfn;
+ protocol_send_file \*PO, $ourfn;
}
sub responder_receive_files ($@) {
my ($keyword, @ourfns) = @_;
die unless $we_are_responder;
- printdebug "]] $keyword @ourfns\n";
+ printdebug "[[ $keyword @ourfns\n";
responder_send_command "want $keyword";
foreach my $fn (@ourfns) {
- protocol_receive_file \*STDIN, $fn;
+ protocol_receive_file \*PI, $fn;
}
- protocol_expect { m/^files-end$/ } \*STDIN;
+ printdebug "[[\$\n";
+ protocol_expect { m/^files-end$/ } \*PI;
}
#---------- remote protocol support, initiator ----------
if ($we_are_responder) {
my $m = join '', @_;
responder_send_command "progress ".length($m) or die $!;
- print $m or die $!;
+ print PO $m or die $!;
} else {
print @_, "\n";
}
my $dversion = getfield $dsc, 'Version';
my $dscpackage = getfield $dsc, 'Source';
($dscpackage eq $package && $dversion eq $cversion) or
- fail "$dsc is for $dscpackage $dversion".
+ fail "$dscfn is for $dscpackage $dversion".
" but debian/changelog is for $package $cversion";
}
-sub push_mktag ($$$$$$$$) {
+sub push_mktag ($$$$$$$) {
my ($head,$clogp,$tag,
- $dsc,$dscfn,
+ $dscfn,
$changesfile,$changesfilewhat,
$tfn) = @_;
}
my $cversion = getfield $clogp, 'Version';
+ my $clogsuite = getfield $clogp, 'Distribution';
# We make the git tag by hand because (a) that makes it easier
# to control the "tagger" (b) we can do remote signing
tag $tag
tagger $authline
-$package release $cversion for $csuite [dgit]
+$package release $cversion for $clogsuite [dgit]
END
close TO or die $!;
}
responder_send_file('changes',$changesfile);
+ responder_send_command("param head $head");
my $tfn = sub { ".git/dgit/tag$_[0]"; };
- my ($tagobjfn) =
- $we_are_responder
- ? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
- : push_mktag($head,$clogp,$tag,
- $dsc,"../$dscfn",
- $changesfile,$changesfile,
- $tfn);
+ my $tagobjfn;
+
+ if ($we_are_responder) {
+ $tagobjfn = $tfn->('.signed.tmp');
+ responder_receive_files('signed-tag', $tagobjfn);
+ } else {
+ $tagobjfn =
+ push_mktag($head,$clogp,$tag,
+ "../$dscfn",
+ $changesfile,$changesfile,
+ $tfn);
+ }
my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
die unless @rargs;
my ($dir) = @rargs;
$debugprefix = ' ';
- changedir $dir;
$we_are_responder = 1;
+
+ open PI, "<&STDIN" or die $!;
+ open STDIN, "/dev/null" or die $!;
+ open PO, ">&STDOUT" or die $!;
+ autoflush PO 1;
+ open STDOUT, ">&STDERR" or die $!;
autoflush STDOUT 1;
+
responder_send_command("dgit-remote-push-ready");
+
+ changedir $dir;
&cmd_push;
}
};
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 ($) {
}
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;
}
my $localpath = "$i_tmp/$localname";
stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
protocol_receive_file \*RO, $localpath;
+ i_method "i_file", $keyword;
}
our %i_param;
-sub i_param ($) {
- $_[0] =~ m/^(\S+) (.*)$/;
+sub i_resp_param ($) {
+ $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
$i_param{$1} = $2;
}
my ($keyword) = @_;
die "$keyword ?" if $i_wanted{$keyword}++;
my @localpaths = i_method "i_want", $keyword;
- printdebug "]] $keyword @localpaths\n";
+ printdebug "[[ $keyword @localpaths\n";
foreach my $localpath (@localpaths) {
protocol_send_file \*RI, $localpath;
}
- print RI "end-files\n" or die $!;
+ print RI "files-end\n" or die $!;
}
-our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
-sub i_localname_parsed_changelog { return "remote-changelog.822"; }
-sub i_localname_changes { return "remote.changes"; }
-sub i_localname_dsc {
+sub i_localname_parsed_changelog {
+ return "remote-changelog.822";
+}
+sub i_file_parsed_changelog {
($i_clogp, $i_version, $i_tag, $i_dscfn) =
push_parse_changelog "$i_tmp/remote-changelog.822";
die if $i_dscfn =~ m#/|^\W#;
+}
+
+sub i_localname_dsc {
+ defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
return $i_dscfn;
}
+sub i_file_dsc { }
+
+sub i_localname_changes {
+ defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+ $i_changesfn = $i_dscfn;
+ $i_changesfn =~ s/\.dsc$/_dgit.changes/ or die;
+ return $i_changesfn;
+}
+sub i_file_changes { }
sub i_want_signed_tag {
- defined $i_param{'head'} && defined $i_dscfn
- or badproto \*RO, "sequencing error";
+ printdebug Dumper(\%i_param, $i_dscfn);
+ defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+ or badproto \*RO, "premature desire for signed-tag";
my $head = $i_param{'head'};
die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
- push_parse_dsc $i_dscfn, 'remote dsc',
+ push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
- push_mktag $head, $i_clogp, $i_tag,
- $dsc, $i_dscfn,
- 'remote.changes', 'remote changes',
- 'tag.tag';
+ my $tagobjfn =
+ push_mktag $head, $i_clogp, $i_tag,
+ $i_dscfn,
+ $i_changesfn, 'remote changes',
+ sub { "tag$_[0]"; };
- return 'tag.tag';
+ return $tagobjfn;
}
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');
+ sign_changes $i_changesfn;
+ return ($i_dscfn, $i_changesfn);
}
#---------- building etc. ----------
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';
}
}
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: $!";
} 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]) {
} 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, $_;
$_ = '';
~ianmdlvl / dgit.git / blobdiff