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; |