chiark
/
gitweb
/
~ianmdlvl
/
dgit.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Break out mktree_in_ud_here (nfc)
[dgit.git]
/
dgit
diff --git
a/dgit
b/dgit
index 40953871a6724b8c3015a4889e47aa275daac419..b13b5ed566c74f36d24a96298f59eb5e0ea007aa 100755
(executable)
--- a/
dgit
+++ b/
dgit
@@
-34,6
+34,8
@@
use Config;
our $our_version = 'UNRELEASED'; ###substituted###
our $our_version = 'UNRELEASED'; ###substituted###
+our $rpushprotovsn = 2;
+
our $isuite = 'unstable';
our $idistro;
our $package;
our $isuite = 'unstable';
our $idistro;
our $package;
@@
-175,6
+177,13
@@
sub changedir ($) {
chdir $newdir or die "chdir: $newdir: $!";
}
chdir $newdir or die "chdir: $newdir: $!";
}
+sub stat_exists ($) {
+ my ($f) = @_;
+ return 1 if stat $f;
+ return 0 if $!==&ENOENT;
+ die "stat $f: $!";
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
@@
-639,7
+648,6
@@
sub parsecontrolfh ($$;$) {
for (;;) {
my %opts = ('name' => $desc);
$opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
for (;;) {
my %opts = ('name' => $desc);
$opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
-print STDERR Dumper(\%opts);
$c = Dpkg::Control::Hash->new(%opts);
$c->parse($fh,$desc) or die "parsing of $desc failed";
last if $allowsigned;
$c = Dpkg::Control::Hash->new(%opts);
$c->parse($fh,$desc) or die "parsing of $desc failed";
last if $allowsigned;
@@
-765,7
+773,7
@@
sub madison_parse ($) {
$5 eq 'source' or die "$rmad ?";
push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
}
$5 eq 'source' or die "$rmad ?";
push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
}
- return sort { -version_compare
_string
($a->[0],$b->[0]); } @out;
+ return sort { -version_compare($a->[0],$b->[0]); } @out;
}
sub canonicalise_suite_madison ($$) {
}
sub canonicalise_suite_madison ($$) {
@@
-823,7
+831,7
@@
sub archive_query_sshpsql ($$) {
AND source.source='$package'
AND files.filename LIKE '%.dsc';
END
AND source.source='$package'
AND files.filename LIKE '%.dsc';
END
- @rows = sort { -version_compare
_string
($a->[0],$b->[0]) } @rows;
+ @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
my $digester = Digest::SHA->new(256);
@rows = map {
my ($vsn,$component,$filename,$sha256sum) = @$_;
my $digester = Digest::SHA->new(256);
@rows = map {
my ($vsn,$component,$filename,$sha256sum) = @$_;
@@
-881,7
+889,7
@@
sub archive_query_dummycat ($$) {
}
C->error and die "$dpath: $!";
close C;
}
C->error and die "$dpath: $!";
close C;
- return sort { -version_compare
_string
($a->[0],$b->[0]); } @rows;
+ return sort { -version_compare($a->[0],$b->[0]); } @rows;
}
sub canonicalise_suite () {
}
sub canonicalise_suite () {
@@
-968,6
+976,12
@@
sub prep_ud () {
mkdir $ud or die $!;
}
mkdir $ud or die $!;
}
+sub mktree_in_ud_here () {
+ runcmd qw(git init -q);
+ rmtree('.git/objects');
+ symlink '../../../../objects','.git/objects' or die $!;
+}
+
sub mktree_in_ud_from_only_subdir () {
# changes into the subdir
my (@dirs) = <*/.>;
sub mktree_in_ud_from_only_subdir () {
# changes into the subdir
my (@dirs) = <*/.>;
@@
-975,11
+989,8
@@
sub mktree_in_ud_from_only_subdir () {
$dirs[0] =~ m#^([^/]+)/\.$# or die;
my $dir = $1;
changedir $dir;
$dirs[0] =~ m#^([^/]+)/\.$# or die;
my $dir = $1;
changedir $dir;
- fail "source package contains .git directory" if stat '.git';
- die $! unless $!==&ENOENT;
- runcmd qw(git init -q);
- rmtree('.git/objects');
- symlink '../../../../objects','.git/objects' or die $!;
+ fail "source package contains .git directory" if stat_exists '.git';
+ mktree_in_ud_here();
runcmd @git, qw(add -Af);
my $tree = cmdoutput @git, qw(write-tree);
$tree =~ m/^\w+$/ or die "$tree ?";
runcmd @git, qw(add -Af);
my $tree = cmdoutput @git, qw(write-tree);
$tree =~ m/^\w+$/ or die "$tree ?";
@@
-1095,7
+1106,7
@@
END
my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
my $oversion = getfield $oldclogp, 'Version';
my $vcmp =
my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
my $oversion = getfield $oldclogp, 'Version';
my $vcmp =
- version_compare
_string
($oversion, $cversion);
+ version_compare($oversion, $cversion);
if ($vcmp < 0) {
# git upload/ is earlier vsn than archive, use archive
open C, ">../commit2.tmp" or die $!;
if ($vcmp < 0) {
# git upload/ is earlier vsn than archive, use archive
open C, ">../commit2.tmp" or die $!;
@@
-1139,11
+1150,9
@@
sub complete_file_from_dsc ($$) {
my $tf = "$dstdir/$f";
my $downloaded = 0;
my $tf = "$dstdir/$f";
my $downloaded = 0;
- if (stat $tf) {
+ if (stat
_exists
$tf) {
progress "using existing $f";
} else {
progress "using existing $f";
} else {
- die "$tf $!" unless $!==&ENOENT;
-
my $furl = $dscurl;
$furl =~ s{/[^/]+$}{};
$furl .= "/$f";
my $furl = $dscurl;
$furl =~ s{/[^/]+$}{};
$furl .= "/$f";
@@
-1277,7
+1286,7
@@
END
my $gotclogp = parsechangelog("-l$clogf");
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
my $gotclogp = parsechangelog("-l$clogf");
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
- if (version_compare
_string
($got_vsn, $skew_warning_vsn) < 0) {
+ if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
print STDERR <<END or die $!;
Warning: archive skew detected. Using the available version:
print STDERR <<END or die $!;
Warning: archive skew detected. Using the available version:
@@
-1489,7
+1498,7
@@
sub dopush () {
push_parse_changelog("$clogpfn");
my $dscpath = "$buildproductsdir/$dscfn";
push_parse_changelog("$clogpfn");
my $dscpath = "$buildproductsdir/$dscfn";
- stat $dscpath or
+ stat
_exists
$dscpath or
fail "looked for .dsc $dscfn, but $!;".
" maybe you forgot to build";
fail "looked for .dsc $dscfn, but $!;".
" maybe you forgot to build";
@@
-1534,10
+1543,9
@@
sub dopush () {
if (!$changesfile) {
my $multi = "$buildproductsdir/".
"${package}_".(stripepoch $cversion)."_multi.changes";
if (!$changesfile) {
my $multi = "$buildproductsdir/".
"${package}_".(stripepoch $cversion)."_multi.changes";
- if (stat "$multi") {
+ if (stat
_exists
"$multi") {
$changesfile = $multi;
} else {
$changesfile = $multi;
} else {
- $!==&ENOENT or die "$multi: $!";
my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
my @cs = glob "$buildproductsdir/$pat";
fail "failed to find unique changes file".
my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
my @cs = glob "$buildproductsdir/$pat";
fail "failed to find unique changes file".
@@
-1620,10
+1628,8
@@
sub cmd_clone {
}
$dstdir ||= "$package";
}
$dstdir ||= "$package";
- if (stat $dstdir) {
+ if (stat
_exists
$dstdir) {
fail "$dstdir already exists";
fail "$dstdir already exists";
- } elsif ($! != &ENOENT) {
- die "$dstdir: $!";
}
my $cwd_remove;
}
my $cwd_remove;
@@
-1727,12
+1733,15
@@
sub cmd_push {
#---------- remote commands' implementation ----------
#---------- remote commands' implementation ----------
-sub cmd_remote_push_
responder
{
+sub cmd_remote_push_
build_host
{
my ($nrargs) = shift @ARGV;
my (@rargs) = @ARGV[0..$nrargs-1];
@ARGV = @ARGV[$nrargs..$#ARGV];
die unless @rargs;
my ($nrargs) = shift @ARGV;
my (@rargs) = @ARGV[0..$nrargs-1];
@ARGV = @ARGV[$nrargs..$#ARGV];
die unless @rargs;
- my ($dir) = @rargs;
+ my ($dir,$vsnwant) = @rargs;
+ # vsnwant is a comma-separated list; we report which we have
+ # chosen in our ready response (so other end can tell if they
+ # offered several)
$debugprefix = ' ';
$we_are_responder = 1;
$debugprefix = ' ';
$we_are_responder = 1;
@@
-1743,12
+1752,21
@@
sub cmd_remote_push_responder {
open STDOUT, ">&STDERR" or die $!;
autoflush STDOUT 1;
open STDOUT, ">&STDERR" or die $!;
autoflush STDOUT 1;
- responder_send_command("dgit-remote-push-ready");
+ $vsnwant //= 1;
+ fail "build host has dgit rpush protocol version".
+ " $rpushprotovsn but invocation host has $vsnwant"
+ unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant;
+
+ responder_send_command("dgit-remote-push-ready $rpushprotovsn");
changedir $dir;
&cmd_push;
}
changedir $dir;
&cmd_push;
}
+sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
+# ... for compatibility with proto vsn.1 dgit (just so that user gets
+# a good error message)
+
our $i_tmp;
sub i_cleanup {
our $i_tmp;
sub i_cleanup {
@@
-1784,11
+1802,11
@@
sub cmd_rpush {
$dir = nextarg;
}
$dir =~ s{^-}{./-};
$dir = nextarg;
}
$dir =~ s{^-}{./-};
- my @rargs = ($dir);
+ my @rargs = ($dir
,$rpushprotovsn
);
my @rdgit;
push @rdgit, @dgit;
push @rdgit, @ropts;
my @rdgit;
push @rdgit, @dgit;
push @rdgit, @ropts;
- push @rdgit, qw(remote-push-
responder
), (scalar @rargs), @rargs;
+ push @rdgit, qw(remote-push-
build-host
), (scalar @rargs), @rargs;
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
printcmd \*DEBUG,$debugprefix."+",@cmd;
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
printcmd \*DEBUG,$debugprefix."+",@cmd;
@@
-1835,7
+1853,8
@@
sub i_resp_file ($) {
my ($keyword) = @_;
my $localname = i_method "i_localname", $keyword;
my $localpath = "$i_tmp/$localname";
my ($keyword) = @_;
my $localname = i_method "i_localname", $keyword;
my $localpath = "$i_tmp/$localname";
- stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+ stat_exists $localpath and
+ badproto \*RO, "file $keyword ($localpath) twice";
protocol_receive_file \*RO, $localpath;
i_method "i_file", $keyword;
}
protocol_receive_file \*RO, $localpath;
i_method "i_file", $keyword;
}
@@
-2040,7
+2059,7
@@
sub changesopts () {
}
if (@vsns) {
@vsns = map { $_->[0] } @vsns;
}
if (@vsns) {
@vsns = map { $_->[0] } @vsns;
- @vsns = sort { -version_compare
_string
($a, $b) } @vsns;
+ @vsns = sort { -version_compare($a, $b) } @vsns;
$changes_since_version = $vsns[0];
progress "changelog will contain changes since $vsns[0]";
} else {
$changes_since_version = $vsns[0];
progress "changelog will contain changes since $vsns[0]";
} else {
@@
-2105,8
+2124,9
@@
sub cmd_sbuild {
changedir "..";
my $pat = "${package}_".(stripepoch $version)."_*.changes";
if (act_local()) {
changedir "..";
my $pat = "${package}_".(stripepoch $version)."_*.changes";
if (act_local()) {
- stat $dscfn or fail "$dscfn (in parent directory): $!";
- stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
+ stat_exist $dscfn or fail "$dscfn (in parent directory): $!";
+ stat_exists $sourcechanges
+ or fail "$sourcechanges (in parent directory): $!";
foreach my $cf (glob $pat) {
next if $cf eq $sourcechanges;
unlink $cf or fail "remove $cf: $!";
foreach my $cf (glob $pat) {
next if $cf eq $sourcechanges;
unlink $cf or fail "remove $cf: $!";
@@
-2123,7
+2143,7
@@
sub cmd_sbuild {
runcmd_ordryrun_local @mergechanges, @changesfiles;
my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
if (act_local()) {
runcmd_ordryrun_local @mergechanges, @changesfiles;
my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
if (act_local()) {
- stat $multichanges or fail "$multichanges: $!";
+ stat
_exists
$multichanges or fail "$multichanges: $!";
}
printdone "build successful, results in $multichanges\n" or die $!;
}
}
printdone "build successful, results in $multichanges\n" or die $!;
}