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