-
Notifications
You must be signed in to change notification settings - Fork 3
/
PreFork.pm
131 lines (101 loc) · 3.24 KB
/
PreFork.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
package Net::Server::SS::PreFork;
use strict;
use warnings;
use Net::Server::PreFork;
use Net::Server::Proto::TCP;
use Net::Server::Proto::UNIX;
use Server::Starter qw(server_ports);
use base qw(Net::Server::PreFork);
our $VERSION = 0.05;
sub pre_bind {
my $self = shift;
my $prop = $self->{server};
my %ports = %{server_ports()};
for my $port (sort keys %ports) {
my $sock;
if ($port =~ /^(.*):(.*?)$/ || $port =~ /^[0-9]+$/s) {
$sock = Net::Server::Proto::TCP->new();
$sock->NS_proto('TCP');
if ($port =~ /^(.*):(.*?)$/) {
$sock->NS_host($1);
$sock->NS_port($2);
} else {
$sock->NS_host('*');
$sock->NS_port($port);
}
} else {
$sock = Net::Server::Proto::UNIX->new();
$sock->NS_proto('UNIX');
$sock->NS_port($port);
}
$sock->fdopen($ports{$port}, 'r')
or $self->fatal("failed to bind listening socket:$ports{$port}:$!");
push @{$prop->{sock}}, $sock;
}
$prop->{multi_port} = 1 if @{$prop->{sock}} > 1;
}
sub bind {
my $self = shift;
my $prop = $self->{server};
### if more than one port we'll need to select on it
if( @{ $prop->{port} } > 1 || $prop->{multi_port} ){
$prop->{multi_port} = 1;
$prop->{select} = IO::Select->new();
foreach ( @{ $prop->{sock} } ){
$prop->{select}->add( $_ );
}
}else{
$prop->{multi_port} = undef;
$prop->{select} = undef;
}
}
sub sig_hup {
my $self = shift;
$self->log(
0,
$self->log_time(),
"Net::Server::SS::PreFork does not accept SIGHUP, send it to the"
. " daemon!",
);
}
sub shutdown_sockets {
# Net::Server::shutdown_sockets uses shutdown(2) to close accept(2)ing
# sockets (which is a bug IMHO). On OSX, shutdown(2) returns ENOTSOCK
# so the socket is not closed. On Linux, shutdown(2) closes the accepting
# connection on all the forked processes sharing the socket (and the
# next generation workers spawned by Server::Starter woul never be able
# to accept incoming connections). Thus we override the function and use
# close(2) instead of shutdown(2).
my $self = shift;
my $prop = $self->{server};
for my $sock (@{$prop->{sock}}) {
$sock->close; # close sockets - nobody should be reading/writing still
}
### delete the sock objects
$prop->{sock} = [];
return 1;
}
1;
__END__
=head1 NAME
Net::Server::SS::PreFork - a hot-deployable variant of Net::Server::PreFork
=head1 SYNOPSIS
# from command line
% start_server --port=80 my_server.pl
# in my_server.pl
use base qw(Net::Server::SS::PreFork);
sub process_request {
#...code...
}
__PACKAGE__->run();
=head1 DESCRIPTION
L<Net::Server::SS::PreFork> is L<Net::Server> personality, extending L<Net::Server::PreFork>, that can be run by the L<start_server> script of L<Server::Starter>.
=head1 AUTHOR
Kazuho Oku E<lt>kazuhooku@gmail.comE<gt>
Copyright (C) 2009 Cybozu Labs, Inc.
=head1 SEE ALSO
L<Net::Server>
L<Server::Starter>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut