diff options
Diffstat (limited to 'FS/bin/freeside-selfservice-xmlrpcd')
| -rwxr-xr-x | FS/bin/freeside-selfservice-xmlrpcd | 349 |
1 files changed, 349 insertions, 0 deletions
diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd new file mode 100755 index 0000000..fa745ec --- /dev/null +++ b/FS/bin/freeside-selfservice-xmlrpcd @@ -0,0 +1,349 @@ +#!/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 constants and variables, oh my +### + +use warnings; +use strict; + +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 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 XMLRPC::Transport::HTTP; #SOAP::Transport::HTTP; +use XMLRPC::Lite; # for XMLRPC::Serializer + +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; + +#freeside +my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; +my $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; +my $lock_file = "$FREESIDE_LOCK/selfservice-xmlrpcd.writelock"; + +#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'], +); + +### +# freeside init +### + +my $user = shift or die &usage; + +$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 +### + +server_spawn(MAX_PROCESSES); +POE::Kernel->run(); +exit; + +### +# the subroutines +### + +### Spawn the main server. This will run as the parent process. + +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_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 +### bookkeeping information, then fork the initial child processes. + +sub server_start { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + $heap->{server} = POE::Wheel::SocketFactory->new + ( BindPort => SERVER_PORT, + SuccessEvent => "got_connection", + FailureEvent => "got_error", + Reuse => "yes", + ); + + $kernel->sig( INT => "got_sig_int" ); + $kernel->sig( TERM => "got_sig_int" ); #huh + + $heap->{children} = {}; + $heap->{is_a_child} = 0; + + warn "Server $$ has begun listening on port ", SERVER_PORT, "\n"; + + $kernel->yield("do_fork"); +} + +### The server session has shut down. If this process has any +### children, signal them to shutdown too. + +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; + } +} + +### The server session has encountered an error. Shut it down. + +sub server_got_error { + my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ]; + warn( "Server $$ got $syscall error $errno: $error\n", + "Server $$ is shutting down.\n", + ); + delete $heap->{server}; +} + +### The server has a need to fork off more children. Only honor that +### request form the parent, otherwise we would surely "forkbomb". +### Fork off as many child processes as we need. + +sub server_do_fork { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + return if $heap->{is_a_child}; + + #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"; + + my $pid = fork(); + + unless ( defined($pid) ) { + DEBUG and + warn( "Server $$ fork failed: $!\n", + "Server $$ will retry fork shortly.\n", + ); + $kernel->delay( do_fork => 1 ); + return; + } + + # 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; + } +} + +### The server session received SIGINT. Don't handle the signal, +### which in turn will trigger the process to exit gracefully. + +sub server_got_sig_int { + 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_child { + my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ]; + + 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 +### client handler session to parse the request and respond to it. + +sub server_got_connection { + my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + + 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, + }, + ); + + # Gracefully exit if testing process churn. + delete $heap->{server} + if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 ); +} + +### The client handler has started. Wrap its socket in a ReadWrite +### wheel to begin interacting with it. + +sub client_start { + my $heap = $_[HEAP]; + + $heap->{client} = POE::Wheel::ReadWrite->new + ( Handle => $heap->{socket}, + Filter => POE::Filter::HTTPD->new(), + InputEvent => "got_request", + ErrorEvent => "got_error", + FlushedEvent => "got_flush", + ); + + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n"; +} + +### The client handler has stopped. Log that fact. + +sub client_stop { + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n"; +} + +### The client handler has received a request. If it's an +### HTTP::Response object, it means some error has occurred while +### parsing the request. Send that back and return immediately. +### Otherwise parse and process the request, generating and sending an +### HTTP::Response object in response. + +sub client_got_request { + my ( $heap, $request ) = @_[ HEAP, ARG0 ]; + + forksuidsetup($user) unless dbh && dbh->ping; + + my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); + + #my $soap = SOAP::Transport::HTTP::Server + my $soap = XMLRPC::Transport::HTTP::Server + -> new + -> dispatch_to('FS::ClientAPI_XMLRPC') + -> serializer($serializer); + + DEBUG and + warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n"; + + if ( $request->isa("HTTP::Response") ) { + $heap->{client}->put($request); + return; + } + + $soap->request($request); + $soap->handle; + my $response = $soap->response; + + $heap->{client}->put($response); +} + +### The client handler received an error. Stop the ReadWrite wheel, +### which also closes the socket. + +sub client_got_error { + my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " got $operation error $errnum: $errstr\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +### The client handler has flushed its response to the socket. We're +### done with the client connection, so stop the ReadWrite wheel. + +sub client_flushed_request { + my $heap = $_[HEAP]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " flushed its response.\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +sub usage { + die "Usage:\n\n freeside-selfservice-xmlrpcd user\n"; +} + +### +# the end +### + +1; |