X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=bin%2Fwanna-build;h=b46eb2232a48096491c59153736e68f703216549;hb=adcbb3629f3f9fe7b284d62ca252b3b0ffabc1b8;hp=54b7491be3f4bad26df5e4663fa0ec4b04d89c79;hpb=dc56ace62b52dfb21838820e8da5b188082b4613;p=wannabuild.git diff --git a/bin/wanna-build b/bin/wanna-build index 54b7491..b46eb22 100755 --- a/bin/wanna-build +++ b/bin/wanna-build @@ -41,6 +41,12 @@ use File::Copy; use DBI; use lib '/org/wanna-build/bin'; use WannaBuild; +use YAML::Tiny; +use Data::Dumper; +use Hash::Merge qw ( merge ); +use String::Format; +use Date::Parse; +use List::Util qw[max]; our ($verbose, $mail_logs, $list_order, $list_state, $curr_date, $op_mode, $user, $real_user, $distribution, @@ -49,10 +55,13 @@ our ($verbose, $mail_logs, $list_order, $list_state, $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); + $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc, + $printformat, $ownprintformat, $privmode + ); # global vars $ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/org/wanna-build/bin/"; +$ENV{'LC_ALL'} = 'C'; $verbose = 0; $mail_logs = ""; @curr_time = gmtime; @@ -181,6 +190,8 @@ my %options = if $list_min_age == 0; $list_min_age *= -1; } }, + "format" => { arg => \$printformat }, + "own-format" => { arg => \$ownprintformat }, # special actions export => { arg => \$export_to, mode => "export" }, import => { arg => \$import_from, mode => "import" }, @@ -230,11 +241,26 @@ while( @ARGV && $ARGV[0] =~ /^-/ ) { $op_mode = $category ? "set-failed" : "set-building" if !$op_mode; # default operation -$list_order = $list_state eq "failed" ? 'fPcpsn' : 'PScpsn' - if !$list_order and $list_state; $distribution ||= "unstable"; -die "Bad distribution '$distribution'\n" - if !isin($distribution, keys %conf::distributions); +if ($distribution eq 'any-priv') { + $privmode = 'yes'; + $distribution = 'any'; +} +if ($distribution eq 'any-unpriv') { + $privmode = 'no'; + $distribution = 'any'; +} +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 %conf::distributions); + } +} +if (!isin ( $op_mode, qw(list) ) && ( !$distribution || $distribution =~ /[ ,]/)) { + die "multiple distributions are only allowed for list"; +} # If they didn't specify an arch, try to get it from database name which # is in the form of $arch/build-db @@ -294,6 +320,26 @@ if (!$fail_reason) { } } +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) { push ( @files, "$user.yaml"); } +foreach my $file (@files) { + my $cfile = File::Spec->rel2abs( $file, $yamldir ); + if ($verbose >= 2) { print "Trying to read $file ($cfile) ...\n"; } + next unless -f $cfile; + if ($verbose >= 2) { print "Read $file ($cfile) ...\n"; } + my $m = YAML::Tiny->read( $cfile )->[0]; + $yamlmap = merge($m, $yamlmap); +} +if (not $yamlmap) { + die "FATAL: no configuration found\n"; +} +$list_order = $yamlmap->{"list-order"}{$list_state} if !$list_order and $list_state; +$list_order ||= $yamlmap->{"list-order"}{'default'}; + my $dbh; END { @@ -304,7 +350,7 @@ END { } my $schema_suffix = ''; -if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/)) { +if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/) && !($privmode eq 'yes')) { $dbh = DBI->connect("DBI:Pg:service=wanna-build") || die "FATAL: Cannot open database: $DBI::errstr\n"; $schema_suffix = '_public'; @@ -1740,102 +1786,44 @@ BEGIN { } sub sort_list_func { - my( $letter, $x, $ax, $bx ); - - foreach $letter (split( "", $list_order )) { - SWITCH: foreach ($letter) { - /C/ && do { - $x = $b->{'calprio'} <=> $a->{'calprio'}; - return $x if $x != 0; - last SWITCH; - }; - /W/ && do { - $x = $b->{'waiting_days'} <=> $a->{'waiting_days'}; - return $x if $x != 0; - last SWITCH; - }; - /P/ && do { - $x = $b->{'buildpri'} <=> $a->{'buildpri'}; - return $x if $x != 0; - last SWITCH; - }; - /p/ && do { - $x = $prioval{$a->{'priority'}} <=> $prioval{$b->{'priority'}}; - return $x if $x != 0; - last SWITCH; - }; - /s/ && do { - $x = $sectval{$a->{'section'}} <=> $sectval{$b->{'section'}}; - return $x if $x != 0; - last SWITCH; - }; - /n/ && do { - $x = $a->{'package'} cmp $b->{'package'}; - return $x if $x != 0; - last SWITCH; - }; - /b/ && do { - $x = $a->{'builder'} cmp $b->{'builder'}; - return $x if $x != 0; - last SWITCH; - }; - /c/ && do { - $ax = ($a->{'notes'} =~ /^(out-of-date|partial)/) ? 0 : - ($a->{'notes'} =~ /^uncompiled/) ? 2 : 1; - $bx = ($b->{'notes'} =~ /^(out-of-date|partial)/) ? 0 : - ($b->{'notes'} =~ /^uncompiled/) ? 2 : 1; - $x = $ax <=> $bx; - return $x if $x != 0; - last SWITCH; - }; - /f/ && do { - my $ca = defined $a->{'failed_category'} ? - $a->{'failed_category'} : "none"; - my $cb = defined $b->{'failed_category'} ? - $b->{'failed_category'} : "none"; - $x = $catval{$ca} <=> $catval{$cb}; - return $x if $x != 0; - last SWITCH; - }; - /S/ && do { - my $pa = $prioval{$a->{'priority'}} > - $prioval{'standard'}; - my $pb = $prioval{$b->{'priority'}} > - $prioval{'standard'}; - $x = $pa <=> $pb; - return $x if $x != 0; - last SWITCH; - }; - } + my $map_funcs = { + 'C' => ['<=>', sub { return (-1) * $_[0]->{'calprio'}; }], + 'W' => ['<=>', sub { return (-1) * $_[0]->{'state_days'}; }], + 'P' => ['<=>', sub { return (-1) * $_[0]->{'buildpri'}; }], + 'p' => ['<=>', sub { return $prioval{$_[0]->{'priority'}}; }], + 's' => ['<=>', sub { return $sectval{$_[0]->{'section'}}; }], + 'n' => ['cmp', sub { return $_[0]->{'package'}; }], + 'b' => ['cmp', sub { return $_[0]->{'builder'}; }], + 'c' => ['<=>', sub { return ($_[0]->{'notes'} =~ /^(out-of-date|partial)/) ? 0: ($_[0]->{'notes'} =~ /^uncompiled/) ? 2 : 1; }], + 'f' => ['<=>', sub { return $catval{ $_[0]->{'failed_category'} ? $_[0]->{'failed_category'}: "none" }; }], + 'S' => ['<=>', sub { return $prioval{$_[0]->{'priority'}} > $prioval{'standard'}; }], + }; + + foreach my $letter (split( //, $list_order )) { + my $r; + $r = &{$map_funcs->{$letter}[1]}($a) <=> &{$map_funcs->{$letter}[1]}($b) if $map_funcs->{$letter}[0] eq '<=>'; + $r = &{$map_funcs->{$letter}[1]}($a) cmp &{$map_funcs->{$letter}[1]}($b) if $map_funcs->{$letter}[0] eq 'cmp'; + return $r if $r != 0; } return 0; } sub calculate_prio { -###################### -# priority: required = 50, important = 40, standard = 30, optional = 5 -# section: libs = 4, devel = 2 -# component: contrib = -10, non-free = -20 -# never built = -20 -# max(floor(waitingdays),6) - - my $priomap; - $priomap->{'priority'} = { 'required' => 50, 'important' => 40, 'standard' => 30, 'optional' => 5 }; - $priomap->{'section'} = { 'libs' => 4, 'devel' => 2 }; - $priomap->{'component'} = { 'contrib' => -10, 'non-free' => -20 }; - $priomap->{'notes'} = { 'uncompiled' => 20, 'out-of-date' => 40, 'partial' => 40 }; - $priomap->{'waitingdays'} = { 'min' => 0, 'max' => 6, scale => 2 }; + my $priomap = $yamlmap->{priority}; my $pkg = shift; + my @s=split("/", $pkg->{'section'}); + $pkg->{'component'} = $s[0] if $s[1]; + $pkg->{'component'} ||= 'main'; $pkg->{'calprio'} = 0; - foreach my $k (keys %$priomap) { - $pkg->{'calprio'} += $priomap->{$k}{$pkg->{$k}} if $pkg->{$k} and $priomap->{$k}{$pkg->{$k}}; + foreach my $k (keys %{$priomap->{keys}}) { + $pkg->{'calprio'} += $priomap->{keys}->{$k}{$pkg->{$k}} if $pkg->{$k} and $priomap->{keys}->{$k}{$pkg->{$k}}; } - my $wd = $pkg->{'waiting_days'}; - $wd = $priomap->{'waitingdays'}->{'min'} if $priomap->{'waitingdays'}->{'min'} and $wd < $priomap->{'waitingdays'}->{'min'}; - $wd = $priomap->{'waitingdays'}->{'max'} if $priomap->{'waitingdays'}->{'max'} and $wd > $priomap->{'waitingdays'}->{'max'}; + my $days = $pkg->{'state_days'}; + $days = $priomap->{'waitingdays'}->{'min'} if $priomap->{'waitingdays'}->{'min'} and $days < $priomap->{'waitingdays'}->{'min'}; + $days = $priomap->{'waitingdays'}->{'max'} if $priomap->{'waitingdays'}->{'max'} and $days > $priomap->{'waitingdays'}->{'max'}; my $scale = $priomap->{'waitingdays'}->{'scale'} || 1; - $pkg->{'calprio'} += $wd * $scale; + $pkg->{'calprio'} += $days * $scale; $pkg->{'calprio'} += $pkg->{'permbuildpri'} if $pkg->{'permbuildpri'}; $pkg->{'calprio'} += $pkg->{'buildpri'} if $pkg->{'buildpri'}; @@ -1844,6 +1832,128 @@ sub calculate_prio { } +sub seconds2time { + my $t = shift; + return "" unless $t; + my $sec = $t % 60; + my $min = int($t/60) % 60; + my $hours = int($t / 3600); + return sprintf("%d:%02d:%02d", $hours, $min, $sec) if $hours; + return sprintf("%d:%02d", $min, $sec); +} + + +sub use_fmt { + my $r; + + if (ref($_[0]) eq 'CODE') { + $r = &{$_[0]}; + } else { + $r = $_[0]; + } + + shift; + my $t = shift; + + $r ||= ""; + return $r unless $t; + + my $pkg = shift; + my $var = shift; + if (substr($t,0,1) eq '!') { + $t = substr($t,1); + return "" if $r; + } else { + return "" unless $r; + } + if ($t =~ /%/) { + return print_format($t, $pkg, $var); + } + return $t; +} +sub make_fmt { my $c = shift; my $pkg = shift; my $var = shift; return sub { use_fmt($c, $_[0], $pkg, $var); } }; + +sub print_format { + my $printfmt = shift; + my $pkg = shift; + my $var = shift; +=pod +Within an format string, the following values are allowed (need to be preceded by %). +This can be combined to e.g. +wanna-build --format='wanna-build -A %a --give-back %p_%v' -A mipsel --list=failed + +a Architecture +c section (e.g. libs or utils) +D in case of BD-Uninstallable the reason for the uninstallability +d distribution +E in case of Dep-Wait the packages being waited on, in case of Needs-Build the number in the queue +F in case of Failed the fail reason +n newline +o time of last successful build (seconds) +O time of last successful build (formated) +P previous state +p Package name +q time of last build (seconds) +Q time of last build (formated) +r max time of last (successful) build (seconds) +R max time of last (successful) build (formated) +S Package state +s Time in this state in full seconds since epoch +t time of state change +T time since state change +u Builder (e.g. buildd_mipsel-rem) +v Package version +V full Package version (i.e. with +b.., = %v%{+b}B%B +X the string normally between [], e.g. optional:out-of-date:calprio{61}:days{25} + +%{Text}? print Text in case ? is not empty; ? is never printed +%{!Text}? print Text in case ? is empty; ? is never printed +Text could contain further %. To start with !, use %! + +=cut + return stringf($printfmt, ( + 'p' => make_fmt( $pkg->{'package'}, $pkg, $var), + 'a' => make_fmt( $arch, $pkg, $var), + 's' => make_fmt( sub { return floor(str2time($pkg->{'state_change'})); }, $pkg, $var), + 'v' => make_fmt( $pkg->{'version'}, $pkg, $var), + 'V' => make_fmt( sub { $pkg->{'binary_nmu_version'} ? $pkg->{'version'}."+b".$pkg->{'binary_nmu_version'} : $pkg->{'version'} }, $pkg, $var), + 'S' => make_fmt( $pkg->{'state'}, $pkg, $var), + '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 .= ":bp{" . $pkg->{'buildpri'} . "}" if defined $pkg->{'buildpri'}; + $c .= ":binNMU{" . $pkg->{'binary_nmu_version'} . "}" if defined $pkg->{'binary_nmu_version'}; + $c .= ":calprio{". $pkg->{'calprio'}."}"; + $c .= ":days{". $pkg->{'state_days'}."}"; + return $c; + }, $pkg, $var), + 'c' => make_fmt( $pkg->{'section'}, $pkg, $var), + 'P' => make_fmt( $pkg->{'previous_state'} || "unknwon", $pkg, $var), + 'E' => make_fmt( sub { return $pkg->{'depends'} if $pkg->{'state'} eq "Dep-Wait"; + return $var->{scnt}{'Needs-Build'} + 1 if $pkg->{'state'} eq 'Needs-Build'; + return ""; }, $pkg, $var), + 'F' => make_fmt( sub { return "" unless $pkg->{'failed'}; + my $failed = $pkg->{'failed'}; + $failed =~ s/\\/\\\\/g; + return $pkg->{'package'}."#".$arch."-failure\n ". + join("\\0a",split("\n",$failed))."\\0a\n"; }, $pkg, $var), + 'D' => make_fmt( sub { return "" unless $pkg->{'bd_problem'}; + return $pkg->{'package'}."#".$arch."-bd-problem\n". + join("\\0a",split("\n",$pkg->{'bd_problem'}))."\\0a\n"; }, $pkg, $var), + 'B' => make_fmt( sub { return $pkg->{'binary_nmu_version'} if defined $pkg->{'binary_nmu_version'}; }, $pkg, $var), + 'd' => make_fmt( $pkg->{'distribution'}, $pkg, $var), + 't' => make_fmt( $pkg->{'state_change'}, $pkg, $var), + 'T' => make_fmt( sub { return seconds2time(time() - floor(str2time($pkg->{'state_change'}))); }, $pkg, $var), + 'o' => make_fmt( $pkg->{'successtime'}, $pkg, $var), + '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), + )); +} + sub list_packages { my $state = shift; my( $name, $pkg, @list ); @@ -1857,22 +1967,28 @@ sub list_packages { push @list, calculate_prio($db->{$name}); } + # filter components + @list = grep { my $i = $_->{'component'}; grep { $i eq $_ } split /[, ]+/, $yamlmap->{"restrict"}{'component'} } @list; + + # first adjust ownprintformat, then set printformat accordingly + $printformat ||= $yamlmap->{"format"}{$ownprintformat}; + $printformat ||= $yamlmap->{"format"}{"default"}{$state}; + $printformat ||= $yamlmap->{"format"}{"default"}{"default"}; + undef $printformat if ($ownprintformat eq 'none'); + foreach $pkg (sort sort_list_func @list) { - print "$pkg->{'section'}/$pkg->{'package'}_$pkg->{'version'}"; - print ": $pkg->{'state'}" + if ($printformat) { + print print_format($printformat, $pkg, {'cnt' => $cnt, 'scnt' => \%scnt})."\n"; + ++$cnt; + $scnt{$pkg->{'state'}}++; + next; + } + print print_format("%c/%p_%v", $pkg, {}); + print print_format(": %S", $pkg, {}) if $state eq "all"; - print " by $pkg->{'builder'}" - if $pkg->{'state'} ne "Needs-Build" && $pkg->{'builder'}; - print " [$pkg->{'priority'}:$pkg->{'notes'}"; - print ":PREV-FAILED" - if $pkg->{'previous_state'} =~ /^Failed/; - print ":bp{" . $pkg->{'buildpri'} . "}" - if defined $pkg->{'buildpri'}; - print ":binNMU{" . $pkg->{'binary_nmu_version'} . "}" - if defined $pkg->{'binary_nmu_version'}; - print ":calprio{". $pkg->{'calprio'}."}"; - print ":wd{". $pkg->{'waiting_days'}."}"; - print "]\n"; + print print_format("%{ by }u%u", $pkg, {}) + if $pkg->{'state'} ne "Needs-Build"; + print print_format(" [%X]\n", $pkg, {}); print " Reasons for failing:\n", " [Category: ", defined $pkg->{'failed_category'} ? $pkg->{'failed_category'} : "none", @@ -1884,23 +2000,26 @@ sub list_packages { 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" + print " Previous state was $pkg->{'previous_state'}\n" if $verbose && $pkg->{'previous_state'}; print " No previous state recorded\n" if $verbose && !$pkg->{'previous_state'}; + print " State changed at $pkg->{'state_change'}\n" + if $verbose && $pkg->{'state_change'}; + print " Previous state $pkg->{'previous_state'} left $pkg->{'state_time'} ago\n" + if $verbose && $pkg->{'previous_state'}; print " Previous failing reasons:\n ", join("\n ",split("\n",$pkg->{'old_failed'})), "\n" if $verbose && $pkg->{'old_failed'}; ++$cnt; $scnt{$pkg->{'state'}}++ if $state eq "all"; } - if ($state eq "all") { + if ($state eq "all" && !$printformat) { foreach (sort keys %scnt) { print "Total $scnt{$_} package(s) in state $_.\n"; } } - print "Total $cnt package(s)\n"; + print "Total $cnt package(s)\n" unless $printformat; } @@ -1909,6 +2028,20 @@ sub info_packages { my @firstkeys = qw(package version builder state section priority installed_version previous_state state_change); my @dists = $info_all_dists ? keys %conf::distributions : ($distribution); + my %beautykeys = ( 'package' => 'Package', 'version' => 'Version', 'builder' => 'Builder', + 'state' => 'State', 'section' => 'Section', 'priority' => 'Priority', + 'installed_version' => 'Installed-Version', 'previous_state' => 'Previous-State', + 'state_change' => 'State-Change', + 'bd_problem' => 'BD-Problem', + 'binary_nmu_changelog' => 'Binary-NMU-Changelog', 'binary_nmu_version' => 'Binary-NMU-Version', + 'buildpri' => 'BuildPri', 'depends' => 'Depends', 'failed' => 'Failed', + 'failed_category' => 'Failed-Category', 'notes' => 'Notes', + 'distribution' => 'Distribution', 'old_failed' => 'Old-Failed', + 'permbuildpri' => 'PermBuildPri', 'rel' => 'Rel', + 'calprio' => 'CalculatedPri', 'state_days' => 'State-Days', + 'successtime' => 'Success-build-time', + 'anytime' => 'Build-time' + ); foreach $name (@_) { $name =~ s/_.*$//; # strip version @@ -1930,15 +2063,7 @@ sub info_packages { $val = "\n$val" if isin( $key, qw(Failed Old-Failed)); $val =~ s/\n/\n /g; my $print_key = $key; - $print_key = 'Package' if ($key eq 'package'); - $print_key = 'Version' if ($key eq 'version'); - $print_key = 'Builder' if ($key eq 'builder'); - $print_key = 'State' if ($key eq 'state'); - $print_key = 'Section' if ($key eq 'section'); - $print_key = 'Priority' if ($key eq 'priority'); - $print_key = 'Installed-Version' if ($key eq 'installed_version'); - $print_key = 'Previous-State' if ($key eq 'previous_state'); - $print_key = 'State-Change' if ($key eq 'state_change'); + $print_key = $beautykeys{$print_key} if $beautykeys{$print_key}; printf " %-20s: %s\n", $print_key, $val; } foreach $key (sort keys %$pkg) { @@ -1949,20 +2074,7 @@ sub info_packages { $val = "\n$val" if isin( $key, qw(Failed Old-Failed)); $val =~ s/\n/\n /g; my $print_key = $key; - $print_key = 'BD-Problem' if ($key eq 'bd_problem'); - $print_key = 'Binary-NMU-Changelog' if ($key eq 'binary_nmu_changelog'); - $print_key = 'Binary-NMU-Version' if ($key eq 'binary_nmu_version'); - $print_key = 'BuildPri' if ($key eq 'buildpri'); - $print_key = 'Depends' if ($key eq 'depends'); - $print_key = 'Failed' if ($key eq 'failed'); - $print_key = 'Failed-Category' if ($key eq 'failed_category'); - $print_key = 'Notes' if ($key eq 'notes'); - $print_key = 'Distribution' if ($key eq 'distribution'); - $print_key = 'Old-Failed' if ($key eq 'old_failed'); - $print_key = 'PermBuildPri' if ($key eq 'permbuildpri'); - $print_key = 'Rel' if ($key eq 'rel'); - $print_key = 'CalculatedPri' if ($key eq 'calprio'); - $print_key = 'Waiting-Days' if ($key eq 'waiting_days'); + $print_key = $beautykeys{$print_key} if $beautykeys{$print_key}; printf " %-20s: %s\n", $print_key, $val; } } @@ -2226,6 +2338,108 @@ sub build_deplist { return $result; } + +sub greparch { + my ($gapkglong, $gaarch) = @_; + my ($gapkg, $gaarchs) = split(/ \[/, $gapkglong); + if ($gaarchs) { + $_ = $gapkg; + chop($gaarchs); # take away the ] + my @gaarches = split(/ /, $gaarchs); + if (substr($gaarches[0], 0, 1) eq '!') { + return 0 if grep /^!$gaarch$/, @gaarches; + } else { # positive case + return 0 unless grep /^$gaarch$/, @gaarches; + } + }; + return 1; +} +sub filterarch { + my $faarch = $_[1]; + return join(', ', grep { &greparch($_, $faarch) } split(/, ?/, $_[0])); +} + +sub wb_edos_builddebcheck { +# Copyright (C) 2008 Ralf Treinen +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, version 2 of the License. +# integrated into wanna-builds code by Andreas Barth 2010 + + my $args = shift; + my $sourceprefix="source---"; + my $architecture=$args->{'arch'}; + my $edosoptions = "-failures -explain -quiet"; + my @packagefiles = $args->{'pkgs'}; + my $sourcesfile = $args->{'src'}; + + my $packagearch=""; + foreach my $packagefile (@packagefiles) { + open(P,$packagefile); + while (

) { + next unless /^Architecture/; + next if /^Architecture:\s*all/; + /Architecture:\s*([^\s]*)/; + if ($packagearch eq "") { + $packagearch = $1; + } elsif ( $packagearch ne $1) { + return "Package file contains different architectures: $packagearch, $1"; + } + } + close P; + } + + if ( $architecture eq "" ) { + if ( $packagearch eq "" ) { + return "No architecture option given, " . + "and no non-all architecture found in the Packages file"; + } else { + $architecture = $packagearch; + } + } else { + if ( $packagearch ne "" & $architecture ne $packagearch) { + return "Architecture option is $architecture ". + "but the package file contains architecture $packagearch"; + } + } + + print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @packagefiles); + open(RESULT, '-|', + "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @packagefiles)); + + my $explanation=""; + my $result={}; + my $binpkg=""; + + while () { +# 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) +# source---libcanberra (= 0.22-1~bpo50+1): FAILED +# source---libcanberra (= 0.22-1~bpo50+1) depends on missing: +# - libltdl-dev +# - libltdl7-dev (>= 2.2.6) + + if (/^\s+/) { + s/^(\s*)$sourceprefix(.*)depends on/$1$2build-depends on/o; + s/^(\s*)$sourceprefix(.*) and (.*) conflict/$1$2 build-conflicts with $3/o; + $explanation .= $_; + } else { + if (/^$sourceprefix(.*) \(.*\): FAILED/o) { + $result->{$binpkg} = $explanation if $binpkg; + $explanation = ""; + $binpkg = $1; + } # else something broken is happening + } + } + + close RESULT; + $result->{$binpkg} = $explanation if $binpkg; + return $result; + +} + + sub call_edos_depcheck { my $packagesfile = shift; my $srcs = shift; @@ -2248,47 +2462,40 @@ sub call_edos_depcheck { #print "I would look at these sources with edos-depcheck:\n"; #print join " ", keys %interesting_packages,"\n"; + return unless %interesting_packages; - 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"; + my $tmpfile_pattern = "/tmp/wanna-build-interesting-sources-$distribution.$$-XXXXX"; + use File::Temp qw/ tempfile /; + my ($SOURCES, $tmpfile) = tempfile( $tmpfile_pattern, UNLINK => 1 ); 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"; + # we print the source files as binary ones (with "source---"-prefixed), + # so we can try if these "binary" packages are installable. + # 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'}, $arch); + print $SOURCES "Depends: $t\n" if $t; + my $u = &filterarch($srcs->{$key}{'conf'}, $arch); + print $SOURCES "Conflicts: $u\n" if $u; + 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'; + close $SOURCES; + my $edosresults = wb_edos_builddebcheck({'arch' => $arch, 'pkgs' => [$packagesfile], 'src' => $tmpfile}); + if (ref($edosresults) eq 'HASH') { + foreach my $key (keys %$edosresults) { if (exists $interesting_packages{$key}) { - $interesting_packages{$key} = $reason; + $interesting_packages{$key} = $edosresults->{$key}; } 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." + # if $edosresults isn't an hash, then something went wrong and the string is the error message + print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" . + "all packages have installable build-dependencies." } unlink( $tmpfile ); @@ -2402,18 +2609,26 @@ sub transactions_table_name { return '"' . $arch . $schema_suffix . '".transactions'; } +sub pkg_history_table_name { + return '"' . $arch . $schema_suffix . '".pkg_history'; +} + sub get_readonly_source_info { my $name = shift; # SELECT FLOOR(EXTRACT('epoch' FROM age(localtimestamp, '2010-01-22 23:45')) / 86400) -- change to that? - my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as waiting_days FROM ' . - table_name() . ' WHERE package = ? AND distribution = ?', + my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days" + . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime" + . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime" + . " FROM " . table_name() + . ' WHERE package = ? AND distribution = ?'; + my $pkg = $dbh->selectrow_hashref( $q, undef, $name, $distribution); return $pkg; } sub get_source_info { my $name = shift; - my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as waiting_days FROM ' . + my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change)) as state_days FROM ' . table_name() . ' WHERE package = ? AND distribution = ?' . ' FOR UPDATE', undef, $name, $distribution); @@ -2423,19 +2638,35 @@ sub get_source_info { sub get_all_source_info { my %options = @_; - my $q = 'SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as waiting_days FROM ' . table_name() - . ' WHERE distribution = ? '; - my @args = ($distribution); + my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days" +# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime" +# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime" + . ", successtime.build_time as successtime, anytime.build_time as anytime" + . " FROM " . table_name() + . " left join ( " + . "select distinct on (package, distribution) build_time, package, distribution from ".pkg_history_table_name()." where result = 'successful' order by package, distribution, timestamp " + . " ) as successtime using (package, distribution) " + . " left join ( " + . "select distinct on (package, distribution) build_time, package, distribution from ".pkg_history_table_name()." order by package, distribution, timestamp desc" + . " ) as anytime using (package, distribution) " + . " WHERE TRUE "; + my @args = (); + if ($distribution) { + my @dists = split(/[, ]+/, $distribution); + $q .= ' AND ( distribution = ? '.(' OR distribution = ? ' x $#dists).' )'; + foreach my $d ( @dists ) { + push @args, ($d); + } + } if ($options{state} && uc($options{state}) ne "ALL") { $q .= ' AND upper(state) = ? '; push @args, uc($options{state}); } - if ($options{user}) { + if ($options{user} && uc($options{state}) ne "NEEDS-BUILD") { # if it's NEEDS-BUILD, we don't look at users #this basically means "this user, or no user at all": - $q .= ' AND (builder = ? OR upper(state) = ?)'; + $q .= " AND (builder = ? OR upper(state) = 'NEEDS-BUILD')"; push @args, $options{user}; - push @args, "NEEDS-BUILD"; } if ($options{category}) { @@ -2445,12 +2676,12 @@ sub get_all_source_info { } if ($options{list_min_age} > 0) { - $q .= ' AND age(state_change::timestamp) > ? '; + $q .= ' AND age(state_change) > ? '; push @args, $options{list_min_age} . " days"; } if ($options{list_min_age} < 0) { - $q .= ' AND age(state_change::timestamp) < ? '; + $q .= ' AND age(state_change) < ? '; push @args, -$options{list_min_age} . " days"; }