… | |
… | |
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 | |
86 | $self->{remote_addr} = inet_ntoa $iaddr; |
87 | $self->{remote_addr} = inet_ntoa $iaddr; |
87 | |
88 | |
88 | # enter ourselves into various lists |
89 | # enter ourselves into various lists |
89 | weaken ($conn{$self->{remote_addr}}{$self*1} = $self); |
90 | weaken ($conn{$self->{remote_addr}}{$self*1} = $self); |
90 | |
91 | |
… | |
… | |
221 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
222 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
222 | |
223 | |
223 | weaken ($uri{$self->{uri}}{$self*1} = $self); |
224 | weaken ($uri{$self->{uri}}{$self*1} = $self); |
224 | |
225 | |
225 | $self->map_uri; |
226 | $self->map_uri; |
226 | |
|
|
227 | Coro::Event::do_timer(after => 5); |
|
|
228 | |
|
|
229 | $self->respond; |
227 | $self->respond; |
230 | #} |
228 | #} |
231 | } |
229 | } |
232 | |
230 | |
233 | # uri => path mapping |
231 | # uri => path mapping |
… | |
… | |
247 | |
245 | |
248 | $self->{name} = $uri; |
246 | $self->{name} = $uri; |
249 | |
247 | |
250 | # now do the path mapping |
248 | # now do the path mapping |
251 | $self->{path} = "$::DOCROOT/$host$uri"; |
249 | $self->{path} = "$::DOCROOT/$host$uri"; |
|
|
250 | |
|
|
251 | $self->access_check; |
252 | } |
252 | } |
253 | |
253 | |
254 | sub server_address { |
254 | sub server_address { |
255 | my $self = shift; |
255 | my $self = shift; |
256 | my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname |
256 | my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname |
… | |
… | |
406 | } |
406 | } |
407 | |
407 | |
408 | $h -= $l - 1; |
408 | $h -= $l - 1; |
409 | |
409 | |
410 | while ($h > 0) { |
410 | while ($h > 0) { |
411 | $h -= sysread $fh, $buf, $h > 16384 ? 16384 : $h; |
411 | $h -= sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h; |
412 | print {$self->{fh}} $buf |
412 | $self->{fh}->syswrite($buf) |
413 | or last; |
413 | or last; |
414 | cede; |
|
|
415 | } |
414 | } |
416 | } |
415 | } |
417 | |
416 | |
418 | close $fh; |
417 | close $fh; |
419 | } |
418 | } |
420 | |
419 | |
|
|
420 | sub access_check { |
|
|
421 | my $self = shift; |
|
|
422 | my $whois = ::ip_request($self->{remote_addr}); |
|
|
423 | |
|
|
424 | if ($whois =~ /^\*cy: (\S+)/m) { |
|
|
425 | $self->slog(9, "COUNTRY($1)"); |
|
|
426 | } else { |
|
|
427 | $self->slog(9, "no country($whois)"); |
|
|
428 | } |
|
|
429 | } |
|
|
430 | |
421 | 1; |
431 | 1; |