X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=bin%2Fwanna-build;h=cd2db3acc1964e079181d969db8da869f91429f6;hb=3cab6a27680b24b57bc5da8f8e854be0af143a3e;hp=b2d75b5f3fd4e89ece23c8167ed1e8f0957a6493;hpb=008cb81cbc71cbb0250b0efbb34ccf175d6c06c3;p=wannabuild.git

diff --git a/bin/wanna-build b/bin/wanna-build
index b2d75b5..cd2db3a 100755
--- a/bin/wanna-build
+++ b/bin/wanna-build
@@ -3,7 +3,7 @@
 # wanna-build: coordination script for Debian buildds
 # Copyright (C) 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
 # Copyright (C) 2005-2008 Ryan Murray <rmurray@debian.org>
-# Copyright (C) 2010      Andreas Barth <aba@not.so.argh.org>
+# Copyright (C) 2010,2011 Andreas Barth <aba@not.so.argh.org>
 #
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License as
@@ -23,6 +23,8 @@ use strict;
 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 >;
@@ -170,6 +172,7 @@ my @wannabuildoptions = (
                 $privmode = 0;
                 $distribution = 'any';
             }
+            $privmode = 1 if $distribution =~ /security/;
         }
     },
     'order|O=s' => sub {
@@ -219,11 +222,8 @@ END {
 	}
 }
 
-$distribution ||= "sid";
-
 my $schema_suffix = '';
-$recorduser //= (not -t and $user//"" =~ /^buildd_/);
-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';
@@ -258,15 +258,14 @@ foreach my $name (keys %$rows) {
 $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 !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";
 }
 
@@ -276,7 +275,7 @@ if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)
 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";
+	print "wanna-build $version for ".($distribution//"sid")." on $arch\n";
 }
 
 if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
@@ -344,22 +343,20 @@ $list_order ||= $yamlmap->{"list-order"}{'default'};
 $api //= $yamlmap->{"api"};
 $api //= 0;
 
-process();
-
-$dbh->commit;
-$dbh->disconnect;
-
-if ($mail_logs && $conf::log_mail) {
-	send_mail( $conf::log_mail,
-			   "wanna-build $distribution state changes $curr_date",
-			   "State changes at $curr_date for distribution ".
-			   "$distribution:\n\n$mail_logs\n" );
+if (isin($op_mode, qw<forget-user merge-v3 import>) && defined @conf::admin_users && !isin( $real_user, @conf::admin_users) && !$simulate ) {
+    die "This operation is restricted to admin users";
+}
+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;
 }
 
-exit 0;
-
-
-sub process {
+my $suite = $distribution;
+$distribution ||='sid';
+undef $distribution if $distribution eq 'any';
 
 	SWITCH: foreach ($op_mode) {
 		/^set-(.+)/ && do {
@@ -375,9 +372,6 @@ sub process {
 			last SWITCH;
 		};
 		/^forget-user/ && do {
-			die "This operation is restricted to admin users\n"
-				if (defined @conf::admin_users and
-				    !isin( $real_user, @conf::admin_users));
 			forget_users( @ARGV );
 			last SWITCH;
 		};
@@ -386,8 +380,6 @@ sub process {
 			last SWITCH;
 		};
 		/^merge-v3/ && do {
-                        die "This operation is restricted to admin users\n"
-			    if (defined @conf::admin_users and !isin( $real_user, @conf::admin_users) and !$simulate);
                         # call with installed-packages+ . installed-sources+ [ . available-for-build-packages* [ . consider-as-installed-source* ]  ]
                         # in case available-for-build-packages is not specified, installed-packages are used
                         lock_table() unless $simulate;
@@ -414,12 +406,7 @@ sub process {
                         last SWITCH;
 		};
 		/^import/ && do {
-			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() . 
-				" WHERE distribution = ?", undef,
-				$distribution)
+			$dbh->do("DELETE from ".table_name()." WHERE distribution = ?", undef, $distribution)
 				or die $dbh->errstr;
 			forget_users();
 			read_db( $import_from );
@@ -430,7 +417,7 @@ sub process {
 			last SWITCH;
 		};
 		/^distribution-architectures/ && do {
-			show_distribution_architectures();
+			show_distribution_architectures({'suite' => $suite});
 			last SWITCH;
 		};
 		/^distribution-aliases/ && do {
@@ -451,8 +438,20 @@ sub process {
 			update_user_info($user);
 		}
 	}
+
+
+$dbh->commit unless $simulate;
+$dbh->disconnect;
+
+if ($mail_logs && $conf::log_mail) {
+	send_mail( $conf::log_mail,
+			   "wanna-build $distribution state changes $curr_date",
+			   "State changes at $curr_date for distribution ".
+			   "$distribution:\n\n$mail_logs\n" );
 }
 
+exit 0;
+
 
 BEGIN {
     $actions = {
@@ -1562,7 +1561,7 @@ sub build_deplist {
 
 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 {
@@ -1609,9 +1608,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, '-|',
-        "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles));
+        "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" -I ".$_ } @$packagefiles));
 
     my $explanation="";
     my $result={};
@@ -1693,12 +1692,12 @@ sub call_edos_depcheck {
         # If such a "binary" package is installable, the corresponding source package is buildable.
 	print $SOURCES "Package: source---$key\n";
 	print $SOURCES "Version: $pkg->{'version'}\n";
-        my $t = &filterarch($srcs->{$key}{'dep'} || $srcs->{$key}{'depends'}, $arch);
-        my $tt = &filterarch($pkg->{'extra_depends'}, $arch);
+        my $t = &filterarch($srcs->{$key}{'dep'} || $srcs->{$key}{'depends'}, $args->{'arch'});
+        my $tt = &filterarch($pkg->{'extra_depends'}, $args->{'arch'});
         $t = $t ? ($tt ? "$t, $tt" : $t) : $tt;
 	print $SOURCES "Depends: $t\n" if $t;
-        my $u = &filterarch($srcs->{$key}{'conf'} || $srcs->{$key}{'conflicts'}, $arch);
-        my $uu = &filterarch($pkg->{'extra_conflicts'}, $arch);
+        my $u = &filterarch($srcs->{$key}{'conf'} || $srcs->{$key}{'conflicts'}, $args->{'arch'});
+        my $uu = &filterarch($pkg->{'extra_conflicts'}, $args->{'arch'});
         $u = $u ? ($uu ? "$u, $uu" : $u) : $uu;
 	print $SOURCES "Conflicts: $u\n" if $u;
 	print $SOURCES "Architecture: all\n";
@@ -1955,13 +1954,18 @@ sub get_all_source_info {
 }
 
 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');
-	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";
-	}
+	    }
+        }
 }
 
 sub show_distribution_aliases {