target=source
suppressrepeatedemails=false
arch=`dpkg --print-architecture`
+logheadmaxbytes=32768
+logtailmaxbytes=32768
for config in "$@"; do
case "$config" in
rm -rf "$tmp"
mkdir "$tmp"
->"$tmp"/_log
+>"$tmp"/_log_raw
if $interactive; then
- echo '(log diverted to stdout)' >>"$tmp"/_log
+ echo '(log diverted to stdout)' >>"$tmp"/_log_raw
else
- exec >>"$tmp"/_log
+ exec >>"$tmp"/_log_raw
fi
exec 4>&1
zcat "$tmp"/_$sources.gz >"$tmp"/_$sources-in
lastinfo="$var"/lastinfo-$target
+: "${scorelog:="$var"/scores-$target}"
now=`date +%s`
>>"$lastinfo"
progress selecting
+if test $target = source; then
+ blacklist="$blacklistsourcepackages"
+else
+ blacklist="$blacklistbinarypackages"
+fi
+
if [ "x$pkg" = x ]; then
pkg="`perl -e '
use IO::Handle;
sub f1() { $fn=shift @ARGV; open F, $fn or die "$fn $!"; }
sub f2() { F->error and die "$fn $!"; close F or die "$fn $!"; }
+ $scorelog= "'"$scorelog"'";
+ if (length $scorelog) { open SCORE, "> $scorelog.new" or die $!; }
+ sub pscore ($;$) {
+ return unless length $scorelog;
+ printf SCORE "%$_[1]s", $_[0] or die $!;
+ }
+
+ sub readpkglist ($$) {
+ my ($arrayref, $filename) = @_;
+ return unless length $filename;
+ unshift @ARGV, $filename; f1();
+ while (<F>) {
+ next if m/^\#/ or !m/\S/;
+ die unless m/^($pre)\s*$/;
+ $arrayref->{$1}= 1;
+ }
+ f2();
+ }
+ readpkglist(\%suppress, "'"$suppresspackages"'");
+ readpkglist(\%blacklist, "'"$blacklist"'");
+
f1();
while (<F>) {
die unless m/^($pre) ($vre) (\d+)( .*)?$/;
}
f2();
f1();
- $best_score= -1;
+ $best_score= -2e9;
sub scorepackage () {
- return if $skip;
+ return if length $skip;
+ return if $blacklist{$package};
return if $score < $best_score
or ($score==$best_score and \
$package gt $best_package);
#printf STDERR " <----- best score=%s best_score=%s\n", $score, $best_score;
+ pscore(" (best)");
$best_score= $score;
$best_package= $package;
}
sub endpackage () {
return unless (defined $package
or defined $version
- or defined $skip);
+ or defined $skip
+ or defined $source);
die unless defined $package;
die unless defined $version;
+ $source= $package if !defined $source;
+
+ $score= '$now' - $lasttime{$package};
+ pscore("$package ",-30);
+ pscore("$source ",-25);
+ pscore("$score",10);
+
+ if ($score>1e7) {
+ $score= 1e7;
+ $scorechars.='c';
+ }
+ pscore(" $lastver{$package}",-25);
+ pscore(" $version ",-25);
+ $scorechars= "";
+ if ($lastver{$package} ne $version) {
+ $score *= 5;
+ $scorechars.="U";
+ }
+ if ($extras{$package} =~ m/ nt /) {
+ $scorechars.="n";
+ } else {
+ $score *= 10;
+ }
+ if ($suppress{$source}) {
+ $score -= 2e7;
+ $scorechars.="s";
+ }
+ $scorechars.="[$skip]" if length $skip;
+
+ pscore("-$scorechars",-7);
+ pscore("$score",10);
+
+#print STDERR "SCORE package=$package score $score source=$source\n";
scorepackage();
+ pscore("\n");
undef $package;
undef $version;
undef $skip;
+ undef $source;
}
while (<F>) {
if (m/^Package: ($pre)$/) {
} elsif (m/^Version: ($vre)$/) {
die if defined $version;
$version= $1;
- $score= '$now' - $lasttime{$package};
- $score= 1e7 if $score>1e7;
- $score *= 5 if $lastver{$package} ne $version;
- $score *= 10 unless $extras{$package} =~ m/ nt /;
-#print STDERR "$package score $score\n";
+ } elsif (m/^Source: ($pre)$/) {
+ die if defined $source;
+ $source= $1;
} elsif (m/^Architecture:.*/ &&
!m/\s(?:'$arch'|all|any)\s/) {
#printf STDERR " <----- skip %s %s\n", $&, "'$arch'";
- $skip= 1;
+ $skip .= 'a';
} elsif (m/^$/) {
endpackage();
}
}
f2();
endpackage();
+ if (length $scorelog) {
+ close SCORE or die $!;
+ rename "$scorelog.new","$scorelog" or die $!;
+ }
die unless length $best_package;
open L, ">&4" or die $!;
printf L "selected %s (age %s, score %d)\n",
getfield Version
+getfield Source
+if [ "x$pSource" != x ]; then
+ src="$pSource"
+else
+ src="$pkg"
+fi
+
if test $target = source; then
getfield Directory
leafnames="`
testmode2=''
desc="$pkg"
: ${upload_if_ok:=true}
+ email_package_header="$email_sourcepackage_header"
else
getfield Filename
fot="$tp/src/$pkg.deb"
testmode2=--instantiate
desc="$pkg $descx"
: ${upload_if_ok:=false}
+ email_package_header="$email_binarypackage_header"
fi
if [ "x$maintainer_email_override" = x ]; then
progress "RESULTS $summary"
if [ "x$suppresspackages" != x ] \
- && grep -x "$pkg" "$suppresspackages" >/dev/null; then
+ && grep -x "$src" "$suppresspackages" >/dev/null; then
printf >&3 "email-suppressed "
email=''
fi
END
- printf >"$tmp"/_email "$email_package_header" "$pkg"
+ email_package_header="${email_package_header//@p/$pkg}"
+ email_package_header="${email_package_header//@s/$src}"
+ email_package_header="${email_package_header//@v/$pVersion}"
+ email_package_header="${email_package_header//@a/@}"
+ printf >"$tmp"/_email "%s" "$email_package_header"
cat >>"$tmp"/_email <<END
Test executed for: $distro $target $pkg
esac
cat >>"$tmp/_email" <<END
-The test log, which is intended to be sufficient to diagnose most
-failures, can be found below. However, in case this is not
-sufficient, another copy can be found along with output files, saved
-temporary files, and so on, at:
+The top and tail of the test log, which is intended to be sufficient
+to diagnose most failures, can be found below. However, in case this
+is not sufficient, a complete log can be found along with output
+files, saved temporary files, and so on, at:
$desthttphead/$destdirfin/
$email_extra_info
If you have any questions about this service please contact me at:
progress "fault ($ourx)."
fi
+perl <"$tmp"/_log_raw >"$tmp"/_log -ne '
+ s/[^\012\040-\133\135-\176]/
+ $& eq "\t" ? "\\t" :
+ $& eq "\r" ? "\\r" :
+ $& eq "\b" ? "\\b" :
+ $& eq "\\" ? "\\\\" :
+ sprintf "\\x%02x", ord $&
+ /ge;
+
+ if (!$middle) {
+ $headlen += length;
+ $middle=1 if $headlen > '"$logheadmaxbytes"';
+ }
+ if (!$middle) {
+ print or die $!;
+ } else {
+ $taillen += length;
+ push @tail, $_;
+ while ($taillen > '"$logtailmaxbytes"') {
+ $taillen -= length shift @tail;
+ $some_dropped= 1;
+ }
+ }
+ END {
+ print "...\n" or die $! if $some_dropped;
+ print @tail or die $!;
+ }
+'
+
if [ "x$email" = x ]; then
if $interactive; then
cat "$tmp"/_log >&2