3 # wanna-build: coordination script for Debian buildds
4 # Copyright (C) 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
5 # Copyright (C) 2005-2008 Ryan Murray <rmurray@debian.org>
7 # This program is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU General Public License as
9 # published by the Free Software Foundation; either version 2 of the
10 # License, or (at your option) any later version.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
24 $basedir ||= "/var/lib/debbuild";
25 $dbbase ||= "build-db";
26 $transactlog ||= "transactions.log";
27 $mailprog ||= "/usr/sbin/sendmail";
28 require "/org/wanna-build/etc/wanna-build.conf";
29 die "$conf::basedir is not a directory\n" if ! -d $conf::basedir;
30 die "dbbase is empty\n" if ! $dbbase;
31 die "transactlog is empty\n" if ! $transactlog;
32 die "mailprog binary $conf::mailprog does not exist or isn't executable\n"
33 if !-x $conf::mailprog;
34 die "no distributions defined\n" if ! %distributions;
42 use lib '/org/wanna-build/bin';
46 use Hash::Merge qw ( merge );
48 our ($verbose, $mail_logs, $list_order, $list_state,
49 $curr_date, $op_mode, $user, $real_user, $distribution,
50 $fail_reason, $opt_override, $import_from, $export_to, $opt_create_db,
52 $info_all_dists, $arch,
53 $category, %catval, %short_category,
54 $short_date, $list_min_age, $dbbase, @curr_time,
55 $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc);
58 $ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/org/wanna-build/bin/";
63 $curr_date = strftime("%Y %b %d %H:%M:%S",@curr_time);
64 $short_date = strftime("%m/%d/%y",@curr_time);
67 # map program invocation names to operation modes
68 my %prognames = ( "uploaded-build" => "set-uploaded",
69 "failed-build" => "set-failed",
70 "no-build" => "set-not-for-us",
71 "give-back-build" => "set-needs-build",
72 "dep-wait-build" => "set-dep-wait",
73 "forget-build" => "forget",
74 "merge-quinn" => "merge-quinn",
75 "merge-packages" => "merge-packages",
76 "merge-sources" => "merge-sources",
77 "build-info" => "info" );
79 %short_category = ( u => "uploaded-fixed-pkg",
86 c => "compiler-error",
90 ($progname = $0) =~ s,.*/,,;
91 if ($prognames{$progname}) {
92 $op_mode = $prognames{$progname};
94 elsif ($progname =~ /^list-(.*)$/) {
96 $list_state = ($1 eq "all") ? "" : $1;
101 verbose => { short => "v", flag => \$verbose },
102 override => { short => "o", flag => \$opt_override },
103 "create-db" => { flag => \$opt_create_db },
104 "correct-compare" => { flag => \$WannaBuild::opt_correct_version_cmp },
105 # TODO: remove after buildds no longer pass to wanna-build
106 "no-propagation" => { short => "N" },
107 "no-down-propagation" => { short => "D" },
109 take => { mode => "set-building" },
110 failed => { short => "f", mode => "set-failed" },
111 uploaded => { short => "u", mode => "set-uploaded" },
112 "no-build" => { short => "n", mode => "set-not-for-us" },
113 built => { mode => "set-built" },
114 attempted => { mode => "set-attempted" },
115 "give-back" => { mode => "set-needs-build" },
116 "dep-wait" => { mode => "set-dep-wait" },
117 forget => { mode => "forget" },
118 'forget-user' => { mode => 'forget-user' },
119 "merge-quinn" => { mode => "merge-quinn" },
120 "merge-partial-quinn" => { mode => "merge-partial-quinn" },
121 "merge-packages" => { mode => "merge-packages" },
122 "merge-sources" => { mode => "merge-sources" },
123 "pretend-avail" => { short => "p", mode => "pretend-avail" },
124 "merge-all" => { mode => "merge-all" },
125 "merge-all-secondary" => { mode => "merge-all-secondary" },
126 info => { short => "i", mode => "info" },
127 'binNMU' => { mode => 'set-binary-nmu', arg => \$binNMUver,
128 code => sub { die "Invalid binNMU version: $binNMUver\n"
129 if $binNMUver !~ /^([\d]*)$/ and $1 >= 0; } },
130 'perm-build-priority' => { mode => "set-permanent-build-priority", arg => \$build_priority,
131 code => sub { die "Invalid build priority: $build_priority\n"
132 if $build_priority !~ /^-?[\d]+$/; } },
133 'build-priority' => { mode => "set-build-priority", arg => \$build_priority,
134 code => sub { die "Invalid build priority: $build_priority\n"
135 if $build_priority !~ /^-?[\d]+$/; } },
137 { short => "l", mode => "list", arg => \$list_state,
139 die "Unknown state to list: $list_state\n"
140 if !isin( $list_state, qw(needs-build building uploaded
141 built build-attempted failed installed dep-wait
142 not-for-us all failed-removed
143 install-wait reupload-wait bd-uninstallable));} },
146 { short => "d", arg => \$distribution,
148 if ($distribution eq "a" || $distribution eq "all") {
153 $distribution = "oldstable" if $distribution eq "o";
154 $distribution = "stable" if $distribution eq "s";
155 $distribution = "testing" if $distribution eq "t";
156 $distribution = "unstable" if $distribution eq "u";
160 { short => "O", arg => \$list_order,
162 die "Bad ordering character\n"
163 if $list_order !~ /^[PSpsncbCW]+$/;
165 message => { short => "m", arg => \$fail_reason },
166 # database is deprecated, use arch instead.
167 database => { short => "b", arg => \$conf::dbbase },
168 arch => { short => "A", arg => \$arch },
169 user => { short => "U", arg => \$user },
170 category => { short => "c", arg => \$category,
172 $category = $short_category{$category}
173 if exists $short_category{$category};
174 die "Unknown category: $category\n"
175 if !isin( $category, values %short_category );
177 "min-age" => { short => "a", arg => \$list_min_age,
179 die "Argument of --min-age must be a non-zero number\n"
180 if $list_min_age == 0;
182 "max-age" => { arg => \$list_min_age,
184 die "Argument of --max-age must be a non-zero number\n"
185 if $list_min_age == 0;
189 export => { arg => \$export_to, mode => "export" },
190 import => { arg => \$import_from, mode => "import" },
191 "manual-edit" => { mode => "manual-edit" },
194 while( @ARGV && $ARGV[0] =~ /^-/ ) {
197 my($opt, $optname, $arg);
198 if (/^--([^=]+)(=|$)/) {
200 $opt = $options{$optname};
201 $arg = $1 if /^--\Q$optname\E=((.|\n)*)$/;
204 $optname = substr( $_, 1, 1 );
205 $opt = (grep { defined($_->{short}) ? $_->{short} eq $optname : 0} values %options)[0];
206 $arg = $1 if /^-$optname(.+)$/;
209 warn "Unknown option: --$1\n";
214 die "$optname option missing argument\n" if !@ARGV;
217 ${$opt->{arg}} = $arg;
219 elsif (defined $arg) {
220 die "Option $optname takes no argument\n";
224 die "Conflicting operation modes\n" if $op_mode;
225 $op_mode = $opt->{mode};
235 $op_mode = $category ? "set-failed" : "set-building"
236 if !$op_mode; # default operation
237 $list_order = $list_state eq "failed" ? 'fPcpsn' : 'PScpsn'
238 if !$list_order and $list_state;
239 $distribution ||= "unstable";
240 die "Bad distribution '$distribution'\n"
241 if !isin($distribution, keys %conf::distributions);
243 # If they didn't specify an arch, try to get it from database name which
244 # is in the form of $arch/build-db
245 # This is for backwards compatibity with older versions that didn't
246 # specify the arch yet.
247 $conf::dbbase =~ m#^([^/]+)#;
250 # TODO: Check that it's an known arch (for that dist), and give
254 my $version = '$Revision: db181a534e9d $ $Date: 2008/03/26 06:20:22 $ $Author: rmurray $';
255 $version =~ s/(^\$| \$ .*$)//g;
256 print "wanna-build $version for $distribution on $arch\n";
259 if (!@ARGV && !isin( $op_mode, qw(list merge-quinn merge-partial-quinn import export
260 merge-packages manual-edit
262 warn "No packages given.\n";
266 $real_user = (getpwuid($<))[0];
267 die "Can't determine your user name\n"
268 if $op_mode ne "list" && !$user &&
269 !($user = $real_user);
272 if ($op_mode eq "set-failed" && !$category) {
273 print "Enter reason for failing (end with '.' alone on ".
278 last if $line eq ".\n";
279 $fail_reason .= $line;
281 chomp( $fail_reason );
282 } elsif ($op_mode eq "set-dep-wait") {
283 print "Enter dependencies (one line):\n";
285 while( !$line && !eof(STDIN) ) {
286 chomp( $line = <STDIN> );
288 die "No dependencies given\n" if !$line;
289 $fail_reason = $line;
290 } elsif ($op_mode eq "set-binary-nmu" and $binNMUver > 0) {
291 print "Enter changelog entry (one line):\n";
293 while( !$line && !eof(STDIN) ) {
294 chomp( $line = <STDIN> );
296 die "No changelog entry given\n" if !$line;
297 $fail_reason = $line;
302 my $yamldir = "/org/wanna-build/etc/yaml";
303 my @files = ('wanna-build.yaml');
304 if ($user =~ /(buildd.*)-/) { push (@files, "$1.yaml") };
305 push ( @files, "$user.yaml");
306 foreach my $file (@files) {
307 if ($verbose >= 2) { print "Trying to read $file ...\n"; }
308 next unless -f $yamldir."/".$file;
309 if ($verbose >= 2) { print "Read $file ...\n"; }
310 my $m = YAML::Tiny->read( $yamldir."/".$file )->[0];
311 $yamlmap = merge($m, $yamlmap);
314 die "FATAL: no configuration found\n";
322 $dbh->disconnect or warn $dbh->errstr;
326 my $schema_suffix = '';
327 if (isin( $op_mode, qw(list info)) && $distribution !~ /security/ && !(not -t and $user =~ /-/)) {
328 $dbh = DBI->connect("DBI:Pg:service=wanna-build") ||
329 die "FATAL: Cannot open database: $DBI::errstr\n";
330 $schema_suffix = '_public';
334 $dbh = DBI->connect("DBI:Pg:service=wanna-build-privileged") ||
335 die "FATAL: Cannot open database: $DBI::errstr\n";
338 # TODO: This shouldn't be needed, file a bug.
339 $dbh->{pg_server_prepare} = 0;
341 $dbh->begin_work or die $dbh->errstr;
348 if ($mail_logs && $conf::log_mail) {
349 send_mail( $conf::log_mail,
350 "wanna-build $distribution state changes $curr_date",
351 "State changes at $curr_date for distribution ".
352 "$distribution:\n\n$mail_logs\n" );
360 SWITCH: foreach ($op_mode) {
362 add_packages( $1, @ARGV );
366 list_packages( $list_state );
370 info_packages( @ARGV );
373 /^forget-user/ && do {
374 die "This operation is restricted to admin users\n"
375 if (defined @conf::admin_users and
376 !isin( $real_user, @conf::admin_users));
377 forget_users( @ARGV );
381 forget_packages( @ARGV );
384 /^merge-partial-quinn/ && do {
385 die "This operation is restricted to admin users\n"
386 if (defined @conf::admin_users and
387 !isin( $real_user, @conf::admin_users));
392 /^merge-quinn/ && do {
393 die "This operation is restricted to admin users\n"
394 if (defined @conf::admin_users and
395 !isin( $real_user, @conf::admin_users));
400 /^merge-packages/ && do {
401 die "This operation is restricted to admin users\n"
402 if (defined @conf::admin_users and
403 !isin( $real_user, @conf::admin_users));
408 /^merge-sources/ && do {
409 die "This operation is restricted to admin users\n"
410 if (defined @conf::admin_users and
411 !isin( $real_user, @conf::admin_users));
416 /^pretend-avail/ && do {
417 pretend_avail( @ARGV );
420 /^merge-all$/ && do {
421 die "This operation is restricted to admin users\n"
422 if (defined @conf::admin_users and
423 !isin( $real_user, @conf::admin_users));
426 @ARGV = ( $ARGS[0] );
427 my $pkgs = parse_packages(0);
428 @ARGV = ( $ARGS[1] );
430 @ARGV = ( $ARGS[2] );
431 my $srcs = parse_sources(1);
432 call_edos_depcheck( $ARGS[0], $srcs );
435 /^merge-all-secondary/ && do {
436 die "This operation is restricted to admin users\n"
437 if (defined @conf::admin_users and
438 !isin( $real_user, @conf::admin_users));
439 # This is in case the chroot has multiple unrelated
440 # dist, for instance unstable and experimental.
441 # This is not for stable and proposed-updates.
442 # The second packages file contains a combination
443 # of all Packages files known to the buildd, the
444 # first only for the current dist.
447 @ARGV = ( $ARGS[0] );
448 my $pkgs = parse_packages(0);
449 @ARGV = ( $ARGS[3] );
450 my $pkgs = parse_packages(1);
451 @ARGV = ( $ARGS[1] );
453 @ARGV = ( $ARGS[2] );
454 my $srcs = parse_sources(1);
455 call_edos_depcheck( $ARGS[3], $srcs );
459 die "This operation is restricted to admin users\n"
460 if (defined @conf::admin_users and
461 !isin( $real_user, @conf::admin_users));
462 $dbh->do("DELETE from " . table_name() .
463 " WHERE distribution = ?", undef,
467 read_db( $import_from );
471 export_db( $export_to );
475 die "Unexpected operation mode $op_mode\n";
477 if (not -t and $user =~ /-/) {
478 my $userinfo = get_user_info($user);
479 if (!defined $userinfo)
481 add_user_info($user);
485 update_user_info($user);
491 my $newstate = shift;
492 my( $package, $name, $version, $ok, $reason );
494 foreach $package (@_) {
495 $package =~ s,^.*/,,; # strip path
496 $package =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension
497 $package =~ s/_[a-zA-Z\d-]+\.changes$//; # strip extension
498 if ($package =~ /^([\w\d.+-]+)_([\w\d:.+~-]+)/) {
499 ($name,$version) = ($1,$2);
502 warn "$package: can't extract package name and version ".
507 if ($op_mode eq "set-building") {
508 add_one_building( $name, $version );
510 elsif ($op_mode eq "set-built") {
511 add_one_built( $name, $version );
513 elsif ($op_mode eq "set-attempted") {
514 add_one_attempted( $name, $version );
516 elsif ($op_mode eq "set-uploaded") {
517 add_one_uploaded( $name, $version );
519 elsif ($op_mode eq "set-failed") {
520 add_one_failed( $name, $version );
522 elsif ($op_mode eq "set-not-for-us") {
523 add_one_notforus( $name, $version );
525 elsif ($op_mode eq "set-needs-build") {
526 add_one_needsbuild( $name, $version );
528 elsif ($op_mode eq "set-dep-wait") {
529 add_one_depwait( $name, $version );
531 elsif ($op_mode eq "set-build-priority") {
532 set_one_buildpri( $name, $version, 'buildpri' );
534 elsif ($op_mode eq "set-permanent-build-priority") {
535 set_one_buildpri( $name, $version, 'permbuildpri' );
537 elsif ($op_mode eq "set-binary-nmu") {
538 set_one_binnmu( $name, $version );
543 sub add_one_building {
549 my $pkg = get_source_info($name);
551 if ($pkg->{'state'} eq "Not-For-Us") {
553 $reason = "not suitable for this architecture";
555 elsif ($pkg->{'state'} =~ /^Dep-Wait/) {
557 $reason = "not all source dependencies available yet";
559 elsif ($pkg->{'state'} =~ /^BD-Uninstallable/) {
561 $reason = "source dependencies are not installable";
563 elsif ($pkg->{'state'} eq "Uploaded" &&
564 (version_lesseq($version, $pkg->{'version'}))) {
566 $reason = "already uploaded by $pkg->{'builder'}";
567 $reason .= " (in newer version $pkg->{'version'})"
568 if !version_eq($pkg, $version);
570 elsif ($pkg->{'state'} eq "Installed" &&
571 version_less($version,$pkg->{'version'})) {
573 print "$name: Warning: newer version $pkg->{'version'} ".
574 "already installed, but overridden.\n";
578 $reason = "newer version $pkg->{'version'} already in ".
579 "archive; doesn't need rebuilding";
580 print "$name: Note: If the following is due to an epoch ",
581 " change, use --override\n";
584 elsif ($pkg->{'state'} eq "Installed" &&
585 pkg_version_eq($pkg,$version)) {
587 $reason = "is up-to-date in the archive; doesn't need rebuilding";
589 elsif ($pkg->{'state'} eq "Needs-Build" &&
590 version_less($version,$pkg->{'version'})) {
592 print "$name: Warning: newer version $pkg->{'version'} ".
593 "needs building, but overridden.";
597 $reason = "newer version $pkg->{'version'} needs building, ".
601 elsif (isin($pkg->{'state'},qw(Building Built Build-Attempted))) {
602 if (version_less($pkg->{'version'},$version)) {
603 print "$name: Warning: Older version $pkg->{'version'} ",
604 "is being built by $pkg->{'builder'}\n";
605 if ($pkg->{'builder'} ne $user) {
606 send_mail( $pkg->{'builder'},
607 "package takeover in newer version",
608 "You are building package '$name' in ".
609 "version $version\n".
610 "(as far as I'm informed).\n".
611 "$user now has taken the newer ".
612 "version $version for building.".
613 "You can abort the build if you like.\n" );
618 print "User $pkg->{'builder'} had already ",
619 "taken the following package,\n",
620 "but overriding this as you request:\n";
621 send_mail( $pkg->{'builder'}, "package takeover",
622 "The package '$name' (version $version) that ".
623 "was taken by you\n".
624 "has been taken over by $user\n" );
626 elsif ($pkg->{'builder'} eq $user) {
627 print "$name: Note: already taken by you.\n";
628 print "$name: ok\n" if $verbose;
633 $reason = "already taken by $pkg->{'builder'}";
634 $reason .= " (in newer version $pkg->{'version'})"
635 if !version_eq($pkg->{'version'}, $version);
639 elsif ($pkg->{'state'} =~ /^Failed/ &&
640 pkg_version_eq($pkg, $version)) {
642 print "The following package previously failed ",
643 "(by $pkg->{'builder'})\n",
644 "but overriding this as you request:\n";
645 send_mail( $pkg->{'builder'}, "failed package takeover",
646 "The package '$name' (version $version) that ".
648 "and has failed previously has been taken over ".
650 if $pkg->{'builder'} ne $user;
654 $reason = "build of $version failed previously:\n ";
655 $reason .= join( "\n ", split( "\n", $pkg->{'failed'} ));
656 $reason .= "\nalso the package doesn't need builing"
657 if $pkg->{'state'} eq 'Failed-Removed';
663 if ($pkg->{'binary_nmu_version'}) {
664 print "$name: Warning: needs binary NMU $pkg->{'binary_nmu_version'}\n" .
665 "$pkg->{'binary_nmu_changelog'}\n";
668 print "$name: Warning: Previous version failed!\n"
669 if $pkg->{'previous_state'} =~ /^Failed/ ||
670 $pkg->{'state'} =~ /^Failed/;
672 change_state( \$pkg, 'Building' );
673 $pkg->{'package'} = $name;
674 $pkg->{'version'} = $version;
675 $pkg->{'builder'} = $user;
676 log_ta( $pkg, "--take" );
677 update_source_info($pkg);
678 print "$name: $ok\n" if $verbose;
681 print "$name: NOT OK!\n $reason\n";
685 sub add_one_attempted {
688 my $pkg = get_source_info($name);
690 if (!defined($pkg)) {
691 print "$name: not registered yet.\n";
695 if (($pkg->{'state'} ne "Building") && ($pkg->{'state'} ne "Build-Attempted")) {
696 print "$name: not taken for building (state is $pkg->{'state'}). ",
700 if ($pkg->{'builder'} ne $user) {
701 print "$name: not taken by you, but by $pkg->{'builder'}. Skipping.\n";
704 elsif ( !pkg_version_eq($pkg, $version) ) {
705 print "$name: version mismatch ".
706 "$(pkg->{'version'} ".
707 "by $pkg->{'builder'})\n";
711 change_state( \$pkg, 'Build-Attempted' );
712 log_ta( $pkg, "--attempted" );
713 update_source_info($pkg);
714 print "$name: registered as uploaded\n" if $verbose;
720 my $pkg = get_source_info($name);
722 if (!defined($pkg)) {
723 print "$name: not registered yet.\n";
727 if (($pkg->{'state'} ne "Building") && ($pkg->{'state'} ne "Build-Attempted")) {
728 print "$name: not taken for building (state is $pkg->{'state'}). ",
732 if ($pkg->{'builder'} ne $user) {
733 print "$name: not taken by you, but by $pkg->{'builder'}. Skipping.\n";
736 elsif ( !pkg_version_eq($pkg, $version) ) {
737 print "$name: version mismatch ".
738 "$(pkg->{'version'} ".
739 "by $pkg->{'builder'})\n";
742 change_state( \$pkg, 'Built' );
743 log_ta( $pkg, "--built" );
744 update_source_info($pkg);
745 print "$name: registered as built\n" if $verbose;
748 sub add_one_uploaded {
751 my $pkg = get_source_info($name);
753 if (!defined($pkg)) {
754 print "$name: not registered yet.\n";
758 if ($pkg->{'state'} eq "Uploaded" &&
759 pkg_version_eq($pkg,$version)) {
760 print "$name: already uploaded\n";
763 if (!isin( $pkg->{'state'}, qw(Building Built Build-Attempted))) {
764 print "$name: not taken for building (state is $pkg->{'state'}). ",
768 if ($pkg->{'builder'} ne $user) {
769 print "$name: not taken by you, but by $pkg->{'builder'}. Skipping.\n";
772 # strip epoch -- buildd-uploader used to go based on the filename.
773 # (to remove at some point)
775 ($pkgver = $pkg->{'version'}) =~ s/^\d+://;
776 $version =~ s/^\d+://; # for command line use
777 if ($pkg->{'binary_nmu_version'} ) {
778 my $nmuver = binNMU_version($pkgver, $pkg->{'binary_nmu_version'});
779 if (!version_eq( $nmuver, $version )) {
780 print "$name: version mismatch ($nmuver registered). ",
784 } elsif (!version_eq($pkgver, $version)) {
785 print "$name: version mismatch ($pkg->{'version'} registered). ",
790 change_state( \$pkg, 'Uploaded' );
791 log_ta( $pkg, "--uploaded" );
792 update_source_info($pkg);
793 print "$name: registered as uploaded\n" if $verbose;
800 my $pkg = get_source_info($name);
802 if (!defined($pkg)) {
803 print "$name: not registered yet.\n";
806 $state = $pkg->{'state'};
808 if ($state eq "Not-For-Us") {
809 print "$name: not suitable for this architecture anyway. Skipping.\n";
812 elsif ($state eq "Failed-Removed") {
813 print "$name: failed previously and doesn't need building. Skipping.\n";
816 elsif ($state eq "Installed") {
817 print "$name: Is already installed in archive. Skipping.\n";
820 elsif ($pkg->{'builder'} &&
821 (($user ne $pkg->{'builder'}) &&
822 !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user))) {
823 print "$name: not taken by you, but by ".
824 "$pkg->{'builder'}. Skipping.\n";
827 elsif ( !pkg_version_eq($pkg, $version) ) {
828 print "$name: version mismatch ".
829 "$(pkg->{'version'} ".
830 "by $pkg->{'builder'})\n";
835 if (!$cat && $fail_reason =~ /^\[([^\]]+)\]/) {
837 $cat = $short_category{$cat} if exists $short_category{$cat};
838 if (!isin( $cat, values %short_category )) {
839 print "$name: Warning: unknown category $cat; discarded\n";
842 $fail_reason =~ s/^\[[^\]]+\][ \t]*\n*//;
845 if ($state eq "Needs-Build") {
846 print "$name: Warning: not registered for building previously, ".
847 "but processing anyway.\n";
849 elsif ($state eq "Uploaded") {
850 print "$name: Warning: marked as uploaded previously, ".
851 "but processing anyway.\n";
853 elsif ($state eq "Dep-Wait") {
854 print "$name: Warning: marked as waiting for dependencies, ".
855 "but processing anyway.\n";
857 elsif ($state eq "BD-Uninstallable") {
858 print "$name: Warning: marked as having uninstallable build-dependencies, ".
859 "but processing anyway.\n";
861 elsif ($state eq "Failed") {
862 print "$name: already registered as failed; will append new message\n"
864 print "$name: already registered as failed; changing category\n"
868 if (($cat eq "reminder-sent" || $cat eq "nmu-offered") &&
869 defined $pkg->{'failed_category'} &&
870 $pkg->{'failed_category'} ne $cat) {
871 (my $action = $cat) =~ s/-/ /;
872 $fail_reason .= "\n$short_date: $action";
875 change_state( \$pkg, 'Failed' );
876 $pkg->{'builder'} = $user;
877 $pkg->{'failed'} .= "\n" if $pkg->{'failed'};
878 $pkg->{'failed'} .= $fail_reason;
879 $pkg->{'failed_category'} = $cat if $cat;
880 if (defined $pkg->{'permbuildpri'}) {
881 $pkg->{'buildpri'} = $pkg->{'permbuildpri'};
883 delete $pkg->{'buildpri'};
885 log_ta( $pkg, "--failed" );
886 update_source_info($pkg);
887 print "$name: registered as failed\n" if $verbose;
890 sub add_one_notforus {
893 my $pkg = get_source_info($name);
895 if ($pkg->{'state'} eq 'Not-For-Us') {
896 # reset Not-For-Us state in case it's called twice; this is
897 # the only way to get a package out of this state...
898 # There is no really good state in which such packages should
899 # be put :-( So use Failed for now.
900 change_state( \$pkg, 'Failed' );
901 $pkg->{'package'} = $name;
902 $pkg->{'failed'} = "Was Not-For-Us previously";
903 delete $pkg->{'builder'};
904 delete $pkg->{'depends'};
905 log_ta( $pkg, "--no-build(rev)" );
906 print "$name: now not unsuitable anymore\n";
908 send_mail( $conf::notforus_maint,
909 "$name moved out of Not-For-Us state",
910 "The package '$name' has been moved out of the Not-For-Us ".
912 "It should probably also be removed from ".
913 "Packages-arch-specific or\n".
914 "the action was wrong.\n" )
915 if $conf::notforus_maint;
918 change_state( \$pkg, 'Not-For-Us' );
919 $pkg->{'package'} = $name;
920 delete $pkg->{'builder'};
921 delete $pkg->{'depends'};
922 delete $pkg->{'buildpri'};
923 delete $pkg->{'binary_nmu_version'};
924 delete $pkg->{'binary_nmu_changelog'};
925 log_ta( $pkg, "--no-build" );
926 print "$name: registered as unsuitable\n" if $verbose;
928 send_mail( $conf::notforus_maint,
929 "$name set to Not-For-Us",
930 "The package '$name' has been set to state Not-For-Us ".
932 "It should probably also be added to ".
933 "Packages-arch-specific or\n".
934 "the Not-For-Us state is wrong.\n" )
935 if $conf::notforus_maint;
937 update_source_info($pkg);
940 sub add_one_needsbuild {
944 my $pkg = get_source_info($name);
946 if (!defined($pkg)) {
947 print "$name: not registered; can't give back.\n";
950 $state = $pkg->{'state'};
952 if ($state eq "BD-Uninstallable") {
954 print "$name: Forcing uninstallability mark to be removed. This is not permanent and might be reset with the next trigger run\n";
956 change_state( \$pkg, 'Needs-Build' );
957 delete $pkg->{'builder'};
958 delete $pkg->{'depends'};
959 log_ta( $pkg, "--give-back" );
960 update_source_info($pkg);
961 print "$name: given back\n" if $verbose;
965 print "$name: has uninstallable build-dependencies. Skipping\n",
966 " (use --override to clear dependency list and ",
967 "give back anyway)\n";
971 elsif ($state eq "Dep-Wait") {
973 print "$name: Forcing source dependency list to be cleared\n";
976 print "$name: waiting for source dependencies. Skipping\n",
977 " (use --override to clear dependency list and ",
978 "give back anyway)\n";
982 elsif (!isin( $state, qw(Building Built Build-Attempted))) {
983 print "$name: not taken for building (state is $state).";
985 print "\n$name: Forcing give-back\n";
988 print " Skipping.\n";
992 if (defined ($pkg->{'builder'}) && $user ne $pkg->{'builder'} &&
993 !($pkg->{'builder'} =~ /^(\w+)-\w+/ && $1 eq $user) &&
995 print "$name: not taken by you, but by ".
996 "$pkg->{'builder'}. Skipping.\n";
999 if (!pkg_version_eq($pkg, $version)) {
1000 print "$name: version mismatch ($pkg->{'version'} registered). ",
1004 if ($distribution eq "unstable") {
1005 change_state( \$pkg, 'BD-Uninstallable' );
1006 $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet";
1008 change_state( \$pkg, 'Needs-Build' );
1010 $pkg->{'builder'} = undef;
1011 $pkg->{'depends'} = undef;
1012 log_ta( $pkg, "--give-back" );
1013 update_source_info($pkg);
1014 print "$name: given back\n" if $verbose;
1017 sub set_one_binnmu {
1019 my $version = shift;
1020 my $pkg = get_source_info($name);
1023 if (!defined($pkg)) {
1024 print "$name: not registered; can't register for binNMU.\n";
1027 my $db_ver = $pkg->{'version'};
1029 if (!version_eq($db_ver, $version)) {
1030 print "$name: version mismatch ($db_ver registered). ",
1034 $state = $pkg->{'state'};
1036 if (defined $pkg->{'binary_nmu_version'}) {
1037 if ($binNMUver == 0) {
1038 change_state( \$pkg, 'Installed' );
1039 delete $pkg->{'builder'};
1040 delete $pkg->{'depends'};
1041 delete $pkg->{'binary_nmu_version'};
1042 delete $pkg->{'binary_nmu_changelog'};
1043 } elsif ($binNMUver <= $pkg->{'binary_nmu_version'}) {
1044 print "$name: already building binNMU $pkg->{'binary_nmu_version'}\n";
1047 $pkg->{'binary_nmu_version'} = $binNMUver;
1048 $pkg->{'binary_nmu_changelog'} = $fail_reason;
1049 $pkg->{'notes'} = 'out-of-date';
1050 $pkg->{'buildpri'} = $pkg->{'permbuildpri'}
1051 if (defined $pkg->{'permbuildpri'});
1053 log_ta( $pkg, "--binNMU" );
1054 update_source_info($pkg);
1056 } elsif ($binNMUver == 0) {
1057 print "${name}_$version: no scheduled binNMU to cancel.\n";
1061 if ($state ne 'Installed') {
1062 print "${name}_$version: not installed; can't register for binNMU.\n";
1066 my $fullver = binNMU_version($version,$binNMUver);
1067 if ( version_lesseq( $fullver, $pkg->{'installed_version'} ) )
1069 print "$name: binNMU $fullver is not newer than current version $pkg->{'installed_version'}\n";
1073 if ($distribution eq "unstable") {
1074 change_state( \$pkg, 'BD-Uninstallable' );
1075 $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet";
1079 change_state( \$pkg, 'Needs-Build' );
1081 delete $pkg->{'builder'};
1082 delete $pkg->{'depends'};
1083 $pkg->{'binary_nmu_version'} = $binNMUver;
1084 $pkg->{'binary_nmu_changelog'} = $fail_reason;
1085 $pkg->{'notes'} = 'out-of-date';
1086 log_ta( $pkg, "--binNMU" );
1087 update_source_info($pkg);
1088 print "${name}: registered for binNMU $fullver\n" if $verbose;
1091 sub set_one_buildpri {
1093 my $version = shift;
1095 my $pkg = get_source_info($name);
1098 if (!defined($pkg)) {
1099 print "$name: not registered; can't set priority.\n";
1102 $state = $pkg->{'state'};
1104 if ($state eq "Not-For-Us") {
1105 print "$name: not suitable for this architecture. Skipping.\n";
1107 } elsif ($state eq "Failed-Removed") {
1108 print "$name: failed previously and doesn't need building. Skipping.\n";
1111 if (!pkg_version_eq($pkg, $version)) {
1112 print "$name: version mismatch ($pkg->{'version'} registered). ",
1116 if ( $build_priority == 0 ) {
1117 delete $pkg->{'buildpri'}
1118 if $key eq 'permbuildpri' and defined $pkg->{'buildpri'}
1119 and $pkg->{'buildpri'} == $pkg->{$key};
1120 delete $pkg->{$key};
1122 $pkg->{'buildpri'} = $build_priority
1123 if $key eq 'permbuildpri';
1124 $pkg->{$key} = $build_priority;
1126 update_source_info($pkg);
1127 print "$name: set to build priority $build_priority\n" if $verbose;
1130 sub add_one_depwait {
1132 my $version = shift;
1134 my $pkg = get_source_info($name);
1136 if (!defined($pkg)) {
1137 print "$name: not registered yet.\n";
1140 $state = $pkg->{'state'};
1142 if ($state eq "Dep-Wait") {
1143 print "$name: merging with previously registered dependencies\n";
1146 if (isin( $state, qw(Needs-Build Failed BD-Uninstallable))) {
1147 print "$name: Warning: not registered for building previously, ".
1148 "but processing anyway.\n";
1150 elsif ($state eq "Not-For-Us") {
1151 print "$name: not suitable for this architecture anyway. Skipping.\n";
1154 elsif ($state eq "Failed-Removed") {
1155 print "$name: failed previously and doesn't need building. Skipping.\n";
1158 elsif ($state eq "Installed") {
1159 print "$name: Is already installed in archive. Skipping.\n";
1162 elsif ($state eq "Uploaded") {
1163 print "$name: Is already uploaded. Skipping.\n";
1166 elsif ($pkg->{'builder'} &&
1167 $user ne $pkg->{'builder'}) {
1168 print "$name: not taken by you, but by ".
1169 "$pkg->{'builder'}. Skipping.\n";
1172 elsif ( !pkg_version_eq($pkg,$version)) {
1173 print "$name: version mismatch ".
1174 "($pkg->{'version'} ".
1175 "by $pkg->{'builder'})\n";
1178 elsif ($fail_reason =~ /^\s*$/ ||
1179 !parse_deplist( $fail_reason, 1 )) {
1180 print "$name: Bad dependency list\n";
1183 change_state( \$pkg, 'Dep-Wait' );
1184 $pkg->{'builder'} = $user;
1185 if (defined $pkg->{'permbuildpri'}) {
1186 $pkg->{'buildpri'} = $pkg->{'permbuildpri'};
1188 delete $pkg->{'buildpri'};
1190 my $deplist = parse_deplist( $pkg->{'depends'} );
1191 my $new_deplist = parse_deplist( $fail_reason );
1192 # add new dependencies, maybe overwriting old entries
1193 foreach (keys %$new_deplist) {
1194 $deplist->{$_} = $new_deplist->{$_};
1196 $pkg->{'depends'} = build_deplist($deplist);
1197 log_ta( $pkg, "--dep-wait" );
1198 update_source_info($pkg);
1199 print "$name: registered as waiting for dependencies\n" if $verbose;
1209 my $db = get_all_source_info();
1211 local($/) = ""; # read in paragraph mode
1213 my( $version, $arch, $section, $priority, $builddep, $buildconf, $binaries );
1215 /^Package:\s*(\S+)$/mi and $name = $1;
1216 /^Version:\s*(\S+)$/mi and $version = $1;
1217 /^Architecture:\s*(\S+)$/mi and $arch = $1;
1218 /^Section:\s*(\S+)$/mi and $section = $1;
1219 /^Priority:\s*(\S+)$/mi and $priority = $1;
1220 /^Build-Depends:\s*(.*)$/mi and $builddep = $1;
1221 /^Build-Conflicts:\s*(.*)$/mi and $buildconf = $1;
1222 /^Binary:\s*(.*)$/mi and $binaries = $1;
1224 next if (defined $srcver{$name} and version_less( $version, $srcver{$name} ));
1225 $srcver{$name} = $version;
1227 $pkgs{$name}{'ver'} = $version;
1228 $pkgs{$name}{'bin'} = $binaries;
1229 $pkgs{$name}{'dep'} = $builddep;
1230 $pkgs{$name}{'conf'} = $buildconf;
1231 my $pkg = $db->{$name};
1236 if ($arch eq "all" && !version_less( $version, $pkg->{'version'} )) {
1237 # package is now Arch: all, delete it from db
1238 change_state( \$pkg, 'deleted' );
1239 log_ta( $pkg, "--merge-sources" );
1240 print "$name ($pkg->{'version'}): deleted ".
1241 "from database, because now Arch: all\n"
1243 del_source_info($name);
1244 delete $db->{$name};
1248 # The "Version" should always be the source version --
1249 # not a possible binNMU version number.
1250 $pkg->{'version'} = $version, $change++
1251 if ($pkg->{'state'} eq 'Installed' and
1252 !version_eq( $pkg->{'version'}, $version));
1253 # Always update priority and section, if available
1254 $pkg->{'priority'} = $priority, $change++
1255 if defined $priority and (not defined($pkg->{'priority'}) or $pkg->{'priority'} ne $priority);
1257 $pkg->{'section'} = $section, $change++
1258 if defined $section and (not defined($pkg->{'section'}) or $pkg->{'section'} ne $section);
1260 update_source_info($pkg) if $change;
1263 # Now that we only have the latest source version, build the list
1264 # of binary packages from the Sources point of view
1265 foreach $name (keys %pkgs) {
1266 foreach my $bin (split( /\s*,\s*/, $pkgs{$name}{'bin'} ) ) {
1267 $merge_binsrc{$bin} = $name;
1270 # remove installed packages that no longer have source available
1271 # or binaries installed
1272 foreach $name (keys %$db) {
1273 next if $name =~ /^_/;
1274 my $pkg = $db->{$name};
1275 if (not defined($pkgs{$name})) {
1276 change_state( \$pkg, 'deleted' );
1277 log_ta( $pkg, "--merge-sources" );
1278 print "$name ($pkg->{'version'}): ".
1279 "deleted from database, because ".
1280 "not in Sources anymore\n"
1282 del_source_info($name);
1283 delete $db->{$name};
1285 next if !isin( $pkg->{'state'}, qw(Installed) );
1286 if ($full && not defined $merge_srcvers{$name}) {
1287 change_state( \$pkg, 'deleted' );
1288 log_ta( $pkg, "--merge-sources" );
1289 print "$name ($pkg->{'version'}): ".
1290 "deleted from database, because ".
1291 "binaries don't exist anymore\n"
1293 del_source_info($name);
1294 delete $db->{$name};
1295 } elsif ($full && version_less( $merge_srcvers{$name}, $pkg->{'version'})) {
1296 print "$name ($pkg->{'version'}): ".
1297 "package is Installed but binaries are from ".
1298 $merge_srcvers{$name}. "\n"
1306 # This function looks through a Packages file and sets the state of
1307 # packages to 'Installed'
1308 sub parse_packages {
1309 my $depwait_only = shift;
1312 my $pkgs = get_all_source_info();
1313 local($/) = ""; # read in paragraph mode
1315 my( $name, $version, $depends, $source, $sourcev, $architecture, $provides, $binaryv, $binnmu );
1317 /^Package:\s*(\S+)$/mi and $name = $1;
1318 /^Version:\s*(\S+)$/mi and $version = $1;
1319 /^Depends:\s*(.*)$/mi and $depends = $1;
1320 /^Source:\s*(\S+)(\s*\((\S+)\))?$/mi and ($source,$sourcev) = ($1, $3);
1321 /^Architecture:\s*(\S+)$/mi and $architecture = $1;
1322 /^Provides:\s*(.*)$/mi and $provides = $1;
1323 next if !$name || !$version;
1324 next if ($arch ne $architecture and $architecture ne "all");
1325 next if (defined ($installed->{$name}) and $installed->{$name}{'version'} ne "" and
1326 version_lesseq( $version, $installed->{$name}{'version'} ));
1327 $installed->{$name}{'version'} = $version;
1328 next if $depwait_only;
1329 $installed->{$name}{'depends'} = $depends;
1330 $installed->{$name}{'all'} = 1 if $architecture eq "all";
1331 undef $installed->{$name}{'Provider'};
1332 $installed->{$name}{'Source'} = $source ? $source : $name;
1334 foreach (split( /\s*,\s*/, $provides )) {
1335 if (not defined ($installed->{$_})) {
1336 $installed->{$_}{'version'} = "";
1337 $installed->{$_}{'Provider'} = $name;
1341 if ( $version =~ /\+b(\d+)$/ ) {
1344 $version = $sourcev if $sourcev;
1345 $binaryv = $version;
1346 $binaryv =~ s/\+b\d+$//;
1347 $installed->{$name}{'Sourcev'} = $sourcev ? $sourcev : $binaryv;
1348 $binaryv .= "+b$binnmu" if defined($binnmu);
1350 next if $architecture ne $arch;
1351 $name = $source if $source;
1352 next if defined($merge_srcvers{$name}) and $merge_srcvers{$name} eq $version;
1353 $merge_srcvers{$name} = $version;
1355 my $pkg = $pkgs->{$name};
1358 if (isin( $pkg->{'state'}, qw(Not-For-Us)) ||
1359 (isin($pkg->{'state'}, qw(Installed)) &&
1360 version_lesseq($binaryv, $pkg->{'installed_version'}))) {
1361 print "Skipping $name because State == $pkg->{'state'}\n"
1365 if ($pkg->{'binary_nmu_version'} ) {
1366 my $nmuver = binNMU_version($pkg->{'version'}, $pkg->{'binary_nmu_version'});
1367 if (version_less( $binaryv, $nmuver )) {
1368 print "Skipping $name ($version) because have newer ".
1369 "version ($nmuver) in db.\n"
1373 } elsif (version_less($version, $pkg->{'version'})) {
1374 print "Skipping $name ($version) because have newer ".
1375 "version ($pkg->{'version'}) in db.\n"
1380 if (!pkg_version_eq($pkg, $version) &&
1381 $pkg->{'state'} ne "Installed") {
1382 warn "Warning: $name: newer version than expected appeared ".
1383 "in archive ($version vs. $pkg->{'version'})\n";
1384 delete $pkg->{'builder'};
1387 if (!isin( $pkg->{'state'}, qw(Uploaded) )) {
1388 warn "Warning: Package $name was not in uploaded state ".
1389 "before (but in '$pkg->{'state'}').\n";
1390 delete $pkg->{'builder'};
1391 delete $pkg->{'depends'};
1395 $pkg->{'version'} = $version;
1398 change_state( \$pkg, 'Installed' );
1399 $pkg->{'package'} = $name;
1400 $pkg->{'installed_version'} = $binaryv;
1401 if (defined $pkg->{'permbuildpri'}) {
1402 $pkg->{'buildpri'} = $pkg->{'permbuildpri'};
1404 delete $pkg->{'buildpri'};
1406 $pkg->{'version'} = $version
1407 if version_less( $pkg->{'version'}, $version);
1408 delete $pkg->{'binary_nmu_version'};
1409 delete $pkg->{'binary_nmu_changelog'};
1410 log_ta( $pkg, "--merge-packages" );
1411 update_source_info($pkg);
1412 print "$name ($version) is up-to-date now.\n" if $verbose;
1415 check_dep_wait( "--merge-packages", $installed );
1420 my ($package, $name, $version, $installed);
1422 foreach $package (@_) {
1423 $package =~ s,^.*/,,; # strip path
1424 $package =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension
1425 $package =~ s/_[\w\d]+\.changes$//; # strip extension
1426 if ($package =~ /^([\w\d.+-]+)_([\w\d:.+~-]+)/) {
1427 ($name,$version) = ($1,$2);
1430 warn "$package: can't extract package name and version ".
1434 $installed->{$name}{'version'} = $version;
1437 check_dep_wait( "--pretend-avail", $installed );
1440 sub check_dep_wait {
1442 my $installed = shift;
1444 # check all packages in state Dep-Wait if dependencies are all
1447 my $db = get_all_source_info();
1448 foreach $name (keys %$db) {
1449 next if $name =~ /^_/;
1450 my $pkg = $db->{$name};
1451 next if $pkg->{'state'} ne "Dep-Wait";
1452 my $deps = $pkg->{'depends'};
1454 print "$name: was in state Dep-Wait, but with empty ",
1456 goto make_needs_build;
1458 my $deplist = parse_deplist($deps);
1462 foreach (keys %$deplist) {
1463 if (!exists $installed->{$_} ||
1464 ($deplist->{$_}->{'rel'} && $deplist->{$_}->{'version'} &&
1465 !version_compare( $installed->{$_}{'version'},
1466 $deplist->{$_}->{'rel'},
1467 $deplist->{$_}->{'version'}))) {
1469 $new_deplist->{$_} = $deplist->{$_};
1472 push( @removed_deps, $_ );
1477 change_state( \$pkg, 'Needs-Build' );
1478 log_ta( $pkg, $action );
1479 delete $pkg->{'builder'};
1480 delete $pkg->{'depends'};
1481 print "$name ($pkg->{'version'}) has all ",
1482 "dependencies available now\n" if $verbose;
1484 update_source_info($pkg);
1486 elsif (@removed_deps) {
1487 $pkg->{'depends'} = build_deplist( $new_deplist );
1488 print "$name ($pkg->{'version'}): some dependencies ",
1489 "(@removed_deps) available now, but not all yet\n"
1491 update_source_info($pkg);
1496 # This function accepts quinn-diff output (either from a file named on
1497 # the command line, or on stdin) and sets the packages named there to
1498 # state 'Needs-Build'.
1499 sub parse_quinn_diff {
1500 my $partial = shift;
1504 my $pkgs = get_all_source_info();
1508 next if !m,^([-\w\d/]*)/ # section
1509 ([-\w\d.+]+)_ # package name
1510 ([\w\d:.~+-]+)\.dsc\s* # version
1511 \[([^:]*): # priority
1512 ([^]]+)\]\s*$,x; # rest of notes
1513 my($section,$name,$version,$priority,$notes) = ($1, $2, $3, $4, $5);
1514 $quinn_pkgs{$name}++;
1515 $section ||= "unknown";
1516 $priority ||= "unknown";
1517 $priority = "unknown" if $priority eq "-";
1518 $priority = "standard" if ($name eq "debian-installer");
1520 my $pkg = $pkgs->{$name};
1522 # Always update section and priority.
1523 if (defined($pkg)) {
1525 $pkg->{'section'} = $section, $change++ if not defined
1526 $pkg->{'section'} or $section ne "unknown";
1527 $pkg->{'priority'} = $priority, $change++ if not defined
1528 $pkg->{'priority'} or $priority ne "unknown";
1531 if (defined($pkg) &&
1532 $pkg->{'state'} =~ /^Dep-Wait/ &&
1533 version_less( $pkg->{'version'}, $version )) {
1534 change_state( \$pkg, 'Dep-Wait' );
1535 $pkg->{'version'} = $version;
1536 delete $pkg->{'binary_nmu_version'};
1537 delete $pkg->{'binary_nmu_changelog'};
1538 log_ta( $pkg, "--merge-quinn" );
1540 print "$name ($version) still waiting for dependencies.\n"
1543 elsif (defined($pkg) &&
1544 $pkg->{'state'} =~ /-Removed$/ &&
1545 version_eq($pkg->{'version'}, $version)) {
1546 # reinstantiate a package that has been removed earlier
1547 # (probably due to a quinn-diff malfunction...)
1548 my $newstate = $pkg->{'state'};
1549 $newstate =~ s/-Removed$//;
1550 change_state( \$pkg, $newstate );
1551 $pkg->{'version'} = $version;
1552 $pkg->{'notes'} = $notes;
1553 log_ta( $pkg, "--merge-quinn" );
1555 print "$name ($version) reinstantiated to $newstate.\n"
1558 elsif (defined($pkg) &&
1559 $pkg->{'state'} eq "Not-For-Us" &&
1560 version_less( $pkg->{'version'}, $version )) {
1561 # for Not-For-Us packages just update the version etc., but
1563 change_state( \$pkg, "Not-For-Us" );
1564 $pkg->{'package'} = $name;
1565 $pkg->{'version'} = $version;
1566 $pkg->{'notes'} = $notes;
1567 delete $pkg->{'builder'};
1568 log_ta( $pkg, "--merge-quinn" );
1570 print "$name ($version) still Not-For-Us.\n" if $verbose;
1572 elsif (!defined($pkg) ||
1573 $pkg->{'state'} ne "Not-For-Us" &&
1574 (version_less( $pkg->{'version'}, $version ) ||
1575 ($pkg->{'state'} eq "Installed" && version_less($pkg->{'installed_version'}, $version)))) {
1577 if (defined( $pkg->{'state'} ) && isin( $pkg->{'state'}, qw(Building Built Build-Attempted))) {
1578 send_mail( $pkg->{'builder'},
1579 "new version of $name (dist=$distribution)",
1580 "As far as I'm informed, you're currently ".
1581 "building the package $name\n".
1582 "in version $pkg->{'version'}.\n\n".
1583 "Now there's a new source version $version. ".
1584 "If you haven't finished\n".
1585 "compiling $name yet, you can stop it to ".
1586 "save some work.\n".
1587 "Just to inform you...\n".
1588 "(This is an automated message)\n" );
1589 print "$name: new version ($version) while building ".
1590 "$pkg->{'version'} -- sending mail ".
1591 "to builder ($pkg->{'builder'})\n"
1594 change_state( \$pkg, 'Needs-Build' );
1595 $pkg->{'package'} = $name;
1596 $pkg->{'version'} = $version;
1597 $pkg->{'section'} = $section;
1598 $pkg->{'priority'} = $priority;
1599 $pkg->{'notes'} = $notes;
1600 delete $pkg->{'builder'};
1601 delete $pkg->{'binary_nmu_version'};
1602 delete $pkg->{'binary_nmu_changelog'};
1603 log_ta( $pkg, "--merge-quinn" );
1606 print "$name ($version) needs rebuilding now.\n" if $verbose;
1608 elsif (defined($pkg) &&
1609 !version_eq( $pkg->{'version'}, $version ) &&
1610 isin( $pkg->{'state'}, qw(Installed Not-For-Us) )) {
1611 print "$name: skipping because version in db ".
1612 "($pkg->{'version'}) is >> than ".
1613 "what quinn-diff says ($version) ".
1614 "(state is $pkg->{'state'})\n"
1616 $dubious .= "$pkg->{'state'}: ".
1617 "db ${name}_$pkg->{'version'} >> ".
1618 "quinn $version\n" if !$partial;
1620 elsif ($verbose >= 2) {
1621 if ($pkg->{'state'} eq "Not-For-Us") {
1622 print "Skipping $name because State == ".
1623 "$pkg->{'state'}\n";
1625 elsif (!version_less($pkg->{'version'}, $version)) {
1626 print "Skipping $name because version in db ".
1627 "($pkg->{'version'}) is >= than ".
1628 "what quinn-diff says ($version)\n";
1631 update_source_info($pkg) if $change;
1635 send_mail( $conf::db_maint,
1636 "Dubious versions in " . table_name() . " "
1637 . $distribution . " table",
1638 "The following packages have a newer version in the ".
1639 "wanna-build database\n".
1640 "than what quinn-diff says, and this is strange for ".
1642 "It could be caused by a lame mirror, or the version ".
1643 "in the database\n".
1648 # Now re-check the DB for packages in states Needs-Build, Failed,
1649 # Dep-Wait or BD-Uninstallable and remove them if they're not listed
1650 # anymore by quinn-diff.
1653 my $db = get_all_source_info();
1654 foreach $name (keys %$db) {
1655 next if $name =~ /^_/;
1656 my $pkg = $db->{$name};
1657 next if defined $pkg->{'binary_nmu_version'};
1658 next if !isin( $pkg->{'state'},
1659 qw(Needs-Build Building Built Build-Attempted Uploaded Failed Dep-Wait BD-Uninstallable) );
1660 my $virtual_delete = $pkg->{'state'} eq 'Failed';
1662 if (!$quinn_pkgs{$name}) {
1663 change_state( \$pkg, $virtual_delete ?
1664 $pkg->{'state'}."-Removed" :
1666 log_ta( $pkg, "--merge-quinn" );
1667 print "$name ($pkg->{'version'}): ".
1668 ($virtual_delete ? "(virtually) " : "") . "deleted ".
1669 "from database, because not in quinn-diff anymore\n"
1671 if ($virtual_delete) {
1672 update_source_info($pkg);
1674 del_source_info($name);
1682 # for sorting priorities and sections
1684 %prioval = ( required => -5,
1692 'debian-installer' => -199,
1713 localizations => -178,
1714 interpreters => -177,
1739 electronics => -152,
1745 foreach my $i (keys %sectval) {
1746 $sectval{"contrib/$i"} = $sectval{$i}+40;
1747 $sectval{"non-free/$i"} = $sectval{$i}+80;
1749 $sectval{'unknown'} = -165;
1751 %catval = ( "none" => -20,
1752 "uploaded-fixed-pkg" => -19,
1753 "fix-expected" => -18,
1754 "reminder-sent" => -17,
1755 "nmu-offered" => -16,
1759 "compiler-error" => -12 );
1762 sub sort_list_func {
1763 my( $letter, $x, $ax, $bx );
1765 foreach $letter (split( "", $list_order )) {
1766 SWITCH: foreach ($letter) {
1768 $x = $b->{'calprio'} <=> $a->{'calprio'};
1769 return $x if $x != 0;
1773 $x = $b->{'state_days'} <=> $a->{'state_days'};
1774 return $x if $x != 0;
1778 $x = $b->{'buildpri'} <=> $a->{'buildpri'};
1779 return $x if $x != 0;
1783 $x = $prioval{$a->{'priority'}} <=> $prioval{$b->{'priority'}};
1784 return $x if $x != 0;
1788 $x = $sectval{$a->{'section'}} <=> $sectval{$b->{'section'}};
1789 return $x if $x != 0;
1793 $x = $a->{'package'} cmp $b->{'package'};
1794 return $x if $x != 0;
1798 $x = $a->{'builder'} cmp $b->{'builder'};
1799 return $x if $x != 0;
1803 $ax = ($a->{'notes'} =~ /^(out-of-date|partial)/) ? 0 :
1804 ($a->{'notes'} =~ /^uncompiled/) ? 2 : 1;
1805 $bx = ($b->{'notes'} =~ /^(out-of-date|partial)/) ? 0 :
1806 ($b->{'notes'} =~ /^uncompiled/) ? 2 : 1;
1808 return $x if $x != 0;
1812 my $ca = defined $a->{'failed_category'} ?
1813 $a->{'failed_category'} : "none";
1814 my $cb = defined $b->{'failed_category'} ?
1815 $b->{'failed_category'} : "none";
1816 $x = $catval{$ca} <=> $catval{$cb};
1817 return $x if $x != 0;
1821 my $pa = $prioval{$a->{'priority'}} >
1822 $prioval{'standard'};
1823 my $pb = $prioval{$b->{'priority'}} >
1824 $prioval{'standard'};
1826 return $x if $x != 0;
1834 sub calculate_prio {
1835 my $priomap = $yamlmap->{priority};
1837 $pkg->{'calprio'} = 0;
1838 foreach my $k (keys %{$priomap->{keys}}) {
1839 $pkg->{'calprio'} += $priomap->{keys}->{$k}{$pkg->{$k}} if $pkg->{$k} and $priomap->{keys}->{$k}{$pkg->{$k}};
1842 my $days = $pkg->{'state_days'};
1843 $days = $priomap->{'waitingdays'}->{'min'} if $priomap->{'waitingdays'}->{'min'} and $days < $priomap->{'waitingdays'}->{'min'};
1844 $days = $priomap->{'waitingdays'}->{'max'} if $priomap->{'waitingdays'}->{'max'} and $days > $priomap->{'waitingdays'}->{'max'};
1845 my $scale = $priomap->{'waitingdays'}->{'scale'} || 1;
1846 $pkg->{'calprio'} += $days * $scale;
1848 $pkg->{'calprio'} += $pkg->{'permbuildpri'} if $pkg->{'permbuildpri'};
1849 $pkg->{'calprio'} += $pkg->{'buildpri'} if $pkg->{'buildpri'};
1857 my( $name, $pkg, @list );
1862 my $db = get_all_source_info(state => $state, user => $user, category => $category, list_min_age => $list_min_age);
1863 foreach $name (keys %$db) {
1864 next if $name =~ /^_/;
1865 push @list, calculate_prio($db->{$name});
1868 foreach $pkg (sort sort_list_func @list) {
1869 print "$pkg->{'section'}/$pkg->{'package'}_$pkg->{'version'}";
1870 print ": $pkg->{'state'}"
1872 print " by $pkg->{'builder'}"
1873 if $pkg->{'state'} ne "Needs-Build" && $pkg->{'builder'};
1874 print " [$pkg->{'priority'}:$pkg->{'notes'}";
1875 print ":PREV-FAILED"
1876 if $pkg->{'previous_state'} =~ /^Failed/;
1877 print ":bp{" . $pkg->{'buildpri'} . "}"
1878 if defined $pkg->{'buildpri'};
1879 print ":binNMU{" . $pkg->{'binary_nmu_version'} . "}"
1880 if defined $pkg->{'binary_nmu_version'};
1881 print ":calprio{". $pkg->{'calprio'}."}";
1882 print ":days{". $pkg->{'state_days'}."}";
1884 print " Reasons for failing:\n",
1886 defined $pkg->{'failed_category'} ? $pkg->{'failed_category'} : "none",
1888 join("\n ",split("\n",$pkg->{'failed'})), "\n"
1889 if $pkg->{'state'} =~ /^Failed/;
1890 print " Dependencies: $pkg->{'depends'}\n"
1891 if $pkg->{'state'} eq "Dep-Wait";
1892 print " Reasons for BD-Uninstallable:\n ",
1893 join("\n ",split("\n",$pkg->{'bd_problem'})), "\n"
1894 if $pkg->{'state'} eq "BD-Uninstallable";
1895 print " Previous state was $pkg->{'previous_state'} until ",
1896 "$pkg->{'state_change'}\n"
1897 if $verbose && $pkg->{'previous_state'};
1898 print " Previous state $pkg->{'previous_state'} left $pkg->{'state_time'} ago\n"
1899 if $verbose && $pkg->{'previous_state'};
1900 print " No previous state recorded\n"
1901 if $verbose && !$pkg->{'previous_state'};
1902 print " Previous failing reasons:\n ",
1903 join("\n ",split("\n",$pkg->{'old_failed'})), "\n"
1904 if $verbose && $pkg->{'old_failed'};
1906 $scnt{$pkg->{'state'}}++ if $state eq "all";
1908 if ($state eq "all") {
1909 foreach (sort keys %scnt) {
1910 print "Total $scnt{$_} package(s) in state $_.\n";
1913 print "Total $cnt package(s)\n";
1918 my( $name, $pkg, $key, $dist );
1919 my @firstkeys = qw(package version builder state section priority
1920 installed_version previous_state state_change);
1921 my @dists = $info_all_dists ? keys %conf::distributions : ($distribution);
1922 my %beautykeys = ( 'package' => 'Package', 'version' => 'Version', 'builder' => 'Builder',
1923 'state' => 'State', 'section' => 'Section', 'priority' => 'Priority',
1924 'installed_version' => 'Installed-Version', 'previous_state' => 'Previous-State',
1925 'state_change' => 'State-Change',
1926 'bd_problem' => 'BD-Problem',
1927 'binary_nmu_changelog' => 'Binary-NMU-Changelog', 'binary_nmu_version' => 'Binary-NMU-Version',
1928 'buildpri' => 'BuildPri', 'depends' => 'Depends', 'failed' => 'Failed',
1929 'failed_category' => 'Failed-Category', 'notes' => 'Notes',
1930 'distribution' => 'Distribution', 'old_failed' => 'Old-Failed',
1931 'permbuildpri' => 'PermBuildPri', 'rel' => 'Rel',
1932 'calprio' => 'CalculatedPri', 'state_days' => 'State-Days'
1935 foreach $name (@_) {
1936 $name =~ s/_.*$//; # strip version
1937 foreach $dist (@dists) {
1938 my $pname = "$name" . ($info_all_dists ? "($dist)" : "");
1940 $pkg = get_readonly_source_info($name);
1941 if (!defined( $pkg )) {
1942 print "$pname: not registered\n";
1945 $pkg = calculate_prio($pkg);
1948 foreach $key (@firstkeys) {
1949 next if !defined $pkg->{$key};
1950 my $val = $pkg->{$key};
1952 $val = "\n$val" if isin( $key, qw(Failed Old-Failed));
1954 my $print_key = $key;
1955 $print_key = $beautykeys{$print_key} if $beautykeys{$print_key};
1956 printf " %-20s: %s\n", $print_key, $val;
1958 foreach $key (sort keys %$pkg) {
1959 next if isin( $key, @firstkeys );
1960 my $val = $pkg->{$key};
1961 next if !defined($val);
1963 $val = "\n$val" if isin( $key, qw(Failed Old-Failed));
1965 my $print_key = $key;
1966 $print_key = $beautykeys{$print_key} if $beautykeys{$print_key};
1967 printf " %-20s: %s\n", $print_key, $val;
1973 sub forget_packages {
1974 my( $name, $pkg, $key, $data );
1976 foreach $name (@_) {
1977 $name =~ s/_.*$//; # strip version
1978 $pkg = get_source_info($name);
1979 if (!defined( $pkg )) {
1980 print "$name: not registered\n";
1985 foreach $key (sort keys %$pkg) {
1986 my $val = $pkg->{$key};
1989 $data .= sprintf " %-20s: %s\n", $key, $val;
1991 send_mail( $conf::db_maint,
1992 "$name deleted from DB " . table_name() . " " . $distribution,
1993 "The package '$name' has been deleted from the database ".
1995 "Data registered about the deleted package:\n".
1996 "$data\n" ) if $conf::db_maint;
1997 change_state( \$pkg, 'deleted' );
1998 log_ta( $pkg, "--forget" );
1999 del_source_info($name);
2000 print "$name: deleted from database\n" if $verbose;
2005 $dbh->do("DELETE from " . user_table_name() .
2006 " WHERE distribution = ?", undef, $distribution) or die $dbh->errstr;
2012 print "Reading ASCII database from $file..." if $verbose >= 1;
2013 open( F, "<$file" ) or
2014 die "Can't open database $file: $!\n";
2016 local($/) = ""; # read in paragraph mode
2018 my( %thispkg, $name );
2020 s/\n[ \t]+/\376\377/g; # fix continuation lines
2021 s/\376\377\s*\376\377/\376\377/og;
2023 while( /^(\S+):[ \t]*(.*)[ \t]*$/mg ) {
2024 my ($key, $val) = ($1, $2);
2026 $key =~ tr/A-Z/a-z/;
2027 $val =~ s/\376\377/\n/g;
2028 $thispkg{$key} = $val;
2030 check_entry( \%thispkg );
2032 if (exists($thispkg{'package'})) {
2033 update_source_info(\%thispkg);
2035 elsif(exists($thispkg{'user'})) {
2036 # user in import, username in database.
2037 $dbh->do('INSERT INTO ' . user_table_name() .
2038 ' (username, distribution, last_seen)' .
2039 ' values (?, ?, ?)',
2040 undef, $thispkg{'user'}, $distribution,
2041 $thispkg{'last_seen'})
2042 or die $dbh->errstr;
2046 print "done\n" if $verbose >= 1;
2053 return if $op_mode eq "manual-edit"; # no checks then
2055 # check for required fields
2056 if (exists $pkg->{'user'}) {
2059 if (!exists $pkg->{'package'}) {
2060 print STDERR "Bad entry: ",
2061 join( "\n", map { "$_: $pkg->{$_}" } keys %$pkg ), "\n";
2062 die "Database entry lacks package or username field\n";
2064 # if no State: field, generate one (for old db compat)
2065 if (!exists($pkg->{'state'})) {
2067 exists $pkg->{'failed'} ? 'Failed' : 'Building';
2069 if (!exists $pkg->{'version'} and $pkg->{'state'} ne 'Not-For-Us') {
2070 die "Database entry for $pkg->{'package'} lacks Version: field\n";
2073 die "Bad state $pkg->{'state'} of package $pkg->{Package}\n"
2074 if !isin( $pkg->{'state'},
2075 qw(Needs-Build Building Built Build-Attempted Uploaded Installed Dep-Wait Dep-Wait-Removed
2076 Failed Failed-Removed Not-For-Us BD-Uninstallable
2082 my($name,$pkg,$key);
2084 print "Writing ASCII database to $file..." if $verbose >= 1;
2085 open( F, ">$file" ) or
2086 die "Can't open export $file: $!\n";
2088 my $db = get_all_source_info();
2089 foreach $name (keys %$db) {
2090 next if $name =~ /^_/;
2091 my $pkg = $db->{$name};
2092 foreach $key (keys %{$pkg}) {
2093 my $val = $pkg->{$key};
2094 next if !defined($val);
2097 $val =~ s/^ +$/ ./mg;
2098 print F "$key: $val\n";
2103 print "done\n" if $verbose >= 1;
2109 my $newstate = shift;
2110 my $state = \$pkg->{'state'};
2112 return if defined($$state) and $$state eq $newstate;
2113 $pkg->{'previous_state'} = $$state if defined($$state);
2114 $pkg->{'state_change'} = $curr_date;
2115 $pkg->{'do_state_change'} = 1;
2117 if (defined($$state) and $$state eq 'Failed') {
2118 $pkg->{'old_failed'} =
2119 "-"x20 . " $pkg->{'version'} " . "-"x20 . "\n" .
2120 $pkg->{'failed'} . "\n" .
2121 $pkg->{'old_failed'};
2122 delete $pkg->{'failed'};
2123 delete $pkg->{'failed_category'};
2125 if (defined($$state) and $$state eq 'BD-Uninstallable') {
2126 delete $pkg->{'bd_problem'};
2128 $$state = $newstate;
2134 my $dist = $distribution;
2138 $prevstate = $pkg->{'previous_state'};
2139 $str = "$action($dist): $pkg->{'package'}_$pkg->{'version'} ".
2140 "changed from $prevstate to $pkg->{'state'} ".
2141 "by $real_user as $user";
2143 $dbh->do('INSERT INTO ' . transactions_table_name() .
2144 ' (package, distribution, version, action, ' .
2145 ' prevstate, state, real_user, set_user, time) ' .
2146 ' values (?, ?, ?, ?, ?, ?, ?, ?, ?)',
2147 undef, $pkg->{'package'}, $distribution,
2148 $pkg->{'version'}, $action, $prevstate, $pkg->{'state'},
2149 $real_user, $user, 'now()') or die $dbh->errstr;
2151 if (!($prevstate eq 'Failed' && $pkg->{'state'} eq 'Failed')) {
2152 $str .= " (with --override)"
2154 $mail_logs .= "$str\n";
2161 my $subject = shift;
2164 my $from = $conf::db_maint;
2165 my $domain = $conf::buildd_domain;
2167 $from .= "\@$domain" if $from !~ /\@/;
2169 $to .= '@' . $domain if $to !~ /\@/;
2170 $text =~ s/^\.$/../mg;
2171 local $SIG{'PIPE'} = 'IGNORE';
2172 open( PIPE, "| $conf::mailprog -oem $to" )
2173 or die "Can't open pipe to $conf::mailprog: $!\n";
2175 print PIPE "From: $from\n";
2176 print PIPE "Subject: $subject\n\n";
2177 print PIPE "$text\n";
2181 # for parsing input to dep-wait
2187 foreach (split( /\s*,\s*/, $deps )) {
2189 # verification requires > starting prompts, no | crap
2190 if (!/^(\S+)\s*(\(\s*(>(?:[>=])?)\s*(\S+)\s*\))?\s*$/) {
2195 my @alts = split( /\s*\|\s*/, $_ );
2196 # Anything with an | is ignored, as it can be configured on a
2197 # per-buildd basis what will be installed
2198 next if $#alts != 0;
2201 if (!/^(\S+)\s*(\(\s*(>=|=|==|>|>>|<<|<=)\s*(\S+)\s*\))?\s*$/) {
2202 warn( "parse_deplist: bad dependency $_\n" );
2205 my($dep, $rel, $relv) = ($1, $3, $4);
2206 $rel = ">>" if defined($rel) and $rel eq ">";
2207 $result{$dep}->{'package'} = $dep;
2208 if ($rel && $relv) {
2209 $result{$dep}->{'rel'} = $rel;
2210 $result{$dep}->{'version'} = $relv;
2213 return 1 if $verify;
2221 foreach $key (keys %$list) {
2222 $result .= ", " if $result;
2224 $result .= " ($list->{$key}->{'rel'} $list->{$key}->{'version'})"
2225 if $list->{$key}->{'rel'} && $list->{$key}->{'version'};
2230 sub call_edos_depcheck {
2231 my $packagesfile = shift;
2235 return if defined ($conf::distributions{$distribution}{noadw});
2237 # We need to check all of needs-build, as any new upload could make
2238 # something in needs-build have uninstallable deps
2239 # We also check everything in bd-uninstallable, as any new upload could
2240 # make that work again
2241 my %interesting_packages;
2242 my $db = get_all_source_info();
2243 foreach $key (keys %$db) {
2244 my $pkg = $db->{$key};
2245 if (defined $pkg and isin($pkg->{'state'}, qw/Needs-Build BD-Uninstallable/)) {
2246 $interesting_packages{$key} = undef;
2250 #print "I would look at these sources with edos-depcheck:\n";
2251 #print join " ", keys %interesting_packages,"\n";
2253 my $tmpfile_pattern = "/tmp/wanna-build-interesting-sources-$distribution.$$-";
2255 for( $i = 0;; ++$i ) {
2256 $tmpfile = $tmpfile_pattern . $i;
2257 last if ! -e $tmpfile;
2260 open SOURCES, '>', $tmpfile or die "Could not open temporary file $tmpfile\n";
2261 for my $key (keys %interesting_packages) {
2262 my $pkg = $db->{$key};
2263 print SOURCES "Package: $key\n";
2264 print SOURCES "Version: $pkg->{'version'}\n";
2265 print SOURCES "Build-Depends: $srcs->{$key}{'dep'}\n" if $srcs->{$key}{'dep'};
2266 print SOURCES "Build-Conflicts: $srcs->{$key}{'conf'}\n" if $srcs->{$key}{'conf'};
2267 print SOURCES "Architecture: all\n";
2272 if (open(EDOS,"-|","wb-edos-builddebcheck", "-a", $arch, $packagesfile, $tmpfile))
2274 local($/) = ""; # read in paragraph mode
2276 my( $key, $reason ) ;
2278 /^Package:\s*(\S+)$/mi and $key = $1;
2279 /^Failed-Why:(([^\n]|\n ([^\n]|\.))*)$/msi and $reason = $1;
2280 $reason =~ s/^\s*//mg;
2281 $reason ||= 'No reason given by edos-debcheck';
2283 if (exists $interesting_packages{$key}) {
2284 $interesting_packages{$key} = $reason;
2286 #print "TODO: edos reported a package we do not care about now\n" if $verbose;
2291 print "ERROR: Could not run wb-edos-builddebcheck. I am continuing, assuming\n" .
2292 "all packages have installable build-dependencies."
2297 for my $key (keys %interesting_packages) {
2298 my $pkg = $db->{$key};
2300 (defined $interesting_packages{$key} and $pkg->{'state'} eq 'Needs-Build') ||
2301 (not defined $interesting_packages{$key} and $pkg->{'state'} eq 'BD-Uninstallable');
2302 my $problemchange = $interesting_packages{$key} ne $pkg->{'bd_problem'};
2304 if (defined $interesting_packages{$key}) {
2305 change_state( \$pkg, 'BD-Uninstallable' );
2306 $pkg->{'bd_problem'} = $interesting_packages{$key};
2308 change_state( \$pkg, 'Needs-Build' );
2311 if ($problemchange) {
2312 if (defined $interesting_packages{$key}) {
2313 $pkg->{'bd_problem'} = $interesting_packages{$key};
2317 log_ta( $pkg, "--merge-all" );
2318 print "edos-builddebchange changed state of ${key}_$pkg->{'version'} to $pkg->{'state'}\n" if $verbose;
2320 if ($change || $problemchange) {
2321 update_source_info($pkg);
2328 ($prgname = $0) =~ s,^.*/,,;
2330 Usage: $prgname <options...> <package_version...>
2332 -v, --verbose: Verbose execution.
2333 -A arch: Architecture this operation is for.
2334 --take: Take package for building [default operation]
2335 -f, --failed: Record in database that a build failed due to
2336 deficiencies in the package (that aren't fixable without a new
2338 -u, --uploaded: Record in the database that the packages build
2339 correctly and were uploaded.
2340 -n, --no-build: Record in the database that the packages aren't
2341 desired for this architecture and shouldn't appear in listings even
2342 if they're out of date.
2343 --dep-wait: Record in the database that the packages are waiting
2344 for some source dependencies to become available
2345 --binNMU num: Schedule a re-build of the package with unchanged source, but
2346 a new version number (source-version + "+b<num>")
2347 --give-back: Mark a package as ready to build that is in state Building,
2348 Built or Build-Attempted. To give back a package in state Failed, use
2349 --override. This command will actually put the package in state
2350 BD-Uninstallable, until the installability of its Build-Dependencies
2351 were verified. This happens at each call of --merge-all, usually
2353 --merge-quinn: Merge quinn-diff output into database.
2354 --merge-packages: Merge Packages files into database.
2355 --pretend-avail: Pretend that given packages are available now and give
2356 free packages waiting for them
2357 -i SRC_PKG, --info SRC_PKG: Show information for source package
2358 -l STATE, --list=STATE: List all packages in state STATE; can be
2359 combined with -U to restrict to a specific user; STATE can
2361 -m MESSAGE, --message=MESSAGE: Give reason why package failed or
2362 source dependency list
2363 (used with -f, --dep-wait, and --binNMU)
2364 -o, --override: Override another user's lock on a package, i.e.
2365 take it over; a notice mail will be sent to the other user
2366 -U USER, --user=USER: select user name for which listings should
2367 apply, if not given all users are listed.
2368 if -l is missing, set user name to be entered in db; usually
2369 automatically choosen
2370 --import FILE: Import database from a ASCII file FILE
2371 --export FILE: Export database to a ASCII file FILE
2373 The remaining arguments (depending on operation) usually start with
2374 "name_version", the trailer is ignored. This allows to pass the names
2375 of .dsc files, for which file name completion can be used.
2376 --merge-packages and --merge-quinn take Package/quin--diff file names
2377 on the command line or read stdin. --list needs nothing more on the
2378 command line. --info takes source package names (without version).
2383 sub pkg_version_eq {
2385 my $version = shift;
2388 if (defined $pkg->{'binary_nmu_version'}) and
2389 version_compare(binNMU_version($pkg->{'version'},
2390 $pkg->{'binary_nmu_version'}),'=', $version);
2391 return version_compare( $pkg->{'version'}, "=", $version );
2395 return '"' . $arch . $schema_suffix . '".packages';
2398 sub user_table_name {
2399 return '"' . $arch . $schema_suffix . '".users';
2402 sub transactions_table_name {
2403 return '"' . $arch . $schema_suffix . '".transactions';
2406 sub get_readonly_source_info {
2408 # SELECT FLOOR(EXTRACT('epoch' FROM age(localtimestamp, '2010-01-22 23:45')) / 86400) -- change to that?
2409 my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as state_days FROM ' .
2410 table_name() . ' WHERE package = ? AND distribution = ?',
2411 undef, $name, $distribution);
2415 sub get_source_info {
2417 my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as state_days FROM ' .
2418 table_name() . ' WHERE package = ? AND distribution = ?' .
2420 undef, $name, $distribution);
2424 sub get_all_source_info {
2427 my $q = 'SELECT *, '.
2428 'extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as state_days, '.
2429 'date_trunc(\'seconds\', now() - state_change::timestamp) as state_time'.
2430 ' FROM ' . table_name()
2431 . ' WHERE distribution = ? ';
2432 my @args = ($distribution);
2433 if ($options{state} && uc($options{state}) ne "ALL") {
2434 $q .= ' AND upper(state) = ? ';
2435 push @args, uc($options{state});
2438 if ($options{user}) {
2439 #this basically means "this user, or no user at all":
2440 $q .= ' AND (builder = ? OR upper(state) = ?)';
2441 push @args, $options{user};
2442 push @args, "NEEDS-BUILD";
2445 if ($options{category}) {
2446 $q .= ' AND failed_category <> ? AND upper(state) = ? ';
2447 push @args, $options{category};
2448 push @args, "FAILED";
2451 if ($options{list_min_age} > 0) {
2452 $q .= ' AND age(state_change::timestamp) > ? ';
2453 push @args, $options{list_min_age} . " days";
2456 if ($options{list_min_age} < 0) {
2457 $q .= ' AND age(state_change::timestamp) < ? ';
2458 push @args, -$options{list_min_age} . " days";
2461 my $db = $dbh->selectall_hashref($q, 'package', undef, @args);
2465 sub update_source_info {
2468 my $pkg2 = get_source_info($pkg->{'package'});
2469 if (! defined $pkg2)
2471 add_source_info($pkg);
2474 $dbh->do('UPDATE ' . table_name() . ' SET ' .
2479 'installed_version = ?, ' .
2480 'previous_state = ?, ' .
2481 (($pkg->{'do_state_change'}) ? "state_change = now()," : "").
2485 'old_failed = ?, ' .
2486 'binary_nmu_version = ?, ' .
2487 'binary_nmu_changelog = ?, ' .
2488 'failed_category = ?, ' .
2489 'permbuildpri = ?, ' .
2494 'WHERE package = ? AND distribution = ?',
2500 $pkg->{'installed_version'},
2501 $pkg->{'previous_state'},
2505 $pkg->{'old_failed'},
2506 $pkg->{'binary_nmu_version'},
2507 $pkg->{'binary_nmu_changelog'},
2508 $pkg->{'failed_category'},
2509 $pkg->{'permbuildpri'},
2513 $pkg->{'bd_problem'},
2515 $distribution) or die $dbh->errstr;
2518 sub add_source_info {
2520 $dbh->do('INSERT INTO ' . table_name() .
2521 ' (package, distribution) values (?, ?)',
2522 undef, $pkg->{'package'}, $distribution) or die $dbh->errstr;
2525 sub del_source_info {
2527 $dbh->do('DELETE FROM ' . table_name() .
2528 ' WHERE package = ? AND distribution = ?',
2529 undef, $name, $distribution) or die $dbh->errstr;
2534 my $user = $dbh->selectrow_hashref('SELECT * FROM ' .
2535 user_table_name() . ' WHERE username = ? AND distribution = ?',
2536 undef, $name, $distribution);
2540 sub update_user_info {
2542 $dbh->do('UPDATE ' . user_table_name() .
2543 ' SET last_seen = now() WHERE username = ?' .
2544 ' AND distribution = ?',
2545 undef, $user, $distribution)
2546 or die $dbh->errstr;
2552 $dbh->do('INSERT INTO ' . user_table_name() .
2553 ' (username, distribution, last_seen)' .
2554 ' values (?, ?, now())',
2555 undef, $user, $distribution)
2556 or die $dbh->errstr;
2561 $dbh->do('LOCK TABLE ' . table_name() .
2562 ' IN EXCLUSIVE MODE', undef) or die $dbh->errstr;