summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
authorIvan Kohler <ivan@freeside.biz>2014-03-05 16:07:14 -0800
committerIvan Kohler <ivan@freeside.biz>2014-03-05 16:07:14 -0800
commita8001fede477df80f80951eaf962bdb058d9f605 (patch)
treea1a1c5c3ebf4646cdad7d2249aaa1a9326b2c2f2 /FS
parent1ac43321cf1601e42bfc24433d0edd2268cb2a2e (diff)
add back-office xmlrpc api and daemon, RT#27958
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/API.pm112
-rw-r--r--FS/FS/ClientAPI_XMLRPC.pm15
-rw-r--r--FS/FS/Conf.pm21
-rw-r--r--FS/FS/Daemon/Preforking.pm358
-rw-r--r--FS/MANIFEST2
-rwxr-xr-xFS/bin/freeside-selfservice-xmlrpcd325
-rw-r--r--FS/bin/freeside-xmlrpcd58
7 files changed, 564 insertions, 327 deletions
diff --git a/FS/FS/API.pm b/FS/FS/API.pm
new file mode 100644
index 0000000..df48802
--- /dev/null
+++ b/FS/FS/API.pm
@@ -0,0 +1,112 @@
+package FS::API;
+
+use FS::Conf;
+use FS::Record qw( qsearchs );
+use FS::cust_main;
+
+=head1 NAME
+
+FS::API - Freeside backend API
+
+=head1 SYNOPSIS
+
+ use FS::API;
+
+=head1 DESCRIPTION
+
+This module implements a backend API for advanced back-office integration.
+
+In contrast to the self-service API, which authenticates an end-user and offers
+functionality to that end user, the backend API performs a simple shared-secret
+authentication and offers full, administrator functionality, enabling
+integration with other back-office systems.
+
+If accessing this API remotely with XML-RPC or JSON-RPC, be careful to block
+the port by default, only allow access from back-office servers with the same
+security precations as the Freeside server, and encrypt the communication
+channel (for exampple, with an SSH tunnel or VPN) rather than accessing it
+in plaintext.
+
+=head1 METHODS
+
+=over 4
+
+# needs to be able to:
+Enter cash payment
+Enter credit
+Enter cash refund.
+
+# would like to be able to pass the phone number ( from svc_phone ) to the API for this query.
+
+#---
+
+#Customer data
+# pull customer info
+# The fields needed are:
+#
+# cust_main.custnum
+# cust_main.first
+# cust_main.last
+# cust_main.company
+# cust_main.address1
+# cust_main.address2
+# cust_main.city
+# cust_main.state
+# cust_main.zip
+# cust_main.daytime
+# cust_main.night
+# cust_main_invoice.dest
+#
+# at minimum
+
+#Customer balances
+
+#Advertising sources?
+
+# "2 way syncing" ? start with non-sync pulling info here, then if necessary
+# figure out how to trigger something when those things change
+
+# long-term: package changes?
+
+=item customer_info
+
+=cut
+
+#some false laziness w/ClientAPI::Myaccount customer_info/customer_info_short
+
+use vars qw( @cust_main_editable_fields @location_editable_fields );
+@cust_main_editable_fields = qw(
+ first last company daytime night fax mobile
+);
+# locale
+# payby payinfo payname paystart_month paystart_year payissue payip
+# ss paytype paystate stateid stateid_state
+@location_editable_fields = qw(
+ address1 address2 city county state zip country
+);
+
+sub customer_info {
+ my( $class, %opt ) = @_;
+ my $conf = new FS::Conf;
+ return { 'error' => 'Incorrect shared secret' }
+ unless $opt{secret} eq $conf->config('api_shared_secret');
+
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
+ or return { 'error' => 'Unknown custnum' };
+
+ my %return = (
+ 'error' => '',
+ 'display_custnum' => $cust_main->display_custnum,
+ 'name' => $cust_main->first. ' '. $cust_main->get('last'),
+ );
+
+ $return{$_} = $cust_main->get($_)
+ foreach @cust_main_editable_fields;
+
+ return \%return;
+
+}
+
+=back
+
+1;
diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm
index 6ebdcec..62f61d6 100644
--- a/FS/FS/ClientAPI_XMLRPC.pm
+++ b/FS/FS/ClientAPI_XMLRPC.pm
@@ -30,7 +30,7 @@ L<FS::SelfService::XMLRPC>, L<FS::SelfService>
use strict;
use vars qw($DEBUG $AUTOLOAD);
-use XMLRPC::Lite; # for XMLRPC::Data
+use FS::XMLRPC_Lite; #XMLRPC::Lite, for XMLRPC::Data
use FS::ClientAPI;
$DEBUG = 0;
@@ -188,17 +188,4 @@ sub ss2clientapi {
};
}
-
-#XXX submit patch to SOAP::Lite
-
-use XMLRPC::Transport::HTTP;
-
-package XMLRPC::Transport::HTTP::Server;
-
-@XMLRPC::Transport::HTTP::Server::ISA = qw(SOAP::Transport::HTTP::Server);
-
-sub initialize; *initialize = \&XMLRPC::Server::initialize;
-sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
-sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
-
1;
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 48b39c5..ccf8752 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5606,6 +5606,27 @@ and customer address. Include units.',
'type' => 'text',
},
+ {
+ 'key' => 'api_shared_secret',
+ 'section' => 'API',
+ 'description' => 'Shared secret for back-office API authentication',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'xmlrpc_api',
+ 'section' => 'API',
+ 'description' => 'Enable the back-office API XML-RPC server (on port 8008).',
+ 'type' => 'checkbox',
+ },
+
+# {
+# 'key' => 'jsonrpc_api',
+# 'section' => 'API',
+# 'description' => 'Enable the back-office API JSON-RPC server (on port 8081).',
+# 'type' => 'checkbox',
+# },
+
{ key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
{ key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
{ key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
diff --git a/FS/FS/Daemon/Preforking.pm b/FS/FS/Daemon/Preforking.pm
new file mode 100644
index 0000000..98b4fa6
--- /dev/null
+++ b/FS/FS/Daemon/Preforking.pm
@@ -0,0 +1,358 @@
+package FS::Daemon::Preforking;
+use base 'Exporter';
+
+=head1 NAME
+
+FS::Daemon::Preforking - A preforking web server
+
+=head1 SYNOPSIS
+
+ use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run );
+
+ my $me = 'mydaemon'; #keep unique among fs daemons, for logfiles etc.
+
+ freeside_init1($me); #daemonize, drop root and connect to freeside
+
+ #do setup tasks which should throw an error to the shell starting the daemon
+
+ freeside_init2($me); #move logging to logfile and disassociate from terminal
+
+ #do setup tasks which will warn/error to the log file, such as declining to
+ # run if our config is not in place
+
+ daemon_run(
+ 'port' => 5454, #keep unique among fs daemons
+ 'handle_request' => \&handle_request,
+ );
+
+ sub handle_request {
+ my $request = shift; #HTTP::Request object
+
+ #... do your thing
+
+ return $response; #HTTP::Response object
+
+ }
+
+=head1 AUTHOR
+
+Based on L<http://www.perlmonks.org/?node_id=582781> by Justin Hawkins
+
+and L<http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking>
+
+=cut
+
+use warnings;
+use strict;
+
+use constant DEBUG => 0; # Enable much runtime information.
+use constant MAX_PROCESSES => 10; # Total server process count.
+#use constant TESTING_CHURN => 0; # Randomly test process respawning.
+
+use vars qw( @EXPORT_OK $FREESIDE_LOG $SERVER_PORT $user $handle_request );
+@EXPORT_OK = qw( freeside_init1 freeside_init2 daemon_run );
+$FREESIDE_LOG = '%%%FREESIDE_LOG%%%';
+
+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::Daemon qw( daemonize1 drop_root logfile daemonize2 );
+use FS::UID qw( adminsuidsetup forksuidsetup dbh );
+
+#use FS::TicketSystem;
+
+sub freeside_init1 {
+ my $name = shift;
+
+ $user = shift @ARGV or die &usage($name);
+
+ $FS::Daemon::NOSIG = 1;
+ $FS::Daemon::PID_NEWSTYLE = 1;
+ daemonize1($name);
+
+ POE::Kernel->has_forked(); #daemonize forks...
+
+ drop_root();
+
+ adminsuidsetup($user);
+}
+
+sub freeside_init2 {
+ my $name = shift;
+
+ logfile("$FREESIDE_LOG/$name.log");
+
+ daemonize2();
+
+}
+
+sub daemon_run {
+ my %opt = @_;
+ $SERVER_PORT = $opt{port};
+ $handle_request = $opt{handle_request};
+
+ #parent doesn't need to hold a DB connection open
+ dbh->disconnect;
+ undef $FS::UID::dbh;
+
+ server_spawn(MAX_PROCESSES);
+ POE::Kernel->run();
+ #exit;
+
+}
+
+### 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);
+
+ #why isn't this needed ala freeside-selfservice-server??
+ #FS::TicketSystem->init();
+
+ 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 ];
+
+ DEBUG and
+ warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n";
+
+ if ( $request->isa("HTTP::Response") ) {
+ $heap->{client}->put($request);
+ return;
+ }
+
+ forksuidsetup($user) unless dbh && dbh->ping;
+
+ my $response = &{ $handle_request }( $request );
+
+ $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 {
+ my $name = shift;
+ die "Usage:\n\n freeside-$name user\n";
+}
+
+1;
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 7ba2226..637401a 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -24,6 +24,7 @@ bin/freeside-sqlradius-reset
bin/freeside-sqlradius-seconds
bin/freeside-torrus-srvderive
FS.pm
+FS/API.pm
FS/AccessRight.pm
FS/AuthCookieHandler.pm
FS/AuthCookieHandler24.pm
@@ -46,6 +47,7 @@ FS/Cron/backup.pm
FS/Cron/bill.pm
FS/Cron/vacuum.pm
FS/Daemon.pm
+FS/Daemon/Preforking.pm
FS/Misc.pm
FS/Record.pm
FS/Report.pm
diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd
index 423d2c3..6413b2b 100755
--- a/FS/bin/freeside-selfservice-xmlrpcd
+++ b/FS/bin/freeside-selfservice-xmlrpcd
@@ -1,299 +1,40 @@
#!/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 FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run );
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;
-use FS::TicketSystem;
-
-#freeside
-my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%";
-my $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%";
-my $lock_file = "$FREESIDE_LOCK/selfservice-xmlrpcd.writelock";
#freeside xmlrpc.cgi
my %typelookup = (
#not utf-8 safe# 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'],
+ string => [40, sub {1}, 'as_string'],
);
-###
-# freeside init
-###
+use constant ME => 'selfservice-xmlrpcd';
-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);
+freeside_init1(ME);
load_clientapi_modules;
-logfile("$FREESIDE_LOG/selfservice-xmlrpcd.log");
-
-daemonize2();
+freeside_init2(ME);
FS::ClientAPI::Signup::clear_cache();
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);
-
- #why isn't this needed ala freeside-selfservice-server??
- #FS::TicketSystem->init();
-
- 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;
+daemon_run( 'port' => 8080, 'handle_request' =>
+ sub {
+ my $request = shift;
my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup);
@@ -303,53 +44,11 @@ sub client_got_request {
-> 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
-###
+ return $soap->response;
+ }
+);
1;
diff --git a/FS/bin/freeside-xmlrpcd b/FS/bin/freeside-xmlrpcd
new file mode 100644
index 0000000..e22d0f0
--- /dev/null
+++ b/FS/bin/freeside-xmlrpcd
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run );
+
+use FS::XMLRPC_Lite; #XMLRPC::Lite for XMLRPC::Serializer
+ #and XMLRPC::Transport::HTTP
+
+use FS::Conf;
+
+##use FS::ClientAPI qw( load_clientapi_modules );
+##use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC;
+use FS::API;
+
+#freeside xmlrpc.cgi
+my %typelookup = (
+#not utf-8 safe# 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'],
+);
+
+use constant ME => 'xmlrpcd';
+
+#
+
+freeside_init1(ME);
+
+#load_clientapi_modules;
+
+freeside_init2(ME);
+
+#FS::ClientAPI::Signup::clear_cache();
+
+my $conf = new FS::Conf;
+die "not running; xmlrpc_api conf option is off\n"
+ unless $conf->exists('xmlrpc_api');
+die "not running; api_shared_secret conf option is not set\n"
+ unless $conf->config('api_shared_secret');
+
+daemon_run( 'port' => 8008, 'handle_request' =>
+ sub {
+ my $request = shift;
+
+ my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup);
+
+ #my $soap = SOAP::Transport::HTTP::Server
+ my $soap = XMLRPC::Transport::HTTP::Server
+ -> new
+ -> dispatch_to('FS::API')
+ -> serializer($serializer);
+
+ $soap->request($request);
+ $soap->handle;
+
+ return $soap->response;
+ }
+);
+
+1;