# wanna-build: coordination script for Debian buildds
# Copyright (C) 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright (C) 2005-2008 Ryan Murray <rmurray@debian.org>
-# Copyright (C) 2010
Andreas Barth <aba@not.so.argh.org>
+# Copyright (C) 2010
,2011 Andreas Barth <aba@not.so.argh.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use warnings;
use 5.010;
+die "wanna-build disabled" if -f "/org/wanna-build/NO-WANNA-BUILD";
+
package conf;
use vars qw< $basedir $dbbase $transactlog $mailprog $buildd_domain >;
$short_date, $list_min_age, $list_max_age, $dbbase, @curr_time,
$build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc,
$printformat, $ownprintformat, $privmode, $extra_depends, $extra_conflicts,
- %distributions, %distribution_aliases, $actions
+ %distributions, %distribution_aliases, $actions,
+ $sshwrapper,
);
our $Pas = '/org/buildd.debian.org/etc/packages-arch-specific/Packages-arch-specific';
our $simulate = 0;
sub _option_deprecated { warn "Option $_[0] is deprecated" }
-GetOptions(
+my @wannabuildoptions = (
# this is not supported by all operations (yet)!
'simulate' => \$simulate,
'simulate-edos' => \$simulate_edos,
when ('s') { $distribution = 'stable'; }
when ('t') { $distribution = 'testing'; }
when ('u') { $distribution = 'unstable'; }
+
+ if ($distribution eq 'any-priv') {
+ $privmode = 1;
+ $distribution = 'any';
+ }
+ if ($distribution eq 'any-unpriv') {
+ $privmode = 0;
+ $distribution = 'any';
+ }
+ $privmode = 1 if $distribution =~ /security/;
}
},
'order|O=s' => sub {
},
'message|m=s' => \$fail_reason,
'database|b=s' => sub {
+ # If they didn't specify an arch, try to get it from database name which
+ # is in the form of $arch/build-db
+ # This is for backwards compatibity with older versions that didn't
+ # specify the arch yet.
warn "database is deprecated, please use 'arch' instead.\n";
- $conf::dbbase = $_[1];
+ $_[1] =~ m#^([^/]+)#;
+ $arch ||= $1;
},
'arch|A=s' => \$arch,
'user|U=s' => \$user,
'min-age|a=i' => \$list_min_age,
- 'max-age=i' => \$list_max_age,
+ 'max-age=i' => sub { $list_min_age = -1 * ($_[1]); },
'format=s' => \$printformat,
'own-format=s' => \$ownprintformat,
'Pas=s' => \$Pas,
'manual-edit' => \&_set_mode,
'distribution-architectures' => \&_set_mode,
'distribution-aliases' => \&_set_mode,
-) or usage();
-$list_min_age = -1 * $list_max_age if $list_max_age;
+
+ 'ssh-wrapper' => \$sshwrapper,
+ 'recorduser' => \$recorduser,
+ );
+
+GetOptions(@wannabuildoptions) or usage();
my $dbh;
}
}
-$distribution ||= "sid";
-if ($distribution eq 'any-priv') {
- $privmode = 1;
- $distribution = 'any';
-}
-if ($distribution eq 'any-unpriv') {
- $privmode = 0;
- $distribution = 'any';
-}
-
my $schema_suffix = '';
-$recorduser //= (not -t and $user//"" =~ /^buildd_/);
-if ((isin( $op_mode, qw(list info distribution-architectures distribution-aliases)) && $distribution !~ /security/ && !$recorduser && !($privmode)) || $simulate) {
+if ((isin( $op_mode, qw(list info distribution-architectures distribution-aliases)) && !$recorduser && !$privmode) || $simulate) {
$dbh = DBI->connect("DBI:Pg:service=wanna-build") ||
die "FATAL: Cannot open database: $DBI::errstr\n";
$schema_suffix = '_public';
$distribution = $distribution_aliases{$distribution} if (isin($distribution, keys %distribution_aliases));
$op_mode ||= "set-building";
-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 %distributions);
+ if !isin($dist, keys %distributions, "any");
}
}
-if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)) {
+if (!isin ( $op_mode, qw(list) ) && ( ($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
-# This is for backwards compatibity with older versions that didn't
-# specify the arch yet.
-$conf::dbbase =~ m#^([^/]+)#;
-$arch ||= $1;
-
# TODO: Check that it's an known arch (for that dist), and give
# a proper error.
if ($verbose) {
- my $version = '$Revision: db181a534e9d $ $Date: 2008/03/26 06:20:22 $ $Author: rmurray $';
- $version =~ s/(^\$| \$ .*$)//g;
- print "wanna-build $version for $distribution on $arch\n";
+ my $version = '$Id$';
+ $version =~ s/^.* ([a-f0-9]+) .*$/$1/g;
+ print "wanna-build $version for ".($distribution//"sid")." on $arch\n";
}
if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
$api //= $yamlmap->{"api"};
$api //= 0;
-process();
-
-$dbh->commit;
-$dbh->disconnect;
-
-if ($mail_logs && $conf::log_mail) {
- send_mail( $conf::log_mail,
- "wanna-build $distribution state changes $curr_date",
- "State changes at $curr_date for distribution ".
- "$distribution:\n\n$mail_logs\n" );
+if (isin($op_mode, qw<forget-user merge-v3 import>) && defined @conf::admin_users && !isin( $real_user, @conf::admin_users) && !$simulate ) {
+ die "This operation is restricted to admin users";
+}
+if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
+ die "need an architecture" unless $arch;
+ my $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=? and distribution=?', [qw<d>], undef, ($arch, $distribution//"sid")) if ($distribution//"") ne 'any';
+ $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=?', [qw<d>], undef, ($arch,)) unless $rows;
+ die "architecture ($arch) does not exist (at least not for ".($distribution//"sid").")" if !keys %$rows and $distribution//"sid" ne 'any';
+ die "architecture ($arch) does not exist" if !keys %$rows;
}
-exit 0;
-
-
-sub process {
+my $suite = $distribution;
+$distribution ||='sid';
+undef $distribution if $distribution eq 'any';
SWITCH: foreach ($op_mode) {
/^set-(.+)/ && do {
last SWITCH;
};
/^forget-user/ && do {
- die "This operation is restricted to admin users\n"
- if (defined @conf::admin_users and
- !isin( $real_user, @conf::admin_users));
forget_users( @ARGV );
last SWITCH;
};
last SWITCH;
};
/^merge-v3/ && do {
- die "This operation is restricted to admin users\n"
- if (defined @conf::admin_users and !isin( $real_user, @conf::admin_users) and !$simulate);
# call with installed-packages+ . installed-sources+ [ . available-for-build-packages* [ . consider-as-installed-source* ] ]
# in case available-for-build-packages is not specified, installed-packages are used
lock_table() unless $simulate;
my $replacemap = { '%ARCH%' => $arch, '%SUITE%' => $distribution };
map { my $k = $_; grep { $k =~ s,$_,$replacemap->{$_}, } keys %{$replacemap}; $_ = $k; } @ARGV;
- my @ipkgs = &parse_argv( \@ARGV, '.');
- my @isrcs = &parse_argv( \@ARGV, '.');
- my @bpkgs = &parse_argv( \@ARGV, '.');
- my @psrcs = &parse_argv( \@ARGV, '.');
+ my @ipkgs = &parse_argv( \@ARGV, '.'); # installed packages
+ my @isrcs = &parse_argv( \@ARGV, '.'); # installed sources
+ my @bpkgs = &parse_argv( \@ARGV, '.'); # packages available for building (edos-debcheck)
+ my @psrcs = &parse_argv( \@ARGV, '.'); # consider as installed sources
use WB::QD;
my $srcs = WB::QD::readsourcebins($arch, $Pas, \@isrcs, \@ipkgs);
if (@psrcs) {
+ # Installed sources of the base suite: only add them as related, not
+ # installed; skip the entries if we got something in installed
+ # sources already.
my $psrcs = WB::QD::readsourcebins($arch, $Pas, \@psrcs, []);
foreach my $k (keys %$$psrcs) {
next if $$srcs->{$k};
}
}
parse_all_v3($$srcs, {'arch' => $arch, 'suite' => $distribution, 'time' => $curr_date});
+ # The packages passed to edos-debcheck are normally the binaries available,
+ # unless you've also a base suite the builder will take packages from.
@bpkgs = @ipkgs unless @bpkgs;
call_edos_depcheck( {'arch' => $arch, 'pkgs' => \@bpkgs, 'srcs' => $$srcs, 'depwait' => 1 });
last SWITCH;
};
/^import/ && do {
- die "This operation is restricted to admin users\n"
- if (defined @conf::admin_users and
- !isin( $real_user, @conf::admin_users));
- $dbh->do("DELETE from " . table_name() .
- " WHERE distribution = ?", undef,
- $distribution)
+ $dbh->do("DELETE from ".table_name()." WHERE distribution = ?", undef, $distribution)
or die $dbh->errstr;
forget_users();
read_db( $import_from );
last SWITCH;
};
/^distribution-architectures/ && do {
- show_distribution_architectures();
+ show_distribution_architectures({'suite' => $suite});
last SWITCH;
};
/^distribution-aliases/ && do {
update_user_info($user);
}
}
+
+
+$dbh->commit unless $simulate;
+$dbh->disconnect;
+
+if ($mail_logs && $conf::log_mail) {
+ send_mail( $conf::log_mail,
+ "wanna-build $distribution state changes $curr_date",
+ "State changes at $curr_date for distribution ".
+ "$distribution:\n\n$mail_logs\n" );
}
+exit 0;
+
BEGIN {
$actions = {
'set-building' => { 'noversion' => 1, 'nopkgdef' => 1, },
'set-built' => { 'builder' => 1, to => 'Built', action => 'built', 'from' => [qw<Building Build-Attempted>]},
'set-attempted' => { 'builder' => 1, to => 'Build-Attempted', action => 'attempted', 'from' => [qw<Building Build-Attempted>]},
- 'set-uploaded' => { 'builder' => 1, 'noversion' => 1 },
- 'set-dep-wait' => { 'builder' => 1, },
- 'set-update' => { 'noversion' => 1, }
-
+ 'set-uploaded' => { 'builder' => 1, to => 'Uploaded', action => 'uploaded', 'from' => [qw<Building Built Build-Attempted>], binversion => 1, },
+ 'set-failed' => { 'builder' => 1, to => 'Failed', action => 'failed', from => [qw<Building Built Build-Attempted Dep-Wait Failed>], warnfrom => [qw<Needs-Build Uploaded Dep-Wait BD-Uninstallable>], },
+ 'set-dep-wait' => { 'builder' => 1, warnfrom => [qw<Needs-Build Failed BD-Uninstallable>], },
+ 'set-update' => { 'noversion' => 1, },
+ 'set-needs-build' => { builder => 1, to => 'BD-Uninstallable', action => 'give-back'},
};
}
}
}
if ($actions->{$op_mode} && $actions->{$op_mode}->{'builder'}) {
- if ($pkg->{'builder'} && $user ne $pkg->{'builder'}) {
+ if (($pkg->{'builder'} && $user ne $pkg->{'builder'}) &&
+ !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user) &&
+ !$opt_override) {
print "$pkg->{'package'}: not taken by you, but by $pkg->{'builder'}. Skipping.\n";
next;
}
}
if (!($actions->{$op_mode}) || !($actions->{$op_mode}->{'noversion'})) {
- if ( !pkg_version_eq($pkg,$version)) {
- print "$pkg->{package}: version mismatch ($pkg->{'version'} by $pkg->{'builder'})\n";
+ my $nmuver = binNMU_version($pkg->{version}, $pkg->{'binary_nmu_version'});
+ if ((!pkg_version_eq($pkg,$version) || $actions->{$op_mode}->{'binversion'}) && !version_eq( $nmuver, $version )) {
+ print "$pkg->{package}: version mismatch ($nmuver";
+ print " by $pkg->{'builder'}" if $pkg->{'builder'};
+ print ")\n";
next;
}
}
if ($actions->{$op_mode} && $actions->{$op_mode}->{'from'}) {
- if (!isin($pkg->{'state'}, @{$actions->{$op_mode}->{'from'}})) {
- print "$name: skiping: state is $pkg->{'state'}, not in ".join(", ",@{$actions->{$op_mode}->{'from'}})."\n";
+ if (!isin($pkg->{'state'}, @{$actions->{$op_mode}->{'from'}}, @{$actions->{$op_mode}->{'warnfrom'}})) {
+ print "$name: skiping: state is $pkg->{'state'}, not in ".join(", ",@{$actions->{$op_mode}->{'from'}}, @{$actions->{$op_mode}->{'warnfrom'}})."\n";
next;
}
}
+ if ($actions->{$op_mode} && $actions->{$op_mode}->{'warnfrom'}) {
+ if (isin($pkg->{'state'}, @{$actions->{$op_mode}->{'warnfrom'}})) {
+ print "$name: warning: state is $pkg->{'state'}, processing anyways.\n";
+ }
+ }
if ($op_mode eq "set-building") {
add_one_building( $name, $version, $pkg );
}
- elsif ($op_mode eq "set-built") {
- 1;
- }
- elsif ($op_mode eq "set-attempted") {
- 1;
- }
- elsif ($op_mode eq "set-uploaded") {
- add_one_uploaded( $name, $version, $pkg );
- }
elsif ($op_mode eq "set-failed") {
- add_one_failed( $pkg );
+ print "$pkg->{'package'}: already registered as failed; will append new message\n" if $pkg->{'state'} eq "Failed";
+ $pkg->{'builder'} = $user;
+ $pkg->{'failed'} .= "\n" if $pkg->{'failed'};
+ $pkg->{'failed'} .= $fail_reason;
}
elsif ($op_mode eq "set-not-for-us") {
add_one_notforus( $pkg );
}
elsif ($op_mode eq "set-needs-build") {
- add_one_needsbuild( $pkg );
+ my $state = $pkg->{'state'};
+
+ if ($state eq "BD-Uninstallable") {
+ if ($opt_override) {
+ print "$name: Forcing uninstallability mark to be removed. This is not permanent and might be reset with the next trigger run\n";
+
+ change_state( \$pkg, 'Needs-Build' );
+ delete $pkg->{'builder'};
+ delete $pkg->{'depends'};
+ log_ta( $pkg, "--give-back" );
+ update_source_info($pkg);
+ print "$name: given back\n" if $verbose;
+ next;
+ }
+ else {
+ print "$name: has uninstallable build-dependencies. Skipping\n (use --override to clear dependency list and give back anyway)\n";
+ next;
+ }
+ }
+ elsif ($state eq "Dep-Wait") {
+ if ($opt_override) {
+ print "$name: Forcing source dependency list to be cleared\n";
+ }
+ else {
+ print "$name: waiting for source dependencies. Skipping\n (use --override to clear dependency list and give back anyway)\n";
+ next;
+ }
+ }
+ elsif (!isin( $state, qw(Building Built Build-Attempted))) {
+ print "$name: not taken for building (state is $state).";
+ if ($opt_override) {
+ print "\n$name: Forcing give-back\n";
+ }
+ else {
+ print " Skipping.\n";
+ next;
+ }
+ }
+ $pkg->{'builder'} = undef;
+ $pkg->{'depends'} = undef;
}
elsif ($op_mode eq "set-dep-wait") {
add_one_depwait( $pkg );
set_one_binnmu( $name, $version, $pkg );
}
elsif ($op_mode eq "set-update") {
- set_one_update( $pkg );
+ $pkg->{'version'} =~ s/\+b[0-9]+$//;
+
+ log_ta( $pkg, "--update" );
+ update_source_info($pkg);
}
if ($actions->{$op_mode} && $actions->{$op_mode}->{'action'} && $actions->{$op_mode}->{'to'}) {
$ok = 1;
my $pkg = shift;
if (defined($pkg)) {
- if ($pkg->{'state'} eq "Not-For-Us") {
- $ok = 0;
- $reason = "not suitable for this architecture";
- }
- elsif ($pkg->{'state'} =~ /^Dep-Wait/) {
- $ok = 0;
- $reason = "not all source dependencies available yet";
- }
- elsif ($pkg->{'state'} =~ /^BD-Uninstallable/) {
+ my $pkgnack = {
+ 'Not-For-Us' => 'not suitable for this architecture',
+ 'Dep-Wait' => 'not all source dependencies available yet',
+ 'BD-Uninstallable' => 'source dependencies are not installable',
+ };
+ if ($pkgnack->{$pkg->{'state'}}) {
$ok = 0;
- $reason = "source dependencies are not installable";
+ $reason = $pkgnack->{$pkg->{'state'}};
}
elsif ($pkg->{'state'} eq "Uploaded" &&
(version_lesseq($version, $pkg->{'version'}))) {
}
-sub add_one_uploaded {
- my $name = shift;
- my $version = shift;
- my $pkg = shift;
-
- if ($pkg->{'state'} eq "Uploaded" &&
- pkg_version_eq($pkg,$version)) {
- print "$name: already uploaded\n";
- return;
- }
- if (!isin( $pkg->{'state'}, qw(Building Built Build-Attempted))) {
- print "$name: not taken for building (state is $pkg->{'state'}). ",
- "Skipping.\n";
- return;
- }
- # strip epoch -- buildd-uploader used to go based on the filename.
- # (to remove at some point)
- my $pkgver;
- ($pkgver = $pkg->{'version'}) =~ s/^\d+://;
- $version =~ s/^\d+://; # for command line use
- if ($pkg->{'binary_nmu_version'} ) {
- my $nmuver = binNMU_version($pkgver, $pkg->{'binary_nmu_version'});
- if (!version_eq( $nmuver, $version )) {
- print "$name: version mismatch ($nmuver registered). ",
- "Skipping.\n";
- return;
- }
- } elsif (!version_eq($pkgver, $version)) {
- print "$name: version mismatch ($pkg->{'version'} registered). ",
- "Skipping.\n";
- return;
- }
-
- change_state( \$pkg, 'Uploaded' );
- log_ta( $pkg, "--uploaded" );
- update_source_info($pkg);
- print "$name: registered as uploaded\n" if $verbose;
-}
-
-sub add_one_failed {
- my $pkg = shift;
- my $state = $pkg->{'state'};
- my $name = $pkg->{'package'};
-
- if ($state eq "Not-For-Us") {
- print "$name: not suitable for this architecture anyway. Skipping.\n";
- return;
- }
- elsif ($state eq "Failed-Removed") {
- print "$name: failed previously and doesn't need building. Skipping.\n";
- return;
- }
- elsif ($state eq "Installed") {
- print "$name: Is already installed in archive. Skipping.\n";
- return;
- }
- elsif ($pkg->{'builder'} &&
- (($user ne $pkg->{'builder'}) &&
- !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user))) {
- print "$name: not taken by you, but by ".
- "$pkg->{'builder'}. Skipping.\n";
- return;
- }
-
- if (isin($state, qw<Needs-Build Uploaded Dep-Wait BD-Uninstallable>)) {
- print "add_one_failed: $name: Warning: not registered for building previously (but $state), processing anyway.\n";
- }
- elsif ($state eq "Failed") {
- print "$name: already registered as failed; will append new message\n"
- if $fail_reason;
- }
-
- change_state( \$pkg, 'Failed' );
- $pkg->{'builder'} = $user;
- $pkg->{'failed'} .= "\n" if $pkg->{'failed'};
- $pkg->{'failed'} .= $fail_reason;
- log_ta( $pkg, "--failed" );
- update_source_info($pkg);
- print "$name: registered as failed\n" if $verbose;
-}
-
sub add_one_notforus {
my $pkg = shift;
my $state = $pkg->{'state'};
update_source_info($pkg);
}
-sub add_one_needsbuild {
- my $pkg = shift;
- my $state = $pkg->{'state'};
- my $name = $pkg->{'package'};
-
- if ($state eq "BD-Uninstallable") {
- if ($opt_override) {
- print "$name: Forcing uninstallability mark to be removed. This is not permanent and might be reset with the next trigger run\n";
-
- change_state( \$pkg, 'Needs-Build' );
- delete $pkg->{'builder'};
- delete $pkg->{'depends'};
- log_ta( $pkg, "--give-back" );
- update_source_info($pkg);
- print "$name: given back\n" if $verbose;
- return;
- }
- else {
- print "$name: has uninstallable build-dependencies. Skipping\n",
- " (use --override to clear dependency list and ",
- "give back anyway)\n";
- return;
- }
- }
- elsif ($state eq "Dep-Wait") {
- if ($opt_override) {
- print "$name: Forcing source dependency list to be cleared\n";
- }
- else {
- print "$name: waiting for source dependencies. Skipping\n",
- " (use --override to clear dependency list and ",
- "give back anyway)\n";
- return;
- }
- }
- elsif (!isin( $state, qw(Building Built Build-Attempted))) {
- print "$name: not taken for building (state is $state).";
- if ($opt_override) {
- print "\n$name: Forcing give-back\n";
- }
- else {
- print " Skipping.\n";
- return;
- }
- }
- if (defined ($pkg->{'builder'}) && $user ne $pkg->{'builder'} &&
- !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user) &&
- !$opt_override) {
- print "$name: not taken by you, but by ".
- "$pkg->{'builder'}. Skipping.\n";
- return;
- }
- if (!defined $distributions{$distribution}{noadw}) {
- change_state( \$pkg, 'BD-Uninstallable' );
- $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet";
- } else {
- change_state( \$pkg, 'Needs-Build' );
- }
- $pkg->{'builder'} = undef;
- $pkg->{'depends'} = undef;
- log_ta( $pkg, "--give-back" );
- update_source_info($pkg);
- print "$name: given back\n" if $verbose;
-}
-
sub set_one_binnmu {
my $name = shift;
my $version = shift;
$pkg->{'binary_nmu_changelog'} = $fail_reason;
$pkg->{'notes'} = 'out-of-date';
delete $pkg->{'buildpri'};
- if (defined $distributions{$distribution}{noadw}) {
- change_state( \$pkg, 'Installed' );
- } else {
- change_state( \$pkg, 'BD-Uninstallable' );
- }
+ change_state( \$pkg, 'BD-Uninstallable' );
}
log_ta( $pkg, "--binNMU" );
update_source_info($pkg);
return;
}
- if (!defined $distributions{$distribution}{noadw}) {
- change_state( \$pkg, 'BD-Uninstallable' );
- $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet";
- }
- else
- {
- change_state( \$pkg, 'Needs-Build' );
- }
+ change_state( \$pkg, 'BD-Uninstallable' );
delete $pkg->{'builder'};
delete $pkg->{'depends'};
$pkg->{'binary_nmu_version'} = $binNMUver;
sub set_one_buildpri {
my $key = shift;
my $pkg = shift;
- my $state = $pkg->{'state'};
my $name = $pkg->{'package'};
- if ($state eq "Not-For-Us") {
- print "$name: not suitable for this architecture. Skipping.\n";
- return;
- } elsif ($state eq "Failed-Removed") {
- print "$name: failed previously and doesn't need building. Skipping.\n";
- return;
- }
if ( $build_priority ) {
$pkg->{$key} = $build_priority;
} else {
print "$name: merging with previously registered dependencies\n";
}
- if (isin( $state, qw(Needs-Build Failed BD-Uninstallable))) {
- print "$name: Warning: not registered for building previously, ".
- "but processing anyway.\n";
- }
-
if (isin( $state, qw<Installed Not-For-Us>)) {
print "add_one_depwait: $name: skiping in state $state\n";
return;
print "$name: registered as waiting for dependencies\n" if $verbose || $simulate;
}
-sub set_one_update {
- my $pkg = shift;
- $pkg->{'version'} =~ s/\+b[0-9]+$//;
-
- log_ta( $pkg, "--update" );
- update_source_info($pkg);
-}
# for sorting priorities and sections
BEGIN {
@list = grep { my $i = $_->{'component'}; grep { $i eq $_ } split /[, ]+/, $yamlmap->{"restrict"}{'component'} } @list;
# extra depends / conflicts only from api 1 on
@list = grep { !$_->{'extra_depends'} and !$_->{'extra_conflicts'} } @list if $api < 1 ;
+ # filter out packages for needs-build in noautobuild state - same could exist for weaknoautobuild if buildds would tell us what they do
+ if (($state eq 'needs-build') && ($yamlmap->{"restrict"}) && ($yamlmap->{"restrict"}{"noautobuild"})) {
+ foreach my $key (map {keys %$_} @{$yamlmap->{"restrict"}{"noautobuild"}}) {
+ @list = grep { $_->{'package'} ne $key } @list;
+ }
+ }
# first adjust ownprintformat, then set printformat accordingly
$printformat ||= $yamlmap->{"format"}{$ownprintformat} if $ownprintformat;
my $newstate = shift;
my $state = \$pkg->{'state'};
+ $newstate = 'Needs-Build' if $newstate eq 'BD-Uninstallable' && $distributions{$distribution}{noadw};
return if defined($$state) and $$state eq $newstate;
$pkg->{'previous_state'} = $$state if defined($$state);
$pkg->{'state_change'} = $curr_date;
($pkg->{'old_failed'} // "");
delete $pkg->{'failed'};
}
- if (defined($$state) and $$state eq 'BD-Uninstallable') {
- delete $pkg->{'bd_problem'};
- }
+ delete $pkg->{'bd_problem'} if ($$state//"") eq 'BD-Uninstallable';
+ $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet" if $newstate eq 'BD-Uninstallable';
$$state = $newstate;
}
sub filterarch {
return "" unless $_[0];
- return Dpkg::Deps::parse($_[0], ("reduce_arch" => 1, "host_arch" => $_[1]))->dump();
+ return Dpkg::Deps::deps_parse($_[0], ("reduce_arch" => 1, "host_arch" => $_[1]))->output();
}
sub wb_edos_builddebcheck {
}
}
- print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles)."\n";
+ print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" -I ".$_ } @$packagefiles)."\n";
open(my $result_cmd, '-|',
- "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles));
+ "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" -I ".$_ } @$packagefiles));
my $explanation="";
my $result={};
my $args = shift;
my $srcs = $args->{'srcs'};
my $key;
-
+
+ # Do not dispatch edos-debcheck if BD-Uninstallable is deactivated for the target.
+ # ("noadw") Depwait will always be 1 in normal use.
return if defined ($distributions{$distribution}{noadw}) && not defined $args->{'depwait'};
# We need to check all of needs-build, as any new upload could make
# We also check everything in bd-uninstallable, as any new upload could
# make that work again
my (%interesting_packages, %interesting_packages_depwait);
- my $db = get_all_source_info();
+ my $db = get_all_source_info(); # TODO: Filter for needs-build bd-uninst dep-wait, that's all we need.
foreach $key (keys %$db) {
my $pkg = $db->{$key};
if (defined $pkg and isin($pkg->{'state'}, qw/Needs-Build BD-Uninstallable/) and not defined ($distributions{$distribution}{noadw})) {
- $interesting_packages{$key} = undef;
+ $interesting_packages{$key} = undef; # add key to interesting packages
}
if (defined $pkg and isin($pkg->{'state'}, qw/Dep-Wait/) and defined $args->{'depwait'}) {
+ # Depwaits are checked by creating pseudo binaries for edos-debcheck, so collect them.
$interesting_packages_depwait{$key} = undef;
# we always check for BD-Uninstallability in depwait - could be that depwait is satisfied but package is uninstallable
$interesting_packages{$key} = undef unless defined ($distributions{$distribution}{noadw});
# 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'} || $srcs->{$key}{'depends'}, $arch);
- my $tt = &filterarch($pkg->{'extra_depends'}, $arch);
+ my $t = &filterarch($srcs->{$key}{'dep'} || $srcs->{$key}{'depends'}, $args->{'arch'});
+ my $tt = &filterarch($pkg->{'extra_depends'}, $args->{'arch'});
$t = $t ? ($tt ? "$t, $tt" : $t) : $tt;
print $SOURCES "Depends: $t\n" if $t;
- my $u = &filterarch($srcs->{$key}{'conf'} || $srcs->{$key}{'conflicts'}, $arch);
- my $uu = &filterarch($pkg->{'extra_conflicts'}, $arch);
+ my $u = &filterarch($srcs->{$key}{'conf'} || $srcs->{$key}{'conflicts'}, $args->{'arch'});
+ my $uu = &filterarch($pkg->{'extra_conflicts'}, $args->{'arch'});
$u = $u ? ($uu ? "$u, $uu" : $u) : $uu;
print $SOURCES "Conflicts: $u\n" if $u;
print $SOURCES "Architecture: all\n";
for my $key (keys %interesting_packages) {
next if defined $interesting_packages_depwait{$key};
my $pkg = $db->{$key};
+ # (defined $interesting_packages{$key}) => edos found an uninstallability
my $change =
(defined $interesting_packages{$key} and $pkg->{'state'} eq 'Needs-Build') ||
(not defined $interesting_packages{$key} and $pkg->{'state'} eq 'BD-Uninstallable');
next;
}
my $pkg = $db->{$key};
- if (defined $interesting_packages{$key}) {
- change_state( \$pkg, 'BD-Uninstallable' );
- $pkg->{'bd_problem'} = $interesting_packages{$key};
- } else {
- change_state( \$pkg, 'Needs-Build' );
- }
+ # The depwait could be cleared with the result still being uninstallable.
+ if (defined $interesting_packages{$key}) {
+ change_state( \$pkg, 'BD-Uninstallable' );
+ $pkg->{'bd_problem'} = $interesting_packages{$key};
+ } else {
+ change_state( \$pkg, 'Needs-Build' );
+ }
log_ta( $pkg, "edos_depcheck: depwait" ) unless $simulate;
update_source_info($pkg) unless $simulate;
print "edos-builddebchange changed state of ${key}_$pkg->{'version'} ($args->{'arch'}) from dep-wait to $pkg->{'state'}\n" if $verbose || $simulate;
Usage: $prgname <options...> <package_version...>
Options:
-v, --verbose: Verbose execution.
- -A arch: Architecture this operation is for.
+ --simulate: Do not actually execute the action.
+ (Not yet implemented for all operations. Check the source.)
+ -A arch: Architecture this operation is for. (REQUIRED)
+ -d dist: Distribution/suite this operation is for. Defaults to unstable.
--take: Take package for building [default operation]
-f, --failed: Record in database that a build failed due to
deficiencies in the package (that aren't fixable without a new
BD-Uninstallable, until the installability of its Build-Dependencies
were verified. This happens at each call of --merge-all, usually
every 15 minutes.
+ --build-priority=VALUE: Adjust the build priority of the currently
+ queued build.
+ --permanent-build-priority=VALUE: Adjust the permanent build
+ priority of a source package in a given distribution.
+ --extra-depends=BUILD-DEPENDS: Specify additional build-dependencies
+ used for the build.
+ --extra-conflicts=BUILD-DEPENDS: Specify additional build-conflicts
+ used for the build.
-i SRC_PKG, --info SRC_PKG: Show information for source package
-l STATE, --list=STATE: List all packages in state STATE; can be
combined with -U to restrict to a specific user; STATE can
also be 'all'
+ --min-age=VALUE, --max-age=VALUE: Filter the output of --list
+ by the age of the builds.
-m MESSAGE, --message=MESSAGE: Give reason why package failed or
source dependency list
(used with -f, --dep-wait, and --binNMU)
automatically choosen
--import FILE: Import database from a ASCII file FILE
--export FILE: Export database to a ASCII file FILE
+ --format string, --own-format name: specify how the listing of packages
+ should look like. Please check the source for details. Own-Format
+ definitions are in ~/.wanna-build.yaml within the format section.
+
+There are more options not relevant for normal usage - please check source
+if you need them.
The remaining arguments (depending on operation) usually start with
"name_version", the trailer is ignored. This allows to pass the names
of .dsc files, for which file name completion can be used.
---merge-packages and --merge-quinn take Package/quin--diff file names
-on the command line or read stdin. --list needs nothing more on the
-command line. --info takes source package names (without version).
EOF
exit 1;
}
sub get_source_info {
my $name = shift;
return get_readonly_source_info($name) if $simulate;
+ lock_table();
my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change)) as state_days, floor(extract(epoch from now()) - extract(epoch from state_change)) as state_time FROM ' .
- table_name() . ' WHERE package = ? AND distribution = ?' .
- ' FOR UPDATE',
+ table_name() . ' WHERE package = ? AND distribution = ?',
undef, $name, $distribution);
return $pkg;
}
}
sub show_distribution_architectures {
+ my $args = shift;
my $q = 'SELECT distribution, spacecat_all(architecture) AS architectures '.
'FROM distribution_architectures '.
'GROUP BY distribution';
my $rows = $dbh->selectall_hashref($q, 'distribution');
- foreach my $name (keys %$rows) {
+ if ($args->{suite}) {
+ print $rows->{$args->{'suite'}}->{'architectures'}."\n";
+ } else {
+ foreach my $name (keys %$rows) {
print $name.': '.$rows->{$name}->{'architectures'}."\n";
- }
+ }
+ }
}
sub show_distribution_aliases {
sub lock_table {
return if $simulate;
- $dbh->do('LOCK TABLE ' . table_name() .
- ' IN EXCLUSIVE MODE', undef) or die $dbh->errstr;
+ $q = 'SELECT 1 AS result FROM public.locks' .
+ ' WHERE architecture = ? AND distribution = ? FOR UPDATE';
+ my $result = $dbh->selectrow_hashref($q, undef, $arch, $distribution) or die $dbh->errstr;
+ die unless $result->{'result'} == 1;
}
sub parse_argv {
# does at least one binary exist in the database and is more recent - if so, we're probably just outdated, ignore the source package
for my $bin (@{$pkgs->{'binary'}}) {
- if ($binary->{$bin} and vercmp($pkgs->{'version'}, $binary->{$bin}->{'version'}) < 0) {
- print "$logstr skipped because binaries (assumed to be) overwritten\n" if $verbose || $simulate;
+ if ($binary->{$bin} and $binary->{$bin}->{'arch'} ne 'all' and vercmp($pkgs->{'version'}, $binary->{$bin}->{'version'}) < 0) {
+ print Dumper($binary->{$bin}) . "\n";
+ print "$logstr skipped because binaries (assumed to be) overwritten (" .
+ $bin . ", " . $pkgs->{'version'} . " vs. " . $binary->{$bin}->{'version'} . ")\n" if $verbose || $simulate;
next SRCS;
}
}
projects / wannabuild.git / blobdiff