]> git.donarmstrong.com Git - wannabuild.git/blobdiff - bin/wanna-build
Only go to BD-Uninstallable state on give-back for unstable.
[wannabuild.git] / bin / wanna-build
index ff523e70674572eb115d138b8b25756591491e9f..028242745c7286742ef858b523c13c8511780a64 100755 (executable)
@@ -50,10 +50,10 @@ our ($verbose, $mail_logs, $list_order, $list_state,
     $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" },
@@ -253,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
@@ -324,7 +331,9 @@ 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 ))
@@ -352,17 +361,19 @@ if ($op_mode eq "commit-transaction") {
 }
 
 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();
@@ -445,8 +456,8 @@ sub process {
                        @ARGV = ( $ARGS[1] );
                        parse_quinn_diff(0);
                        @ARGV = ( $ARGS[2] );
-                       my $build_deps = parse_sources(1);
-                       call_edos_depcheck( $ARGS[0], $ARGS[2] );
+                       my $srcs = parse_sources(1);
+                       call_edos_depcheck( $ARGS[0], $srcs );
                        clean_db();
                        last SWITCH;
                };
@@ -575,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;
@@ -869,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;
@@ -960,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";
                }
@@ -992,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" );
@@ -1056,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;
@@ -1122,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";
        }
@@ -1200,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) {
@@ -1239,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;
                }
        }
@@ -1619,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) {
@@ -1627,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}) {
@@ -1851,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'};
@@ -2167,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
                                         ) );
 }
 
@@ -2190,7 +2242,7 @@ sub write_db {
                                my $val = $ui->{$key};
                                 $val =~ s/\n*$//;
                                $val =~ s/^/ /mg;
-                               $val =~ s/^ $/ ./mg;
+                               $val =~ s/^ +$/ ./mg;
                                print F "$key: $val\n";
                            }
                            print F "\n";
@@ -2201,7 +2253,7 @@ sub write_db {
                                my $val = $pkg->{$key};
                                 $val =~ s/\n*$//;
                                $val =~ s/^/ /mg;
-                               $val =~ s/^ $/ ./mg;
+                               $val =~ s/^ +$/ ./mg;
                                print F "$key: $val\n";
                        }
                        print F "\n";
@@ -2239,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;
 }
 
@@ -2538,7 +2593,7 @@ sub get_unsatisfied_dep {
 
 sub call_edos_depcheck {
     my $packagesfile = shift;
-    my $sourcesfile = shift;
+    my $srcs = shift;
     my $key;
     
     return if defined ($conf::distributions{$distribution}{noadw});
@@ -2558,42 +2613,76 @@ sub call_edos_depcheck {
     #print "I would look at these sources with edos-depcheck:\n";
     #print join " ", keys %interesting_packages,"\n";
 
-    open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $sourcesfile)
-       or die "Failed to run wb-edos-builddebcheck: $!\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;
+    }
 
-    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;
+    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 (exists $interesting_packages{$key}) {
-               $interesting_packages{$key} = $reason;
-           }
+    if (open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $tmpfile))
+    {
+       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\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."
     }
-    close EDOS;
+    
+    unlink( $tmpfile );
 
     for my $key (keys %interesting_packages) {
        my $pkg = $db{$key};
        my $change = 
-           (defined $interesting_packages{$key} && $pkg->{'State'} eq 'Needs-Build') ||
-           (not defined $interesting_packages{$key} && $pkg->{'State'} eq 'BD-Uninstallable');
+           (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}) {
-                   $pkg->{'State'} = 'BD-Uninstallable';
-                   $pkg->{'Reason'} = $interesting_packages{$key};
                    change_state( \$pkg, 'BD-Uninstallable' );
+                   $pkg->{'BD-Problem'} = $interesting_packages{$key};
            } else {
-                   $pkg->{'State'} = 'Needs-Build';
-                   delete $pkg->{'Reason'};
                    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" );
-           $db{$key} = $pkg;
            print "edos-builddebchange changed state of ${key}_$pkg->{'Version'} to $pkg->{'State'}\n" if $verbose;
        }
+       if ($change || $problemchange) {
+           $db{$key} = $pkg;
+       }
     }
 }
 
@@ -2619,7 +2708,10 @@ Options:
          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
+        --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
@@ -2641,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