view release on metacpan or  search on metacpan

lib/Any/Daemon/HTTP.pm  view on Meta::CPAN

# Copyrights 2013-2020 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Any-Daemon-HTTP. Meta-POD processed
# with OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Any::Daemon::HTTP;
use vars '$VERSION';
$VERSION = '0.30';


use Log::Report      'any-daemon-http';
use parent 'Any::Daemon';

use warnings;
use strict;

use Any::Daemon::HTTP::VirtualHost ();
use Any::Daemon::HTTP::Session     ();
use Any::Daemon::HTTP::Proxy       ();

use HTTP::Daemon     ();
use HTTP::Status     qw/:constants :is/;
use Socket           qw/inet_aton PF_INET AF_INET/;
use IO::Socket       qw/SOCK_STREAM SOMAXCONN SOL_SOCKET SO_LINGER/;
use IO::Socket::IP   ();
use IO::Select       ();
use File::Basename   qw/basename/;
use File::Spec       ();
use Scalar::Util     qw/blessed/;
use Errno            qw/EADDRINUSE/;

use constant   # default ports
  { PORT_HTTP  => 80
  , PORT_HTTPS => 443
  };

# To support IPv6, replace ::INET by ::IP
@HTTP::Daemon::ClientConn::ISA = qw(IO::Socket::IP);


sub _to_list($) { ref $_[0] eq 'ARRAY' ? @{$_[0]} : defined $_[0] ? $_[0] : () }

sub init($)
{   my ($self, $args) = @_;
    $self->SUPER::init($args);

    my $listen = $args->{listen} || $args->{socket} || $args->{host};
    my (@sockets, @hosts);
    foreach my $conn (_to_list $listen)
    {   my ($socket, @host) = $self->_create_socket($conn
          , protocol => $args->{protocol}
          );

        push @sockets, $socket if $socket;
        push @hosts, @host;
    }

    @sockets or error __x"host or socket required for {pkg}::new()"
      , pkg => ref $self;

    $self->{ADH_sockets} = \@sockets;
    $self->{ADH_hosts}   = \@hosts;

    $self->{ADH_session_class}
      = $args->{session_class} || 'Any::Daemon::HTTP::Session';
    $self->{ADH_vhost_class}
      = $args->{vhost_class}   || 'Any::Daemon::HTTP::VirtualHost';
    $self->{ADH_proxy_class}
      = $args->{proxy_class}   || 'Any::Daemon::HTTP::Proxy';

    $self->{ADH_vhosts}  = {};
    $self->addVirtualHost($_) for _to_list($args->{vhosts}  || $args->{vhost});

    $self->{ADH_proxies} = [];
    $self->addProxy($_)       for _to_list($args->{proxies} || $args->{proxy});

    !$args->{docroot}
        or error __x"docroot parameter has been removed in v0.11";

    $self->{ADH_server}  = $args->{server_id} || basename($0);
    $self->{ADH_headers} = $args->{standard_headers} || [];
    $self->{ADH_error}   = $args->{on_error}  || sub { $_[1] };
    $self->{ADH_show_ps} = exists $args->{show_in_ps} ? $args->{show_in_ps} : 1;

    # "handlers" is probably a common typo
    my $handler = $args->{handlers} || $args->{handler};

    my $host      = shift @hosts;
    $self->addVirtualHost
      ( name      => $host
      , aliases   => [@hosts, 'default']
      , documents => $args->{documents}
      , handler   => $handler
      ) if $args->{documents} || $handler;

    $self;
}

sub _create_socket($%)
{   my ($self, $listen, %args) = @_;
    defined $listen or return;

    return ($listen, $listen->sockhost.':'.$listen->sockport)
        if blessed $listen && $listen->isa('IO::Socket');

lib/Any/Daemon/HTTP.pm  view on Meta::CPAN

{   my ($self, %args) = @_;

    my $new_child = $args{new_child} || 'newChild';
    $args{new_connection} ||= 'newConnection';

    my $vhosts = $self->{ADH_vhosts};
    unless(keys %$vhosts)
    {   my ($host, @aliases) = $self->hosts;
        $self->addVirtualHost(name => $host, aliases => ['default', @aliases]);
    }

    # option handle_request is deprecated in 0.11
    if(my $handler = delete $args{handle_request})
    {   my (undef, $first) = %$vhosts;
        $first->addHandler('/' => $handler);
    }

    my $title      = $0 =~ /^(\S+)/ ? basename($1) : $0;

    my ($req_count, $conn_count) = (0, 0);
    my $max_conn   = $args{max_conn_per_child} || 10_000;
    $max_conn      = int(0.9 * $max_conn + rand(0.2 * $max_conn))
        if $max_conn > 10;

    my $max_req    = $args{max_req_per_child}  || 100_000;
    my $linger     = $args{linger};

    $self->psTitle("$title manager\x00\x00");
    $args{child_task} ||= sub {
        $self->psTitle("$title not used yet");
        # even with one port, we still select...
        my $select = IO::Select->new($self->sockets);

        $self->$new_child($select);

      CONNECTION:
        while(my @ready = $select->can_read)
        {
            foreach my $socket (@ready)
            {   my $client = $socket->accept or next;
                $client->sockopt(SO_LINGER, (pack "II", 1, $linger))
                    if defined $linger;

                $self->psTitle("$title handling "
                   . $client->peerhost.":".$client->peerport . " at "
                   . $client->sockhost.':'.$client->sockport);

                $req_count += $self->_connection($client, \%args);
                $client->close;

                last CONNECTION
                    if $conn_count++ >= $max_conn
                    || $req_count    >= $max_req;
            }
            $self->psTitle("$title idle after $conn_count");
        }
        0;
    };

    info __x"start running the webserver";
    $self->SUPER::run(%args);
}


sub newConnection($)
{   my ($self, $session) = @_;
    return $self;
}


sub newChild($)
{   my ($self, $select) = @_;
    return $self;
}


sub psTitle($)
{   my ($self, $string) = @_;
    $0 = $string if $self->{ADH_show_ps};
}

# HTTP::Daemon methods used by ::ClientConn.  We steal that parent role,
# but need to mimic the object a little.  The names are not compatible
# with MarkOv's convention, so hidden for the users of this module
sub url() { shift->{ADH_host_base} }
sub product_tokens() {shift->{ADH_server}}

1;

__END__