X-Git-Url: https://git.donarmstrong.com/?p=wannabuild.git;a=blobdiff_plain;f=bin%2Fwanna-build;h=477d5f4782871dce9cc6a3dd338968193096cc9d;hp=5003b661eefc6dbb164c8c9abdf92d7cfaa7388c;hb=a79b1c9284e2013e4fa5cce66c001411db3ebee4;hpb=9023a012bb2199ba4dbeb34cb487632a0c37764b diff --git a/bin/wanna-build b/bin/wanna-build index 5003b66..477d5f4 100755 --- a/bin/wanna-build +++ b/bin/wanna-build @@ -3,7 +3,7 @@ # wanna-build: coordination script for Debian buildds # Copyright (C) 1998 Roman Hodek # Copyright (C) 2005-2008 Ryan Murray -# Copyright (C) 2010 Andreas Barth +# Copyright (C) 2010,2011 Andreas Barth # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -70,7 +70,8 @@ our ($verbose, $mail_logs, $list_order, $list_state, $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 + %distributions, %distribution_aliases, $actions, + $sshwrapper, ); our $Pas = '/org/buildd.debian.org/etc/packages-arch-specific/Packages-arch-specific'; our $simulate = 0; @@ -95,7 +96,7 @@ sub _set_mode { $op_mode = "$_[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, @@ -160,6 +161,15 @@ GetOptions( 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'; + } } }, 'order|O=s' => sub { @@ -169,13 +179,18 @@ GetOptions( }, '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, @@ -188,8 +203,12 @@ GetOptions( '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; @@ -201,18 +220,9 @@ END { } $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 !~ /security/ && !$recorduser && !($privmode)) || $simulate) { +if ((isin( $op_mode, qw(list info distribution-architectures distribution-aliases)) && $distribution !~ /security/ && !$recorduser && !($privmode)) || $simulate) { $dbh = DBI->connect("DBI:Pg:service=wanna-build") || die "FATAL: Cannot open database: $DBI::errstr\n"; $schema_suffix = '_public'; @@ -259,13 +269,6 @@ 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 -# 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. @@ -340,22 +343,16 @@ $list_order ||= $yamlmap->{"list-order"}{'default'}; $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) && defined @conf::admin_users && !isin( $real_user, @conf::admin_users) && !$simulate ) { + die "This operation is restricted to admin users"; +} +if (!isin($op_mode, qw)) { + die "need an architecture" unless $arch; + my $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=? and distribution=?', [qw], undef, ($arch, $distribution)) if $distribution; + $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=?', [qw], undef, ($arch,)) unless $rows; + die "architecture ($arch) does not exist (at least not for $distribution)" if !keys %$rows and $distribution; + die "architecture ($arch) does not exist" if !keys %$rows; } - -exit 0; - - -sub process { SWITCH: foreach ($op_mode) { /^set-(.+)/ && do { @@ -371,9 +368,6 @@ sub process { 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; }; @@ -382,8 +376,6 @@ sub process { 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; @@ -410,12 +402,7 @@ sub process { 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 ); @@ -447,62 +434,166 @@ sub process { 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" ); } -sub add_packages { - my $newstate = shift; - my( $package, $name, $version, $ok, $reason ); - - foreach $package (@_) { - $package =~ s,^.*/,,; # strip path - $package =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension - $package =~ s/_[a-zA-Z\d-]+\.changes$//; # strip extension - if ($package =~ /^([\w\d.+-]+)_([\w\d:.+~-]+)/) { - ($name,$version) = ($1,$2); - } - else { - warn "$package: can't extract package name and version ". - "(bad format)\n"; - next; - } +exit 0; - if ($op_mode eq "set-building") { - add_one_building( $name, $version ); - } - elsif ($op_mode eq "set-built") { - add_one_built( $name, $version ); - } - elsif ($op_mode eq "set-attempted") { - add_one_attempted( $name, $version ); - } - elsif ($op_mode eq "set-uploaded") { - add_one_uploaded( $name, $version ); - } - elsif ($op_mode eq "set-failed") { - add_one_failed( $name, $version ); - } - elsif ($op_mode eq "set-not-for-us") { - add_one_notforus( $name, $version ); - } - elsif ($op_mode eq "set-needs-build") { - add_one_needsbuild( $name, $version ); - } - elsif ($op_mode eq "set-dep-wait") { - add_one_depwait( $name, $version ); - } - elsif ($op_mode eq "set-build-priority") { - set_one_buildpri( $name, $version, 'buildpri' ); - } - elsif ($op_mode eq "set-permanent-build-priority") { - set_one_buildpri( $name, $version, 'permbuildpri' ); - } - elsif ($op_mode eq "set-binary-nmu") { - set_one_binnmu( $name, $version ); - } - elsif ($op_mode eq "set-update") { - set_one_update( $name, $version ); - } + +BEGIN { + $actions = { + 'set-building' => { 'noversion' => 1, 'nopkgdef' => 1, }, + 'set-built' => { 'builder' => 1, to => 'Built', action => 'built', 'from' => [qw]}, + 'set-attempted' => { 'builder' => 1, to => 'Build-Attempted', action => 'attempted', 'from' => [qw]}, + 'set-uploaded' => { 'builder' => 1, to => 'Uploaded', action => 'uploaded', 'from' => [qw], binversion => 1, }, + 'set-failed' => { 'builder' => 1, to => 'Failed', action => 'failed', from => [qw], warnfrom => [qw], }, + 'set-dep-wait' => { 'builder' => 1, warnfrom => [qw], }, + 'set-update' => { 'noversion' => 1, }, + 'set-needs-build' => { builder => 1, to => 'BD-Uninstallable', action => 'give-back'}, + }; +} + +sub add_packages { + my $newstate = shift; + my( $package, $name, $version, $ok, $reason ); + + foreach $package (@_) { + $package =~ s,^.*/,,; # strip path + $package =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension + $package =~ s/_[a-zA-Z\d-]+\.changes$//; # strip extension + if ($package =~ /^([\w\d.+-]+)_([\w\d:.+~-]+)/) { + ($name,$version) = ($1,$2); + } else { + warn "$package: can't extract package name and version (bad format)\n"; + next; } + + my $pkg = get_source_info($name); + if (!($actions->{$op_mode}) || !($actions->{$op_mode}->{'nopkgdef'})) { + if (!defined($pkg)) { + print "$name: not registered yet.\n"; + next; + } + } + if ($actions->{$op_mode} && $actions->{$op_mode}->{'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'})) { + 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'}}, @{$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-failed") { + 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") { + 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 ); + } + elsif ($op_mode eq "set-build-priority") { + set_one_buildpri( 'buildpri', $pkg ); + } + elsif ($op_mode eq "set-permanent-build-priority") { + set_one_buildpri( 'permbuildpri', $pkg ); + } + elsif ($op_mode eq "set-binary-nmu") { + set_one_binnmu( $name, $version, $pkg ); + } + elsif ($op_mode eq "set-update") { + $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'}) { + change_state( \$pkg, $actions->{$op_mode}->{'to'} ); + log_ta( $pkg, "--".$actions->{$op_mode}->{'action'} ); + update_source_info($pkg); + print "$name: registered as ".$actions->{$op_mode}->{'action'}."\n" if $verbose; + } + } } sub add_one_building { @@ -511,19 +602,16 @@ sub add_one_building { my( $ok, $reason ); $ok = 1; - my $pkg = get_source_info($name); + my $pkg = shift; if (defined($pkg)) { - if ($pkg->{'state'} eq "Not-For-Us") { + 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 = "not suitable for this architecture"; - } - elsif ($pkg->{'state'} =~ /^Dep-Wait/) { - $ok = 0; - $reason = "not all source dependencies available yet"; - } - elsif ($pkg->{'state'} =~ /^BD-Uninstallable/) { - $ok = 0; - $reason = "source dependencies are not installable"; + $reason = $pkgnack->{$pkg->{'state'}}; } elsif ($pkg->{'state'} eq "Uploaded" && (version_lesseq($version, $pkg->{'version'}))) { @@ -665,189 +753,11 @@ sub add_one_building { } } -sub add_one_attempted { - my $name = shift; - my $version = shift; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - - if (($pkg->{'state'} ne "Building") && ($pkg->{'state'} ne "Build-Attempted")) { - print "$name: not taken for building (state is $pkg->{'state'}). ", - "Skipping.\n"; - return; - } - if ($pkg->{'builder'} ne $user) { - print "$name: not taken by you, but by $pkg->{'builder'}. Skipping.\n"; - return; - } - elsif ( !pkg_version_eq($pkg, $version) ) { - print "$name: version mismatch ". - "$(pkg->{'version'} ". - "by $pkg->{'builder'})\n"; - return; - } - - change_state( \$pkg, 'Build-Attempted' ); - log_ta( $pkg, "--attempted" ); - update_source_info($pkg); - print "$name: registered as uploaded\n" if $verbose; -} - -sub add_one_built { - my $name = shift; - my $version = shift; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - - if (($pkg->{'state'} ne "Building") && ($pkg->{'state'} ne "Build-Attempted")) { - print "$name: not taken for building (state is $pkg->{'state'}). ", - "Skipping.\n"; - return; - } - if ($pkg->{'builder'} ne $user) { - print "$name: not taken by you, but by $pkg->{'builder'}. Skipping.\n"; - return; - } - elsif ( !pkg_version_eq($pkg, $version) ) { - print "$name: version mismatch ". - "$(pkg->{'version'} ". - "by $pkg->{'builder'})\n"; - return; - } - change_state( \$pkg, 'Built' ); - log_ta( $pkg, "--built" ); - update_source_info($pkg); - print "$name: registered as built\n" if $verbose; -} - -sub add_one_uploaded { - my $name = shift; - my $version = shift; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - - 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; - } - if ($pkg->{'builder'} ne $user) { - print "$name: not taken by you, but by $pkg->{'builder'}. 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 $name = shift; - my $version = shift; - my $state; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - $state = $pkg->{'state'}; - - 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; - } - elsif ( !pkg_version_eq($pkg, $version) ) { - print "$name: version mismatch ". - "$(pkg->{'version'} ". - "by $pkg->{'builder'})\n"; - return; - } - - if ($state eq "Needs-Build") { - print "$name: Warning: not registered for building previously, ". - "but processing anyway.\n"; - } - elsif ($state eq "Uploaded") { - print "$name: Warning: marked as uploaded previously, ". - "but processing anyway.\n"; - } - elsif ($state eq "Dep-Wait") { - print "$name: Warning: marked as waiting for dependencies, ". - "but processing anyway.\n"; - } - elsif ($state eq "BD-Uninstallable") { - print "$name: Warning: marked as having uninstallable build-dependencies, ". - "but 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 $name = shift; - my $version = shift; - my $pkg = get_source_info($name); + my $pkg = shift; + my $state = $pkg->{'state'}; + my $name = $pkg->{'package'}; if ($pkg->{'state'} eq 'Not-For-Us') { # reset Not-For-Us state in case it's called twice; this is @@ -893,101 +803,11 @@ sub add_one_notforus { update_source_info($pkg); } -sub add_one_needsbuild { - my $name = shift; - my $version = shift; - my $state; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered; can't give back.\n"; - return; - } - $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; - 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 (!pkg_version_eq($pkg, $version)) { - print "$name: version mismatch ($pkg->{'version'} registered). ", - "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; - my $pkg = get_source_info($name); - my $state; - - if (!defined($pkg)) { - print "$name: not registered; can't register for binNMU.\n"; - return; - } - my $db_ver = $pkg->{'version'}; - - if (!version_eq($db_ver, $version)) { - print "$name: version mismatch ($db_ver registered). ", - "Skipping.\n"; - return; - } - $state = $pkg->{'state'}; + my $pkg = shift; + my $state = $pkg->{'state'}; if (defined $pkg->{'binary_nmu_version'}) { if ($binNMUver == 0) { @@ -1005,11 +825,7 @@ sub set_one_binnmu { $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); @@ -1031,14 +847,7 @@ sub set_one_binnmu { 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; @@ -1051,88 +860,34 @@ sub set_one_binnmu { } sub set_one_buildpri { - my $name = shift; - my $version = shift; my $key = shift; - my $pkg = get_source_info($name); - my $state; - - if (!defined($pkg)) { - print "$name: not registered; can't set priority.\n"; - return; - } - $state = $pkg->{'state'}; + my $pkg = shift; + 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 (!pkg_version_eq($pkg, $version)) { - print "$name: version mismatch ($pkg->{'version'} registered). ", - "Skipping.\n"; - return; - } - if ( $build_priority == 0 ) { - delete $pkg->{$key}; - } else { + if ( $build_priority ) { $pkg->{$key} = $build_priority; + } else { + delete $pkg->{$key}; } update_source_info($pkg); print "$name: set to build priority $build_priority\n" if $verbose; } sub add_one_depwait { - my $name = shift; - my $version = shift; - my $state; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - $state = $pkg->{'state'}; + my $pkg = shift; + my $state = $pkg->{'state'}; + my $name = $pkg->{'package'}; if ($state eq "Dep-Wait") { 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"; - } - elsif ($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 ($state eq "Uploaded") { - print "$name: Is already uploaded. Skipping.\n"; - return; - } - elsif ($pkg->{'builder'} && - $user ne $pkg->{'builder'}) { - print "$name: not taken by you, but by ". - "$pkg->{'builder'}. Skipping.\n"; - return; - } - elsif ( !pkg_version_eq($pkg,$version)) { - print "$name: version mismatch ". - "($pkg->{'version'} ". - "by $pkg->{'builder'})\n"; - return; - } - elsif ($fail_reason =~ /^\s*$/ || + if (isin( $state, qw)) { + print "add_one_depwait: $name: skiping in state $state\n"; + return; + } + + if ($fail_reason =~ /^\s*$/ || !parse_deplist( $fail_reason, 1 )) { print "$name: Bad dependency list\n"; return; @@ -1146,24 +901,9 @@ sub add_one_depwait { $deplist->{$_} = $new_deplist->{$_}; } $pkg->{'depends'} = build_deplist($deplist); - log_ta( $pkg, "--dep-wait" ); - update_source_info($pkg); - print "$name: registered as waiting for dependencies\n" if $verbose; -} - -sub set_one_update { - my $name = shift; - my $version = shift; - my $pkg = get_source_info($name); - - if (!defined($pkg)) { - print "$name: not registered yet.\n"; - return; - } - $pkg->{'version'} =~ s/\+b[0-9]+$//; - - log_ta( $pkg, "--update" ); - update_source_info($pkg); + log_ta( $pkg, "--dep-wait" ) unless $simulate; + update_source_info($pkg) unless $simulate; + print "$name: registered as waiting for dependencies\n" if $verbose || $simulate; } @@ -1421,15 +1161,15 @@ Text could contain further %. To start with !, use %! sub list_packages { my $state = shift; - my( $name, $pkg, @list ); + my @list; my $cnt = 0; my %scnt; my $ctime = time; - my $db = get_all_source_info(state => $state, user => $user, list_min_age => $list_min_age); - foreach $name (keys %$db) { - next if $name =~ /^_/; - push @list, calculate_prio($db->{$name}); + my $db = get_all_source_info(state => $state, user => $user, list_min_age => $list_min_age, multisuite => 1); + foreach my $key (keys %$db) { + next if $key =~ /^_/; + push @list, calculate_prio($db->{$key}); } # filter components @@ -1443,7 +1183,7 @@ sub list_packages { $printformat ||= $yamlmap->{"format"}{"default"}{"default"}; undef $printformat if ($ownprintformat && $ownprintformat eq 'none'); - foreach $pkg (sort sort_list_func @list) { + foreach my $pkg (sort sort_list_func @list) { no warnings; if ($printformat) { print print_format($printformat, $pkg, {'cnt' => $cnt, 'scnt' => \%scnt})."\n"; @@ -1689,6 +1429,7 @@ sub change_state { 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; @@ -1701,9 +1442,8 @@ sub change_state { ($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; } @@ -1770,6 +1510,7 @@ sub parse_deplist { my $verify = shift; my %result; + return $verify ? 0 : \%result unless $deps; foreach (split( /\s*,\s*/, $deps )) { if ($verify) { # verification requires > starting prompts, no | crap @@ -1947,12 +1688,12 @@ sub call_edos_depcheck { # 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"; @@ -2191,7 +1932,20 @@ sub get_all_source_info { push @args, -$options{list_min_age} . " days"; } - my $db = $dbh->selectall_hashref($q, 'package', undef, @args); + my $db; + if (($options{multisuite}) && (!$distribution || $distribution =~ / /)) { + # return packages in multiple suites - only for those functions marked as clean for that api change + $db = $dbh->selectall_hashref($q, [qw], undef, @args); + my $dbk = {}; + foreach my $p ( keys %$db ) { + foreach my $d (keys %{$db->{$p}}) { + $dbk->{"$p/$d"} = $db->{$p}->{$d}; + } + } + $db = $dbk; + } else { + $db = $dbh->selectall_hashref($q, [qw], undef, @args); + } return $db; }