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