~ubuntu-branches/ubuntu/karmic/sbuild/karmic-proposed

« back to all changes in this revision

Viewing changes to bin/buildd

  • Committer: Bazaar Package Importer
  • Author(s): Roger Leigh, Roger Leigh
  • Date: 2009-05-17 15:52:53 UTC
  • mfrom: (8.1.7 upstream) (3.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090517155253-fbxadfsyaf940ete
Tags: 0.58.3-1
[ Roger Leigh ]
* New release.
* debian/control:
  - Update to Standards Version 3.8.1.
  - Add buildd package.
  - Add libsbuild-perl package.
  - All packages depend upon libsbuild-perl.
* Add support for appending a tag to version numbers (Closes: #475777).
  Thanks to Timothy G Abbott for this patch.
* When using the --help or --version options, don't abort if not
  in the sbuild group (Closes: #523670).  Group membership is now
  only performed after options parsing, and only if required.
* Allow config files to use $HOME (Closes: #524564).  Thanks to
  James Vega for this patch.
* Restore buildd package.
* Split common library functions into new libsbuild-perl package.
* debian/sbuild.(preinst|postinst|postrm):
  - Remove special cases for versions older than oldstable.  Update
    addition and removal of sbuild group to use return value of getent
    rather than parsing getent output.
  - Use addgroup/delgroup in place of adduser/deluser.
  - Use --system when adding and deleting group, to ensure creation
    of a system group.  Migrate existing non-system group and group
    members if the system group is not present.
  - Handle removal of 50sbuild setup script.
* debian/buildd.(preinst|postinst|postrm): Add maintainer scripts for
  buildd package.  Move configuration file from /etc/buildd.conf to
  /etc/buildd/buildd.conf if present.  Also create buildd user and
  group for running the buildd daemon.
* Sbuild::Conf: Don't default MAINTAINER_NAME to $DEBEMAIL if unset
  in the configuration file (Closes: #520158).
* /etc/schroot/setup.d/50sbuild: Remove.  The setup tasks performed by
  this script are now handled internally by sbuild.

Show diffs side-by-side

added added

removed removed

Lines of Context:
2
2
#
3
3
# buildd: daemon to automatically build packages
4
4
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
 
5
# Copyright © 2009 Roger Leigh <rleigh@debian.org>
5
6
# Copyright © 2005 Ryan Murray <rmurray@debian.org>
6
7
#
7
8
# This program is free software: you can redistribute it and/or modify
20
21
#
21
22
#######################################################################
22
23
 
23
 
BEGIN {
24
 
    ($main::HOME = $ENV{'HOME'})
25
 
        or die "HOME not defined in environment!\n";
26
 
}
27
 
 
28
24
use strict;
29
25
use warnings;
30
 
use POSIX;
31
 
use Buildd;
 
26
 
 
27
use Buildd qw(open_log close_log);
32
28
use Buildd::Conf;
33
 
use Cwd;
34
 
 
35
 
sub ST_MTIME ();
36
 
sub get_from_REDO ($\%);
37
 
sub read_givenback ();
38
 
sub do_wanna_build ($\%@);
39
 
sub do_build ($\%@);
40
 
sub handle_prevfailed ($$);
41
 
sub get_changelog ($$);
42
 
sub df ($);
43
 
sub append_to_REDO ($$@);
44
 
sub read_FINISHED ();
45
 
sub shutdown ($);
46
 
sub check_restart ();
47
 
sub block_signals ();
48
 
sub unblock_signals ();
49
 
sub check_ssh_master ();
50
 
 
51
 
sub ST_MTIME () { 9 }
52
 
 
53
 
my @distlist = qw(oldstable-security stable-security testing-security stable testing unstable);
54
 
my $my_binary = $0;
55
 
$my_binary = cwd . "/" . $my_binary if $my_binary !~ m,^/,;
56
 
my @bin_stats = stat( $my_binary );
57
 
die "Cannot stat $my_binary: $!\n" if !@bin_stats;
58
 
my $my_bin_time = $bin_stats[ST_MTIME];
59
 
 
60
 
 
61
 
chdir( "$main::HOME/build" )
62
 
    or die "Can't cd to $main::HOME/build: $!\n";
63
 
 
64
 
open( STDIN, "</dev/null" )
65
 
    or die "$0: can't redirect stdin to /dev/null: $!\n";
66
 
 
67
 
if (open( PID, "<buildd.pid" )) {
68
 
    my $pid = <PID>;
69
 
    close( PID );
70
 
    $pid =~ /^(\d+)/; $pid = $1;
71
 
    if (!$pid || (kill( 0, $pid ) == 0 && $! == ESRCH)) {
72
 
        warn "Removing stale pid file (process $pid dead)\n";
73
 
    }
74
 
    else {
75
 
        die "Another buildd (pid $pid) is already running.\n";
76
 
    }
77
 
}
78
 
 
79
 
# Initialise the configuration.
80
 
Buildd::Conf::init();
81
 
 
82
 
@Buildd::Conf::take_from_dists
83
 
    or die "take_from_dists is empty, aborting.";
84
 
 
85
 
defined(my $pid = fork) or die "can't fork: $!\n";
86
 
exit if $pid; # parent exits
87
 
setsid or die "can't start a new session: $!\n";
88
 
 
89
 
open( PID, ">buildd.pid" )
90
 
    or die "can't create buildd.pid: $!\n";
91
 
printf PID "%5d\n", $$;
92
 
close( PID );
93
 
END { unlink( "buildd.pid" ) if (defined($pid) and $pid == 0); }
94
 
 
95
 
open_log();
96
 
 
97
 
logger( "Daemon started. (pid=$$)\n" );
98
 
 
 
29
use Buildd::Daemon;
 
30
use Sbuild::OptionsBase;
 
31
 
 
32
sub shutdown_fast ($);
 
33
sub shutdown($);
 
34
sub reread_config ($);
 
35
sub reopen_log ($);
 
36
 
 
37
my $conf = Buildd::Conf->new();
 
38
exit 1 if !defined($conf);
 
39
my $options = Sbuild::OptionsBase->new($conf, "buildd", "1");
 
40
exit 1 if !defined($options);
 
41
my $daemon = Buildd::Daemon->new($conf);
 
42
exit 1 if !defined($daemon);
 
43
 
 
44
my $log = open_log($daemon->get('Config'));
 
45
$daemon->set('Log Stream', $log);
 
46
 
 
47
# Global signal handling
99
48
foreach (qw(QUIT ILL TRAP ABRT BUS FPE USR2 SEGV PIPE XCPU XFSZ PWR)) {
100
 
    $SIG{$_} = sub ($) {
101
 
        my $signame = shift;
102
 
        logger( "buildd ($$) killed by SIG$signame\n" );
103
 
        unlink( "buildd.pid" );
104
 
        exit 1;
105
 
    };
 
49
    $SIG{$_} = \&shutdown_fast;
106
50
}
107
51
$SIG{'HUP'} = \&reopen_log;
 
52
$SIG{'USR1'} = \&reread_config;
108
53
$SIG{'INT'} = \&shutdown;
109
54
$SIG{'TERM'} = \&shutdown;
110
 
undef $ENV{'DISPLAY'};
111
 
 
112
 
# the main loop
113
 
my $dist;
114
 
MAINLOOP: while( 1 ) {
115
 
    check_restart();
116
 
    Buildd::Conf::check_reread_config();
117
 
    check_ssh_master();
118
 
 
119
 
    my $done = 0;
120
 
    my $thisdone;
121
 
    my %binNMUlog;
122
 
    do {
123
 
        $thisdone = 0;
124
 
        foreach $dist (@Buildd::Conf::take_from_dists) {
125
 
            check_restart();
126
 
            Buildd::Conf::check_reread_config();
127
 
            my @redo = get_from_REDO( $dist, %binNMUlog );
128
 
            next if !@redo;
129
 
            do_build( $dist, %binNMUlog, @redo );
130
 
            ++$done;
131
 
            ++$thisdone;
132
 
        }
133
 
    } while( $thisdone );
134
 
 
135
 
    foreach $dist (@Buildd::Conf::take_from_dists) {
136
 
        check_restart();
137
 
        Buildd::Conf::check_reread_config();
138
 
        my %givenback = read_givenback();
139
 
        if (!open( PIPE, "$Buildd::Conf::sshcmd wanna-build --list=needs-build --dist=$dist ".
140
 
                   ($Buildd::Conf::wanna_build_dbbase ?
141
 
                    "--database=$Buildd::Conf::wanna_build_dbbase ":"").
142
 
                   ($Buildd::Conf::wanna_build_user?"--user=$Buildd::Conf::wanna_build_user " : "")."2>&1 |" )) {
143
 
            logger( "Can't spawn wanna-build --list=needs-build: $!\n" );
144
 
            next MAINLOOP;
145
 
        }
146
 
        my(@todo, $total, $nonex, @lowprio_todo, $max_build);
147
 
        $max_build = $Buildd::Conf::max_build;
148
 
        while( <PIPE> ) {
149
 
            if ($Buildd::Conf::sshsocket and (/^Couldn't connect to $Buildd::Conf::sshsocket: Connection refused[\r]?$/ or
150
 
                                      /^Control socket connect\($Buildd::Conf::sshsocket\): Connection refused[\r]?$/)) {
151
 
                unlink( $Buildd::Conf::sshsocket );
152
 
                check_ssh_master();
153
 
            }
154
 
            elsif (/^Total (\d+) package/) {
155
 
                $total = $1;
156
 
                next;
157
 
            }
158
 
            elsif (/^Database for \S+ doesn.t exist/) {
159
 
                $nonex = 1;
160
 
            }
161
 
            next if $nonex;
162
 
            next if @todo >= $max_build;
163
 
            my @line = (split( /\s+/, $_));
164
 
            my $pv = $line[0];
165
 
            next if $Buildd::Conf::no_build_regex && $pv =~ m,$Buildd::Conf::no_build_regex,;
166
 
            next if $Buildd::Conf::build_regex && $pv !~ m,$Buildd::Conf::build_regex,;
167
 
            $pv =~ s,^.*/,,;
168
 
            my $p;
169
 
            ($p = $pv) =~ s/_.*$//;
170
 
            next if Buildd::isin( $p, @Buildd::Conf::no_auto_build );
171
 
            next if $givenback{$pv};
172
 
            if (Buildd::isin( $p, @Buildd::Conf::weak_no_auto_build )) {
173
 
                push( @lowprio_todo, $pv );
174
 
                next;
175
 
            }
176
 
            if ($line[1] =~ /:binNMU/) {
177
 
                $max_build = 1;
178
 
                @todo = ();
179
 
            }
180
 
            push( @todo, $pv );
181
 
        }
182
 
        close( PIPE );
183
 
        next if $nonex;
184
 
        if ($?) {
185
 
            logger( "wanna-build --list=needs-build --dist=$dist failed; status ",
186
 
                    exitstatus($?), "\n" );
187
 
            next;
188
 
        }
189
 
        logger( "$dist: total $total packages to build.\n" ) if $total;
190
 
        if ($total && $Buildd::Conf::secondary_daemon_threshold &&
191
 
            $total < $Buildd::Conf::secondary_daemon_threshold) {
192
 
            logger( "Not enough packages to build -- ".
193
 
                    "secondary daemon not starting\n" );
194
 
            next;
195
 
        }
196
 
 
197
 
        # Build weak_no_auto packages before the next dist
198
 
        if (!@todo && @lowprio_todo) {
199
 
            push ( @todo, @lowprio_todo );
200
 
        }
201
 
 
202
 
        next if !@todo;
203
 
        @todo = do_wanna_build( $dist, %binNMUlog, @todo );
204
 
        next if !@todo;
205
 
        do_build( $dist, %binNMUlog, @todo );
206
 
        ++$done;
207
 
        last;
208
 
    }
209
 
 
210
 
    # sleep a little bit if there was nothing to do this time
211
 
    if (!$done) {
212
 
        logger( "Nothing to do -- sleeping $Buildd::Conf::idle_sleep_time seconds\n" );
213
 
        my $idle_start_time = time;
214
 
        sleep( $Buildd::Conf::idle_sleep_time );
215
 
        my $idle_end_time = time;
216
 
        write_stats( "idle-time", $idle_end_time - $idle_start_time );
217
 
    }
218
 
}
219
 
 
220
 
sub get_from_REDO ($\%) {
221
 
    my $wanted_dist = shift;
222
 
    my $binNMUlog = shift;
223
 
    my @redo = ();
224
 
    local( *F );
225
 
 
226
 
    lock_file( "REDO" );
227
 
    goto end if ! -f "REDO";
228
 
    if (!open( F, "<REDO" )) {
229
 
        logger( "File REDO exists, but can't open it: $!\n" );
230
 
        goto end;
231
 
    }
232
 
    my @lines = <F>;
233
 
    close( F );
234
 
 
235
 
    block_signals();
236
 
    if (!open( F, ">REDO" )) {
237
 
        logger( "Can't open REDO for writing: $!\n",
238
 
                "Raw contents:\n@lines\n" );
239
 
        goto end;
240
 
    }
241
 
    my $max_build = $Buildd::Conf::max_build;
242
 
    foreach (@lines) {
243
 
        if (!/^(\S+)\s+(\S+)(?:\s*|\s+(\d+)\s+(\S.*))?$/) {
244
 
            logger( "Ignoring/deleting bad line in REDO: $_" );
245
 
            next;
246
 
        }
247
 
        my($pkg, $dist, $binNMUver, $changelog) = ($1, $2, $3, $4);
248
 
        if ($dist eq $wanted_dist && @redo < $max_build) {
249
 
            if (defined $binNMUver) {
250
 
                if (scalar(@redo) == 0) {
251
 
                    $binNMUlog->{$pkg} = $changelog;
252
 
                    push( @redo, "!$binNMUver!$pkg" );
253
 
                } else {
254
 
                    print F $_;
255
 
                }
256
 
                $max_build = scalar(@redo);
257
 
            } else {
258
 
                push( @redo, $pkg );
259
 
            }
260
 
        }
261
 
        else {
262
 
            print F $_;
263
 
        }
264
 
    }
265
 
    close( F );
266
 
 
267
 
  end:
268
 
    unlock_file( "REDO" );
269
 
    unblock_signals();
270
 
    return @redo;
271
 
}
272
 
 
273
 
sub read_givenback () {
274
 
    my %gb;
275
 
    my $now = time;
276
 
    local( *F );
277
 
 
278
 
    lock_file( "SBUILD-GIVEN-BACK" );
279
 
 
280
 
    if (open( F, "<SBUILD-GIVEN-BACK" )) {
281
 
        %gb = map { split } <F>;
282
 
        close( F );
283
 
    }
284
 
 
285
 
    if (open( F, ">SBUILD-GIVEN-BACK" )) {
286
 
        foreach (keys %gb) {
287
 
            if ($now - $gb{$_} > $Buildd::Conf::delay_after_give_back*60) {
288
 
                delete $gb{$_};
289
 
            }
290
 
            else {
291
 
                print F "$_ $gb{$_}\n";
292
 
            }
293
 
        }
294
 
        close( F );
295
 
    }
296
 
    else {
297
 
        logger( "Can't open SBUILD-GIVEN-BACK: $!\n" );
298
 
    }
299
 
 
300
 
  unlock:
301
 
    unlock_file( "SBUILD-GIVEN-BACK" );
302
 
    return %gb;
303
 
}
304
 
 
305
 
sub do_wanna_build ($\%@) {
306
 
    my $dist = shift;
307
 
    my $binNMUlog = shift;
308
 
    my @output = ();
309
 
    my $n = 0;
310
 
    local( *PIPE );
311
 
 
312
 
    block_signals();
313
 
    if (open( PIPE, "$Buildd::Conf::sshcmd wanna-build -v --no-down-propagation ".
314
 
              ($Buildd::Conf::wanna_build_dbbase?"--database=$Buildd::Conf::wanna_build_dbbase ":"").
315
 
              ($Buildd::Conf::wanna_build_user?"--user=$Buildd::Conf::wanna_build_user ":"").
316
 
              "--dist=$dist @_ 2>&1 |" )) {
317
 
        while( <PIPE> ) {
318
 
            next if /^wanna-build Revision/;
319
 
            if (/^(\S+):\s*ok/) {
320
 
                my $pkg = $1;
321
 
                push( @output, grep( /^\Q$pkg\E_/, @_ ) );
322
 
                ++$n;
323
 
            }
324
 
            elsif (/^(\S+):.*NOT OK/) {
325
 
                my $pkg = $1;
326
 
                my $nextline = <PIPE>;
327
 
                chomp( $nextline );
328
 
                $nextline =~ s/^\s+//;
329
 
                logger( "Can't take $pkg: $nextline\n" );
330
 
            }
331
 
            elsif (/^(\S+):.*previous version failed/i) {
332
 
                my $pkg = $1;
333
 
                ++$n;
334
 
                if ($Buildd::Conf::should_build_msgs) {
335
 
                    handle_prevfailed( $dist, grep( /^\Q$pkg\E_/, @_ ) );
336
 
                } else {
337
 
                    push( @output, grep( /^\Q$pkg\E_/, @_ ) );
338
 
                }
339
 
                # skip until ok line
340
 
                while( <PIPE> ) {
341
 
                    last if /^\Q$pkg\E:\s*ok/;
342
 
                }
343
 
            }
344
 
            elsif (/^(\S+):.*needs binary NMU (\d+)/) {
345
 
                my $pkg = $1;
346
 
                my $binNMUver = $2;
347
 
                chop (my $changelog = <PIPE>);
348
 
                my $newpkg;
349
 
                ++$n;
350
 
 
351
 
                push( @output, grep( /^\Q$pkg\E_/, @_ ) );
352
 
                $binNMUlog->{$output[$#output]} = $changelog;
353
 
                $output[$#output] = "!$binNMUver!" . $output[$#output];
354
 
                # skip until ok line
355
 
                while( <PIPE> ) {
356
 
                    last if /^\Q$pkg\E:\s*aok/;
357
 
                }
358
 
            }
359
 
        }
360
 
        close( PIPE );
361
 
        unblock_signals();
362
 
        write_stats( "taken", $n ) if $n;
363
 
        return @output;
364
 
    }
365
 
    else {
366
 
        unblock_signals();
367
 
        logger( "Can't spawn wanna-build: $!\n" );
368
 
        return ();
369
 
    }
370
 
}
371
 
 
372
 
sub do_build ($\%@) {
373
 
    my $dist = shift;
374
 
    my $binNMUlog = shift;
375
 
    return if !@_;
376
 
    my $free_space;
377
 
 
378
 
    while (($free_space = df(".")) < $Buildd::Conf::min_free_space) {
379
 
        logger( "Delaying build, because free space is low ($free_space KB)\n" );
380
 
        my $idle_start_time = time;
381
 
        sleep( 10*60 );
382
 
        my $idle_end_time = time;
383
 
        write_stats( "idle-time", $idle_end_time - $idle_start_time );
384
 
    }
385
 
 
386
 
    logger( "Starting build (dist=$dist) of:\n@_\n" );
387
 
    write_stats( "builds", scalar(@_) );
388
 
    my $binNMUver;
389
 
 
390
 
    my @sbuild_args = ( 'nice', '-n', "$Buildd::Conf::nice_level", 'sbuild',
391
 
                        '--apt-update',
392
 
                        '--batch',
393
 
                        "--stats-dir=$main::HOME/stats",
394
 
                        "--dist=$dist" );
395
 
    my $sbuild_gb = '--auto-give-back';
396
 
    if ($Buildd::Conf::sshcmd) {
397
 
        $sbuild_gb .= "=";
398
 
        $sbuild_gb .= "$Buildd::Conf::sshsocket\@" if $Buildd::Conf::sshsocket;
399
 
        $sbuild_gb .= "$Buildd::Conf::wanna_build_user\@" if $Buildd::Conf::wanna_build_user;
400
 
        $sbuild_gb .= "$main::sshuser\@" if $main::sshuser;
401
 
        $sbuild_gb .= "$main::sshhost";
402
 
    } else {
403
 
        # Otherwise newer sbuild will take the package name as an --auto-give-back
404
 
        # parameter (changed from regexp to GetOpt::Long parsing)
405
 
        $sbuild_gb .= "=yes"
406
 
    }
407
 
    push ( @sbuild_args, $sbuild_gb );
408
 
    push ( @sbuild_args, "--database=$Buildd::Conf::wanna_build_dbbase" )
409
 
        if $Buildd::Conf::wanna_build_dbbase;
410
 
 
411
 
    if (scalar(@_) == 1 and $_[0] =~ s/^!(\d+)!//) {
412
 
        $binNMUver = $1;
413
 
 
414
 
        push ( @sbuild_args, "--binNMU=$binNMUver", "--make-binNMU=" . $binNMUlog->{$_[0]});
415
 
    }
416
 
    logger( "command line: @sbuild_args @_\n" );
417
 
 
418
 
    if (($main::sbuild_pid = fork) == 0) {
419
 
        { exec (@sbuild_args, @_) };
420
 
        logger( "Cannot execute sbuild: $!\n" );
421
 
        exit(64);
422
 
    }
423
 
 
424
 
    if (!defined $main::sbuild_pid) {
425
 
        logger( "Cannot fork for sbuild: $!\n" );
426
 
        goto failed;
427
 
    }
428
 
    my $rc;
429
 
    while (($rc = wait) != $main::sbuild_pid) {
430
 
        if ($rc == -1) {
431
 
            last if $! == ECHILD;
432
 
            next if $! == EINTR;
433
 
            logger( "wait for sbuild: $!; continuing to wait\n" );
434
 
        } elsif ($rc != $main::sbuild_pid) {
435
 
            logger( "wait for sbuild: returned unexpected pid $rc\n" );
436
 
        }
437
 
    }
438
 
    undef $main::sbuild_pid;
439
 
 
440
 
    if ($?) {
441
 
        logger( "sbuild failed with status ".exitstatus($?)."\n" );
442
 
      failed:
443
 
        if (-f "SBUILD-REDO-DUMPED") {
444
 
            logger( "Found SBUILD-REDO-DUMPED; sbuild already dumped ",
445
 
                    "pkgs which need rebuiling/\n" );
446
 
            local( *F );
447
 
            my $n = 0;
448
 
            open( F, "<REDO" );
449
 
            while( <F> ) { ++$n; }
450
 
            close( F );
451
 
            write_stats( "builds", -$n );
452
 
        }
453
 
        elsif (-f "SBUILD-FINISHED") {
454
 
            my @finished = read_FINISHED();
455
 
            logger( "sbuild has already finished:\n@finished\n" );
456
 
            my @unfinished;
457
 
            for (@_) {
458
 
                push( @unfinished, $_ ) if !Buildd::isin( $_, @finished );
459
 
            }
460
 
            logger( "Adding rest to REDO:\n@unfinished\n" );
461
 
            append_to_REDO( $dist, '', @unfinished );
462
 
            write_stats( "builds", -scalar(@unfinished) );
463
 
        }
464
 
        else {
465
 
            if (defined $binNMUver) {
466
 
                logger( "Assuming binNMU failed and adding to REDO:\n@_\n" );
467
 
                append_to_REDO( $dist, "$binNMUver $binNMUlog->{$_[0]}", @_ ); 
468
 
            } else {
469
 
                logger( "Assuming all packages unbuilt and adding to REDO:\n@_\n" );
470
 
                append_to_REDO( $dist, '', @_ );
471
 
            }
472
 
            write_stats( "builds", -scalar(@_) );
473
 
        }
474
 
 
475
 
        delete $binNMUlog->{$_[0]} if defined $binNMUver;
476
 
 
477
 
        if (++$main::sbuild_fails > 2) {
478
 
            logger( "sbuild now failed $main::sbuild_fails times in ".
479
 
                    "a row; going to sleep\n" );
480
 
            send_mail( $Buildd::Conf::admin_mail,
481
 
                       "Repeated mess with sbuild",
482
 
                       <<EOF );
483
 
The execution of sbuild now failed for $main::sbuild_fails times.
484
 
Something must be wrong here...
485
 
 
486
 
The daemon is going to sleep for 1 hour, or can be restarted with SIGUSR2.
487
 
EOF
488
 
            my $oldsig;
489
 
            eval <<'EOF';
490
 
$oldsig = $SIG{'USR2'};
491
 
$SIG{'USR2'} = sub ($) { die "signal\n" };
492
 
my $idle_start_time = time;
493
 
sleep( 60*60 );
494
 
my $idle_end_time = time;
495
 
$SIG{'USR2'} = $oldsig;
496
 
write_stats( "idle-time", $idle_end_time - $idle_start_time );
497
 
EOF
498
 
        }
499
 
    }
500
 
    else {
501
 
        $main::sbuild_fails = 0;
502
 
    }
503
 
    unlink "SBUILD-REDO-DUMPED" if -f "SBUILD-REDO-DUMPED";
504
 
    logger( "Build finished.\n" );
505
 
}
506
 
 
507
 
sub handle_prevfailed ($$) {
508
 
    my $dist = shift;
509
 
    my $pkgv = shift;
510
 
    my( $pkg, $fail_msg, $changelog, $fail_cmd);
511
 
 
512
 
    logger( "$pkgv previously failed -- asking admin first\n" );
513
 
    ($pkg = $pkgv) =~ s/_.*$//;
514
 
    $fail_cmd = "$Buildd::Conf::sshcmd wanna-build ".($Buildd::Conf::wanna_build_dbbase?
515
 
                                              "--database=$Buildd::Conf::wanna_build_dbbase ":""). "--info --dist=$dist $pkg";
516
 
    $fail_msg = `$fail_cmd`;
517
 
 
518
 
    {
519
 
        local $SIG{'ALRM'} = sub ($) { die "Timeout!\n" };
520
 
        eval { $changelog = get_changelog( $dist, $pkgv ) };
521
 
    }
522
 
    $changelog = "ERROR: FTP timeout" if $@;
523
 
 
524
 
    send_mail( $Buildd::Conf::admin_mail,
525
 
               "Should I build $pkgv (dist=$dist)?",
526
 
               "The package $pkg failed to build in a previous version. ".
527
 
               "The fail\n".
528
 
               "messages are:\n\n$fail_msg\n".
529
 
               ($changelog !~ /^ERROR/ ?
530
 
                "The changelog entry for the newest version is:\n\n".
531
 
                "$changelog\n" :
532
 
                "Sorry, the last changelog entry could not be extracted:\n".
533
 
                "$changelog\n\n").
534
 
               "Should buildd try to build the new version, or should it ".
535
 
               "fail with the\n".
536
 
               "same messages again.? Please answer with 'build' (or 'ok'), ".
537
 
               "or 'fail'.\n" );
538
 
}
539
 
 
540
 
sub get_changelog ($$) {
541
 
    my $dist = shift;
542
 
    my $pkg = shift;
543
 
    my $changelog = "";
544
 
    my $analyze = "";
545
 
    my $chroot_apt_options;
546
 
    my $msg;
547
 
    my $file;
548
 
    my $retried = 0;
549
 
    local( *PIPE, *F );
550
 
 
551
 
    $pkg =~ /^([\w\d.+-]+)_([\w\d:.~+-]+)/;
552
 
    my ($n, $v) = ($1, $2);
553
 
    (my $v_ne = $v) =~ s/^\d+://;
554
 
    my $pkg_ne = "${n}_${v_ne}";
555
 
 
556
 
retry:
557
 
    my $schroot = "$Buildd::Conf::schroot -c $dist-$Buildd::Conf::arch-sbuild --";
558
 
    my $schroot_root = "$Buildd::Conf::schroot -c $dist-$Buildd::Conf::arch-sbuild -u root --";
559
 
    $msg = `$schroot $Buildd::Conf::apt_get -q -d --diff-only source $n=$v 2>&1`;
560
 
    if ($? == 0 && $msg !~ /get 0B/) {
561
 
        $analyze = "diff";
562
 
        $file = "${n}_${v_ne}.diff.gz";
563
 
    }
564
 
 
565
 
    if (!$analyze) {
566
 
        $msg = `$schroot $Buildd::Conf::apt_get -q -d --tar-only source $n=$v 2>&1`;
567
 
        if ($? == 0 && $msg !~ /get 0B/) {
568
 
            $analyze = "tar";
569
 
            $file = "${n}_${v_ne}.tar.gz";
570
 
        }
571
 
    }
572
 
 
573
 
    if (!$analyze && !$retried) {
574
 
        system "$schroot_root $Buildd::Conf::apt_get ".
575
 
            "-qq update &>/dev/null";
576
 
        $retried = 1;
577
 
        goto retry;
578
 
    }
579
 
 
580
 
    return "ERROR: cannot find any source" if !$analyze;
581
 
 
582
 
    if ($analyze eq "diff") {
583
 
        if (!open( F, "gzip -dc '$file' 2>/dev/null |" )) {
584
 
            return "ERROR: Cannot spawn gzip to zcat $file: $!";
585
 
        }
586
 
        while( <F> ) {
587
 
            # look for header line of a file */debian/changelog
588
 
            last if m,^\+\+\+\s+[^/]+/debian/changelog(\s+|$),;
589
 
        }
590
 
        while( <F> ) {
591
 
            last if /^---/; # end of control changelog patch
592
 
            next if /^\@\@/;
593
 
            $changelog .= "$1\n" if /^\+(.*)$/;
594
 
            last if /^\+\s+--\s+/;
595
 
        }
596
 
        while( <F> ) { } # read to end of file to avoid broken pipe
597
 
        close( F );
598
 
        if ($?) {
599
 
            return "ERROR: error status ".exitstatus($?)." from gzip on $file";
600
 
        }
601
 
        unlink( $file );
602
 
    }
603
 
    elsif ($analyze eq "tar") {
604
 
        if (!open( F, "tar -xzOf '$file' '*/debian/changelog' ".
605
 
                   "2>/dev/null |" )) {
606
 
            return "ERROR: Cannot spawn tar for $file: $!";
607
 
        }
608
 
        while( <F> ) {
609
 
            $changelog .= $_;
610
 
            last if /^\s+--\s+/;
611
 
        }
612
 
        while( <F> ) { } # read to end of file to avoid broken pipe
613
 
        close( F );
614
 
        if ($?) {
615
 
            return "ERROR: error status ".exitstatus($?)." from tar on $file";
616
 
        }
617
 
        unlink( $file );
618
 
    }
619
 
 
620
 
    return $changelog;
621
 
}
622
 
 
623
 
# TODO: Merge with sbuild function
624
 
sub df ($) {
625
 
    my $dir = shift;
626
 
 
627
 
    my $free = `/bin/df $dir | tail -1`;
628
 
    my @free = split( /\s+/, $free );
629
 
    return $free[3];
630
 
}
631
 
 
632
 
sub append_to_REDO ($$@) {
633
 
    my $dist = shift;
634
 
    my $postfix = shift;
635
 
    my @npkgs = @_;
636
 
    my @pkgs = ();
637
 
    my $pkg;
638
 
    local( *F );
639
 
 
640
 
    block_signals();
641
 
    lock_file( "REDO" );
642
 
 
643
 
    if (open( F, "REDO" )) {
644
 
        @pkgs = <F>;
645
 
        close( F );
646
 
    }
647
 
 
648
 
    if (open( F, ">>REDO" )) {
649
 
        foreach $pkg (@npkgs) {
650
 
            next if grep( /^\Q$pkg\E\s/, @pkgs );
651
 
            print F "$pkg ${dist}$postfix\n";
652
 
        }
653
 
        close( F );
654
 
    }
655
 
    else {
656
 
        logger( "Can't open REDO: $!\n" );
657
 
    }
658
 
 
659
 
  unlock:
660
 
    unlock_file( "REDO" );
661
 
    unblock_signals();
662
 
}
663
 
 
664
 
sub read_FINISHED () {
665
 
    local( *F );
666
 
    my @pkgs;
667
 
 
668
 
    if (!open( F, "<SBUILD-FINISHED" )) {
669
 
        logger( "Can't open SBUILD-FINISHED: $!\n" );
670
 
        return ();
671
 
    }
672
 
    chomp( @pkgs = <F> );
673
 
    close( F );
674
 
    unlink( "SBUILD-FINISHED" );
675
 
    return @pkgs;
 
55
 
 
56
exit $daemon->run();
 
57
 
 
58
sub shutdown_fast ($) {
 
59
    my $signame = shift;
 
60
    $daemon->log("buildd ($$) killed by SIG$signame\n")
 
61
        if defined($daemon);
 
62
    unlink( $conf->get('PIDFILE') );
 
63
    exit 1;
676
64
}
677
65
 
678
66
sub shutdown ($) {
679
67
    my $signame = shift;
680
68
 
681
 
    logger( "buildd ($$) received SIG$signame -- shutting down\n" );
 
69
    $daemon->log("buildd ($$) received SIG$signame -- shutting down\n")
 
70
        if defined($daemon);
 
71
 
682
72
    if (defined $main::ssh_pid) {
683
73
        kill ( 15, $main::ssh_pid );
684
74
    }
685
75
    if (defined $main::sbuild_pid) {
686
 
        logger( "Killing sbuild (pid=$main::sbuild_pid)\n" );
 
76
        $daemon->log("Killing sbuild (pid=$main::sbuild_pid)\n")
 
77
            if defined($daemon);
687
78
        kill( 15, $main::sbuild_pid );
688
 
        logger( "Waiting max. 2 minutes for sbuild to finish\n" );
 
79
        $daemon->log("Waiting max. 2 minutes for sbuild to finish\n")
 
80
            if defined($daemon);
689
81
        $SIG{'ALRM'} = sub ($) { die "timeout\n"; };
690
82
        alarm( 120 );
691
83
        eval "waitpid( $main::sbuild_pid, 0 )";
692
84
        alarm( 0 );
693
85
        if ($@) {
694
 
            logger( "sbuild did not die!" );
 
86
            $daemon->log("sbuild did not die!")
 
87
                if defined($daemon);
695
88
        }
696
89
        else {
697
 
            logger( "sbuild died normally" );
 
90
            $daemon->log("sbuild died normally")
 
91
                if defined($daemon);
698
92
        }
699
93
        unlink( "SBUILD-REDO-DUMPED" );
700
94
    }
701
 
    unlink( "buildd.pid" );
702
 
    logger( "exiting now\n" );
703
 
    close_log();
 
95
    unlink( $conf->get('PIDFILE') );
 
96
    $daemon->log("exiting now\n");
 
97
    close_log($conf);
704
98
    exit 1;
705
99
}
706
100
 
707
 
sub check_restart () {
708
 
    my @stats = stat( $my_binary );
709
 
 
710
 
    if (@stats && $my_bin_time != $stats[ST_MTIME]) {
711
 
        logger( "My binary has been updated -- restarting myself (pid=$$)\n" );
712
 
        unlink( "buildd.pid" );
713
 
        kill ( 15, $main::ssh_pid ) if $main::ssh_pid;
714
 
        exec $my_binary;
715
 
    }
716
 
 
717
 
    if ( -f "$main::HOME/EXIT-DAEMON-PLEASE" ) {
718
 
        unlink("$main::HOME/EXIT-DAEMON-PLEASE");
719
 
        &shutdown("NONE (flag file exit)");
720
 
    }
721
 
}
722
 
 
723
 
sub block_signals () {
724
 
    POSIX::sigprocmask( SIG_BLOCK, $main::block_sigset );
725
 
}
726
 
 
727
 
sub unblock_signals () {
728
 
    POSIX::sigprocmask( SIG_UNBLOCK, $main::block_sigset );
729
 
}
730
 
 
731
 
sub check_ssh_master () {
732
 
    return 1 if (!$Buildd::Conf::sshsocket);
733
 
    return 1 if ( -S $Buildd::Conf::sshsocket );
734
 
 
735
 
    if ($main::ssh_pid)
736
 
    {
737
 
        my $wpid = waitpid ( $main::ssh_pid, WNOHANG );
738
 
        return 1 if ($wpid != -1 and $wpid != $main::ssh_pid);
739
 
    }
740
 
 
741
 
    ($main::ssh_pid = fork)
742
 
        or exec "$Buildd::Conf::sshcmd -MN";
743
 
 
744
 
    if (!defined $main::ssh_pid) {
745
 
        logger( "Cannot fork for ssh master: $!\n" );
746
 
        return 0;
747
 
    }
748
 
 
749
 
    while ( ! -S $Buildd::Conf::sshsocket )
750
 
    {
751
 
        sleep 1;
752
 
        my $wpid = waitpid ( $main::ssh_pid, WNOHANG );
753
 
        return 0 if ($wpid == -1 or $wpid == $main::ssh_pid);
754
 
    }
755
 
    return 1;
 
101
sub reread_config ($) {
 
102
    my $signame = shift;
 
103
 
 
104
    $daemon->log("buildd ($$) received SIG$signame -- rereading configuration\n")
 
105
        if defined($daemon);
 
106
 
 
107
    $Buildd::Conf::reread_config = 1;
 
108
}
 
109
 
 
110
sub reopen_log ($) {
 
111
    my $signame = shift;
 
112
 
 
113
    $daemon->log("buildd ($$) received SIG$signame -- reopening logfile\n")
 
114
        if defined($daemon);
 
115
 
 
116
    Buildd::reopen_log($conf);
 
117
}
 
118
 
 
119
END {
 
120
    unlink( $conf->get('PIDFILE') )
 
121
        if (defined($conf) &&
 
122
            defined($daemon) &&
 
123
            $daemon->get('Daemon'));
756
124
}