X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=bin%2Fwanna-build;h=028242745c7286742ef858b523c13c8511780a64;hb=7b09fee8d7503ca518f28e9ba12951848524c652;hp=5689f7b704a62d1a568e3d7e06c1e3bc8a663db1;hpb=bd5d1d3d21ba84af700652d8a46cecc204dc762e;p=wannabuild.git diff --git a/bin/wanna-build b/bin/wanna-build index 5689f7b..0282427 100755 --- a/bin/wanna-build +++ b/bin/wanna-build @@ -21,10 +21,10 @@ 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; @@ -45,15 +45,15 @@ 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, - $lock_for_pid, $transactional); + $lock_for_pid, $transactional, $read_only); # global vars -$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin"; +$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/org/wanna-build/bin/"; $verbose = 0; $mail_logs = ""; @curr_time = gmtime; @@ -62,6 +62,7 @@ $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 +$read_only = 0; # 1 means: do not set or check lock, do never write # map program invocation names to operation modes my %prognames = ( "uploaded-build" => "set-uploaded", @@ -138,7 +139,7 @@ my %options = if !isin( $list_state, qw(needs-build building uploaded built build-attempted failed installed dep-wait not-for-us all failed-removed - install-wait reupload-wait));} }, + install-wait reupload-wait bd-uninstallable));} }, # options with args dist => { short => "d", arg => \$distribution, @@ -188,10 +189,11 @@ my %options = 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-behalve-of" => { arg => \$lock_for_pid }, + "act-on-behalf-of" => { arg => \$lock_for_pid }, "start-transaction" => { mode => "start-transaction" }, "commit-transaction" => { mode => "commit-transaction" }, "transactional" => { flag => \$transactional }, + "read-only" => { flag => \$read_only }, "manual-edit" => { mode => "manual-edit" }, "create-maintenance-lock" => { mode => "maintlock-create" }, "remove-maintenance-lock" => { mode => "maintlock-remove" }, @@ -246,8 +248,6 @@ $list_order = $list_state eq "failed" ? 'fPcpsn' : 'PScpsn' $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 $'; @@ -255,6 +255,11 @@ if ($verbose) { print "wanna-build $version for $distribution on $conf::dbbase\n"; } +if ($read_only && !isin( $op_mode, qw(list export info))) { + warn "Invalid operation with --read-only. You can only use --list, --export or --info.\n"; + exit 1; +} + if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export merge-packages manual-edit maintlock-create lock-for unlock-for start-transaction commit-transaction @@ -276,7 +281,6 @@ if (!$fail_reason) { while(!eof(STDIN)) { $line = ; last if $line eq ".\n"; - $line = ".\n" if $line eq "\n"; $fail_reason .= $line; } chomp( $fail_reason ); @@ -327,32 +331,49 @@ if ($op_mode eq "unlock-for") { exit 0; } -lock_db( $distribution ); +if (!$read_only) { + 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") { - move ( db_filename_transaction( $distribution ), db_filename_master( $distribution )) + # 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 () { print LOG $_ }; + close TLOG; + close LOG; + unlink db_transactlog_transaction( $distribution ); exit 0; } END { - untie %db; - if ($lock_for_pid == -1) { - unlock_db( $distribution ); - } - foreach (keys %conf::distributions) { - untie %{$otherdb{$_}} if tied(%{$otherdb{$_}}); - unlock_db( $_ ) if $otherdb_lock{$_}; + if (!$read_only) { + untie %db; + if ($lock_for_pid == -1) { + unlock_db( $distribution ); + } + foreach (keys %conf::distributions) { + untie %{$otherdb{$_}} if tied(%{$otherdb{$_}}); + unlock_db( $_ ) if $otherdb_lock{$_}; + } } } -tie %db, 'MLDBM', db_filename( $distribution ), GDBM_WRCREAT, 0664 +tie %db, 'MLDBM', db_filename( $distribution ), $read_only ? GDBM_READER : GDBM_WRCREAT, 0664 or die "FATAL: Cannot open database\n"; process(); @@ -435,8 +456,8 @@ sub process { @ARGV = ( $ARGS[1] ); parse_quinn_diff(0); @ARGV = ( $ARGS[2] ); - my $build_deps = parse_sources(1); - auto_dep_wait( $build_deps, $pkgs ); + my $srcs = parse_sources(1); + call_edos_depcheck( $ARGS[0], $srcs ); clean_db(); last SWITCH; }; @@ -565,6 +586,10 @@ sub add_one_building { $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; @@ -859,6 +884,10 @@ sub add_one_failed { 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; @@ -950,7 +979,26 @@ sub add_one_needsbuild { } $state = $pkg->{'State'}; - if ($state eq "Dep-Wait") { + 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" ); + $db{$name} = $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"; } @@ -982,7 +1030,12 @@ sub add_one_needsbuild { "Skipping.\n"; return; } - change_state( \$pkg, 'Needs-Build' ); + if ($distribution eq "unstable") { + change_state( \$pkg, 'BD-Uninstallable' ); + $pkg->{'BD-Problem'} = "Installability of build dependencies not tested yet"; + } else { + change_state( \$pkg, 'Needs-Build' ); + } delete $pkg->{'Builder'}; delete $pkg->{'Depends'}; log_ta( $pkg, "--give-back" ); @@ -1046,7 +1099,8 @@ sub set_one_binnmu { return; } - change_state( \$pkg, 'Needs-Build' ); + change_state( \$pkg, 'BD-Uninstallable' ); + $pkg->{'BD-Problem'} = "Installability of build dependencies not tested yet"; delete $pkg->{'Builder'}; delete $pkg->{'Depends'}; $pkg->{'Binary-NMU-Version'} = $binNMUver; @@ -1112,7 +1166,7 @@ sub add_one_depwait { 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"; } @@ -1190,18 +1244,11 @@ sub parse_sources { next if (defined $srcver{$name} and version_less( $version, $srcver{$name} )); $srcver{$name} = $version; - if ($buildconf) { - $buildconf = join( ", ", map { "!$_" } split( /\s*,\s*/, $buildconf )); - if ($builddep) { - $builddep .= "," . $buildconf; - } else { - $builddep = $buildconf; - } - } - $pkgs{$name}{'dep'} = defined $builddep ? $builddep : ""; $pkgs{$name}{'ver'} = $version; $pkgs{$name}{'bin'} = $binaries; + $pkgs{$name}{'dep'} = $builddep; + $pkgs{$name}{'conf'} = $buildconf; my $pkg = $db{$name}; if (defined $pkg) { @@ -1229,6 +1276,15 @@ sub parse_sources { $pkg->{'Section'} = $section, $change++ if defined $section and (not defined($pkg->{'Section'}) or $pkg->{'Section'} ne $section); + + # Remove field from previous wanna-build versions + for (qw/Reason Build-Depends Build-Conflicts/) { + if (exists $pkg->{$_}) { + delete $pkg->{$_}; + $change++; + } + } + $db{$name} = $pkg if $change; } } @@ -1609,7 +1665,8 @@ sub parse_quinn_diff { } # 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) { @@ -1617,7 +1674,7 @@ sub parse_quinn_diff { 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}) { @@ -1841,9 +1898,14 @@ sub list_packages { if $pkg->{'State'} =~ /^Failed/; print " Dependencies: $pkg->{'Depends'}\n" if $pkg->{'State'} eq "Dep-Wait"; + print " Reasons for BD-Uninstallable:\n ", + 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" if $verbose && $pkg->{'Previous-State'}; + print " No previous state recorded\n" + if $verbose && !$pkg->{'Previous-State'}; print " Previous failing reasons:\n ", join("\n ",split("\n",$pkg->{'Old-Failed'})), "\n" if $verbose && $pkg->{'Old-Failed'}; @@ -1892,7 +1954,7 @@ sub info_packages { 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) { @@ -1900,7 +1962,7 @@ sub info_packages { 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; } } @@ -1959,7 +2021,7 @@ sub forget_users { 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; @@ -2004,7 +2066,7 @@ sub lock_db { 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; @@ -2013,7 +2075,7 @@ sub unlock_db { } sub create_maintlock { - my $lockfile = db_filename("maintenance") . ".lock"; + my $lockfile = db_lockfilename("maintenance"); my $try = 0; local( *F ); @@ -2052,14 +2114,14 @@ sub create_maintlock { } 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 ); @@ -2157,7 +2219,7 @@ sub check_entry { 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 ) ); } @@ -2178,8 +2240,9 @@ sub write_db { if (!defined($ui->{'User'})); foreach $key (keys %{$ui}) { my $val = $ui->{$key}; - chomp($val); - $val =~ s/\n/\n /g; + $val =~ s/\n*$//; + $val =~ s/^/ /mg; + $val =~ s/^ +$/ ./mg; print F "$key: $val\n"; } print F "\n"; @@ -2188,8 +2251,9 @@ sub write_db { else { foreach $key (keys %{$pkg}) { my $val = $pkg->{$key}; - chomp( $val ); - $val =~ s/\n/\n /g; + $val =~ s/\n*$//; + $val =~ s/^/ /mg; + $val =~ s/^ +$/ ./mg; print F "$key: $val\n"; } print F "\n"; @@ -2227,6 +2291,9 @@ sub change_state { delete $pkg->{'Failed'}; delete $pkg->{'Failed-Category'}; } + if (defined($$state) and $$state eq 'BD-Uninstallable') { + delete $pkg->{'BD-Problem'}; + } $$state = $newstate; } @@ -2259,6 +2326,7 @@ sub log_ta { "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; @@ -2300,7 +2368,6 @@ 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"; @@ -2310,6 +2377,27 @@ sub db_filename_transaction { 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 { my $deps = shift; @@ -2503,46 +2591,97 @@ sub get_unsatisfied_dep { return ""; } -sub auto_dep_wait { - my $bd = shift; - my $pkgs = shift; +sub call_edos_depcheck { + my $packagesfile = shift; + my $srcs = 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"; + + my $tmpfile_pattern = "/tmp/wanna-build-interesting-sources-$distribution.$$-"; + my ($tmpfile, $i); + for( $i = 0;; ++$i ) { + $tmpfile = $tmpfile_pattern . $i; + last if ! -e $tmpfile; + } + + open SOURCES, '>', $tmpfile or die "Could not open temporary file $tmpfile\n"; + for my $key (keys %interesting_packages) { + my $pkg = $db{$key}; + print SOURCES "Package: $key\n"; + print SOURCES "Version: $pkg->{'Version'}\n"; + print SOURCES "Build-Depends: $srcs->{$key}{'dep'}\n" if $srcs->{$key}{'dep'}; + print SOURCES "Build-Conflicts: $srcs->{$key}{'conf'}\n" if $srcs->{$key}{'conf'}; + print SOURCES "Architecture: all\n"; + print SOURCES "\n"; + } + close SOURCES; + + if (open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $tmpfile)) + { + local($/) = ""; # read in paragraph mode + while( ) { + 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\n" if $verbose; + } + } + close EDOS; + } else { + print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" . + "all packages have installable build-dependencies." + } + + unlink( $tmpfile ); + + 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'); + my $problemchange = $interesting_packages{$key} ne $pkg->{'BD-Problem'}; + if ($change) { + if (defined $interesting_packages{$key}) { + change_state( \$pkg, 'BD-Uninstallable' ); + $pkg->{'BD-Problem'} = $interesting_packages{$key}; + } else { + change_state( \$pkg, 'Needs-Build' ); + } + } + if ($problemchange) { + if (defined $interesting_packages{$key}) { + $pkg->{'BD-Problem'} = $interesting_packages{$key}; + } + } + if ($change) { + log_ta( $pkg, "--merge-all" ); + print "edos-builddebchange changed state of ${key}_$pkg->{'Version'} to $pkg->{'State'}\n" if $verbose; + } + if ($change || $problemchange) { + $db{$key} = $pkg; } } } @@ -2565,6 +2704,14 @@ Options: 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") + --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. This command will actually put the package in state + BD-Uninstallable, until the installability of its Build-Dependencies + were verified. This happens at each call of --merge-all, usually + every 15 minutes. --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 @@ -2586,7 +2733,7 @@ Options: --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-behalve-of PID: Ignores the log (if it is held by this pid) + --act-on-behalf-of PID: Ignores the lock (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