#!/usr/bin/perl
#
# based on http://www.perlmonks.org/?node_id=582781 by Justin Hawkins
+# and http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking
###
-# modules and variables, oh my
+# modules and constants and variables, oh my
###
use warnings;
use strict;
-#use SOAP::Transport::HTTP;
-use XMLRPC::Transport::HTTP;
-use XMLRPC::Lite; # for XMLRPC::Serializer
+use constant DEBUG => 1; # Enable much runtime information.
+use constant MAX_PROCESSES => 10; # Total server process count.
+use constant SERVER_PORT => 8080; # Server port.
+use constant TESTING_CHURN => 0; # Randomly test process respawning.
-use POE; # Base features.
+use POE 1.2; # Base features.
use POE::Filter::HTTPD; # For serving HTTP content.
use POE::Wheel::ReadWrite; # For socket I/O.
use POE::Wheel::SocketFactory; # For serving socket connections.
-use FS::UID qw(adminsuidsetup);
-#use FS::SelfService::XMLRPC;
-use FS::ClientAPI qw( load_clientapi_modules );
-use FS::ClientAPI_XMLRPC;
-
+use XMLRPC::Transport::HTTP; #SOAP::Transport::HTTP;
+use XMLRPC::Lite; # for XMLRPC::Serializer
-#sub DEBUG () { 0 } # Enable a lot of runtime information.
-#sub MAX_PROCESSES () { 10 } # Total number of server processes.
-#sub SERVER_PORT () { 8092 } # Server port to listen on.
-sub DEBUG () { 0 } # Enable a lot of runtime information.
-sub MAX_PROCESSES () { 32 } # Total number of server processes.
-sub SERVER_PORT () { 8080 } # Server port to listen on.
+use FS::Daemon qw( daemonize1 drop_root logfile daemonize2 );
+use FS::UID qw( adminsuidsetup forksuidsetup dbh );
+use FS::Conf;
+use FS::ClientAPI qw( load_clientapi_modules );
+use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC;
-sub TESTING_CHURN () { 0 } # Randomly shutdown children to test respawn.
+#freeside
+my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%";
+my $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%";
+my $lock_file = "$FREESIDE_LOCK/selfservice-xmlrpcd.writelock";
-#xmlrpc.cgi
+#freeside xmlrpc.cgi
my %typelookup = (
base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'],
dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'],
string => [40, sub {1}, 'as_string'],
);
-# These are HTTP::Request headers that have methods.
-my @method_headers =
- qw( authorization authorization_basic
- content content_encoding content_language content_length content_type
- date expires from if_modified_since if_unmodified_since last_modified
- method protocol proxy_authorization proxy_authorization_basic referer
- server title url user_agent www_authenticate
-);
-
-# These are HTTP::Request headers that do not have methods.
-my @header_headers =
- qw( username opaque stale algorithm realm uri qop auth nonce cnonce
- nc response
-);
-
###
-# init
+# freeside init
###
my $user = shift or die &usage;
-#FS::ClientAPI
+$FS::Daemon::NOSIG = 1;
+$FS::Daemon::PID_NEWSTYLE = 1;
+daemonize1('selfservice-xmlrpcd');
+
+POE::Kernel->has_forked(); #daemonize forks...
+
+drop_root();
+
+adminsuidsetup($user);
+
load_clientapi_modules;
+logfile("$FREESIDE_LOG/selfservice-xmlrpcd.log");
+
+daemonize2();
+
+my $conf = new FS::Conf;
+
+die "not running; selfservice-xmlrpc conf option is off\n"
+ unless $conf->exists('selfservice-xmlrpc');
+
+#parent doesn't need to hold a DB connection open
+dbh->disconnect;
+undef $FS::UID::dbh;
+
###
# the main loop
###
-# Spawn up to MAX_PROCESSES server processes, and then run them. Exit
-# when they are done.
-
server_spawn(MAX_PROCESSES);
-$poe_kernel->run();
-
-#XXX we probably want to sleep a bit and then try all over again...
-exit 0;
+POE::Kernel->run();
+exit;
###
# the subroutines
sub server_spawn {
my ($max_processes) = @_;
- POE::Session->create
- ( inline_states =>
- { _start => \&server_start,
- _stop => \&server_stop,
- do_fork => \&server_do_fork,
- got_error => \&server_got_error,
- got_sig_int => \&server_got_sig_int,
- got_sig_chld => \&server_got_sig_chld,
- got_connection => \&server_got_connection,
-
- _child => sub { 0 },
- },
- heap =>
- { max_processes => $max_processes,
- },
- );
+ POE::Session->create(
+ inline_states => {
+ _start => \&server_start,
+ _stop => \&server_stop,
+ do_fork => \&server_do_fork,
+ got_error => \&server_got_error,
+ got_sig_int => \&server_got_sig_int,
+ got_sig_child => \&server_got_sig_child,
+ got_connection => \&server_got_connection,
+ _child => sub { undef },
+ },
+ heap => { max_processes => MAX_PROCESSES },
+ );
}
### The main server session has started. Set up the server socket and
Reuse => "yes",
);
- $kernel->sig( CHLD => "got_sig_chld" );
$kernel->sig( INT => "got_sig_int" );
+ $kernel->sig( TERM => "got_sig_int" ); #huh
$heap->{children} = {};
$heap->{is_a_child} = 0;
sub server_stop {
my $heap = $_[HEAP];
DEBUG and warn "Server $$ stopped.\n";
+
if ( my @children = keys %{ $heap->{children} } ) {
DEBUG and warn "Server $$ is signaling children to stop.\n";
kill INT => @children;
return if $heap->{is_a_child};
- my $current_children = keys %{ $heap->{children} };
- for ( $current_children + 2 .. $heap->{max_processes} ) {
+ #my $current_children = keys %{ $heap->{children} };
+ #for ( $current_children + 2 .. $heap->{max_processes} ) {
+ while (scalar(keys %{$heap->{children}}) < $heap->{max_processes}) {
DEBUG and warn "Server $$ is attempting to fork.\n";
# Parent. Add the child process to its list.
if ($pid) {
$heap->{children}->{$pid} = 1;
+ $kernel->sig_child($pid, "got_sig_child");
next;
}
# Child. Clear the child process list.
+ $kernel->has_forked();
DEBUG and warn "Server $$ forked successfully.\n";
$heap->{is_a_child} = 1;
$heap->{children} = {};
+ #freeside db connection, etc.
+ forksuidsetup($user);
+
return;
}
}
### which in turn will trigger the process to exit gracefully.
sub server_got_sig_int {
- DEBUG and warn "Server $$ received SIGINT.\n";
- return 0;
+ my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
+ DEBUG and warn "Server $$ received SIGINT/TERM.\n";
+
+ if ( my @children = keys %{ $heap->{children} } ) {
+ DEBUG and warn "Server $$ is signaling children to stop.\n";
+ kill INT => @children;
+ }
+
+ delete $heap->{server};
+ $kernel->sig_handled();
}
### The server session received a SIGCHLD, indicating that some child
### server has gone away. Remove the child's process ID from our
### list, and trigger more fork() calls to spawn new children.
-sub server_got_sig_chld {
+sub server_got_sig_child {
my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ];
- if ( delete $heap->{children}->{$child_pid} ) {
- DEBUG and warn "Server $$ received SIGCHLD.\n";
- $kernel->yield("do_fork");
- }
- return 0;
+ return unless delete $heap->{children}->{$child_pid};
+
+ DEBUG and warn "Server $$ reaped child $child_pid.\n";
+ $kernel->yield("do_fork") if exists $_[HEAP]->{server};
}
### The server session received a connection request. Spawn off a
DEBUG and warn "Server $$ received a connection.\n";
- POE::Session->create
- ( inline_states =>
- { _start => \&client_start,
- _stop => \&client_stop,
- got_request => \&client_got_request,
- got_flush => \&client_flushed_request,
- got_error => \&client_got_error,
- _parent => sub { 0 },
- },
- heap =>
- { socket => $socket,
- peer_addr => $peer_addr,
- peer_port => $peer_port,
- },
- );
-
+ POE::Session->create(
+ inline_states => {
+ _start => \&client_start,
+ _stop => \&client_stop,
+ got_request => \&client_got_request,
+ got_flush => \&client_flushed_request,
+ got_error => \&client_got_error,
+ _parent => sub { 0 },
+ },
+ heap => {
+ socket => $socket,
+ peer_addr => $peer_addr,
+ peer_port => $peer_port,
+ },
+ );
+
+ # Gracefully exit if testing process churn.
delete $heap->{server}
if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 );
}
sub client_got_request {
my ( $heap, $request ) = @_[ HEAP, ARG0 ];
- freeside_kid_time();
+ forksuidsetup($user) unless dbh && dbh->ping;
my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup);
$heap->{client}->put($response);
}
-#setup the database connection and other things FS::SelfService::XMLRPC
-#expects to be in place. aka "kid time" in freeside-selfservice-server
-sub freeside_kid_time {
-
- #if we need a db connection in the parent
- ##get new db handle
- #$FS::UID::dbh->{InactiveDestroy} = 1;
- #forksuidsetup($user);
-
- adminsuidsetup($user);
-
- #i guess that was it
-}
-
### The client handler received an error. Stop the ReadWrite wheel,
### which also closes the socket.