#!/usr/bin/perl

=encoding UTF-8

=head1 NAME

rosetta_server

=head1 SYNOPSIS

rosetta_server --port=18066 [options]

=head1 OPTIONS

=over 15

=item B<--port>

Port numer to listen.

=item B<--daemonize>

To run server as daemon. If you use this option you must use --pid.

=item B<--pid>

Path to pid file.

=item B<--user>

Set daemon owner. (Only with --daemonize and run under root).

=item B<--children>

Number of children to be forked. Optional. Default 5.

=item B<--max-clients>

Number of maximum clients per child. Optional. Default 5.

=back

=cut

use qbit;
use IO::Socket::IP;
use Symbol;
use POSIX;
use Carp;
use Encode;
use Pod::Usage;
use Getopt::Long;
use Proc::Daemon;
use File::Basename;

use FindBin qw($Bin);
use lib "$Bin/../lib";

use Rosetta;
use RosettaProtocol qw(interact);
use Utils::Logger qw(INFO WARN), {
    logger => 'RosettaServer',
};

my $SERVER;
my $APP;
my $CHILDER_COUNT          = 5;
my $MAX_CLIENTS_PER_CHILD  = 5;
my %CHILDREN               = ();    # keys are current child process IDs
my $CURRENT_CHILDREN_COUNT = 0;

=head1 REAPER

takes care of dead children

=cut

sub REAPER {
    my ($sig) = @_;
    $SIG{CHLD} = \&REAPER;
    my $pid = wait;
    $CURRENT_CHILDREN_COUNT--;
    delete $CHILDREN{$pid};
}

=head1 HUNTSMAN

signal handler for SIGINT

=cut

sub HUNTSMAN {
    local ($SIG{CHLD}) = 'IGNORE';    # we're going to kill our children
    kill 'INT' => keys %CHILDREN;
    exit;                             # clean up with dignity
}

sub make_new_child {
    my $pid;
    my $sigset;

    # block signal for fork
    $sigset = POSIX::SigSet->new(SIGINT);
    sigprocmask(SIG_BLOCK, $sigset)
      or die "Can't block SIGINT for fork: $!\n";

    die "fork: $!" unless defined($pid = fork);

    if ($pid) {
        # Parent records the child's birth and returns.
        sigprocmask(SIG_UNBLOCK, $sigset)
          or die "Can't unblock SIGINT for fork: $!\n";
        $CHILDREN{$pid} = 1;
        $CURRENT_CHILDREN_COUNT++;

        return;
    } else {
        # Child can *not* return from this subroutine.
        $SIG{INT} = 'DEFAULT';    # make SIGINT kill us as it did before

        # unblock signals
        sigprocmask(SIG_UNBLOCK, $sigset)
          or die "Can't unblock SIGINT for fork: $!\n";

        # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
        for (my $i = 0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
            my $connection = $SERVER->accept() or last;

            my $other_end = getpeername($connection);

            my ($port, $iaddr, $ip_address);
            if (length($other_end) == 28) {
                ($port, $iaddr) = unpack_sockaddr_in6($other_end);
                $ip_address = Socket::inet_ntop(AF_INET6, $iaddr);
            } else {
                ($port, $iaddr) = unpack_sockaddr_in($other_end);
                $ip_address = inet_ntoa($iaddr);
            }

            $connection->autoflush(1);

            interact($connection, $APP);

            # явно закроем соединение
            close($connection);
        }

        # this exit is VERY important, otherwise the child will become
        # a producer of more and more children, forking yourself into
        # process death.
        exit;
    }
}

=head1 main

Script is based on http://docstore.mik.ua/orelly/perl/cookbook/ch17_13.htm

=cut

sub main {

    my %args;
    my $the_main_pid;

    GetOptions(\%args, 'help|h|?', 'port=i', 'children=i', 'max-clients=i', 'daemonize', 'user=s', 'pid=s',
        'logspath=s')
      or die "Error. $0 is run incorrectly.\n";

    if ($args{help}) {
        pod2usage(1);
        exit;
    }

    if (not defined $args{port}) {
        die "No port. Pleae run this command with port. Example: `$0 --port=18066`\n";
    }

    if ($args{'daemonize'}) {
        my $uid;
        if ($args{'user'}) {
            $uid = getpwnam($args{'user'});
            unless ($uid) {
                print gettext('User "%s" doesn\'t exists') . "\n";
                exit(1);
            }
        }

        if (not defined $args{port}) {
            die "No pid. You should use `--pid=...` with `--daemonize`\n";
        }

        my ($pid_file_name, $pid_file_path) = fileparse($args{pid});

        my $daemon = Proc::Daemon->new(
            ($uid ? (setuid => $uid) : ()),
            work_dir => $pid_file_path,
            pid_file => $pid_file_name,
            $args{'logspath'}
            ? (
                child_STDOUT => '>> ' . $args{'logspath'} . '/partner2_rosetta_server.log',
                child_STDERR => '>> ' . $args{'logspath'} . '/partner2_rosetta_server.err',
              )
            : ()
        );
        $daemon->Init();
    }

    if ($args{'children'}) {
        $CHILDER_COUNT = $args{'children'};
    }

    if ($args{'max-clients'}) {
        $MAX_CLIENTS_PER_CHILD = $args{'max-clients'};
    }

    $SERVER = IO::Socket::IP->new(
        Proto     => 'tcp',
        LocalPort => $args{port},
        Type      => SOCK_STREAM,
        Family    => AF_INET6,
        ReuseAddr => 1,
        Listen    => 10,
    );
    croak "Can't create socket: $!" unless $SERVER;

    $APP = Rosetta->new();

    # Fork off our children.
    for (1 .. $CHILDER_COUNT) {
        make_new_child();
    }

    # Install signal handlers.
    $SIG{CHLD} = \&REAPER;
    $SIG{INT}  = \&HUNTSMAN;
    $SIG{QUIT} = \&HUNTSMAN;
    $SIG{TERM} = \&HUNTSMAN;

    # And maintain the population.
    while (1) {
        sleep;    # wait for a signal (i.e., child's death)
        for (my $i = $CURRENT_CHILDREN_COUNT; $i < $CHILDER_COUNT; $i++) {
            make_new_child();    # top up the child pool
        }
    }

}

my $is_used_from_other_module = caller() ? 1 : 0;

unless ($is_used_from_other_module) {
    # do not run under "use" or "require" (f.e. from test)
    main();
}
