package conf;
# defaults
-$basedir = "/var/lib/debbuild";
-$dbbase = "build-db";
-$transactlog = "transactions.log";
-$mailprog = "/usr/sbin/sendmail";
+$basedir ||= "/var/lib/debbuild";
+$dbbase ||= "build-db";
+$transactlog ||= "transactions.log";
+$mailprog ||= "/usr/sbin/sendmail";
require "/etc/wanna-build.conf";
die "$conf::basedir is not a directory\n" if ! -d $conf::basedir;
die "dbbase is empty\n" if ! $dbbase;
use strict;
use POSIX;
use FileHandle;
+use File::Copy;
use GDBM_File;
use MLDBM qw(GDBM_File Storable);
use WannaBuild;
our ($verbose, $mail_logs, $list_order, $list_state,
$curr_date, $op_mode, $user, $real_user, $distribution,
$fail_reason, $opt_override, $import_from, $export_to, $opt_create_db,
- $transactlog, %db, %otherdb, %otherdb_lock, %prioval, %sectval,
+ %db, %otherdb, %otherdb_lock, %prioval, %sectval,
$info_all_dists, $arch,
$category, %catval, %short_category,
$short_date, $list_min_age, $dbbase, @curr_time,
- $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc);
+ $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc,
+ $lock_for_pid, $transactional);
# global vars
$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin";
$curr_date = strftime("%Y %b %d %H:%M:%S",@curr_time);
$short_date = strftime("%m/%d/%y",@curr_time);
$| = 1;
+$lock_for_pid = -1; # -1 means normal procedure
+$transactional = 0; # 0 means: work on main copy
# map program invocation names to operation modes
my %prognames = ( "uploaded-build" => "set-uploaded",
$distribution = "";
}
else {
+ $distribution = "oldstable" if $distribution eq "o";
$distribution = "stable" if $distribution eq "s";
$distribution = "testing" if $distribution eq "t";
$distribution = "unstable" if $distribution eq "u";
# special actions
import => { arg => \$import_from, mode => "import" },
export => { arg => \$export_to, mode => "export" },
+ "lock-for" => { arg => \$lock_for_pid, mode => "lock-for" },
+ "unlock-for" => { arg => \$lock_for_pid, mode => "unlock-for" },
+ "act-on-behalf-of" => { arg => \$lock_for_pid },
+ "start-transaction" => { mode => "start-transaction" },
+ "commit-transaction" => { mode => "commit-transaction" },
+ "transactional" => { flag => \$transactional },
"manual-edit" => { mode => "manual-edit" },
"create-maintenance-lock" => { mode => "maintlock-create" },
"remove-maintenance-lock" => { mode => "maintlock-remove" },
$distribution ||= "unstable";
die "Bad distribution '$distribution'\n"
if !isin($distribution, keys %conf::distributions);
-$conf::dbbase =~ m#^([^/]+/)#;
-$transactlog = "$conf::basedir/$1$conf::transactlog";
if ($verbose) {
my $version = '$Revision: db181a534e9d $ $Date: 2008/03/26 06:20:22 $ $Author: rmurray $';
}
if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
- merge-packages manual-edit maintlock-create
+ merge-packages manual-edit maintlock-create lock-for unlock-for
+ start-transaction commit-transaction
merge-sources maintlock-remove clean-db))) {
warn "No packages given.\n";
usage();
while(!eof(STDIN)) {
$line = <STDIN>;
last if $line eq ".\n";
- $line = ".\n" if $line eq "\n";
$fail_reason .= $line;
}
chomp( $fail_reason );
waitfor_maintlock() if $op_mode !~ /^(?:merge-|clean-db$)/;
if (!-f db_filename( $distribution ) && !$opt_create_db) {
- die "Database for $distribution doesn't exist\n";
+ if ($transactional) {
+ die "No running transaction for $distribution\n";
+ } else {
+ die "Database for $distribution doesn't exist\n";
+ }
+}
+
+# Locking for another process means that a longer running process (most likely
+# wb) wants to do several steps at once, and manages the locks.
+if ($op_mode eq "lock-for") {
+ lock_db( $distribution );
+ exit 0;
}
+if ($op_mode eq "unlock-for") {
+ unlock_db( $distribution );
+ exit 0;
+}
+
lock_db( $distribution );
+
+if ($op_mode eq "start-transaction") {
+ copy ( db_filename_master( $distribution ), db_filename_transaction( $distribution ))
+ or die "Copy failed: $!";
+ open LOG, ">", db_transactlog_transaction( $distribution )
+ or die "Could not create logfile for transaction: $!";
+ close LOG;
+ exit 0;
+}
+
+if ($op_mode eq "commit-transaction") {
+ # we need to copy here to preserve the owner and group of the file
+ copy ( db_filename_transaction( $distribution ), db_filename_master( $distribution ))
+ or die "Copy failed: $!";
+ unlink db_filename_transaction( $distribution );
+ open TLOG, "<", db_transactlog_transaction( $distribution )
+ or die "Could not open logfile from transaction: $!";
+ open LOG, ">>", db_transactlog_master( $distribution )
+ or die "Could not open logfile: $!";
+ while (<TLOG>) { print LOG $_ };
+ close TLOG;
+ close LOG;
+ unlink db_transactlog_transaction( $distribution );
+ exit 0;
+}
+
END {
- untie %db;
- unlock_db( $distribution );
+ untie %db;
+ if ($lock_for_pid == -1) {
+ unlock_db( $distribution );
+ }
foreach (keys %conf::distributions) {
untie %{$otherdb{$_}} if tied(%{$otherdb{$_}});
unlock_db( $_ ) if $otherdb_lock{$_};
parse_quinn_diff(0);
@ARGV = ( $ARGS[2] );
my $build_deps = parse_sources(1);
- auto_dep_wait( $build_deps, $pkgs );
+ call_edos_depcheck( $ARGS[0], $ARGS[2] );
clean_db();
last SWITCH;
};
}
if (not -t and $user =~ /-/) {
my $userinfo = $db{'_userinfo'};
+ $userinfo = {} if (!defined($userinfo));
+
my $ui = $userinfo->{$user};
+ $ui = {} if (!defined($ui));
- $userinfo->{$user}->{'Last-Seen'} = $curr_date;
+ $ui->{'Last-Seen'} = $curr_date;
+ $ui->{'User'} = $user;
+
+ $userinfo->{$user} = $ui;
$db{'_userinfo'} = $userinfo;
}
}
$ok = 0;
$reason = "not all source dependencies available yet";
}
+ elsif ($pkg->{'State'} =~ /^BD-Uninstallable/) {
+ $ok = 0;
+ $reason = "source dependencies are not installable";
+ }
elsif ($pkg->{'State'} eq "Uploaded" &&
(version_lesseq($version, $pkg->{'Version'}))) {
$ok = 0;
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;
return;
}
}
+ if ($state eq "BD-Uninstallable") {
+ if ($opt_override) {
+ print "$name: Forcing uninstallability mark to be removed\n";
+ }
+ else {
+ print "$name: has uninstallable build-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 "$name: merging with previously registered dependencies\n";
}
- if (isin( $state, qw(Needs-Build Failed))) {
+ if (isin( $state, qw(Needs-Build Failed BD-Uninstallable))) {
print "$name: Warning: not registered for building previously, ".
"but processing anyway.\n";
}
}
# Now re-check the DB for packages in states Needs-Build, Failed,
- # or Dep-Wait and remove them if they're not listed anymore by quinn-diff.
+ # Dep-Wait or BD-Uninstallable and remove them if they're not listed
+ # anymore by quinn-diff.
if ( !$partial ) {
my $name;
foreach $name (keys %db) {
my $pkg = $db{$name};
next if defined $pkg->{'Binary-NMU-Version'};
next if !isin( $pkg->{'State'},
- qw(Needs-Build Building Built Build-Attempted Uploaded Failed Dep-Wait) );
+ qw(Needs-Build Building Built Build-Attempted Uploaded Failed Dep-Wait BD-Uninstallable) );
my $virtual_delete = $pkg->{'State'} eq 'Failed';
if (!$quinn_pkgs{$name}) {
'debian-installer' => -199,
base => -198,
devel => -197,
- shells => -196,
- perl => -195,
- python => -194,
- graphics => -193,
- admin => -192,
- utils => -191,
- x11 => -190,
- editors => -189,
- net => -188,
- mail => -187,
- news => -186,
- tex => -185,
- text => -184,
- web => -183,
- doc => -182,
- interpreters => -181,
- gnome => -180,
- kde => -179,
- games => -178,
- misc => -177,
- otherosfs => -176,
- oldlibs => -175,
- libdevel => -174,
- sound => -173,
- math => -172,
- science => -171,
- comm => -170,
- electronics => -169,
- hamradio => -168,
- embedded => -166,
+ kernel => -196,
+ shells => -195,
+ perl => -194,
+ python => -193,
+ graphics => -192,
+ admin => -191,
+ utils => -190,
+ x11 => -189,
+ editors => -188,
+ net => -187,
+ httpd => -186,
+ mail => -185,
+ news => -184,
+ tex => -183,
+ text => -182,
+ web => -181,
+ vcs => -180,
+ doc => -179,
+ localizations => -178,
+ interpreters => -177,
+ ruby => -176,
+ java => -175,
+ ocaml => -174,
+ lisp => -173,
+ haskell => -172,
+ 'cli-mono' => -171,
+ gnome => -170,
+ kde => -169,
+ xfce => -168,
+ gnustep => -167,
+ database => -166,
+ video => -165,
+ debug => -164,
+ games => -163,
+ misc => -162,
+ fonts => -161,
+ otherosfs => -160,
+ oldlibs => -159,
+ libdevel => -158,
+ sound => -157,
+ math => -156,
+ 'gnu-r' => -155,
+ science => -154,
+ comm => -153,
+ electronics => -152,
+ hamradio => -151,
+ embedded => -150,
+ php => -149,
+ zope => -148,
);
foreach my $i (keys %sectval) {
$sectval{"contrib/$i"} = $sectval{$i}+40;
if $pkg->{'State'} =~ /^Failed/;
print " Dependencies: $pkg->{'Depends'}\n"
if $pkg->{'State'} eq "Dep-Wait";
+ print " Reason: $pkg->{'Reason'}\n"
+ if $pkg->{'State'} eq "BD-Uninstallable";
print " Previous state was $pkg->{'Previous-State'} until ",
"$pkg->{'State-Change'}\n"
if $verbose && $pkg->{'Previous-State'};
my $val = $pkg->{$key};
chomp( $val );
$val = "\n$val" if isin( $key, qw(Failed Old-Failed));
- $val =~ s/\n/\n /g;
+ $val =~ s/\n/\n /g;
printf " %-20s: %s\n", $key, $val;
}
foreach $key (sort keys %$pkg) {
my $val = $pkg->{$key};
chomp( $val );
$val = "\n$val" if isin( $key, qw(Failed Old-Failed));
- $val =~ s/\n/\n /g;
+ $val =~ s/\n/\n /g;
printf " %-20s: %s\n", $key, $val;
}
}
sub lock_db {
my $dist = shift;
my $try = 0;
- my $lockfile = db_filename($dist) . ".lock";
+ my $lockfile = db_lockfilename($dist);
local( *F );
print "Locking $dist database\n" if $verbose >= 2;
unlink( $lockfile );
goto repeat;
}
+ if ($pid == $lock_for_pid) {
+ # We are allowed to use this lock.
+ return;
+ }
warn "Database locked by $usr -- please wait\n" if $try == 0;
}
if (++$try > 200) {
}
die "Can't create lock file $lockfile: $!\n";
}
- F->print("$$ $real_user\n");
+ my $pid = $lock_for_pid == -1 ? $$ : $lock_for_pid;
+ F->print("$pid $real_user\n");
F->close();
}
sub unlock_db {
my $dist = shift;
- my $lockfile = db_filename($dist) . ".lock";
+ my $lockfile = db_lockfilename($dist);
if (!$main::keep_lock{$dist}) {
print "Unlocking $dist database\n" if $verbose >= 2;
}
sub create_maintlock {
- my $lockfile = db_filename("maintenance") . ".lock";
+ my $lockfile = db_lockfilename("maintenance");
my $try = 0;
local( *F );
}
sub remove_maintlock {
- my $lockfile = db_filename("maintenance") . ".lock";
+ my $lockfile = db_lockfilename("maintenance");
print "Removing maintenance lock\n" if $verbose >= 2;
unlink $lockfile;
}
sub waitfor_maintlock {
- my $lockfile = db_filename("maintenance") . ".lock";
+ my $lockfile = db_lockfilename("maintenance");
my $try = 0;
local( *F );
}
check_entry( \%thispkg );
# add to db
- $name = $thispkg{'Package'};
- $db{$name} = \%thispkg;
+ if (exists($thispkg{'Package'})) {
+ $name = $thispkg{'Package'};
+ $db{$name} = \%thispkg;
+ }
+ elsif(exists($thispkg{'User'})) {
+ my $userinfo = $db{'_userinfo'};
+ $userinfo = {} if (!defined($userinfo));
+
+ $name = $thispkg{'User'};
+ $userinfo->{$name} = \%thispkg;
+
+ $db{'_userinfo'} = $userinfo;
+ }
}
close( F );
print "done\n" if $verbose >= 1;
return if $op_mode eq "manual-edit"; # no checks then
# check for required fields
+ if (exists $pkg->{'User'}) {
+ return;
+ }
if (!exists $pkg->{'Package'}) {
print STDERR "Bad entry: ",
join( "\n", map { "$_: $pkg->{$_}" } keys %$pkg ), "\n";
- die "Database entry lacks Package: field\n";
+ die "Database entry lacks Package or User: field\n";
}
if (!exists $pkg->{'Version'}) {
die "Database entry for $pkg->{'Package'} lacks Version: field\n";
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
- Failed Failed-Removed Not-For-Us
+ Failed Failed-Removed Not-For-Us BD-Uninstallable
) );
}
foreach $name (sort keys %db) {
my $pkg = $db{$name};
- foreach $key (keys %{$pkg}) {
- my $val = $pkg->{$key};
- chomp( $val );
- $val =~ s/\n/\n /g;
- print F "$key: $val\n";
+ if ($name eq '_userinfo') {
+ foreach $user (sort keys %{$pkg}) {
+ my $ui = $pkg->{$user};
+ print F "User: $user\n"
+ if (!defined($ui->{'User'}));
+ foreach $key (keys %{$ui}) {
+ my $val = $ui->{$key};
+ $val =~ s/\n*$//;
+ $val =~ s/^/ /mg;
+ $val =~ s/^ $/ ./mg;
+ print F "$key: $val\n";
+ }
+ print F "\n";
+ }
+ }
+ else {
+ foreach $key (keys %{$pkg}) {
+ my $val = $pkg->{$key};
+ $val =~ s/\n*$//;
+ $val =~ s/^/ /mg;
+ $val =~ s/^ $/ ./mg;
+ print F "$key: $val\n";
+ }
+ print F "\n";
}
- print F "\n";
}
close( F );
print "done\n" if $verbose >= 1;
delete $pkg->{'Failed'};
delete $pkg->{'Failed-Category'};
}
+ if (defined($$state) and $$state eq 'BD-Uninstallable') {
+ delete $pkg->{'Reason'};
+ }
$$state = $newstate;
}
"changed from $prevstate to $pkg->{'State'} ".
"by $real_user as $user";
+ my $transactlog = db_transactlog( $distribution );
if (!open( LOG, ">>$transactlog" )) {
warn "Can't open log file $transactlog: $!\n";
return;
}
sub db_filename {
+ my $dist = shift;
+ return $transactional ? db_filename_transaction($dist) : db_filename_master($dist);
+}
+sub db_filename_master {
my $dist = shift;
return "$conf::basedir/$conf::dbbase-$dist";
}
+sub db_filename_transaction {
+ my $dist = shift;
+ return "$conf::basedir/$conf::dbbase-$dist-transaction";
+}
+
+sub db_lockfilename {
+ my $dist = shift;
+ return db_filename_master($dist) . ".lock";
+}
+
+
+sub db_transactlog {
+ my $dist = shift;
+ return $transactional ? db_transactlog_transaction($dist) : db_transactlog_master($dist);
+}
+sub db_transactlog_master {
+ my $dist = shift;
+ $conf::dbbase =~ m#^([^/]+/)#;
+ return "$conf::basedir/$1$conf::transactlog";
+}
+sub db_transactlog_transaction {
+ my $dist = shift;
+ $conf::dbbase =~ m#^([^/]+/)#;
+ return "$conf::basedir/$1$conf::transactlog-$dist-transaction";
+}
# for parsing input to dep-wait
sub parse_deplist {
return "";
}
-sub auto_dep_wait {
- my $bd = shift;
- my $pkgs = shift;
+sub call_edos_depcheck {
+ my $packagesfile = shift;
+ my $sourcesfile = shift;
my $key;
return if defined ($conf::distributions{$distribution}{noadw});
- # We need to walk all of needs-build, as any new upload could make
+ # We need to check all of needs-build, as any new upload could make
# something in needs-build have uninstallable deps
+ # We also check everything in bd-uninstallable, as any new upload could
+ # make that work again
+ my %interesting_packages;
foreach $key (keys %db) {
my $pkg = $db{$key};
- next
- if not defined $pkg or $pkg->{'State'} ne "Needs-Build";
- my $srcdeps = parse_srcdeplist($key,$bd->{$key}{'dep'},$arch);
- foreach my $srcdep (@$srcdeps) {
- next if $srcdep->{'Neg'} != 0; # we ignore conflicts atm
- my $rc = get_unsatisfied_dep($bd,$pkgs,$srcdep,0);
- if ($rc ne "") {
- # set dep-wait
- my $deplist = parse_deplist( $pkg->{'Depends'} );
- my $newdeps = parse_deplist( $rc );
- my $change = 0;
- foreach (%$newdeps) {
- my $dep = $$newdeps{$_};
- # ensure we're not waiting on ourselves, or a package that has been removed
- next if (not defined($merge_binsrc{$dep->{'Package'}})) or ($merge_binsrc{$dep->{'Package'}} eq $key);
- if ($dep->{'Rel'} =~ '^>') {
- $deplist->{$dep->{'Package'}} = $dep;
- $change++;
- }
- }
- if ($change) {
- $pkg->{'Depends'} = build_deplist($deplist);
- change_state( \$pkg, 'Dep-Wait' );
- log_ta( $pkg, "--merge-all" );
- $db{$key} = $pkg;
- print "Auto-Dep-Waiting ${key}_$pkg->{'Version'} to $pkg->{'Depends'}\n" if $verbose;
- }
- last;
- }
+ if (defined $pkg and isin($pkg->{'State'}, qw/Needs-Build BD-Uninstallable/)) {
+ $interesting_packages{$key} = undef;
+ }
+ }
+
+ #print "I would look at these sources with edos-depcheck:\n";
+ #print join " ", keys %interesting_packages,"\n";
+
+ if (open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $sourcesfile)) {
+ local($/) = ""; # read in paragraph mode
+ while( <EDOS> ) {
+ my( $key, $reason ) ;
+ s/\s*$//m;
+ /^Package:\s*(\S+)$/mi and $key = $1;
+ /^Failed-Why:(([^\n]|\n ([^\n]|\.))*)$/msi and $reason = $1;
+ $reason =~ s/^\s*//mg;
+ $reason ||= 'No reason given by edos-debcheck';
+
+ if (exists $interesting_packages{$key}) {
+ $interesting_packages{$key} = $reason;
+ } else {
+ print "TODO: edos reported a package we do not care about now" if $verbose;
+ }
+ }
+ close EDOS;
+ } else {
+ print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" .
+ "all packages have installable build-dependencies."
+ }
+
+ for my $key (keys %interesting_packages) {
+ my $pkg = $db{$key};
+ my $change =
+ (defined $interesting_packages{$key} and $pkg->{'State'} eq 'Needs-Build') ||
+ (not defined $interesting_packages{$key} and $pkg->{'State'} eq 'BD-Uninstallable');
+ if ($change) {
+ if (defined $interesting_packages{$key}) {
+ change_state( \$pkg, 'BD-Uninstallable' );
+ $pkg->{'Reason'} = $interesting_packages{$key};
+ } else {
+ change_state( \$pkg, 'Needs-Build' );
+ }
+ log_ta( $pkg, "--merge-all" );
+ $db{$key} = $pkg;
+ print "edos-builddebchange changed state of ${key}_$pkg->{'Version'} to $pkg->{'State'}\n" if $verbose;
}
}
}
-u, --uploaded: Record in the database that the packages build
correctly and were uploaded.
-n, --no-build: Record in the database that the packages aren't
- desired for m68k and shouldn't appear in listings even if
- they're out of date.
+ desired for this architecture and shouldn't appear in listings even
+ if they're out of date.
--dep-wait: Record in the database that the packages are waiting
for some source dependencies to become available
+ --binNMU num: Schedule a re-build of the package with unchanged source, but
+ a new version number (source-version + "+b<num>")
+ --give-back: Mark a package as ready to build that is in state Building,
+ Built or Build-Attempted. To give back a package in state Failed, use
+ --override
--merge-quinn: Merge quinn-diff output into database.
--merge-packages: Merge Packages files into database.
--pretend-avail: Pretend that given packages are available now and give
automatically choosen
--import FILE: Import database from a ASCII file FILE
--export FILE: Export database to a ASCII file FILE
+ --lock-for PID: Locks the database for the process with this pid
+ --unlock-for PID: Unlocks the database for the process with this pid
+ --act-on-behalf-of PID: Ignores the log (if it is held by this pid)
+ --start-transaction: Creates a copy of the state of the database, for
+ use with --transactional. This overrides any previous uncommited
+ transaction. Should only be used after --lock-for
+ --commit-transaction: Atomically moves the copy back to the main, thus
+ commiting the changes
+ --transactional: Flag to indicate that we want to work on the copy
+
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.