FS/bin/freeside-selfservice-xmlrpcd

   1 #!/usr/bin/perl
   2 #
   3 # based on http://www.perlmonks.org/?node_id=582781 by Justin Hawkins
   4
   5 ###
   6 # modules and variables, oh my
   7 ###
   8
   9 use warnings;
  10 use strict;
  11
  12 #use SOAP::Transport::HTTP;
  13 use XMLRPC::Transport::HTTP;
  14 use XMLRPC::Lite; # for XMLRPC::Serializer
  15
  16 use POE;                         # Base features.
  17 use POE::Filter::HTTPD;          # For serving HTTP content.
  18 use POE::Wheel::ReadWrite;       # For socket I/O.
  19 use POE::Wheel::SocketFactory;   # For serving socket connections.
  20
  21 use FS::UID qw(adminsuidsetup);
  22 #use FS::SelfService::XMLRPC;
  23 use FS::ClientAPI qw( load_clientapi_modules );
  24 use FS::ClientAPI_XMLRPC;
  25
  26
  27 #sub DEBUG ()         { 0 }       # Enable a lot of runtime information.
  28 #sub MAX_PROCESSES () { 10 }      # Total number of server processes.
  29 #sub SERVER_PORT ()   { 8092 }    # Server port to listen on.
  30 sub DEBUG ()         { 0 }       # Enable a lot of runtime information.
  31 sub MAX_PROCESSES () { 32 }      # Total number of server processes.
  32 sub SERVER_PORT ()   { 8080 }    # Server port to listen on.
  33
  34 sub TESTING_CHURN () { 0 }       # Randomly shutdown children to test respawn.
  35
  36 #xmlrpc.cgi
  37 my %typelookup = (
  38   base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'],
  39   dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'],
  40   string => [40, sub {1}, 'as_string'],
  41 );
  42
  43 # These are HTTP::Request headers that have methods.
  44 my @method_headers =
  45   qw( authorization authorization_basic
  46   content content_encoding content_language content_length content_type
  47   date expires from if_modified_since if_unmodified_since last_modified
  48   method protocol proxy_authorization proxy_authorization_basic referer
  49   server title url user_agent www_authenticate
  50 );
  51
  52 # These are HTTP::Request headers that do not have methods.
  53 my @header_headers =
  54   qw( username opaque stale algorithm realm uri qop auth nonce cnonce
  55   nc response
  56 );
  57
  58 ###
  59 # init
  60 ###
  61
  62 my $user = shift or die &usage;
  63
  64 #FS::ClientAPI
  65 load_clientapi_modules;
  66
  67 ###
  68 # the main loop
  69 ###
  70
  71 # Spawn up to MAX_PROCESSES server processes, and then run them.  Exit
  72 # when they are done.
  73
  74 server_spawn(MAX_PROCESSES);
  75 $poe_kernel->run();
  76
  77 #XXX we probably want to sleep a bit and then try all over again...
  78 exit 0;
  79
  80 ###
  81 # the subroutines
  82 ###
  83
  84 ### Spawn the main server.  This will run as the parent process.
  85
  86 sub server_spawn {
  87     my ($max_processes) = @_;
  88
  89     POE::Session->create
  90       ( inline_states =>
  91           { _start => \&server_start,
  92             _stop          => \&server_stop,
  93             do_fork        => \&server_do_fork,
  94             got_error      => \&server_got_error,
  95             got_sig_int    => \&server_got_sig_int,
  96             got_sig_chld   => \&server_got_sig_chld,
  97             got_connection => \&server_got_connection,
  98
  99             _child => sub { 0 },
 100           },
 101         heap =>
 102           { max_processes => $max_processes,
 103           },
 104       );
 105 }
 106
 107 ### The main server session has started.  Set up the server socket and
 108 ### bookkeeping information, then fork the initial child processes.
 109
 110 sub server_start {
 111     my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
 112
 113     $heap->{server} = POE::Wheel::SocketFactory->new
 114       ( BindPort => SERVER_PORT,
 115         SuccessEvent => "got_connection",
 116         FailureEvent => "got_error",
 117         Reuse        => "yes",
 118       );
 119
 120     $kernel->sig( CHLD => "got_sig_chld" );
 121     $kernel->sig( INT  => "got_sig_int" );
 122
 123     $heap->{children}   = {};
 124     $heap->{is_a_child} = 0;
 125
 126     warn "Server $$ has begun listening on port ", SERVER_PORT, "\n";
 127
 128     $kernel->yield("do_fork");
 129 }
 130
 131 ### The server session has shut down.  If this process has any
 132 ### children, signal them to shutdown too.
 133
 134 sub server_stop {
 135     my $heap = $_[HEAP];
 136     DEBUG and warn "Server $$ stopped.\n";
 137     if ( my @children = keys %{ $heap->{children} } ) {
 138         DEBUG and warn "Server $$ is signaling children to stop.\n";
 139         kill INT => @children;
 140     }
 141 }
 142
 143 ### The server session has encountered an error.  Shut it down.
 144
 145 sub server_got_error {
 146     my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ];
 147       warn( "Server $$ got $syscall error $errno: $error\n",
 148         "Server $$ is shutting down.\n",
 149       );
 150     delete $heap->{server};
 151 }
 152
 153 ### The server has a need to fork off more children.  Only honor that
 154 ### request form the parent, otherwise we would surely "forkbomb".
 155 ### Fork off as many child processes as we need.
 156
 157 sub server_do_fork {
 158     my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
 159
 160     return if $heap->{is_a_child};
 161
 162     my $current_children = keys %{ $heap->{children} };
 163     for ( $current_children + 2 .. $heap->{max_processes} ) {
 164
 165         DEBUG and warn "Server $$ is attempting to fork.\n";
 166
 167         my $pid = fork();
 168
 169         unless ( defined($pid) ) {
 170             DEBUG and
 171               warn( "Server $$ fork failed: $!\n",
 172                 "Server $$ will retry fork shortly.\n",
 173               );
 174             $kernel->delay( do_fork => 1 );
 175             return;
 176         }
 177
 178         # Parent.  Add the child process to its list.
 179         if ($pid) {
 180             $heap->{children}->{$pid} = 1;
 181             next;
 182         }
 183
 184         # Child.  Clear the child process list.
 185         DEBUG and warn "Server $$ forked successfully.\n";
 186         $heap->{is_a_child} = 1;
 187         $heap->{children}   = {};
 188
 189         return;
 190     }
 191 }
 192
 193 ### The server session received SIGINT.  Don't handle the signal,
 194 ### which in turn will trigger the process to exit gracefully.
 195
 196 sub server_got_sig_int {
 197     DEBUG and warn "Server $$ received SIGINT.\n";
 198     return 0;
 199 }
 200
 201 ### The server session received a SIGCHLD, indicating that some child
 202 ### server has gone away.  Remove the child's process ID from our
 203 ### list, and trigger more fork() calls to spawn new children.
 204
 205 sub server_got_sig_chld {
 206     my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ];
 207
 208     if ( delete $heap->{children}->{$child_pid} ) {
 209         DEBUG and warn "Server $$ received SIGCHLD.\n";
 210         $kernel->yield("do_fork");
 211     }
 212     return 0;
 213 }
 214
 215 ### The server session received a connection request.  Spawn off a
 216 ### client handler session to parse the request and respond to it.
 217
 218 sub server_got_connection {
 219     my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ];
 220
 221     DEBUG and warn "Server $$ received a connection.\n";
 222
 223     POE::Session->create
 224       ( inline_states =>
 225           { _start => \&client_start,
 226             _stop       => \&client_stop,
 227             got_request => \&client_got_request,
 228             got_flush   => \&client_flushed_request,
 229             got_error   => \&client_got_error,
 230             _parent     => sub { 0 },
 231           },
 232         heap =>
 233           { socket => $socket,
 234             peer_addr => $peer_addr,
 235             peer_port => $peer_port,
 236           },
 237       );
 238
 239     delete $heap->{server}
 240       if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 );
 241 }
 242
 243 ### The client handler has started.  Wrap its socket in a ReadWrite
 244 ### wheel to begin interacting with it.
 245
 246 sub client_start {
 247     my $heap = $_[HEAP];
 248
 249     $heap->{client} = POE::Wheel::ReadWrite->new
 250       ( Handle => $heap->{socket},
 251         Filter       => POE::Filter::HTTPD->new(),
 252         InputEvent   => "got_request",
 253         ErrorEvent   => "got_error",
 254         FlushedEvent => "got_flush",
 255       );
 256
 257     DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n";
 258 }
 259
 260 ### The client handler has stopped.  Log that fact.
 261
 262 sub client_stop {
 263     DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n";
 264 }
 265
 266 ### The client handler has received a request.  If it's an
 267 ### HTTP::Response object, it means some error has occurred while
 268 ### parsing the request.  Send that back and return immediately.
 269 ### Otherwise parse and process the request, generating and sending an
 270 ### HTTP::Response object in response.
 271
 272 sub client_got_request {
 273     my ( $heap, $request ) = @_[ HEAP, ARG0 ];
 274
 275     freeside_kid_time();
 276
 277     my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup);
 278
 279     #my $soap = SOAP::Transport::HTTP::Server
 280     my $soap = XMLRPC::Transport::HTTP::Server
 281                -> new
 282                -> dispatch_to('FS::ClientAPI_XMLRPC')
 283                -> serializer($serializer);
 284
 285     DEBUG and
 286       warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n";
 287
 288     if ( $request->isa("HTTP::Response") ) {
 289         $heap->{client}->put($request);
 290         return;
 291     }
 292
 293     $soap->request($request);
 294     $soap->handle;
 295     my $response = $soap->response;
 296
 297     $heap->{client}->put($response);
 298 }
 299
 300 #setup the database connection and other things FS::SelfService::XMLRPC
 301 #expects to be in place.  aka "kid time" in freeside-selfservice-server
 302 sub freeside_kid_time {
 303
 304   #if we need a db connection in the parent
 305   ##get new db handle
 306   #$FS::UID::dbh->{InactiveDestroy} = 1;
 307   #forksuidsetup($user);
 308
 309   adminsuidsetup($user);
 310
 311   #i guess that was it
 312 }
 313
 314 ### The client handler received an error.  Stop the ReadWrite wheel,
 315 ### which also closes the socket.
 316
 317 sub client_got_error {
 318     my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ];
 319     DEBUG and
 320       warn( "Client handler $$/", $_[SESSION]->ID,
 321         " got $operation error $errnum: $errstr\n",
 322         "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n"
 323       );
 324     delete $heap->{client};
 325 }
 326
 327 ### The client handler has flushed its response to the socket.  We're
 328 ### done with the client connection, so stop the ReadWrite wheel.
 329
 330 sub client_flushed_request {
 331     my $heap = $_[HEAP];
 332     DEBUG and
 333       warn( "Client handler $$/", $_[SESSION]->ID,
 334         " flushed its response.\n",
 335         "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n"
 336       );
 337     delete $heap->{client};
 338 }
 339
 340 sub usage {
 341   die "Usage:\n\n  freeside-selfservice-xmlrpcd user\n";
 342 }
 343
 344 ###
 345 # the end
 346 ###
 347
 348 1;