use Hash::Merge qw ( merge );
use String::Format;
use Date::Parse;
+use List::Util qw[max];
our ($verbose, $mail_logs, $list_order, $list_state,
$curr_date, $op_mode, $user, $real_user, $distribution,
$category, %catval, %short_category,
$short_date, $list_min_age, $dbbase, @curr_time,
$build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc,
- $printformat
+ $printformat, $ownprintformat, $privmode
);
# global vars
$list_min_age *= -1;
} },
"format" => { arg => \$printformat },
+ "own-format" => { arg => \$ownprintformat },
# special actions
export => { arg => \$export_to, mode => "export" },
import => { arg => \$import_from, mode => "import" },
$op_mode = $category ? "set-failed" : "set-building"
if !$op_mode; # default operation
$distribution ||= "unstable";
-die "Bad distribution '$distribution'\n"
- if !isin($distribution, keys %conf::distributions);
+if ($distribution eq 'any-priv') {
+ $privmode = 'yes';
+ $distribution = 'any';
+}
+if ($distribution eq 'any-unpriv') {
+ $privmode = 'no';
+ $distribution = 'any';
+}
+undef $distribution if $distribution eq 'any';
+if ($distribution) {
+ my @dists = split(/[, ]+/, $distribution);
+ foreach my $dist (@dists) {
+ die "Bad distribution '$distribution'\n"
+ if !isin($dist, keys %conf::distributions);
+ }
+}
+if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)) {
+ die "multiple distributions are only allowed for list";
+}
# If they didn't specify an arch, try to get it from database name which
# is in the form of $arch/build-db
my $yamlmap = ();
my $yamldir = "/org/wanna-build/etc/yaml";
my @files = ('wanna-build.yaml');
+if ((getpwuid($>))[7]) { push (@files, ((getpwuid($>))[7])."/.wanna-build.yaml"); }
if ($user =~ /(buildd.*)-/) { push (@files, "$1.yaml") };
-push ( @files, "$user.yaml");
+if ($user) { push ( @files, "$user.yaml"); }
foreach my $file (@files) {
- if ($verbose >= 2) { print "Trying to read $file ...\n"; }
- next unless -f $yamldir."/".$file;
- if ($verbose >= 2) { print "Read $file ...\n"; }
- my $m = YAML::Tiny->read( $yamldir."/".$file )->[0];
+ my $cfile = File::Spec->rel2abs( $file, $yamldir );
+ if ($verbose >= 2) { print "Trying to read $file ($cfile) ...\n"; }
+ next unless -f $cfile;
+ if ($verbose >= 2) { print "Read $file ($cfile) ...\n"; }
+ my $m = YAML::Tiny->read( $cfile )->[0];
$yamlmap = merge($m, $yamlmap);
}
if (not $yamlmap) {
}
my $schema_suffix = '';
-if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/)) {
+if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/) && !($privmode eq 'yes')) {
$dbh = DBI->connect("DBI:Pg:service=wanna-build") ||
die "FATAL: Cannot open database: $DBI::errstr\n";
$schema_suffix = '_public';
}
+sub seconds2time {
+ my $t = shift;
+ return "" unless $t;
+ my $sec = $t % 60;
+ my $min = int($t/60) % 60;
+ my $hours = int($t / 3600);
+ return sprintf("%d:%02d:%02d", $hours, $min, $sec) if $hours;
+ return sprintf("%d:%02d", $min, $sec);
+}
+
+
sub use_fmt {
my $r;
This can be combined to e.g.
wanna-build --format='wanna-build -A %a --give-back %p_%v' -A mipsel --list=failed
-p Package name
a Architecture
-s Time in this state in full seconds since epoch
-v Package version
-S Package state
-u Builder (e.g. buildd_mipsel-rem)
-X the string normally between [], e.g. optional:out-of-date:calprio{61}:days{25}
c section (e.g. libs or utils)
-P previous state
-E in case of Dep-Wait the packages being waited on, in case of Needs-Build the number in the queue
-F in case of Failed the fail reason
D in case of BD-Uninstallable the reason for the uninstallability
d distribution
+E in case of Dep-Wait the packages being waited on, in case of Needs-Build the number in the queue
+F in case of Failed the fail reason
+n newline
+o time of last successful build (seconds)
+O time of last successful build (formated)
+P previous state
+p Package name
+q time of last build (seconds)
+Q time of last build (formated)
+r max time of last (successful) build (seconds)
+R max time of last (successful) build (formated)
+S Package state
+s Time in this state in full seconds since epoch
t time of state change
+T time since state change
+u Builder (e.g. buildd_mipsel-rem)
+v Package version
+V full Package version (i.e. with +b.., = %v%{+b}B%B
+X the string normally between [], e.g. optional:out-of-date:calprio{61}:days{25}
%{Text}? print Text in case ? is not empty; ? is never printed
%{!Text}? print Text in case ? is empty; ? is never printed
'a' => make_fmt( $arch, $pkg, $var),
's' => make_fmt( sub { return floor(str2time($pkg->{'state_change'})); }, $pkg, $var),
'v' => make_fmt( $pkg->{'version'}, $pkg, $var),
+ 'V' => make_fmt( sub { $pkg->{'binary_nmu_version'} ? $pkg->{'version'}."+b".$pkg->{'binary_nmu_version'} : $pkg->{'version'} }, $pkg, $var),
'S' => make_fmt( $pkg->{'state'}, $pkg, $var),
'u' => make_fmt( $pkg->{'builder'}, $pkg, $var),
'X' => make_fmt( sub {
return $var->{scnt}{'Needs-Build'} + 1 if $pkg->{'state'} eq 'Needs-Build';
return ""; }, $pkg, $var),
'F' => make_fmt( sub { return "" unless $pkg->{'failed'};
+ my $failed = $pkg->{'failed'};
+ $failed =~ s/\\/\\\\/g;
return $pkg->{'package'}."#".$arch."-failure\n ".
- join("\\0a",split("\n",$pkg->{'failed'}))."\\0a\n"; }, $pkg, $var),
+ join("\\0a",split("\n",$failed))."\\0a\n"; }, $pkg, $var),
'D' => make_fmt( sub { return "" unless $pkg->{'bd_problem'};
return $pkg->{'package'}."#".$arch."-bd-problem\n".
join("\\0a",split("\n",$pkg->{'bd_problem'}))."\\0a\n"; }, $pkg, $var),
'B' => make_fmt( sub { return $pkg->{'binary_nmu_version'} if defined $pkg->{'binary_nmu_version'}; }, $pkg, $var),
- 'd' => make_fmt( $distribution, $pkg, $var),
+ 'd' => make_fmt( $pkg->{'distribution'}, $pkg, $var),
't' => make_fmt( $pkg->{'state_change'}, $pkg, $var),
+ 'T' => make_fmt( sub { return seconds2time(time() - floor(str2time($pkg->{'state_change'}))); }, $pkg, $var),
+ 'o' => make_fmt( $pkg->{'successtime'}, $pkg, $var),
+ 'O' => make_fmt( sub { return seconds2time ( $pkg->{'successtime'}); }, $pkg, $var),
+ 'q' => make_fmt( $pkg->{'anytime'}, $pkg, $var),
+ 'Q' => make_fmt( sub { return seconds2time ( $pkg->{'anytime'}); }, $pkg, $var),
+ 'r' => make_fmt( sub { return max($pkg->{'successtime'}, $pkg->{'anytime'}); }, $pkg, $var),
+ 'R' => make_fmt( sub { return seconds2time ( max($pkg->{'successtime'}, $pkg->{'anytime'})); }, $pkg, $var),
));
}
# filter components
@list = grep { my $i = $_->{'component'}; grep { $i eq $_ } split /[, ]+/, $yamlmap->{"restrict"}{'component'} } @list;
+ # first adjust ownprintformat, then set printformat accordingly
+ $printformat ||= $yamlmap->{"format"}{$ownprintformat};
+ $printformat ||= $yamlmap->{"format"}{"default"}{$state};
+ $printformat ||= $yamlmap->{"format"}{"default"}{"default"};
+ undef $printformat if ($ownprintformat eq 'none');
+
foreach $pkg (sort sort_list_func @list) {
if ($printformat) {
print print_format($printformat, $pkg, {'cnt' => $cnt, 'scnt' => \%scnt})."\n";
$scnt{$pkg->{'state'}}++;
next;
}
- print "$pkg->{'section'}/$pkg->{'package'}_$pkg->{'version'}";
- print ": $pkg->{'state'}"
+ print print_format("%c/%p_%v", $pkg, {});
+ print print_format(": %S", $pkg, {})
if $state eq "all";
- print " by $pkg->{'builder'}"
- if $pkg->{'state'} ne "Needs-Build" && $pkg->{'builder'};
- print " [$pkg->{'priority'}:$pkg->{'notes'}";
- print ":PREV-FAILED"
- if $pkg->{'previous_state'} =~ /^Failed/;
- print ":bp{" . $pkg->{'buildpri'} . "}"
- if defined $pkg->{'buildpri'};
- print ":binNMU{" . $pkg->{'binary_nmu_version'} . "}"
- if defined $pkg->{'binary_nmu_version'};
- print ":calprio{". $pkg->{'calprio'}."}";
- print ":days{". $pkg->{'state_days'}."}";
- print "]\n";
+ print print_format("%{ by }u%u", $pkg, {})
+ if $pkg->{'state'} ne "Needs-Build";
+ print print_format(" [%X]\n", $pkg, {});
print " Reasons for failing:\n",
" [Category: ",
defined $pkg->{'failed_category'} ? $pkg->{'failed_category'} : "none",
'failed_category' => 'Failed-Category', 'notes' => 'Notes',
'distribution' => 'Distribution', 'old_failed' => 'Old-Failed',
'permbuildpri' => 'PermBuildPri', 'rel' => 'Rel',
- 'calprio' => 'CalculatedPri', 'state_days' => 'State-Days'
+ 'calprio' => 'CalculatedPri', 'state_days' => 'State-Days',
+ 'successtime' => 'Success-build-time',
+ 'anytime' => 'Build-time'
);
foreach $name (@_) {
return $result;
}
+
+sub greparch {
+ my ($gapkglong, $gaarch) = @_;
+ my ($gapkg, $gaarchs) = split(/ \[/, $gapkglong);
+ if ($gaarchs) {
+ $_ = $gapkg;
+ chop($gaarchs); # take away the ]
+ my @gaarches = split(/ /, $gaarchs);
+ if (substr($gaarches[0], 0, 1) eq '!') {
+ return 0 if grep /^!$gaarch$/, @gaarches;
+ } else { # positive case
+ return 0 unless grep /^$gaarch$/, @gaarches;
+ }
+ };
+ return 1;
+}
+sub filterarch {
+ my $faarch = $_[1];
+ return join(', ', grep { &greparch($_, $faarch) } split(/, ?/, $_[0]));
+}
+
+sub wb_edos_builddebcheck {
+# Copyright (C) 2008 Ralf Treinen <treinen@debian.org>
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, version 2 of the License.
+# integrated into wanna-builds code by Andreas Barth 2010
+
+ my $args = shift;
+ my $sourceprefix="source---";
+ my $architecture=$args->{'arch'};
+ my $edosoptions = "-failures -explain -quiet";
+ my @packagefiles = $args->{'pkgs'};
+ my $sourcesfile = $args->{'src'};
+
+ my $packagearch="";
+ foreach my $packagefile (@packagefiles) {
+ open(P,$packagefile);
+ while (<P>) {
+ next unless /^Architecture/;
+ next if /^Architecture:\s*all/;
+ /Architecture:\s*([^\s]*)/;
+ if ($packagearch eq "") {
+ $packagearch = $1;
+ } elsif ( $packagearch ne $1) {
+ return "Package file contains different architectures: $packagearch, $1";
+ }
+ }
+ close P;
+ }
+
+ if ( $architecture eq "" ) {
+ if ( $packagearch eq "" ) {
+ return "No architecture option given, " .
+ "and no non-all architecture found in the Packages file";
+ } else {
+ $architecture = $packagearch;
+ }
+ } else {
+ if ( $packagearch ne "" & $architecture ne $packagearch) {
+ return "Architecture option is $architecture ".
+ "but the package file contains architecture $packagearch";
+ }
+ }
+
+ print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @packagefiles);
+ open(RESULT, '-|',
+ "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @packagefiles));
+
+ my $explanation="";
+ my $result={};
+ my $binpkg="";
+
+ while (<RESULT>) {
+# source---pulseaudio (= 0.9.15-4.1~bpo50+1): FAILED
+# source---pulseaudio (= 0.9.15-4.1~bpo50+1) depends on missing:
+# - libltdl-dev (>= 2.2.6a-2)
+# source---libcanberra (= 0.22-1~bpo50+1): FAILED
+# source---libcanberra (= 0.22-1~bpo50+1) depends on missing:
+# - libltdl-dev
+# - libltdl7-dev (>= 2.2.6)
+
+ if (/^\s+/) {
+ s/^(\s*)$sourceprefix(.*)depends on/$1$2build-depends on/o;
+ s/^(\s*)$sourceprefix(.*) and (.*) conflict/$1$2 build-conflicts with $3/o;
+ $explanation .= $_;
+ } else {
+ if (/^$sourceprefix(.*) \(.*\): FAILED/o) {
+ $result->{$binpkg} = $explanation if $binpkg;
+ $explanation = "";
+ $binpkg = $1;
+ } # else something broken is happening
+ }
+ }
+
+ close RESULT;
+ $result->{$binpkg} = $explanation if $binpkg;
+ return $result;
+
+}
+
+
sub call_edos_depcheck {
my $packagesfile = shift;
my $srcs = shift;
#print "I would look at these sources with edos-depcheck:\n";
#print join " ", keys %interesting_packages,"\n";
+ return unless %interesting_packages;
- my $tmpfile_pattern = "/tmp/wanna-build-interesting-sources-$distribution.$$-";
- my ($tmpfile, $i);
- for( $i = 0;; ++$i ) {
- $tmpfile = $tmpfile_pattern . $i;
- last if ! -e $tmpfile;
- }
-
- open SOURCES, '>', $tmpfile or die "Could not open temporary file $tmpfile\n";
+ my $tmpfile_pattern = "/tmp/wanna-build-interesting-sources-$distribution.$$-XXXXX";
+ use File::Temp qw/ tempfile /;
+ my ($SOURCES, $tmpfile) = tempfile( $tmpfile_pattern, UNLINK => 1 );
for my $key (keys %interesting_packages) {
my $pkg = $db->{$key};
- print SOURCES "Package: $key\n";
- print SOURCES "Version: $pkg->{'version'}\n";
- print SOURCES "Build-Depends: $srcs->{$key}{'dep'}\n" if $srcs->{$key}{'dep'};
- print SOURCES "Build-Conflicts: $srcs->{$key}{'conf'}\n" if $srcs->{$key}{'conf'};
- print SOURCES "Architecture: all\n";
- print SOURCES "\n";
+ # we print the source files as binary ones (with "source---"-prefixed),
+ # so we can try if these "binary" packages are installable.
+ # If such a "binary" package is installable, the corresponding source package is buildable.
+ print $SOURCES "Package: source---$key\n";
+ print $SOURCES "Version: $pkg->{'version'}\n";
+ my $t = &filterarch($srcs->{$key}{'dep'}, $arch);
+ print $SOURCES "Depends: $t\n" if $t;
+ my $u = &filterarch($srcs->{$key}{'conf'}, $arch);
+ print $SOURCES "Conflicts: $u\n" if $u;
+ print $SOURCES "Architecture: all\n";
+ print $SOURCES "\n";
}
- close SOURCES;
-
- if (open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $tmpfile))
- {
- local($/) = ""; # read in paragraph mode
- while( <EDOS> ) {
- my( $key, $reason ) ;
- s/\s*$//m;
- /^Package:\s*(\S+)$/mi and $key = $1;
- /^Failed-Why:(([^\n]|\n ([^\n]|\.))*)$/msi and $reason = $1;
- $reason =~ s/^\s*//mg;
- $reason ||= 'No reason given by edos-debcheck';
+ close $SOURCES;
+ my $edosresults = wb_edos_builddebcheck({'arch' => $arch, 'pkgs' => [$packagesfile], 'src' => $tmpfile});
+ if (ref($edosresults) eq 'HASH') {
+ foreach my $key (keys %$edosresults) {
if (exists $interesting_packages{$key}) {
- $interesting_packages{$key} = $reason;
+ $interesting_packages{$key} = $edosresults->{$key};
} else {
#print "TODO: edos reported a package we do not care about now\n" if $verbose;
}
- }
- close EDOS;
+ }
} else {
- print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" .
- "all packages have installable build-dependencies."
+ # if $edosresults isn't an hash, then something went wrong and the string is the error message
+ print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" .
+ "all packages have installable build-dependencies."
}
unlink( $tmpfile );
return '"' . $arch . $schema_suffix . '".transactions';
}
+sub pkg_history_table_name {
+ return '"' . $arch . $schema_suffix . '".pkg_history';
+}
+
sub get_readonly_source_info {
my $name = shift;
# SELECT FLOOR(EXTRACT('epoch' FROM age(localtimestamp, '2010-01-22 23:45')) / 86400) -- change to that?
- my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change)) as state_days FROM ' .
- table_name() . ' WHERE package = ? AND distribution = ?',
+ my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days"
+ . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime"
+ . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime"
+ . " FROM " . table_name()
+ . ' WHERE package = ? AND distribution = ?';
+ my $pkg = $dbh->selectrow_hashref( $q,
undef, $name, $distribution);
return $pkg;
}
sub get_all_source_info {
my %options = @_;
- my $q = 'SELECT *, '.
- 'extract(days from date_trunc(\'days\', now() - state_change)) as state_days, '.
- 'date_trunc(\'seconds\', now() - state_change) as state_time'.
- ' FROM ' . table_name()
- . ' WHERE distribution = ? ';
- my @args = ($distribution);
+ my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days"
+# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime"
+# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime"
+ . ", successtime.build_time as successtime, anytime.build_time as anytime"
+ . " FROM " . table_name()
+ . " left join ( "
+ . "select distinct on (package, distribution) build_time, package, distribution from ".pkg_history_table_name()." where result = 'successful' order by package, distribution, timestamp "
+ . " ) as successtime using (package, distribution) "
+ . " left join ( "
+ . "select distinct on (package, distribution) build_time, package, distribution from ".pkg_history_table_name()." order by package, distribution, timestamp desc"
+ . " ) as anytime using (package, distribution) "
+ . " WHERE TRUE ";
+ my @args = ();
+ if ($distribution) {
+ my @dists = split(/[, ]+/, $distribution);
+ $q .= ' AND ( distribution = ? '.(' OR distribution = ? ' x $#dists).' )';
+ foreach my $d ( @dists ) {
+ push @args, ($d);
+ }
+ }
if ($options{state} && uc($options{state}) ne "ALL") {
$q .= ' AND upper(state) = ? ';
push @args, uc($options{state});
}
- if ($options{user}) {
+ if ($options{user} && uc($options{state}) ne "NEEDS-BUILD") { # if it's NEEDS-BUILD, we don't look at users
#this basically means "this user, or no user at all":
- $q .= ' AND (builder = ? OR upper(state) = ?)';
+ $q .= " AND (builder = ? OR upper(state) = 'NEEDS-BUILD')";
push @args, $options{user};
- push @args, "NEEDS-BUILD";
}
if ($options{category}) {