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 )