start of a local XML-RPC server for ncic, RT#7780

3 files changed, 502 insertions, 0 deletions

diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm
new file mode 100644
index 0000000..3182eb8
--- /dev/null
+++ b/FS/FS/ClientAPI_XMLRPC.pm
@@ -0,0 +1,146 @@
+package FS::ClientAPI_XMLRPC;
+
+=head1 NAME
+
+FS::ClientAPI_XMLRPC - Freeside XMLRPC accessible self-service API, on the backend
+
+=head1 SYNOPSIS
+
+This module implements the self-service API offered by xmlrpc.cgi and friends,
+but on a backend machine.
+
+=head1 DESCRIPTION
+
+Use this API to implement your own client "self-service" module vi XMLRPC.
+
+Each routine described in L<FS::SelfService> is available vi XMLRPC as the
+method FS.SelfService.XMLRPC.B<method>.  All values are passed to the
+selfservice-server in a struct of strings.  The return values are in a
+struct as strings, arrays, or structs as appropriate for the values
+described in L<FS::SelfService>.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::SelfService::XMLRPC>, L<FS::SelfService>
+
+=cut
+
+use strict;
+
+use vars qw($DEBUG $AUTOLOAD);
+use FS::ClientAPI;
+
+$DEBUG = 0;
+$FS::ClientAPI::DEBUG = $DEBUG;
+
+sub AUTOLOAD {
+  my $call = $AUTOLOAD;
+  $call =~ s/^FS::(SelfService::|ClientAPI_)XMLRPC:://;
+
+  warn "FS::ClientAPI_XMLRPC::AUTOLOAD $call\n";
+
+  my $autoload = &ss2clientapi;
+
+  if (exists($autoload->{$call})) {
+    shift; #discard package name;
+    #$call = "FS::SelfService::$call";
+    #no strict 'refs';
+    #&{$call}(@_);
+    #FS::ClientAPI->dispatch($autoload->{$call}, @_);
+    FS::ClientAPI->dispatch($autoload->{$call}, { @_ } );
+  }else{
+    die "No such procedure: $call";
+  }
+}
+
+#terrible false laziness w/SelfService.pm
+# - fix at build time, by including some file in both selfserv and backend libs?
+# - or fix at runtime, by having selfservice client ask server for the list?
+sub ss2clientapi {
+  {
+  'passwd'                    => 'passwd/passwd',
+  'chfn'                      => 'passwd/passwd',
+  'chsh'                      => 'passwd/passwd',
+  'login_info'                => 'MyAccount/login_info',
+  'login'                     => 'MyAccount/login',
+  'logout'                    => 'MyAccount/logout',
+  'customer_info'             => 'MyAccount/customer_info',
+  'edit_info'                 => 'MyAccount/edit_info',     #add to ss cgi!
+  'invoice'                   => 'MyAccount/invoice',
+  'invoice_logo'              => 'MyAccount/invoice_logo',
+  'list_invoices'             => 'MyAccount/list_invoices', #?
+  'cancel'                    => 'MyAccount/cancel',        #add to ss cgi!
+  'payment_info'              => 'MyAccount/payment_info',
+  'payment_info_renew_info'   => 'MyAccount/payment_info_renew_info',
+  'process_payment'           => 'MyAccount/process_payment',
+  'process_payment_order_pkg' => 'MyAccount/process_payment_order_pkg',
+  'process_payment_change_pkg' => 'MyAccount/process_payment_change_pkg',
+  'process_payment_order_renew' => 'MyAccount/process_payment_order_renew',
+  'process_prepay'            => 'MyAccount/process_prepay',
+  'realtime_collect'          => 'MyAccount/realtime_collect',
+  'list_pkgs'                 => 'MyAccount/list_pkgs',     #add to ss (added?)
+  'list_svcs'                 => 'MyAccount/list_svcs',     #add to ss (added?)
+  'list_svc_usage'            => 'MyAccount/list_svc_usage',   
+  'list_cdr_usage'            => 'MyAccount/list_cdr_usage',   
+  'list_support_usage'        => 'MyAccount/list_support_usage',   
+  'order_pkg'                 => 'MyAccount/order_pkg',     #add to ss cgi!
+  'change_pkg'                => 'MyAccount/change_pkg', 
+  'order_recharge'            => 'MyAccount/order_recharge',
+  'renew_info'                => 'MyAccount/renew_info',
+  'order_renew'               => 'MyAccount/order_renew',
+  'cancel_pkg'                => 'MyAccount/cancel_pkg',    #add to ss cgi!
+  'charge'                    => 'MyAccount/charge',        #?
+  'part_svc_info'             => 'MyAccount/part_svc_info',
+  'provision_acct'            => 'MyAccount/provision_acct',
+  'provision_external'        => 'MyAccount/provision_external',
+  'unprovision_svc'           => 'MyAccount/unprovision_svc',
+  'myaccount_passwd'          => 'MyAccount/myaccount_passwd',
+  'create_ticket'             => 'MyAccount/create_ticket',
+  'signup_info'               => 'Signup/signup_info',
+  'skin_info'                 => 'MyAccount/skin_info',
+  'access_info'               => 'MyAccount/access_info',
+  'domain_select_hash'        => 'Signup/domain_select_hash',  # expose?
+  'new_customer'              => 'Signup/new_customer',
+  'capture_payment'           => 'Signup/capture_payment',
+  'agent_login'               => 'Agent/agent_login',
+  'agent_logout'              => 'Agent/agent_logout',
+  'agent_info'                => 'Agent/agent_info',
+  'agent_list_customers'      => 'Agent/agent_list_customers',
+  'mason_comp'                => 'MasonComponent/mason_comp',
+  'call_time'                 => 'PrepaidPhone/call_time',
+  'call_time_nanpa'           => 'PrepaidPhone/call_time_nanpa',
+  'phonenum_balance'          => 'PrepaidPhone/phonenum_balance',
+  'bulk_processrow'           => 'Bulk/processrow',
+  'check_username'            => 'Bulk/check_username',
+  #sg
+  'ping'                      => 'SGNG/ping',
+  'decompify_pkgs'            => 'SGNG/decompify_pkgs',
+  'previous_payment_info'     => 'SGNG/previous_payment_info',
+  'previous_payment_info_renew_info'
+                              => 'SGNG/previous_payment_info_renew_info',
+  'previous_process_payment'  => 'SGNG/previous_process_payment',
+  'previous_process_payment_order_pkg'
+                              => 'SGNG/previous_process_payment_order_pkg',
+  'previous_process_payment_change_pkg'
+                              => 'SGNG/previous_process_payment_change_pkg',
+  'previous_process_payment_order_renew'
+                              => 'SGNG/previous_process_payment_order_renew',
+  };
+}
+
+
+#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/MANIFEST b/FS/MANIFEST
index e348b8b..f491b6c 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -17,6 +17,7 @@ bin/freeside-queued
 bin/freeside-radgroup
 bin/freeside-reexport
 bin/freeside-selfservice-server
+bin/freeside-selfservice-xmlrpcd
 bin/freeside-setinvoice
 bin/freeside-setup
 bin/freeside-sqlradius-radacctd
@@ -28,8 +29,15 @@ FS/CGI.pm
 FS/InitHandler.pm
 FS/ClientAPI.pm
 FS/ClientAPI_SessionCache.pm
+FS/ClientAPI_XMLRPC.pm
 FS/ClientAPI/passwd.pm
+FS/ClientAPI/Agent.pm
+FS/ClientAPI/Bulk.pm
+FS/ClientAPI/MasonComponent.pm
 FS/ClientAPI/MyAccount.pm
+FS/ClientAPI/PrepaidPhone.pm
+FS/ClientAPI/SGNG.pm
+FS/ClientAPI/Signup.pm
 FS/Conf.pm
 FS/ConfItem.pm
 FS/Cron/backup.pm
diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd
new file mode 100755
index 0000000..339f52f
--- /dev/null
+++ b/FS/bin/freeside-selfservice-xmlrpcd
@@ -0,0 +1,348 @@
+#!/usr/bin/perl
+#
+# based on http://www.perlmonks.org/?node_id=582781 by Justin Hawkins
+
+###
+# modules and variables, oh my
+###
+
+use warnings;
+use strict;
+
+#use SOAP::Transport::HTTP;
+use XMLRPC::Transport::HTTP;
+use XMLRPC::Lite; # for XMLRPC::Serializer
+
+use POE;                         # 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;
+
+
+#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.
+
+sub TESTING_CHURN () { 0 }       # Randomly shutdown children to test respawn.
+
+#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
+###
+
+my $user = shift or die &usage;
+
+#FS::ClientAPI
+load_clientapi_modules;
+
+###
+# 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;
+
+###
+# 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_chld   => \&server_got_sig_chld,
+            got_connection => \&server_got_connection,
+
+            _child => sub { 0 },
+          },
+        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( CHLD => "got_sig_chld" );
+    $kernel->sig( INT  => "got_sig_int" );
+
+    $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} ) {
+
+        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;
+            next;
+        }
+
+        # Child.  Clear the child process list.
+        DEBUG and warn "Server $$ forked successfully.\n";
+        $heap->{is_a_child} = 1;
+        $heap->{children}   = {};
+
+        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 {
+    DEBUG and warn "Server $$ received SIGINT.\n";
+    return 0;
+}
+
+### 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 {
+    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;
+}
+
+### 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,
+          },
+      );
+
+    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 ];
+
+    freeside_kid_time();
+
+    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);
+}
+
+#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.
+
+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;