$basedir ||= "/var/lib/debbuild";
$dbbase ||= "build-db";
$transactlog ||= "transactions.log";
-#$mailprog ||= "/usr/sbin/sendmail";
-$mailprog = "/bin/true";
-require "/etc/wanna-build.conf";
+$mailprog ||= "/usr/sbin/sendmail";
+require "/org/wanna-build/etc/wanna-build.conf";
die "$conf::basedir is not a directory\n" if ! -d $conf::basedir;
die "dbbase is empty\n" if ! $dbbase;
die "transactlog is empty\n" if ! $transactlog;
use FileHandle;
use File::Copy;
use DBI;
+use lib '/org/wanna-build/bin';
use WannaBuild;
our ($verbose, $mail_logs, $list_order, $list_state,
$curr_date, $op_mode, $user, $real_user, $distribution,
- $fail_reason, $opt_override, $import_from, $opt_create_db,
+ $fail_reason, $opt_override, $import_from, $export_to, $opt_create_db,
%prioval, %sectval,
$info_all_dists, $arch,
$category, %catval, %short_category,
code => sub {
die "Argument of --min-age must be a non-zero number\n"
if $list_min_age == 0;
- $list_min_age *= 24*60*60;
} },
"max-age" => { arg => \$list_min_age,
code => sub {
die "Argument of --max-age must be a non-zero number\n"
if $list_min_age == 0;
- $list_min_age *= -24*60*60;
+ $list_min_age *= -1;
} },
# special actions
+ export => { arg => \$export_to, mode => "export" },
import => { arg => \$import_from, mode => "import" },
"manual-edit" => { mode => "manual-edit" },
);
print "wanna-build $version for $distribution on $arch\n";
}
-if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import
+if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
merge-packages manual-edit
merge-sources))) {
warn "No packages given.\n";
}
}
-$dbh = DBI->connect("DBI:Pg:database=wanna-build") ||
- die "FATAL: Cannot open database: $DBI::errstr\n";
+my $schema_suffix = '';
+if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/)) {
+ $dbh = DBI->connect("DBI:Pg:service=wanna-build") ||
+ die "FATAL: Cannot open database: $DBI::errstr\n";
+ $schema_suffix = '_public';
+}
+else
+{
+ $dbh = DBI->connect("DBI:Pg:service=wanna-build-privileged") ||
+ die "FATAL: Cannot open database: $DBI::errstr\n";
+}
# TODO: This shouldn't be needed, file a bug.
$dbh->{pg_server_prepare} = 0;
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())
+ $dbh->do("DELETE from " . table_name() .
+ " WHERE distribution = ?", undef,
+ $distribution)
or die $dbh->errstr;
forget_users();
read_db( $import_from );
last SWITCH;
};
+ /^export/ && do {
+ export_db( $export_to );
+ last SWITCH;
+ };
die "Unexpected operation mode $op_mode\n";
}
my $ok = 'ok';
if ($pkg->{'binary_nmu_version'}) {
print "$name: Warning: needs binary NMU $pkg->{'binary_nmu_version'}\n" .
- "$pkg->{'Binary-NMU-Changelog'}\n";
+ "$pkg->{'binary_nmu_changelog'}\n";
$ok = 'aok';
} else {
print "$name: Warning: Previous version failed!\n"
delete $pkg->{'depends'};
delete $pkg->{'buildpri'};
delete $pkg->{'binary_nmu_version'};
- delete $pkg->{'Binary-NMU-Changelog'};
+ delete $pkg->{'binary_nmu_changelog'};
log_ta( $pkg, "--no-build" );
print "$name: registered as unsuitable\n" if $verbose;
}
}
if (defined ($pkg->{'builder'}) && $user ne $pkg->{'builder'} &&
- !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user)) {
+ !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user) &&
+ !$opt_override) {
print "$name: not taken by you, but by ".
"$pkg->{'builder'}. Skipping.\n";
return;
delete $pkg->{'builder'};
delete $pkg->{'depends'};
delete $pkg->{'binary_nmu_version'};
- delete $pkg->{'Binary-NMU-Changelog'};
+ delete $pkg->{'binary_nmu_changelog'};
} elsif ($binNMUver <= $pkg->{'binary_nmu_version'}) {
print "$name: already building binNMU $pkg->{'binary_nmu_version'}\n";
return;
} else {
$pkg->{'binary_nmu_version'} = $binNMUver;
- $pkg->{'Binary-NMU-Changelog'} = $fail_reason;
+ $pkg->{'binary_nmu_changelog'} = $fail_reason;
$pkg->{'notes'} = 'out-of-date';
$pkg->{'buildpri'} = $pkg->{'permbuildpri'}
if (defined $pkg->{'permbuildpri'});
delete $pkg->{'builder'};
delete $pkg->{'depends'};
$pkg->{'binary_nmu_version'} = $binNMUver;
- $pkg->{'Binary-NMU-Changelog'} = $fail_reason;
+ $pkg->{'binary_nmu_changelog'} = $fail_reason;
$pkg->{'notes'} = 'out-of-date';
log_ta( $pkg, "--binNMU" );
update_source_info($pkg);
$pkg->{'version'} = $version
if version_less( $pkg->{'version'}, $version);
delete $pkg->{'binary_nmu_version'};
- delete $pkg->{'Binary-NMU-Changelog'};
+ delete $pkg->{'binary_nmu_changelog'};
log_ta( $pkg, "--merge-packages" );
update_source_info($pkg);
print "$name ($version) is up-to-date now.\n" if $verbose;
change_state( \$pkg, 'Dep-Wait' );
$pkg->{'version'} = $version;
delete $pkg->{'binary_nmu_version'};
- delete $pkg->{'Binary-NMU-Changelog'};
+ delete $pkg->{'binary_nmu_changelog'};
log_ta( $pkg, "--merge-quinn" );
$change++;
print "$name ($version) still waiting for dependencies.\n"
$pkg->{'notes'} = $notes;
delete $pkg->{'builder'};
delete $pkg->{'binary_nmu_version'};
- delete $pkg->{'Binary-NMU-Changelog'};
+ delete $pkg->{'binary_nmu_changelog'};
log_ta( $pkg, "--merge-quinn" );
$new_vers{$name}++;
$change++;
if ($dubious) {
send_mail( $conf::db_maint,
- "Dubious versions in " . table_name() . " table",
+ "Dubious versions in " . table_name() . " "
+ . $distribution . " table",
"The following packages have a newer version in the ".
"wanna-build database\n".
"than what quinn-diff says, and this is strange for ".
my %scnt;
my $ctime = time;
- my $db = get_all_source_info();
+ my $db = get_all_source_info(state => $state, user => $user, category => $category, list_min_age => $list_min_age);
foreach $name (keys %$db) {
next if $name =~ /^_/;
- $pkg = $db->{$name};
- next if $state ne "all" && $pkg->{'state'} !~ /^\Q$state\E$/i;
- next if $user && (lc($state) ne 'needs-build' and $pkg->{'builder'} ne $user);
- next if $category && $pkg->{'state'} eq "Failed" &&
- $pkg->{'failed_category'} ne $category;
- next if ($list_min_age > 0 &&
- ($ctime-parse_date($pkg->{'State-Change'})) < $list_min_age)||
- ($list_min_age < 0 &&
- ($ctime-parse_date($pkg->{'State-Change'})) > -$list_min_age);
- push( @list, $pkg );
+ push @list, $db->{$name};
}
foreach $pkg (sort sort_list_func @list) {
join("\n ",split("\n",$pkg->{'bd_problem'})), "\n"
if $pkg->{'state'} eq "BD-Uninstallable";
print " Previous state was $pkg->{'previous_state'} until ",
- "$pkg->{'State-Change'}\n"
+ "$pkg->{'state_change'}\n"
if $verbose && $pkg->{'previous_state'};
print " No previous state recorded\n"
if $verbose && !$pkg->{'previous_state'};
foreach $dist (@dists) {
my $pname = "$name" . ($info_all_dists ? "($dist)" : "");
- $pkg = get_source_info($name);
+ $pkg = get_readonly_source_info($name);
if (!defined( $pkg )) {
print "$pname: not registered\n";
next;
chomp( $val );
$val = "\n$val" if isin( $key, qw(Failed Old-Failed));
$val =~ s/\n/\n /g;
- printf " %-20s: %s\n", $key, $val;
+ my $print_key = $key;
+ $print_key = 'Package' if ($key eq 'package');
+ $print_key = 'Version' if ($key eq 'version');
+ $print_key = 'Builder' if ($key eq 'builder');
+ $print_key = 'State' if ($key eq 'state');
+ $print_key = 'Section' if ($key eq 'section');
+ $print_key = 'Priority' if ($key eq 'priority');
+ $print_key = 'Installed-Version' if ($key eq 'installed_version');
+ $print_key = 'Previous-State' if ($key eq 'previous_state');
+ $print_key = 'State-Change' if ($key eq 'state_change');
+ printf " %-20s: %s\n", $print_key, $val;
}
foreach $key (sort keys %$pkg) {
next if isin( $key, @firstkeys );
my $val = $pkg->{$key};
+ next if !defined($val);
chomp( $val );
$val = "\n$val" if isin( $key, qw(Failed Old-Failed));
$val =~ s/\n/\n /g;
- printf " %-20s: %s\n", $key, $val;
+ my $print_key = $key;
+ $print_key = 'BD-Problem' if ($key eq 'bd_problem');
+ $print_key = 'Binary-NMU-Changelog' if ($key eq 'binary_nmu_changelog');
+ $print_key = 'Binary-NMU-Version' if ($key eq 'binary_nmu_version');
+ $print_key = 'BuildPri' if ($key eq 'buildpri');
+ $print_key = 'Depends' if ($key eq 'depends');
+ $print_key = 'Failed' if ($key eq 'failed');
+ $print_key = 'Failed-Category' if ($key eq 'failed_category');
+ $print_key = 'Notes' if ($key eq 'notes');
+ $print_key = 'Distribution' if ($key eq 'distribution');
+ $print_key = 'Old-Failed' if ($key eq 'old_failed');
+ $print_key = 'PermBuildPri' if ($key eq 'permbuildpri');
+ $print_key = 'Rel' if ($key eq 'rel');
+ printf " %-20s: %s\n", $print_key, $val;
}
}
}
$data .= sprintf " %-20s: %s\n", $key, $val;
}
send_mail( $conf::db_maint,
- "$name deleted from DB " . table_name(),
+ "$name deleted from DB " . table_name() . " " . $distribution,
"The package '$name' has been deleted from the database ".
"by $user.\n\n".
"Data registered about the deleted package:\n".
}
sub forget_users {
- $dbh->do("DELETE from " . user_table_name()) or die $dbh->errstr;
+ $dbh->do("DELETE from " . user_table_name() .
+ " WHERE distribution = ?", undef, $distribution) or die $dbh->errstr;
}
sub read_db {
elsif(exists($thispkg{'user'})) {
# user in import, username in database.
$dbh->do('INSERT INTO ' . user_table_name() .
- ' (username, last_seen) values (?, ?)',
- undef, $thispkg{'user'}, $thispkg{'last_seen'})
+ ' (username, distribution, last_seen)' .
+ ' values (?, ?, ?)',
+ undef, $thispkg{'user'}, $distribution,
+ $thispkg{'last_seen'})
or die $dbh->errstr;
}
}
join( "\n", map { "$_: $pkg->{$_}" } keys %$pkg ), "\n";
die "Database entry lacks package or username field\n";
}
- if (!exists $pkg->{'version'}) {
- die "Database entry for $pkg->{'package'} lacks Version: field\n";
- }
# if no State: field, generate one (for old db compat)
if (!exists($pkg->{'state'})) {
$pkg->{'state'} =
exists $pkg->{'failed'} ? 'Failed' : 'Building';
}
+ if (!exists $pkg->{'version'} and $pkg->{'state'} ne 'Not-For-Us') {
+ die "Database entry for $pkg->{'package'} lacks Version: field\n";
+ }
# check state field
die "Bad state $pkg->{'state'} of package $pkg->{Package}\n"
if !isin( $pkg->{'state'},
- qw(Needs-Build Building Built Build-Attempted Uploaded Installed Dep-Wait
+ qw(Needs-Build Building Built Build-Attempted Uploaded Installed Dep-Wait Dep-Wait-Removed
Failed Failed-Removed Not-For-Us BD-Uninstallable
) );
}
+sub export_db {
+ my $file = shift;
+ my($name,$pkg,$key);
+
+ print "Writing ASCII database to $file..." if $verbose >= 1;
+ open( F, ">$file" ) or
+ die "Can't open export $file: $!\n";
+
+ my $db = get_all_source_info();
+ foreach $name (keys %$db) {
+ next if $name =~ /^_/;
+ my $pkg = $db->{$name};
+ foreach $key (keys %{$pkg}) {
+ my $val = $pkg->{$key};
+ next if !defined($val);
+ $val =~ s/\n*$//;
+ $val =~ s/^/ /mg;
+ $val =~ s/^ +$/ ./mg;
+ print F "$key: $val\n";
+ }
+ print F "\n";
+ }
+ close( F );
+ print "done\n" if $verbose >= 1;
+}
+
sub change_state {
my $pkgr = shift;
my $pkg = $$pkgr;
return if defined($$state) and $$state eq $newstate;
$pkg->{'previous_state'} = $$state if defined($$state);
- $pkg->{'State-Change'} = $curr_date;
+ $pkg->{'state_change'} = $curr_date;
if (defined($$state) and $$state eq 'Failed') {
$pkg->{'old_failed'} =
"changed from $prevstate to $pkg->{'state'} ".
"by $real_user as $user";
- my $transactlog = db_transactlog();
- if (!open( LOG, ">>$transactlog" )) {
- warn "Can't open log file $transactlog: $!\n";
- return;
- }
- print LOG "$curr_date: $str\n";
- close( LOG );
+ $dbh->do('INSERT INTO ' . transactions_table_name() .
+ ' (package, distribution, version, action, ' .
+ ' prevstate, state, real_user, set_user, time) ' .
+ ' values (?, ?, ?, ?, ?, ?, ?, ?, ?)',
+ undef, $pkg->{'package'}, $distribution,
+ $pkg->{'version'}, $action, $prevstate, $pkg->{'state'},
+ $real_user, $user, 'now()') or die $dbh->errstr;
if (!($prevstate eq 'Failed' && $pkg->{'state'} eq 'Failed')) {
$str .= " (with --override)"
close( PIPE );
}
-sub db_transactlog {
- return "$conf::basedir/$arch/$conf::transactlog";
-}
-
# for parsing input to dep-wait
sub parse_deplist {
my $deps = shift;
Usage: $prgname <options...> <package_version...>
Options:
-v, --verbose: Verbose execution.
+ -A arch: Architecture this operation is for.
--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
if -l is missing, set user name to be entered in db; usually
automatically choosen
--import FILE: Import database from a ASCII file FILE
+ --export FILE: Export database to a ASCII file FILE
The remaining arguments (depending on operation) usually start with
"name_version", the trailer is ignored. This allows to pass the names
}
sub table_name {
- return $arch . '_' . $distribution;
+ return '"' . $arch . $schema_suffix . '".packages';
}
sub user_table_name {
- return $arch . '_' . $distribution . '_users';
+ return '"' . $arch . $schema_suffix . '".users';
+}
+
+sub transactions_table_name {
+ return '"' . $arch . $schema_suffix . '".transactions';
+}
+
+sub get_readonly_source_info {
+ my $name = shift;
+ my $pkg = $dbh->selectrow_hashref('SELECT * FROM ' .
+ table_name() . ' WHERE package = ? AND distribution = ?',
+ undef, $name, $distribution);
+ return $pkg;
}
sub get_source_info {
my $name = shift;
my $pkg = $dbh->selectrow_hashref('SELECT * FROM ' .
- table_name() . ' WHERE package = ?',
- undef, $name);
+ table_name() . ' WHERE package = ? AND distribution = ?' .
+ ' FOR UPDATE',
+ undef, $name, $distribution);
return $pkg;
}
sub get_all_source_info {
- my $db = $dbh->selectall_hashref('SELECT * FROM ' . table_name(),
- 'package');
+ my %options = @_;
+
+ my $q = 'SELECT * FROM ' . table_name()
+ . ' WHERE distribution = ? ';
+ my @args = ($distribution);
+ if ($options{state} && uc($options{state}) ne "ALL") {
+ $q .= ' AND upper(state) = ? ';
+ push @args, uc($options{state});
+ }
+
+ if ($options{user}) {
+ #this basically means "this user, or no user at all":
+ $q .= ' AND (builder = ? OR upper(state) = ?)';
+ push @args, $options{user};
+ push @args, "NEEDS-BUILD";
+ }
+
+ if ($options{category}) {
+ $q .= ' AND failed_category <> ? AND upper(state) = ? ';
+ push @args, $options{category};
+ push @args, "FAILED";
+ }
+
+ if ($options{list_min_age} > 0) {
+ $q .= ' AND age(state_change::timestamp) > ? ';
+ push @args, $options{list_min_age} . " days";
+ }
+
+ if ($options{list_min_age} < 0) {
+ $q .= ' AND age(state_change::timestamp) < ? days ';
+ push @args, -$options{list_min_age} . " days";
+ }
+
+ my $db = $dbh->selectall_hashref($q, 'package', undef, @args);
return $db;
}
'depends = ?, ' .
'rel = ?, ' .
'bd_problem = ? ' .
- 'WHERE package = ?',
+ 'WHERE package = ? AND distribution = ?',
undef,
$pkg->{'version'},
$pkg->{'state'},
$pkg->{'depends'},
$pkg->{'rel'},
$pkg->{'bd_problem'},
- $pkg->{'package'}) or die $dbh->errstr;
+ $pkg->{'package'},
+ $distribution) or die $dbh->errstr;
}
sub add_source_info {
my $pkg = shift;
$dbh->do('INSERT INTO ' . table_name() .
- ' (package) values (?)',
- undef, $pkg->{'package'}) or die $dbh->errstr;
+ ' (package, distribution) values (?, ?)',
+ undef, $pkg->{'package'}, $distribution) or die $dbh->errstr;
}
sub del_source_info {
my $name = shift;
$dbh->do('DELETE FROM ' . table_name() .
- ' WHERE package = ?',
- undef, $name) or die $dbh->errstr;
+ ' WHERE package = ? AND distribution = ?',
+ undef, $name, $distribution) or die $dbh->errstr;
}
sub get_user_info {
my $name = shift;
my $user = $dbh->selectrow_hashref('SELECT * FROM ' .
- user_table_name() . ' WHERE username = ?',
- undef, $name);
+ user_table_name() . ' WHERE username = ? AND distribution = ?',
+ undef, $name, $distribution);
return $user;
}
sub update_user_info {
my $user = shift;
$dbh->do('UPDATE ' . user_table_name() .
- ' SET last_seen = now() WHERE username = ?',
- undef, $user)
+ ' SET last_seen = now() WHERE username = ?' .
+ ' AND distribution = ?',
+ undef, $user, $distribution)
or die $dbh->errstr;
}
sub add_user_info {
my $user = shift;
$dbh->do('INSERT INTO ' . user_table_name() .
- ' (username, last_seen) values (?, now())',
- undef, $user)
+ ' (username, distribution, last_seen)' .
+ ' values (?, ?, now())',
+ undef, $user, $distribution)
or die $dbh->errstr;
}