
package Proc::Prefork;

use Carp;
use POSIX;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

our $logger;

our $env_name = 'PREFORK_INTERP';

our @call_fds;
our $socket_path;

sub server_quit ($) {
  my ($m) = @_;
  syslog(LOG_INFO, "$0 prefork [$$]: $m, quitting");
  _exit(0);
}

sub become_monitor () {
  
}

sub initialisation_complete {
  my %opts = @_;

  # if env var not set, we're not running under prefork-interp
  my @env_params = split /,/, ($ENV{$env_name} // return), 5;
  croak "$env_name has too few entries" unless @env_params == 5;

  $num_servers = $opts{max_servers} // 4;

  #---- setup (pm) [1] ----

  $socket_path = pop @env_params;
  foreach (@env_params) {
    $_ eq ($_+0) or croak "$env_name contains $_, not a number";
  }
  open LISTEN, "<>&=$env_params[0]" or croak "listen fd: $!";
  open CALL,   "<>&=$env_params[1]" or croak "listen fd: $!";
  @call_fds = ($env_params[2], $env_params[3], 2);

  if (!$opts{no_openlog}) {
    openlog("prefork-interp $0", 'ndelay,nofatal,pid',
	    $opts{log_facility} // 'log_user');
  }

  open NULL, "<>/dev/null" or croak "open /dev/null: $!";

  #---- fork for server ----

  my $child = fork // croak "first fork failed: $!";
  if ($child) {
    #---- setup (pm) [2], exits ----
    _exit(0);
  }

  #---- server(pm) [1] ----

  $child = fork // croak "second fork failed: $!";
  if (!$child) {
    # we are the child, i.e. the one fa-monitor
    become_monitor();
  }

  our %children;
  $children{$child} = 1;
  
  # --- server(pm) [2] ----

  setsid() > 0 or fail("setsid: $!");
  open STDIN, "<&NULL" or fail("dup null onto stdin: $!");
  open STDOUT, ">&NULL" or fail("dup null onto stdout: $!");
  open STDERR, ">&NULL" or fail("dup null onto stderr: $!");
  close NULL;

  POSIX::close($_) foreach @call_fds;
  close CALL;

  my $flags = fcntl(LISTEN, F_GETFL, 0) or fail("F_GETFL listen socket: $!");
  $flags |= O_NONBLOCK;
  fcntl(LISTEN, F_SETFL, $flags) or fail("F_SETFL listen socket: $!");

  my $errcount = 0;

  for (;;) {
    # reap children
    if (%children) {
      my $full = %children >= $num_servers;
      my $got = waitpid -1, ($full ? 0 : WNOHANG);
      if ($?) {
	syslog(LOG_WARNING,
 "$0 prefork [$$]: monitor process [$got] failed with wait status $?");
      }
      if (!exists $children{$got}) {
	syslog(LOG_WARNING,
 "$0 prefork [$$]: monitor process [$got] wasn't one of ours?!");
      }
      delete $children{$got};
      next;
    }

    # select for accepting or housekeeping timeout
    my $rbits = '';
    vec($rbits, fileno(LISTEN), 1) = 1;
    my $ebits = $rbits;
    my $nfound = select($rbits, '', $ebits, ($opts{check_interval} // 300));

    if ($nfound) {
      if (accept(CALL, LISTEN)) {
	$child = fork // fail("fork for accepted call failed: $!");
	if (!$child) {
	  become_monitor();
	}
	close(CALL);
	$errcount = 0;
	$children{$child} = 1;
      } elsif ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK) {
      } else {
	syslog(LOG_WARNING, "$0 prefork [$$]: accept failed: $!");
	if ($errcount > ($opts{max_errors} // 100)) {
	  syslog(LOG_ERR,
		 "$0 prefork [$$]: too many accept failures, quitting");
	  _exit(16);
	}
      }
      next;
    }

    # are we still live?
    my @st_listen = stat(LISTEN) // fail("fstat listening socket: $!");
    my @st_socket = stat($socket_path) // do {
      if ($! == ENOENT) { server_quit("socket $socket is ENOENT"); }
      fail("stat socket $socket: $!");
    };
    if ("@st_listen[0..2]" ne "@st_socket[0..2]") {
      server_quit("socket $socket is no longer ours");
    }
  }
}

1;

__END__
