| … | |
… | |
| 18 | printf "---: $format\n", @_; |
18 | printf "---: $format\n", @_; |
| 19 | } |
19 | } |
| 20 | |
20 | |
| 21 | my $connections = new Coro::Semaphore $MAX_CONNECTS; |
21 | my $connections = new Coro::Semaphore $MAX_CONNECTS; |
| 22 | |
22 | |
| 23 | my @fh; |
23 | my @newcons; |
| 24 | my @pool; |
24 | my @pool; |
| 25 | |
25 | |
| 26 | # one "execution thread" |
26 | # one "execution thread" |
| 27 | sub handler { |
27 | sub handler { |
| 28 | while () { |
28 | while () { |
| 29 | my $fh = pop @fh; |
29 | my $new = pop @newcons; |
| 30 | if ($fh) { |
30 | if ($new) { |
| 31 | eval { |
31 | eval { |
| 32 | conn->new($fh)->handle; |
32 | conn->new(@$new)->handle; |
| 33 | }; |
33 | }; |
| 34 | close $fh; |
|
|
| 35 | slog 1, "$@" if $@ && !ref $@; |
34 | slog 1, "$@" if $@ && !ref $@; |
| 36 | $connections->up; |
35 | $connections->up; |
| 37 | } else { |
36 | } else { |
| 38 | last if @pool >= $MAX_POOL; |
37 | last if @pool >= $MAX_POOL; |
| 39 | push @pool, $Coro::current; |
38 | push @pool, $Coro::current; |
| … | |
… | |
| 54 | # the "main thread" |
53 | # the "main thread" |
| 55 | async { |
54 | async { |
| 56 | slog 1, "accepting connections"; |
55 | slog 1, "accepting connections"; |
| 57 | while () { |
56 | while () { |
| 58 | $connections->down; |
57 | $connections->down; |
| 59 | push @fh, $http_port->accept; |
58 | push @newcons, [$http_port->accept]; |
| 60 | #slog 3, "accepted @$connections ".scalar(@pool); |
59 | #slog 3, "accepted @$connections ".scalar(@pool); |
| 61 | $::NOW = time; |
60 | $::NOW = time; |
| 62 | if (@pool) { |
61 | if (@pool) { |
| 63 | (pop @pool)->ready; |
62 | (pop @pool)->ready; |
| 64 | } else { |
63 | } else { |
| … | |
… | |
| 77 | our %conn; # $conn{ip}{fh} => connobj |
76 | our %conn; # $conn{ip}{fh} => connobj |
| 78 | our %blocked; |
77 | our %blocked; |
| 79 | |
78 | |
| 80 | sub new { |
79 | sub new { |
| 81 | my $class = shift; |
80 | my $class = shift; |
|
|
81 | my $peername = shift; |
| 82 | my $fh = shift; |
82 | my $fh = shift; |
| 83 | my $self = bless { fh => $fh }, $class; |
83 | my $self = bless { fh => $fh }, $class; |
| 84 | my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername |
84 | my (undef, $iaddr) = unpack_sockaddr_in $peername |
| 85 | or $self->err(500, "unable to get peername"); |
85 | or $self->err(500, "unable to decode peername"); |
| 86 | $self->{remote_addr} = inet_ntoa $iaddr; |
86 | $self->{remote_addr} = inet_ntoa $iaddr; |
| 87 | |
87 | |
| 88 | # enter ourselves into various lists |
88 | # enter ourselves into various lists |
| 89 | weaken ($conn{$self->{remote_addr}}{$self*1} = $self); |
89 | weaken ($conn{$self->{remote_addr}}{$self*1} = $self); |
| 90 | |
90 | |
