1 package FS::Daemon::Preforking;
6 FS::Daemon::Preforking - A preforking web server
10 use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run );
12 my $me = 'mydaemon'; #keep unique among fs daemons, for logfiles etc.
14 freeside_init1($me); #daemonize, drop root and connect to freeside
16 #do setup tasks which should throw an error to the shell starting the daemon
18 freeside_init2($me); #move logging to logfile and disassociate from terminal
20 #do setup tasks which will warn/error to the log file, such as declining to
21 # run if our config is not in place
24 'port' => 5454, #keep unique among fs daemons
25 'handle_request' => \&handle_request,
29 my $request = shift; #HTTP::Request object
33 return $response; #HTTP::Response object
39 Based on L<http://www.perlmonks.org/?node_id=582781> by Justin Hawkins
41 and L<http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking>
48 use constant DEBUG => 0; # Enable much runtime information.
49 use constant MAX_PROCESSES => 10; # Total server process count.
50 #use constant TESTING_CHURN => 0; # Randomly test process respawning.
52 use vars qw( @EXPORT_OK $FREESIDE_LOG $SERVER_PORT $user $handle_request );
53 @EXPORT_OK = qw( freeside_init1 freeside_init2 daemon_run );
54 $FREESIDE_LOG = '%%%FREESIDE_LOG%%%';
56 use POE 1.2; # Base features.
57 use POE::Filter::HTTPD; # For serving HTTP content.
58 use POE::Wheel::ReadWrite; # For socket I/O.
59 use POE::Wheel::SocketFactory; # For serving socket connections.
61 use FS::Daemon qw( daemonize1 drop_root logfile daemonize2 );
62 use FS::UID qw( adminsuidsetup forksuidsetup dbh );
64 #use FS::TicketSystem;
69 $user = shift @ARGV or die &usage($name);
71 $FS::Daemon::NOSIG = 1;
72 $FS::Daemon::PID_NEWSTYLE = 1;
75 POE::Kernel->has_forked(); #daemonize forks...
79 adminsuidsetup($user);
85 logfile("$FREESIDE_LOG/$name.log");
93 $SERVER_PORT = $opt{port};
94 $handle_request = $opt{handle_request};
96 #parent doesn't need to hold a DB connection open
100 server_spawn(MAX_PROCESSES);
106 ### Spawn the main server. This will run as the parent process.
109 my ($max_processes) = @_;
111 POE::Session->create(
113 _start => \&server_start,
114 _stop => \&server_stop,
115 do_fork => \&server_do_fork,
116 got_error => \&server_got_error,
117 got_sig_int => \&server_got_sig_int,
118 got_sig_child => \&server_got_sig_child,
119 got_connection => \&server_got_connection,
120 _child => sub { undef },
122 heap => { max_processes => MAX_PROCESSES },
126 ### The main server session has started. Set up the server socket and
127 ### bookkeeping information, then fork the initial child processes.
130 my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
132 $heap->{server} = POE::Wheel::SocketFactory->new
133 ( BindPort => $SERVER_PORT,
134 SuccessEvent => "got_connection",
135 FailureEvent => "got_error",
139 $kernel->sig( INT => "got_sig_int" );
140 $kernel->sig( TERM => "got_sig_int" ); #huh
142 $heap->{children} = {};
143 $heap->{is_a_child} = 0;
145 warn "Server $$ has begun listening on port $SERVER_PORT\n";
147 $kernel->yield("do_fork");
150 ### The server session has shut down. If this process has any
151 ### children, signal them to shutdown too.
155 DEBUG and warn "Server $$ stopped.\n";
157 if ( my @children = keys %{ $heap->{children} } ) {
158 DEBUG and warn "Server $$ is signaling children to stop.\n";
159 kill INT => @children;
163 ### The server session has encountered an error. Shut it down.
165 sub server_got_error {
166 my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ];
167 warn( "Server $$ got $syscall error $errno: $error\n",
168 "Server $$ is shutting down.\n",
170 delete $heap->{server};
173 ### The server has a need to fork off more children. Only honor that
174 ### request form the parent, otherwise we would surely "forkbomb".
175 ### Fork off as many child processes as we need.
178 my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
180 return if $heap->{is_a_child};
182 #my $current_children = keys %{ $heap->{children} };
183 #for ( $current_children + 2 .. $heap->{max_processes} ) {
184 while (scalar(keys %{$heap->{children}}) < $heap->{max_processes}) {
186 DEBUG and warn "Server $$ is attempting to fork.\n";
190 unless ( defined($pid) ) {
192 warn( "Server $$ fork failed: $!\n",
193 "Server $$ will retry fork shortly.\n",
195 $kernel->delay( do_fork => 1 );
199 # Parent. Add the child process to its list.
201 $heap->{children}->{$pid} = 1;
202 $kernel->sig_child($pid, "got_sig_child");
206 # Child. Clear the child process list.
207 $kernel->has_forked();
208 DEBUG and warn "Server $$ forked successfully.\n";
209 $heap->{is_a_child} = 1;
210 $heap->{children} = {};
212 #freeside db connection, etc.
213 forksuidsetup($user);
215 #why isn't this needed ala freeside-selfservice-server??
216 #FS::TicketSystem->init();
222 ### The server session received SIGINT. Don't handle the signal,
223 ### which in turn will trigger the process to exit gracefully.
225 sub server_got_sig_int {
226 my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
227 DEBUG and warn "Server $$ received SIGINT/TERM.\n";
229 if ( my @children = keys %{ $heap->{children} } ) {
230 DEBUG and warn "Server $$ is signaling children to stop.\n";
231 kill INT => @children;
234 delete $heap->{server};
235 $kernel->sig_handled();
238 ### The server session received a SIGCHLD, indicating that some child
239 ### server has gone away. Remove the child's process ID from our
240 ### list, and trigger more fork() calls to spawn new children.
242 sub server_got_sig_child {
243 my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ];
245 return unless delete $heap->{children}->{$child_pid};
247 DEBUG and warn "Server $$ reaped child $child_pid.\n";
248 $kernel->yield("do_fork") if exists $_[HEAP]->{server};
251 ### The server session received a connection request. Spawn off a
252 ### client handler session to parse the request and respond to it.
254 sub server_got_connection {
255 my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ];
257 DEBUG and warn "Server $$ received a connection.\n";
259 POE::Session->create(
261 _start => \&client_start,
262 _stop => \&client_stop,
263 got_request => \&client_got_request,
264 got_flush => \&client_flushed_request,
265 got_error => \&client_got_error,
266 _parent => sub { 0 },
270 peer_addr => $peer_addr,
271 peer_port => $peer_port,
275 # # Gracefully exit if testing process churn.
276 # delete $heap->{server}
277 # if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 );
280 ### The client handler has started. Wrap its socket in a ReadWrite
281 ### wheel to begin interacting with it.
286 $heap->{client} = POE::Wheel::ReadWrite->new
287 ( Handle => $heap->{socket},
288 Filter => POE::Filter::HTTPD->new(),
289 InputEvent => "got_request",
290 ErrorEvent => "got_error",
291 FlushedEvent => "got_flush",
294 DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n";
297 ### The client handler has stopped. Log that fact.
300 DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n";
303 ### The client handler has received a request. If it's an
304 ### HTTP::Response object, it means some error has occurred while
305 ### parsing the request. Send that back and return immediately.
306 ### Otherwise parse and process the request, generating and sending an
307 ### HTTP::Response object in response.
309 sub client_got_request {
310 my ( $heap, $request ) = @_[ HEAP, ARG0 ];
313 warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n";
315 if ( $request->isa("HTTP::Response") ) {
316 $heap->{client}->put($request);
320 forksuidsetup($user) unless dbh && dbh->ping;
322 my $response = &{ $handle_request }( $request );
324 $heap->{client}->put($response);
327 ### The client handler received an error. Stop the ReadWrite wheel,
328 ### which also closes the socket.
330 sub client_got_error {
331 my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ];
333 warn( "Client handler $$/", $_[SESSION]->ID,
334 " got $operation error $errnum: $errstr\n",
335 "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n"
337 delete $heap->{client};
340 ### The client handler has flushed its response to the socket. We're
341 ### done with the client connection, so stop the ReadWrite wheel.
343 sub client_flushed_request {
346 warn( "Client handler $$/", $_[SESSION]->ID,
347 " flushed its response.\n",
348 "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n"
350 delete $heap->{client};
355 die "Usage:\n\n freeside-$name user\n";