improve help message

[wannabuild.git] / bin / wanna-build

diff --git a/bin/wanna-build b/bin/wanna-build
index 1fb5b901fab48469bb6b5759083d1b5f51a34579..26456b6d540e2e311c6ee6900f3235be12a29717 100755 (executable)
--- a/bin/wanna-build
+++ b/bin/wanna-build
@@ -23,6 +23,8 @@ use strict;
 use warnings;
 use 5.010;
 
 use warnings;
 use 5.010;
 

+die "wanna-build disabled" if -f "/org/wanna-build/NO-WANNA-BUILD";
+

 package conf;
 
 use vars qw< $basedir $dbbase $transactlog $mailprog $buildd_domain >;
 package conf;
 
 use vars qw< $basedir $dbbase $transactlog $mailprog $buildd_domain >;


@@ -170,6 +172,7 @@ my @wannabuildoptions = (
                 $privmode = 0;
                 $distribution = 'any';
             }
                 $privmode = 0;
                 $distribution = 'any';
             }

+            $privmode = 1 if $distribution =~ /security/;

         }
     },
     'order|O=s' => sub {
         }
     },
     'order|O=s' => sub {


@@ -219,10 +222,8 @@ END {
        }
 }
 
        }
 }
 

-$distribution ||= "sid";
-

 my $schema_suffix = '';
 my $schema_suffix = '';

-if ((isin( $op_mode, qw(list info distribution-architectures distribution-aliases)) && $distribution !~ /security/ && !$recorduser && !($privmode)) || $simulate) {
+if ((isin( $op_mode, qw(list info distribution-architectures distribution-aliases)) && !$recorduser && !$privmode) || $simulate) {

        $dbh = DBI->connect("DBI:Pg:service=wanna-build") || 
                die "FATAL: Cannot open database: $DBI::errstr\n";
        $schema_suffix = '_public';
        $dbh = DBI->connect("DBI:Pg:service=wanna-build") || 
                die "FATAL: Cannot open database: $DBI::errstr\n";
        $schema_suffix = '_public';


@@ -257,15 +258,14 @@ foreach my $name (keys %$rows) {
 $distribution = $distribution_aliases{$distribution} if (isin($distribution, keys %distribution_aliases));
 
 $op_mode ||= "set-building";
 $distribution = $distribution_aliases{$distribution} if (isin($distribution, keys %distribution_aliases));
 
 $op_mode ||= "set-building";

-undef $distribution if $distribution eq 'any';

 if ($distribution) {
     my @dists = split(/[, ]+/, $distribution);
     foreach my $dist (@dists) {
         die "Bad distribution '$distribution'\n"
 if ($distribution) {
     my @dists = split(/[, ]+/, $distribution);
     foreach my $dist (@dists) {
         die "Bad distribution '$distribution'\n"

-           if !isin($dist, keys %distributions);
+           if !isin($dist, keys %distributions, "any");

     }
 }
     }
 }

-if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)) {
+if (!isin ( $op_mode, qw(list) ) && ( ($distribution//"") =~ /[ ,]/)) {

     die "multiple distributions are only allowed for list";
 }
 
     die "multiple distributions are only allowed for list";
 }
 


@@ -273,9 +273,9 @@ if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)
 # a proper error.
 
 if ($verbose) {
 # a proper error.
 
 if ($verbose) {

-       my $version = '$Revision: db181a534e9d $ $Date: 2008/03/26 06:20:22 $ $Author: rmurray $';
-       $version =~ s/(^\$| \$ .*$)//g;
-       print "wanna-build $version for $distribution on $arch\n";
+       my $version = '$Id$';
+       $version =~ s/^.* ([a-f0-9]+) .*$/$1/g;
+       print "wanna-build $version for ".($distribution//"sid")." on $arch\n";

 }
 
 if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
 }
 
 if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export


@@ -348,8 +348,16 @@ if (isin($op_mode, qw<forget-user merge-v3 import>) && defined @conf::admin_user
 }
 if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
     die "need an architecture" unless $arch;
 }
 if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
     die "need an architecture" unless $arch;

+    my $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=? and distribution=?', [qw<d>], undef, ($arch, $distribution//"sid")) if ($distribution//"") ne 'any';
+    $rows = $dbh->selectall_hashref('SELECT distribution as d from distribution_architectures where architecture=?', [qw<d>], undef, ($arch,)) unless $rows;
+    die "architecture ($arch) does not exist (at least not for ".($distribution//"sid").")" if !keys %$rows and $distribution//"sid" ne 'any';
+    die "architecture ($arch) does not exist" if !keys %$rows;

 }
 
 }
 

+my $suite = $distribution;
+$distribution ||='sid';
+undef $distribution if $distribution eq 'any';
+

        SWITCH: foreach ($op_mode) {
                /^set-(.+)/ && do {
                        add_packages( $1, @ARGV );
        SWITCH: foreach ($op_mode) {
                /^set-(.+)/ && do {
                        add_packages( $1, @ARGV );


@@ -377,13 +385,16 @@ if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
                         lock_table() unless $simulate;
                         my $replacemap = { '%ARCH%' => $arch, '%SUITE%' => $distribution };
                         map { my $k = $_; grep { $k =~ s,$_,$replacemap->{$_}, } keys %{$replacemap}; $_ = $k; } @ARGV;
                         lock_table() unless $simulate;
                         my $replacemap = { '%ARCH%' => $arch, '%SUITE%' => $distribution };
                         map { my $k = $_; grep { $k =~ s,$_,$replacemap->{$_}, } keys %{$replacemap}; $_ = $k; } @ARGV;

-                        my @ipkgs = &parse_argv( \@ARGV, '.');
-                        my @isrcs = &parse_argv( \@ARGV, '.');
-                        my @bpkgs = &parse_argv( \@ARGV, '.');
-                        my @psrcs = &parse_argv( \@ARGV, '.');
+                        my @ipkgs = &parse_argv( \@ARGV, '.'); # installed packages
+                        my @isrcs = &parse_argv( \@ARGV, '.'); # installed sources
+                        my @bpkgs = &parse_argv( \@ARGV, '.'); # packages available for building (edos-debcheck)
+                        my @psrcs = &parse_argv( \@ARGV, '.'); # consider as installed sources

                         use WB::QD;
                         my $srcs = WB::QD::readsourcebins($arch, $Pas, \@isrcs, \@ipkgs);
                         if (@psrcs) {
                         use WB::QD;
                         my $srcs = WB::QD::readsourcebins($arch, $Pas, \@isrcs, \@ipkgs);
                         if (@psrcs) {

+                            # Installed sources of the base suite: only add them as related, not
+                            # installed; skip the entries if we got something in installed
+                            # sources already.

                             my $psrcs = WB::QD::readsourcebins($arch, $Pas, \@psrcs, []);
                             foreach my $k (keys %$$psrcs) {
                                 next if $$srcs->{$k};
                             my $psrcs = WB::QD::readsourcebins($arch, $Pas, \@psrcs, []);
                             foreach my $k (keys %$$psrcs) {
                                 next if $$srcs->{$k};


@@ -393,6 +404,8 @@ if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
                             }
                         }
                         parse_all_v3($$srcs, {'arch' => $arch, 'suite' => $distribution, 'time' => $curr_date});
                             }
                         }
                         parse_all_v3($$srcs, {'arch' => $arch, 'suite' => $distribution, 'time' => $curr_date});

+                        # The packages passed to edos-debcheck are normally the binaries available,
+                        # unless you've also a base suite the builder will take packages from.

                         @bpkgs = @ipkgs unless @bpkgs;
                         call_edos_depcheck( {'arch' => $arch, 'pkgs' => \@bpkgs, 'srcs' => $$srcs, 'depwait' => 1 });
                         last SWITCH;
                         @bpkgs = @ipkgs unless @bpkgs;
                         call_edos_depcheck( {'arch' => $arch, 'pkgs' => \@bpkgs, 'srcs' => $$srcs, 'depwait' => 1 });
                         last SWITCH;


@@ -409,7 +422,7 @@ if (!isin($op_mode, qw<distribution-architectures distribution-aliases>)) {
                        last SWITCH;
                };
                /^distribution-architectures/ && do {
                        last SWITCH;
                };
                /^distribution-architectures/ && do {

-                       show_distribution_architectures();
+                       show_distribution_architectures({'suite' => $suite});

                        last SWITCH;
                };
                /^distribution-aliases/ && do {
                        last SWITCH;
                };
                /^distribution-aliases/ && do {


@@ -1553,7 +1566,7 @@ sub build_deplist {
 
 sub filterarch {
     return "" unless $_[0];
 
 sub filterarch {
     return "" unless $_[0];

-    return Dpkg::Deps::parse($_[0], ("reduce_arch" => 1, "host_arch" => $_[1]))->dump();
+    return Dpkg::Deps::deps_parse($_[0], ("reduce_arch" => 1, "host_arch" => $_[1]))->output();

 }
 
 sub wb_edos_builddebcheck {
 }
 
 sub wb_edos_builddebcheck {


@@ -1600,9 +1613,9 @@ sub wb_edos_builddebcheck {
         }   
     }
 
         }   
     }
 

-    print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles)."\n";
+    print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" -I ".$_ } @$packagefiles)."\n";

     open(my $result_cmd, '-|',
     open(my $result_cmd, '-|',

-        "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles));
+        "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" -I ".$_ } @$packagefiles));

 
     my $explanation="";
     my $result={};
 
     my $explanation="";
     my $result={};


@@ -1649,7 +1662,9 @@ sub call_edos_depcheck {
     my $args = shift;
     my $srcs = $args->{'srcs'};
     my $key;
     my $args = shift;
     my $srcs = $args->{'srcs'};
     my $key;

-    
+   
+    # Do not dispatch edos-debcheck if BD-Uninstallable is deactivated for the target.
+    # ("noadw")  Depwait will always be 1 in normal use.

     return if defined ($distributions{$distribution}{noadw}) && not defined $args->{'depwait'};
 
     # We need to check all of needs-build, as any new upload could make
     return if defined ($distributions{$distribution}{noadw}) && not defined $args->{'depwait'};
 
     # We need to check all of needs-build, as any new upload could make


@@ -1657,13 +1672,14 @@ sub call_edos_depcheck {
     # We also check everything in bd-uninstallable, as any new upload could
     # make that work again
     my (%interesting_packages, %interesting_packages_depwait);
     # We also check everything in bd-uninstallable, as any new upload could
     # make that work again
     my (%interesting_packages, %interesting_packages_depwait);

-    my $db = get_all_source_info();
+    my $db = get_all_source_info(); # TODO: Filter for needs-build bd-uninst dep-wait, that's all we need.

     foreach $key (keys %$db) {
        my $pkg = $db->{$key};
         if (defined $pkg and isin($pkg->{'state'}, qw/Needs-Build BD-Uninstallable/) and not defined ($distributions{$distribution}{noadw})) {
     foreach $key (keys %$db) {
        my $pkg = $db->{$key};
         if (defined $pkg and isin($pkg->{'state'}, qw/Needs-Build BD-Uninstallable/) and not defined ($distributions{$distribution}{noadw})) {

-               $interesting_packages{$key} = undef;
+               $interesting_packages{$key} = undef; # add key to interesting packages

        }
         if (defined $pkg and isin($pkg->{'state'}, qw/Dep-Wait/) and defined $args->{'depwait'}) {
        }
         if (defined $pkg and isin($pkg->{'state'}, qw/Dep-Wait/) and defined $args->{'depwait'}) {

+                # Depwaits are checked by creating pseudo binaries for edos-debcheck, so collect them.

                $interesting_packages_depwait{$key} = undef;
                 # we always check for BD-Uninstallability in depwait - could be that depwait is satisfied but package is uninstallable
                $interesting_packages{$key} = undef unless defined ($distributions{$distribution}{noadw});
                $interesting_packages_depwait{$key} = undef;
                 # we always check for BD-Uninstallability in depwait - could be that depwait is satisfied but package is uninstallable
                $interesting_packages{$key} = undef unless defined ($distributions{$distribution}{noadw});


@@ -1736,6 +1752,7 @@ sub call_edos_depcheck {
     for my $key (keys %interesting_packages) {
         next if defined $interesting_packages_depwait{$key};
        my $pkg = $db->{$key};
     for my $key (keys %interesting_packages) {
         next if defined $interesting_packages_depwait{$key};
        my $pkg = $db->{$key};

+        # (defined $interesting_packages{$key}) => edos found an uninstallability

        my $change = 
            (defined $interesting_packages{$key} and $pkg->{'state'} eq 'Needs-Build') ||
            (not defined $interesting_packages{$key} and $pkg->{'state'} eq 'BD-Uninstallable');
        my $change = 
            (defined $interesting_packages{$key} and $pkg->{'state'} eq 'Needs-Build') ||
            (not defined $interesting_packages{$key} and $pkg->{'state'} eq 'BD-Uninstallable');


@@ -1768,12 +1785,13 @@ sub call_edos_depcheck {
             next;
         }
        my $pkg = $db->{$key};
             next;
         }
        my $pkg = $db->{$key};

-           if (defined $interesting_packages{$key}) {
-                   change_state( \$pkg, 'BD-Uninstallable' );
-                   $pkg->{'bd_problem'} = $interesting_packages{$key};
-           } else {
-                   change_state( \$pkg, 'Needs-Build' );
-           }
+        # The depwait could be cleared with the result still being uninstallable.
+        if (defined $interesting_packages{$key}) {
+           change_state( \$pkg, 'BD-Uninstallable' );
+           $pkg->{'bd_problem'} = $interesting_packages{$key};
+        } else {
+           change_state( \$pkg, 'Needs-Build' );
+        }

        log_ta( $pkg, "edos_depcheck: depwait" ) unless $simulate;
        update_source_info($pkg) unless $simulate;
        print "edos-builddebchange changed state of ${key}_$pkg->{'version'} ($args->{'arch'}) from dep-wait to $pkg->{'state'}\n" if $verbose || $simulate;
        log_ta( $pkg, "edos_depcheck: depwait" ) unless $simulate;
        update_source_info($pkg) unless $simulate;
        print "edos-builddebchange changed state of ${key}_$pkg->{'version'} ($args->{'arch'}) from dep-wait to $pkg->{'state'}\n" if $verbose || $simulate;


@@ -1787,7 +1805,10 @@ sub usage {
 Usage: $prgname <options...> <package_version...>
 Options:
     -v, --verbose: Verbose execution.
 Usage: $prgname <options...> <package_version...>
 Options:
     -v, --verbose: Verbose execution.

-    -A arch: Architecture this operation is for.
+    --simulate: Do not actually execute the action.
+        (Not yet implemented for all operations.  Check the source.)
+    -A arch: Architecture this operation is for.  (REQUIRED)
+    -d dist: Distribution/suite this operation is for. Defaults to unstable.

     --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
     --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


@@ -1807,10 +1828,20 @@ Options:
         BD-Uninstallable, until the installability of its Build-Dependencies
         were verified. This happens at each call of --merge-all, usually
         every 15 minutes.
         BD-Uninstallable, until the installability of its Build-Dependencies
         were verified. This happens at each call of --merge-all, usually
         every 15 minutes.

+    --build-priority=VALUE: Adjust the build priority of the currently
+        queued build.
+    --permanent-build-priority=VALUE: Adjust the permanent build
+        priority of a source package in a given distribution.
+    --extra-depends=BUILD-DEPENDS: Specify additional build-dependencies
+        used for the build.
+    --extra-conflicts=BUILD-DEPENDS: Specify additional build-conflicts
+        used for the build.

     -i SRC_PKG, --info SRC_PKG: Show information for source package
     -l STATE, --list=STATE: List all packages in state STATE; can be
         combined with -U to restrict to a specific user; STATE can
         also be 'all'
     -i SRC_PKG, --info SRC_PKG: Show information for source package
     -l STATE, --list=STATE: List all packages in state STATE; can be
         combined with -U to restrict to a specific user; STATE can
         also be 'all'

+    --min-age=VALUE, --max-age=VALUE: Filter the output of --list
+        by the age of the builds.

     -m MESSAGE, --message=MESSAGE: Give reason why package failed or
         source dependency list
         (used with -f, --dep-wait, and --binNMU)
     -m MESSAGE, --message=MESSAGE: Give reason why package failed or
         source dependency list
         (used with -f, --dep-wait, and --binNMU)


@@ -1822,13 +1853,16 @@ Options:
         automatically choosen
     --import FILE: Import database from a ASCII file FILE
     --export FILE: Export database to a ASCII file FILE
         automatically choosen
     --import FILE: Import database from a ASCII file FILE
     --export FILE: Export database to a ASCII file FILE

+    --format string, --own-format name: specify how the listing of packages
+        should look like. Please check the source for details. Own-Format
+        definitions are in ~/.wanna-build.yaml within the format section.
+
+There are more options not relevant for normal usage - please check source
+if you need them.

 
 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.
 
 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.

---merge-packages and --merge-quinn take Package/quin--diff file names
-on the command line or read stdin. --list needs nothing more on the
-command line. --info takes source package names (without version).

 EOF
        exit 1;
 }
 EOF
        exit 1;
 }


@@ -1946,13 +1980,18 @@ sub get_all_source_info {
 }
 
 sub show_distribution_architectures {
 }
 
 sub show_distribution_architectures {

+        my $args = shift;

        my $q = 'SELECT distribution, spacecat_all(architecture) AS architectures '.
                'FROM distribution_architectures '.
                'GROUP BY distribution';
        my $rows = $dbh->selectall_hashref($q, 'distribution');
        my $q = 'SELECT distribution, spacecat_all(architecture) AS architectures '.
                'FROM distribution_architectures '.
                'GROUP BY distribution';
        my $rows = $dbh->selectall_hashref($q, 'distribution');

-       foreach my $name (keys %$rows) {
+        if ($args->{suite}) {
+            print $rows->{$args->{'suite'}}->{'architectures'}."\n";
+        } else {
+           foreach my $name (keys %$rows) {

                print $name.': '.$rows->{$name}->{'architectures'}."\n";
                print $name.': '.$rows->{$name}->{'architectures'}."\n";

-       }
+           }
+        }

 }
 
 sub show_distribution_aliases {
 }
 
 sub show_distribution_aliases {


@@ -2069,8 +2108,8 @@ sub add_user_info {
 
 sub lock_table {
         return if $simulate;
 
 sub lock_table {
         return if $simulate;

-       $dbh->do('LOCK TABLE ' . table_name() .
-               ' IN EXCLUSIVE MODE', undef) or die $dbh->errstr;
+       $dbh->do('SELECT 1 FROM ' . table_name() .
+               ' WHERE distribution = ? FOR UPDATE', undef, $distribution) or die $dbh->errstr;

 }
 
 sub parse_argv {
 }
 
 sub parse_argv {