← Back to branch summary

~ubuntu-branches/ubuntu/wily/libserver-starter-perl/wily-proposed

« back to all changes in this revision

Viewing changes to lib/Server/Starter.pm

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini, Salvatore Bonaccorso, Alessandro Ghedini
  • Date: 2013-07-26 20:30:46 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20130726203046-onl1xbn9mgf5kg9g
Tags: 0.15-1
[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs

[ Alessandro Ghedini ]
* New upstream release
* Build-Depends on libtest-tcp-perl

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Server/Starter.pm
15
15
 
16
16
use Exporter qw(import);
17
17
 
18
 
our $VERSION = '0.12';
 
18
our $VERSION = '0.15';
19
19
our @EXPORT_OK = qw(start_server restart_server server_ports);
20
20
 
21
21
my @signals_received;
46
46
    croak "mandatory option ``exec'' is missing or is not an arrayref\n"
47
47
        unless $opts->{exec} && ref $opts->{exec} eq 'ARRAY';
48
48
    
 
49
    # set envs
 
50
    $ENV{ENVDIR} = $opts->{envdir}
 
51
        if defined $opts->{envdir};
 
52
    $ENV{ENABLE_AUTO_RESTART} = $opts->{enable_auto_restart}
 
53
        if defined $opts->{enable_auto_restart};
 
54
    $ENV{KILL_OLD_DELAY} = $opts->{kill_old_delay}
 
55
        if defined $opts->{kill_old_delay};
 
56
    $ENV{AUTO_RESTART_INTERVAL} = $opts->{auto_restart_interval}
 
57
        if defined $opts->{auto_restart_interval};
 
58
    
49
59
    # open pid file
50
60
    my $pid_file_guard = sub {
51
61
        return unless $opts->{pid_file};
125
135
                or die "failed to remove existing socket file:$path:$!";
126
136
        }
127
137
        unlink $path;
 
138
        my $saved_umask = umask(0);
128
139
        my $sock = IO::Socket::UNIX->new(
129
140
            Listen => Socket::SOMAXCONN(),
130
141
            Local  => $path,
131
142
        ) or die "failed to listen to file $path:$!";
 
143
        umask($saved_umask);
132
144
        fcntl($sock, F_SETFD, my $flags = '')
133
145
            or die "fcntl(F_SETFD, 0) failed:$!";
134
146
        push @sockenv, "$path=" . $sock->fileno;
165
177
        };
166
178
    
167
179
    # the main loop
168
 
    my $term_signal;
 
180
    my $term_signal = 0;
169
181
    $current_worker = _start_worker($opts);
170
182
    $update_status->();
 
183
    my $auto_restart_interval = 0;
 
184
    my $last_restart_time = time();
 
185
    my $restart_flag = 0;
171
186
    while (1) {
172
 
        my @r = wait3(! scalar @signals_received);
173
 
        if (@r) {
174
 
            my ($died_worker, $status) = @r;
 
187
        _reload_env();
 
188
        if ($ENV{ENABLE_AUTO_RESTART}) {
 
189
            # restart workers periodically
 
190
            $auto_restart_interval = $ENV{AUTO_RESTART_INTERVAL} ||= 360;
 
191
        }
 
192
        sleep(1);
 
193
        my $died_worker = -1;
 
194
        my $status = -1;
 
195
        while (1) {
 
196
            $died_worker = waitpid(-1, WNOHANG);
 
197
            $status = $?;
 
198
            last if ($died_worker <= 0);
175
199
            if ($died_worker == $current_worker) {
176
200
                print STDERR "worker $died_worker died unexpectedly with status:$status, restarting\n";
177
201
                $current_worker = _start_worker($opts);
 
202
                $last_restart_time = time();
178
203
            } else {
179
204
                print STDERR "old worker $died_worker died, status:$status\n";
180
205
                delete $old_workers{$died_worker};
181
 
                $update_status->();
182
 
            }
183
 
        }
 
206
                # don't update the status file if restart is scheduled and died_worker is the last one
 
207
                if ($restart_flag == 0 || scalar(keys %old_workers) != 0) {
 
208
                    $update_status->();
 
209
                }
 
210
            }
 
211
        }
 
212
        if ($auto_restart_interval > 0 && scalar(@signals_received) == 0 &&
 
213
            time() > $last_restart_time + $auto_restart_interval) {
 
214
            print STDERR "autorestart triggered (interval=$auto_restart_interval)\n";
 
215
            $restart_flag = 1;
 
216
            if (time() > $last_restart_time + $auto_restart_interval * 2) {
 
217
                print STDERR "force autorestart triggered\n";
 
218
                $restart_flag = 2;
 
219
            }
 
220
        }
 
221
        my $num_old_workers = scalar(keys %old_workers);
184
222
        for (; @signals_received; shift @signals_received) {
185
223
            if ($signals_received[0] eq 'HUP') {
186
 
                print STDERR "received HUP, spawning a new worker\n";
187
 
                $old_workers{$current_worker} = $ENV{SERVER_STARTER_GENERATION};
188
 
                $current_worker = _start_worker($opts);
189
 
                $update_status->();
190
 
                print STDERR "new worker is now running, sending $opts->{signal_on_hup} to old workers:";
191
 
                if (%old_workers) {
192
 
                    print STDERR join(',', sort keys %old_workers), "\n";
193
 
                } else {
194
 
                    print STDERR "none\n";
195
 
                }
196
 
                kill $opts->{signal_on_hup}, $_
197
 
                    for sort keys %old_workers;
 
224
                print STDERR "received HUP (num_old_workers=$num_old_workers)\n";
 
225
                $restart_flag = 1;
198
226
            } else {
199
227
                $term_signal = $signals_received[0] eq 'TERM' ? $opts->{signal_on_term} : 'TERM';
200
228
                goto CLEANUP;
201
229
            }
202
230
        }
 
231
        if ($restart_flag > 1 || ($restart_flag > 0 && $num_old_workers == 0)) {
 
232
            print STDERR "spawning a new worker (num_old_workers=$num_old_workers)\n";
 
233
            $old_workers{$current_worker} = $ENV{SERVER_STARTER_GENERATION};
 
234
            $current_worker = _start_worker($opts);
 
235
            $last_restart_time = time();
 
236
            $restart_flag = 0;
 
237
            $update_status->();
 
238
            print STDERR "new worker is now running, sending $opts->{signal_on_hup} to old workers:";
 
239
            if (%old_workers) {
 
240
                print STDERR join(',', sort keys %old_workers), "\n";
 
241
            } else {
 
242
                print STDERR "none\n";
 
243
            }
 
244
            my $kill_old_delay = $ENV{KILL_OLD_DELAY} || 0;
 
245
            $kill_old_delay ||= 5 if $ENV{ENABLE_AUTO_RESTART};
 
246
            print STDERR "sleep $kill_old_delay secs\n";
 
247
            sleep($kill_old_delay) if $kill_old_delay > 0;
 
248
            print STDERR "killing old workers\n";
 
249
            kill $opts->{signal_on_hup}, $_
 
250
                for sort keys %old_workers;
 
251
        }
203
252
    }
204
253
    
205
254
 CLEANUP:
260
309
    # wait for the generation
261
310
    while (1) {
262
311
        my @gens = $get_generations->();
263
 
        last if scalar(@gens) == 1 && $gens[0] == $wait_for;
 
312
        last if scalar(@gens) == 1 && $gens[0] >= $wait_for;
264
313
        sleep 1;
265
314
    }
266
315
}
274
323
    \%ports;
275
324
}
276
325
 
 
326
sub _reload_env {
 
327
    my $dn = $ENV{ENVDIR};
 
328
    return if !defined $dn or !-d $dn;
 
329
    my $d;
 
330
    opendir($d, $dn) or return;
 
331
    while (my $n = readdir($d)) {
 
332
        next if $n =~ /^\./;
 
333
        open my $fh, '<', "$dn/$n" or next;
 
334
        chomp(my $v = <$fh>);
 
335
        $ENV{$n} = $v if $v ne '';
 
336
    }
 
337
}
 
338
 
277
339
sub _start_worker {
278
340
    my $opts = shift;
279
341
    my $pid;
285
347
        if ($pid == 0) {
286
348
            my @args = @{$opts->{exec}};
287
349
            # child process
 
350
            if (defined $opts->{dir}) {
 
351
                chdir $opts->{dir} or die "failed to chdir:$!";
 
352
            }
288
353
            { exec { $args[0] } @args };
289
354
            print STDERR "failed to exec $args[0]$!";
290
355
            exit(255);