$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
);
our $Pas = '/org/buildd.debian.org/etc/packages-arch-specific/Packages-arch-specific';
our $simulate = 0;
}
}
-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;
- }
- 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<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, }
+
+ };
+}
+
+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'}) {
+ 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";
+ 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";
+ next;
+ }
+ }
+
+ 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 );
+ }
+ elsif ($op_mode eq "set-not-for-us") {
+ add_one_notforus( $pkg );
+ }
+ elsif ($op_mode eq "set-needs-build") {
+ add_one_needsbuild( $pkg );
+ }
+ 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") {
+ set_one_update( $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 {
my( $ok, $reason );
$ok = 1;
- my $pkg = get_source_info($name);
+ my $pkg = shift;
if (defined($pkg)) {
if ($pkg->{'state'} eq "Not-For-Us") {
$ok = 0;
}
}
-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;
- }
+ my $pkg = shift;
if ($pkg->{'state'} eq "Uploaded" &&
pkg_version_eq($pkg,$version)) {
"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;
}
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'};
+ 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";
"$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";
+ 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"
$pkg->{'builder'} = $user;
$pkg->{'failed'} .= "\n" if $pkg->{'failed'};
$pkg->{'failed'} .= $fail_reason;
- if (defined $pkg->{'permbuildpri'}) {
- $pkg->{'buildpri'} = $pkg->{'permbuildpri'};
- } else {
- delete $pkg->{'buildpri'};
- }
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
$pkg->{'package'} = $name;
delete $pkg->{'builder'};
delete $pkg->{'depends'};
- delete $pkg->{'buildpri'};
delete $pkg->{'binary_nmu_version'};
delete $pkg->{'binary_nmu_changelog'};
log_ta( $pkg, "--no-build" );
}
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'};
+ my $pkg = shift;
+ my $state = $pkg->{'state'};
+ my $name = $pkg->{'package'};
if ($state eq "BD-Uninstallable") {
if ($opt_override) {
"$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";
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) {
delete $pkg->{'depends'};
delete $pkg->{'binary_nmu_version'};
delete $pkg->{'binary_nmu_changelog'};
+ delete $pkg->{'buildpri'};
} elsif ($binNMUver <= $pkg->{'binary_nmu_version'}) {
print "$name: already building binNMU $pkg->{'binary_nmu_version'}\n";
return;
$pkg->{'binary_nmu_version'} = $binNMUver;
$pkg->{'binary_nmu_changelog'} = $fail_reason;
$pkg->{'notes'} = 'out-of-date';
- $pkg->{'buildpri'} = $pkg->{'permbuildpri'}
- if (defined $pkg->{'permbuildpri'});
+ delete $pkg->{'buildpri'};
if (defined $distributions{$distribution}{noadw}) {
change_state( \$pkg, 'Installed' );
} else {
$pkg->{'binary_nmu_version'} = $binNMUver;
$pkg->{'binary_nmu_changelog'} = $fail_reason;
$pkg->{'notes'} = 'out-of-date';
+ delete $pkg->{'buildpri'};
log_ta( $pkg, "--binNMU" );
update_source_info($pkg);
print "${name}: registered for binNMU $fullver\n" if $verbose;
}
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 $state = $pkg->{'state'};
+ my $name = $pkg->{'package'};
if ($state eq "Not-For-Us") {
print "$name: not suitable for this architecture. Skipping.\n";
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->{'buildpri'}
- if $key eq 'permbuildpri' and defined $pkg->{'buildpri'}
- and $pkg->{'buildpri'} == $pkg->{$key};
- delete $pkg->{$key};
- } else {
- $pkg->{'buildpri'} = $build_priority
- if $key eq 'permbuildpri';
+ 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";
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<Installed Not-For-Us>)) {
+ 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;
}
change_state( \$pkg, 'Dep-Wait' );
$pkg->{'builder'} = $user;
- if (defined $pkg->{'permbuildpri'}) {
- $pkg->{'buildpri'} = $pkg->{'permbuildpri'};
- } else {
- delete $pkg->{'buildpri'};
- }
my $deplist = parse_deplist( $pkg->{'depends'} );
my $new_deplist = parse_deplist( $fail_reason );
# add new dependencies, maybe overwriting old entries
$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;
+ log_ta( $pkg, "--dep-wait" ) unless $simulate;
+ update_source_info($pkg) unless $simulate;
+ print "$name: registered as waiting for dependencies\n" if $verbose || $simulate;
}
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;
- }
+ my $pkg = shift;
$pkg->{'version'} =~ s/\+b[0-9]+$//;
log_ta( $pkg, "--update" );
update_source_info($pkg);
}
-
# for sorting priorities and sections
BEGIN {
%prioval = ( required => -5,
my $map_funcs = {
'C' => ['<->', sub { return $_[0]->{'calprio'}; }],
'W' => ['<->', sub { return $_[0]->{'state_days'}; }],
- 'P' => ['<->', sub { return $_[0]->{'buildpri'}; }],
+ 'P' => ['<->', sub { return ($_[0]->{'buildpri'}//0) + ($_[0]->{'permbuildpri'}//0); }],
'p' => ['<=>', sub { return $prioval{$_[0]->{'priority'}//""}//0; }],
's' => ['<=>', sub { return $sectval{$_[0]->{'section'}//""}//0; }],
'n' => ['cmp', sub { return $_[0]->{'package'}; }],
no warnings;
my $c = "$pkg->{'priority'}:$pkg->{'notes'}";
$c .= ":PREV-FAILED" if $pkg->{'previous_state'} && $pkg->{'previous_state'} =~ /^Failed/;
- $c .= ":bp{" . $pkg->{'buildpri'} . "}" if defined $pkg->{'buildpri'};
+ $c .= ":bp{" . (($pkg->{'buildpri'}//0)+($pkg->{'permbuildpri'}//0)) . "}" if (($pkg->{'buildpri'}//0)+($pkg->{'permbuildpri'}//0));
$c .= ":binNMU{" . $pkg->{'binary_nmu_version'} . "}" if defined $pkg->{'binary_nmu_version'};
$c .= ":calprio{". $pkg->{'calprio'}."}";
$c .= ":days{". $pkg->{'state_days'}."}";
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
$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";
my $verify = shift;
my %result;
+ return $verify ? 0 : \%result unless $deps;
foreach (split( /\s*,\s*/, $deps )) {
if ($verify) {
# verification requires > starting prompts, no | crap
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<package distribution>], 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<package>], undef, @args);
+ }
return $db;
}
delete $pkg->{'builder'};
delete $pkg->{'binary_nmu_version'} unless $pkgs->{'binnmu'};
delete $pkg->{'binary_nmu_changelog'} unless $pkgs->{'binnmu'};
+ delete $pkg->{'buildpri'};
log_ta( $pkg, "--merge-v3: needs-build" ) unless $simulate;
update_source_info($pkg) unless $simulate;
print "$logstr set to needs-builds\n" if $simulate || $verbose;