FS/bin/freeside-selfservice-xmlrpcd

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