LightTCP-Server

 view release on metacpan or  search on metacpan

lib/LightTCP/Server.pm  view on Meta::CPAN

    if (@_ > 1) {
        $self->{_rate_limit_data} = $value;
    }
    return $self->{_rate_limit_data};
}

sub _upload_lock {
    my ($self, $value) = @_;
    if (@_ > 1) {
        $self->{_upload_lock} = $value;
    }
    return $self->{_upload_lock};
}

sub _init_config {
    my ($self) = @_;

    if ($self->verbose) {
        for my $attr (qw(server_addr server_name server_type max_threads server_timeout
                         server_dir server_etc server_deny server_secure server_auth
                         runas_user runas_group server_http server_perlonly server_fnext
                         server_cgi server_cgiext http_postlimit logfn verbose)) {
            $self->logit(sprintf("- %-16s = %s", $attr, $self->$attr), 2);
        }
    }
}

sub _create_server {
    my ($self) = @_;

    my $server = IO::Socket::INET->new(
        LocalAddr => $self->server_addr,
        Proto     => 'tcp',
        Listen    => SOMAXCONN,
        ReuseAddr => SO_REUSEADDR
    );

    if (!$server) {
        $self->logit("# Error: Failed to bind to " . $self->server_addr . " - $!", 0);
        return undef;
    }

    $self->_server($server);
    $self->logit("# " . $self->server_name . " Listening for requests on " . $self->server_addr, 0);
    return $server;
}

sub _set_runas {
    my ($self) = @_;

    my $user = $self->runas_user;
    my $group = $self->runas_group;

    if ($user ne '' || $group ne '') {
        if ($group ne '') {
            my $gid = getgrnam($group);
            $) = "$gid $gid" or $self->logit("# Error setting group $group: $!", 0) if $gid;
        }
        if ($user ne '') {
            my $uid = getpwnam($user);
            chown($uid, -1, $self->logfn) if $self->logfn ne '';
            $> = $uid or $self->logit("# Error setting user $user: $!", 0) if $uid;
        }
        $self->logit("# Running as user $user and group $group", 0);
    }
}

sub start {
    my ($self) = @_;

    my $server = $self->_create_server();
    return 0 unless defined $server;

    $self->_set_runas();

    $self->_serverloop(1);
    $| = 1;

    local $SIG{INT}  = sub { $self->_signal_handler() };
    local $SIG{TERM} = sub { $self->_signal_handler() };

    #$self->logit("# " . $self->server_name . " Listening for requests on " . $self->server_addr, 0);

    my $threads = $self->_threads;

    while ($self->_serverloop) {
        if ($self->server_timeout == 0) {
            my $remain = 86400 - (time() % 86400);
            $server->timeout($remain);
        } elsif ($self->server_timeout > 0) {
            $server->timeout($self->server_timeout);
        }

        my $client = $server->accept();
        if ($self->_serverloop) {
            if (!defined $client) {
                if ($! =~ /timed out/i) {
                    $self->logit("# Timeout waiting for client connection (timeout: " . $self->server_timeout . "s)");
                    if ($self->server_timeout == 0) {
                        $self->_serverloop(0);
                    } else {
                        my $func = $self->func_timeout;
                        $func->($self) if $func;
                    }
                } else {
                    $self->logit("# Error accepting client connection: $!", 0);
                }
            } elsif ($self->server_type eq 'fork') {
                my $pid = fork;
                die "fork: $!" unless defined $pid;
                if ($pid) {
                    close $client;
                } else {
                    close $server;
                    $self->_handle_client($client);
                    exit 0;
                }
            } elsif ($self->server_type eq 'thread') {
                while (scalar(@$threads) >= $self->max_threads) {
                    $threads = [ grep { $_->is_running() } @$threads ];
                    sleep 1 if scalar(@$threads) >= $self->max_threads;



( run in 2.907 seconds using v1.01-cache-2.11-cpan-71847e10f99 )