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
|
package Net::Server::SS::PreFork;
use strict;
use warnings;
use Net::Server::PreFork;
use Net::Server::Proto::TCP;
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 = Net::Server::Proto::TCP->new();
if ($port =~ /^(.*):(.*?)$/) {
$sock->NS_host($1);
$sock->NS_port($2);
} else {
$sock->NS_host('*');
$sock->NS_port($port);
}
$sock->NS_proto('TCP');
$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
|
