| … | |
… | |
| 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 | |
| … | |
… | |
| 221 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
221 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
| 222 | |
222 | |
| 223 | weaken ($uri{$self->{uri}}{$self*1} = $self); |
223 | weaken ($uri{$self->{uri}}{$self*1} = $self); |
| 224 | |
224 | |
| 225 | $self->map_uri; |
225 | $self->map_uri; |
| 226 | |
|
|
| 227 | Coro::Event::do_timer(after => 5); |
|
|
| 228 | |
|
|
| 229 | $self->respond; |
226 | $self->respond; |
| 230 | #} |
227 | #} |
| 231 | } |
228 | } |
| 232 | |
229 | |
| 233 | # uri => path mapping |
230 | # uri => path mapping |
| … | |
… | |
| 406 | } |
403 | } |
| 407 | |
404 | |
| 408 | $h -= $l - 1; |
405 | $h -= $l - 1; |
| 409 | |
406 | |
| 410 | while ($h > 0) { |
407 | while ($h > 0) { |
| 411 | $h -= sysread $fh, $buf, $h > 16384 ? 16384 : $h; |
408 | $h -= sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h; |
| 412 | print {$self->{fh}} $buf |
409 | $self->{fh}->syswrite($buf) |
| 413 | or last; |
410 | or last; |
| 414 | cede; |
|
|
| 415 | } |
411 | } |
| 416 | } |
412 | } |
| 417 | |
413 | |
| 418 | close $fh; |
414 | close $fh; |
| 419 | } |
415 | } |
