END {
local ($@, $?);
+ return unless forkcheck_mainprocess();
print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
}
our @end;
END {
local ($?);
+ return unless forkcheck_mainprocess();
foreach my $f (@end) {
eval { $f->(); };
print STDERR "$us: cleanup: $@" if length $@;
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
my $upper_f = "../../../../$f";
- printdebug "considering linking $f: ";
-
- link_ltarget $upper_f, $f
- or ((printdebug "($!) "), 0)
- or $!==&ENOENT
- or die "$f $!";
-
- printdebug "linked.\n";
+ printdebug "considering reusing $f: ";
+
+ if (link_ltarget "$upper_f,fetch", $f) {
+ printdebug "linked (using ...,fetch).\n";
+ } elsif ((printdebug "($!) "),
+ $! != ENOENT) {
+ fail "accessing ../$f,fetch: $!";
+ } elsif (link_ltarget $upper_f, $f) {
+ printdebug "linked.\n";
+ } elsif ((printdebug "($!) "),
+ $! != ENOENT) {
+ fail "accessing ../$f: $!";
+ } else {
+ printdebug "absent.\n";
+ }
- complete_file_from_dsc('.', $fi)
+ my $refetched;
+ complete_file_from_dsc('.', $fi, \$refetched)
or next;
- link $f, $upper_f
- or $!==&EEXIST
- or die "$f $!";
+ printdebug "considering saving $f: ";
+
+ if (link $f, $upper_f) {
+ printdebug "linked.\n";
+ } elsif ((printdebug "($!) "),
+ $! != EEXIST) {
+ fail "saving ../$f: $!";
+ } elsif (!$refetched) {
+ printdebug "no need.\n";
+ } elsif (link $f, "$upper_f,fetch") {
+ printdebug "linked (using ...,fetch).\n";
+ } elsif ((printdebug "($!) "),
+ $! != EEXIST) {
+ fail "saving ../$f,fetch: $!";
+ } else {
+ printdebug "cannot.\n";
+ }
}
# We unpack and record the orig tarballs first, so that we only
return @output;
}
-sub complete_file_from_dsc ($$) {
- our ($dstdir, $fi) = @_;
- # Ensures that we have, in $dir, the file $fi, with the correct
+sub complete_file_from_dsc ($$;$) {
+ our ($dstdir, $fi, $refetched) = @_;
+ # Ensures that we have, in $dstdir, the file $fi, with the correct
# contents. (Downloading it from alongside $dscurl if necessary.)
+ # If $refetched is defined, can overwrite "$dstdir/$fi->{Filename}"
+ # and will set $$refetched=1 if it did so (or tried to).
my $f = $fi->{Filename};
my $tf = "$dstdir/$f";
};
if (stat_exists $tf) {
- progress "using existing $f";
+ if ($checkhash->()) {
+ progress "using existing $f";
+ return 1;
+ }
+ if (!$refetched) {
+ fail "file $f has hash $got but .dsc".
+ " demands hash $fi->{Hash} ".
+ "(perhaps you should delete this file?)";
+ }
+ progress "need to fetch correct version of $f";
+ unlink $tf or die "$tf $!";
+ $$refetched = 1;
} else {
printdebug "$tf does not exist, need to fetch\n";
- my $furl = $dscurl;
- $furl =~ s{/[^/]+$}{};
- $furl .= "/$f";
- die "$f ?" unless $f =~ m/^\Q${package}\E_/;
- die "$f ?" if $f =~ m#/#;
- runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
- return 0 if !act_local();
- $downloaded = 1;
}
+ my $furl = $dscurl;
+ $furl =~ s{/[^/]+$}{};
+ $furl .= "/$f";
+ die "$f ?" unless $f =~ m/^\Q${package}\E_/;
+ die "$f ?" if $f =~ m#/#;
+ runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
+ return 0 if !act_local();
+
$checkhash->() or
fail "file $f has hash $got but .dsc".
" demands hash $fi->{Hash} ".
- ($downloaded ? "(got wrong file from archive!)"
- : "(perhaps you should delete this file?)");
+ "(got wrong file from archive!)";
return 1;
}
my $canonsuitefh = IO::File::new_tmpfile;
my $pid = fork // die $!;
if (!$pid) {
+ forkcheck_setup();
$isuite = $tsuite;
$us .= " [$isuite]";
$debugprefix .= " ";
}
}
-END { i_cleanup(); }
+END {
+ return unless forkcheck_mainprocess();
+ i_cleanup();
+}
sub i_method {
my ($base,$selector,@args) = @_;
sub build_prep_early () {
our $build_prep_early_done //= 0;
return if $build_prep_early_done++;
- notpushing();
badusage "-p is not allowed when building" if defined $package;
my $clogp = parsechangelog();
$isuite = getfield $clogp, 'Distribution';
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
+ notpushing();
check_not_dirty();
}