| 1 | #!/usr/bin/perl |
|
|
| 2 | |
|
|
| 3 | use Coro; |
1 | use Coro; |
| 4 | use Coro::Semaphore; |
2 | use Coro::Semaphore; |
| 5 | use Coro::Event; |
3 | use Coro::Event; |
| 6 | use Coro::Socket; |
4 | use Coro::Socket; |
| 7 | |
5 | |
| … | |
… | |
| 30 | my $connections = new Coro::Semaphore $MAX_CONNECTS; |
28 | my $connections = new Coro::Semaphore $MAX_CONNECTS; |
| 31 | |
29 | |
| 32 | my @fh; |
30 | my @fh; |
| 33 | my @pool; |
31 | my @pool; |
| 34 | |
32 | |
|
|
33 | # one "execution thread" |
| 35 | sub handler { |
34 | sub handler { |
| 36 | while () { |
35 | while () { |
| 37 | my $fh = pop @fh; |
36 | my $fh = pop @fh; |
| 38 | if ($fh) { |
37 | if ($fh) { |
| 39 | eval { |
38 | eval { |
| … | |
… | |
| 48 | schedule; |
47 | schedule; |
| 49 | } |
48 | } |
| 50 | } |
49 | } |
| 51 | } |
50 | } |
| 52 | |
51 | |
|
|
52 | # the "main thread" |
| 53 | async { |
53 | async { |
| 54 | slog 1, "accepting connections"; |
54 | slog 1, "accepting connections"; |
| 55 | while () { |
55 | while () { |
| 56 | $connections->down; |
56 | $connections->down; |
| 57 | push @fh, $port->accept; |
57 | push @fh, $port->accept; |
| … | |
… | |
| 70 | |
70 | |
| 71 | package conn; |
71 | package conn; |
| 72 | |
72 | |
| 73 | use Socket; |
73 | use Socket; |
| 74 | use HTTP::Date; |
74 | use HTTP::Date; |
|
|
75 | use Convert::Scalar 'weaken'; |
|
|
76 | |
|
|
77 | my %conn; # $conn{ip}{fh} => connobj |
| 75 | |
78 | |
| 76 | sub new { |
79 | sub new { |
| 77 | my $class = shift; |
80 | my $class = shift; |
| 78 | my $fh = shift; |
81 | my $fh = shift; |
|
|
82 | my $self = bless { fh => $fh }, $class; |
| 79 | my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername |
83 | my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername |
| 80 | or $self->err(500, "unable to get peername"); |
84 | or $self->err(500, "unable to get peername"); |
| 81 | $self->{remote_address} = inet_ntoa $iaddr; |
85 | $self->{remote_address} = inet_ntoa $iaddr; |
| 82 | bless { fh => $fh }, $class; |
86 | |
|
|
87 | # enter ourselves into various lists |
|
|
88 | weaken ($conn{$self->{remote_address}}{$self*1} = $self); |
|
|
89 | print $self->{remote_address}.": ".($self*1)." > ".%{$conn{$self->{remote_address}}},"\n"; |
|
|
90 | $self; |
|
|
91 | } |
|
|
92 | |
|
|
93 | sub DESTROY { |
|
|
94 | my $self = shift; |
|
|
95 | delete $conn{$self->{remote_address}}{$self*1}; |
| 83 | } |
96 | } |
| 84 | |
97 | |
| 85 | sub slog { |
98 | sub slog { |
| 86 | main::slog(@_); |
99 | main::slog(@_); |
| 87 | } |
100 | } |
| … | |
… | |
| 94 | |
107 | |
| 95 | while (my ($h, $v) = each %$hdr) { |
108 | while (my ($h, $v) = each %$hdr) { |
| 96 | $res .= "$h: $v\015\012" |
109 | $res .= "$h: $v\015\012" |
| 97 | } |
110 | } |
| 98 | $res .= "\015\012$content" if defined $content; |
111 | $res .= "\015\012$content" if defined $content; |
|
|
112 | |
|
|
113 | print STDERR "$self->{remote_address} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d# |
| 99 | |
114 | |
| 100 | print {$self->{fh}} $res; |
115 | print {$self->{fh}} $res; |
| 101 | } |
116 | } |
| 102 | |
117 | |
| 103 | sub err { |
118 | sub err { |
| … | |
… | |
| 165 | } |
180 | } |
| 166 | |
181 | |
| 167 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
182 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
| 168 | |
183 | |
| 169 | $self->map_uri; |
184 | $self->map_uri; |
|
|
185 | |
|
|
186 | Coro::Event::do_timer(after => 5); |
|
|
187 | |
| 170 | $self->respond; |
188 | $self->respond; |
| 171 | #} |
189 | #} |
| 172 | } |
190 | } |
| 173 | |
191 | |
| 174 | # uri => path mapping |
192 | # uri => path mapping |
| … | |
… | |
| 347 | } |
365 | } |
| 348 | } |
366 | } |
| 349 | |
367 | |
| 350 | close $fh; |
368 | close $fh; |
| 351 | } |
369 | } |
|
|
370 | |
|
|
371 | 1; |
