X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=bin%2Fwanna-build;h=636cdaecca1c7749ca9309007c6f17b621c08271;hb=d38cebee71c4d472d45c09c580c064ae52e12f47;hp=5a32603271c3deeadef2aa5b3600608a4570f925;hpb=2038009de5c47bb0e2e369b42a04024e498bcf71;p=wannabuild.git diff --git a/bin/wanna-build b/bin/wanna-build index 5a32603..636cdae 100755 --- a/bin/wanna-build +++ b/bin/wanna-build @@ -19,8 +19,13 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # +use strict; +use warnings; +use 5.010; package conf; + +use vars qw< $basedir $dbbase $transactlog $mailprog $buildd_domain >; # defaults $basedir ||= "/var/lib/debbuild"; $dbbase ||= "build-db"; @@ -34,7 +39,6 @@ die "mailprog binary $conf::mailprog does not exist or isn't executable\n" if !-x $conf::mailprog; package main; -use strict; use POSIX; use FileHandle; use File::Copy; @@ -269,18 +273,19 @@ END { } } +$distribution ||= "sid"; if ($distribution eq 'any-priv') { - $privmode = 'yes'; + $privmode = 1; $distribution = 'any'; } if ($distribution eq 'any-unpriv') { - $privmode = 'no'; + $privmode = 0; $distribution = 'any'; } my $schema_suffix = ''; $recorduser //= (not -t and $user =~ /^buildd_/); -if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !$recorduser && !($privmode eq 'yes')) { +if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !$recorduser && !($privmode)) { $dbh = DBI->connect("DBI:Pg:service=wanna-build") || die "FATAL: Cannot open database: $DBI::errstr\n"; $schema_suffix = '_public'; @@ -316,7 +321,6 @@ $distribution = $distribution_aliases{$distribution} if (isin($distribution, key $op_mode = $category ? "set-failed" : "set-building" if !$op_mode; # default operation -$distribution ||= "sid"; undef $distribution if $distribution eq 'any'; if ($distribution) { my @dists = split(/[, ]+/, $distribution); @@ -392,7 +396,7 @@ my $yamlmap = (); my $yamldir = "/org/wanna-build/etc/yaml"; my @files = ('wanna-build.yaml'); if ((getpwuid($>))[7]) { push (@files, ((getpwuid($>))[7])."/.wanna-build.yaml"); } -if ($user =~ /(buildd.*)-/) { push (@files, "$1.yaml") }; +if ($user && $user =~ /(buildd.*)-/) { push (@files, "$1.yaml") }; if ($user) { push ( @files, "$user.yaml"); } foreach my $file (@files) { my $cfile = File::Spec->rel2abs( $file, $yamldir ); @@ -517,7 +521,7 @@ sub process { @ARGV = ( $ARGS[0] ); my $pkgs = parse_packages(0); @ARGV = ( $ARGS[3] ); - my $pkgs = parse_packages(1); + $pkgs = parse_packages(1); @ARGV = ( $ARGS[1] ); parse_quinn_diff(0); @ARGV = ( $ARGS[2] ); @@ -1948,8 +1952,8 @@ sub calculate_prio { my $scale = $priomap->{'waitingdays'}->{'scale'} || 1; $pkg->{'calprio'} += $days * $scale; - my $btime = max($pkg->{'anytime'}, $pkg->{'successtime'}); - my $bhours = defined($btime) ? int($btime/3600) : ($priomap->{'buildhours'}->{'default'} || 2); + my $btime = max($pkg->{'anytime'}//0, $pkg->{'successtime'}//0); + my $bhours = $btime ? int($btime/3600) : ($priomap->{'buildhours'}->{'default'} || 2); $bhours = $priomap->{'buildhours'}->{'min'} if $priomap->{'buildhours'}->{'min'} and $bhours < $priomap->{'buildhours'}->{'min'}; $bhours = $priomap->{'buildhours'}->{'max'} if $priomap->{'buildhours'}->{'max'} and $bhours > $priomap->{'buildhours'}->{'max'}; $scale = $priomap->{'buildhours'}->{'scale'} || 1; @@ -2054,7 +2058,7 @@ Text could contain further %. To start with !, use %! 'u' => make_fmt( $pkg->{'builder'}, $pkg, $var), 'X' => make_fmt( sub { my $c = "$pkg->{'priority'}:$pkg->{'notes'}"; - $c .= ":PREV-FAILED" if $pkg->{'previous_state'} =~ /^Failed/; + $c .= ":PREV-FAILED" if $pkg->{'previous_state'} && $pkg->{'previous_state'} =~ /^Failed/; $c .= ":bp{" . $pkg->{'buildpri'} . "}" if defined $pkg->{'buildpri'}; $c .= ":binNMU{" . $pkg->{'binary_nmu_version'} . "}" if defined $pkg->{'binary_nmu_version'}; $c .= ":calprio{". $pkg->{'calprio'}."}"; @@ -2082,8 +2086,8 @@ Text could contain further %. To start with !, use %! 'O' => make_fmt( sub { return seconds2time ( $pkg->{'successtime'}); }, $pkg, $var), 'q' => make_fmt( $pkg->{'anytime'}, $pkg, $var), 'Q' => make_fmt( sub { return seconds2time ( $pkg->{'anytime'}); }, $pkg, $var), - 'r' => make_fmt( sub { return max($pkg->{'successtime'}, $pkg->{'anytime'}); }, $pkg, $var), - 'R' => make_fmt( sub { return seconds2time ( max($pkg->{'successtime'}, $pkg->{'anytime'})); }, $pkg, $var), + 'r' => make_fmt( sub { my $c = max($pkg->{'successtime'}//0, $pkg->{'anytime'}//0); return $c if $c; return; }, $pkg, $var), + 'R' => make_fmt( sub { return seconds2time ( max($pkg->{'successtime'}//0, $pkg->{'anytime'}//0)); }, $pkg, $var), )); } @@ -2106,10 +2110,10 @@ sub list_packages { @list = grep { !$_->{'extra_depends'} and !$_->{'extra_conflicts'} } @list if $api < 1 ; # first adjust ownprintformat, then set printformat accordingly - $printformat ||= $yamlmap->{"format"}{$ownprintformat}; + $printformat ||= $yamlmap->{"format"}{$ownprintformat} if $ownprintformat; $printformat ||= $yamlmap->{"format"}{"default"}{$state}; $printformat ||= $yamlmap->{"format"}{"default"}{"default"}; - undef $printformat if ($ownprintformat eq 'none'); + undef $printformat if ($ownprintformat && $ownprintformat eq 'none'); foreach $pkg (sort sort_list_func @list) { if ($printformat) { @@ -2259,11 +2263,11 @@ sub read_db { my $file = shift; print "Reading ASCII database from $file..." if $verbose >= 1; - open( F, "<$file" ) or + open( my $fh, '<', $file ) or die "Can't open database $file: $!\n"; local($/) = ""; # read in paragraph mode - while( ) { + while( <$fh> ) { my( %thispkg, $name ); s/[\s\n]+$//; s/\n[ \t]+/\376\377/g; # fix continuation lines @@ -2291,7 +2295,7 @@ sub read_db { or die $dbh->errstr; } } - close( F ); + close( $fh ); print "done\n" if $verbose >= 1; } @@ -2331,7 +2335,7 @@ sub export_db { my($name,$pkg,$key); print "Writing ASCII database to $file..." if $verbose >= 1; - open( F, ">$file" ) or + open( my $fh, '>', $file ) or die "Can't open export $file: $!\n"; my $db = get_all_source_info(); @@ -2344,11 +2348,11 @@ sub export_db { $val =~ s/\n*$//; $val =~ s/^/ /mg; $val =~ s/^ +$/ ./mg; - print F "$key: $val\n"; + print $fh "$key: $val\n"; } - print F "\n"; + print $fh "\n"; } - close( F ); + close( $fh ); print "done\n" if $verbose >= 1; } @@ -2366,8 +2370,8 @@ sub change_state { if (defined($$state) and $$state eq 'Failed') { $pkg->{'old_failed'} = "-"x20 . " $pkg->{'version'} " . "-"x20 . "\n" . - $pkg->{'failed'} . "\n" . - $pkg->{'old_failed'}; + ($pkg->{'failed'} // ""). "\n" . + ($pkg->{'old_failed'} // ""); delete $pkg->{'failed'}; delete $pkg->{'failed_category'}; } @@ -2425,13 +2429,13 @@ sub send_mail { $to .= '@' . $domain if $to !~ /\@/; $text =~ s/^\.$/../mg; local $SIG{'PIPE'} = 'IGNORE'; - open( PIPE, "| $conf::mailprog -oem $to" ) + open( my $pipe, '|-', "$conf::mailprog -oem $to" ) or die "Can't open pipe to $conf::mailprog: $!\n"; chomp $text; - print PIPE "From: $from\n"; - print PIPE "Subject: $subject\n\n"; - print PIPE "$text\n"; - close( PIPE ); + print $pipe "From: $from\n"; + print $pipe "Subject: $subject\n\n"; + print $pipe "$text\n"; + close( $pipe ); } # for parsing input to dep-wait @@ -2505,8 +2509,8 @@ sub wb_edos_builddebcheck { my $packagearch=""; foreach my $packagefile (@$packagefiles) { - open(P,$packagefile); - while (

) { + open(my $fh,'<', $packagefile); + while (<$fh>) { next unless /^Architecture/; next if /^Architecture:\s*all/; /Architecture:\s*([^\s]*)/; @@ -2516,7 +2520,7 @@ sub wb_edos_builddebcheck { return "Package file contains different architectures: $packagearch, $1"; } } - close P; + close $fh; } if ( $architecture eq "" ) { @@ -2534,14 +2538,14 @@ sub wb_edos_builddebcheck { } print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles)."\n"; - open(RESULT, '-|', + open(my $result_cmd, '-|', "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles)); my $explanation=""; my $result={}; my $binpkg=""; - while () { + while (<$result_cmd>) { # source---pulseaudio (= 0.9.15-4.1~bpo50+1): FAILED # source---pulseaudio (= 0.9.15-4.1~bpo50+1) depends on missing: # - libltdl-dev (>= 2.2.6a-2) @@ -2570,7 +2574,7 @@ sub wb_edos_builddebcheck { } } - close RESULT; + close $result_cmd; $result->{$binpkg} = $explanation if $binpkg; return $result; @@ -2672,7 +2676,7 @@ sub call_edos_depcheck { 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'}; + my $problemchange = ($interesting_packages{$key}//"") ne ($pkg->{'bd_problem'}//""); if ($change) { if (defined $interesting_packages{$key}) { change_state( \$pkg, 'BD-Uninstallable' ); @@ -2861,12 +2865,12 @@ sub get_all_source_info { push @args, "FAILED"; } - if ($options{list_min_age} > 0) { + if ($options{list_min_age} && $options{list_min_age} > 0) { $q .= ' AND age(state_change) > ? '; push @args, $options{list_min_age} . " days"; } - if ($options{list_min_age} < 0) { + if ($options{list_min_age} && $options{list_min_age} < 0) { $q .= ' AND age(state_change) < ? '; push @args, -$options{list_min_age} . " days"; } @@ -2999,14 +3003,13 @@ sub add_user_info { or die $dbh->errstr; } -sub lock_table() -{ +sub lock_table { return if $simulate; $dbh->do('LOCK TABLE ' . table_name() . ' IN EXCLUSIVE MODE', undef) or die $dbh->errstr; } -sub parse_argv() { +sub parse_argv { # parts the array $_[0] and $_[1] and returns the sub-array (modifies the original one) my @ret = (); my $args = shift; @@ -3018,7 +3021,7 @@ sub parse_argv() { return @ret; } -sub parse_all_v3() { +sub parse_all_v3 { my $srcs = shift; my $vars = shift; my $db = get_all_source_info(); @@ -3045,13 +3048,13 @@ sub parse_all_v3() { } $pkg->{'package'} = $name; } - my $logstr = "merge-v3 $vars->{'time'} ".$name."_$pkgs->{'version'}". + my $logstr = sprintf("merge-v3 %s %s_%s", $vars->{'time'}, $name, $pkgs->{'version'}). ($pkgs->{'binnmu'} ? ";b".$pkgs->{'binnmu'} : ""). - " ($vars->{'arch'}, $vars->{'suite'}, previous: $pkg->{'version'}". + sprintf(" (%s, %s, previous: %s", $vars->{'arch'}, $vars->{'suite'}, $pkg->{'version'}//""). ($pkg->{'binary_nmu_version'} ? ";b".$pkg->{'binary_nmu_version'} : ""). ", $pkg->{'state'}):"; - if (isin($pkgs->{'status'}, qw (installed related)) && $pkgs->{'version'} eq $pkg->{'version'} && $pkg->{'binary_nmu_version'} && $pkgs->{'binnmu'} < int($pkg->{'binary_nmu_version'})) { + if (isin($pkgs->{'status'}, qw (installed related)) && $pkgs->{'version'} eq $pkg->{'version'} && $pkgs->{'binnmu'}//0 < int($pkg->{'binary_nmu_version'}//0)) { $pkgs->{'status'} = 'out-of-date'; } if (isin($pkgs->{'status'}, qw (installed related))) { @@ -3065,7 +3068,7 @@ sub parse_all_v3() { } my $attrs = { 'version' => 'version', 'installed_version' => 'version', 'binary_nmu_version' => 'binnmu', 'section' => 'section', 'priority' => 'priority' }; foreach my $k (keys %$attrs) { - if ($pkg->{$k} ne $pkgs->{$attrs->{$k}}) { + if (($pkg->{$k}//"") ne ($pkgs->{$attrs->{$k}}//"")) { $pkg->{$k} = $pkgs->{$attrs->{$k}}; $change++; } @@ -3075,7 +3078,7 @@ sub parse_all_v3() { $change++; } if ($change) { - print "$logstr set to installed/".$pkg->{'notes'}."\n" if $verbose || $simulate; + print "$logstr set to installed/".($pkg->{'notes'}//"")."\n" if $verbose || $simulate; log_ta( $pkg, "--merge-v3: installed" ) unless $simulate; update_source_info($pkg) unless $simulate; } @@ -3113,7 +3116,7 @@ sub parse_all_v3() { print "$logstr package in unknown state: $pkgs->{'status'}\n"; next SRCS; } - next if $pkgs->{'version'} eq $pkg->{'version'} and $pkgs->{'binnmu'} >= int($pkg->{'binary_nmu_version'}); + next if $pkgs->{'version'} eq $pkg->{'version'} and $pkgs->{'binnmu'}//0 >= int($pkg->{'binary_nmu_version'}//0); next if $pkgs->{'version'} eq $pkg->{'version'} and !isin( $pkg->{'state'}, qw(Installed)); next if isin( $pkg->{'state'}, qw(Not-For-Us Failed-Removed));