… | |
… | |
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; |
58 | #slog 3, "accepted @$connections ".scalar(@pool); |
58 | #slog 3, "accepted @$connections ".scalar(@pool); |
|
|
59 | $::NOW = time; |
59 | if (@pool) { |
60 | if (@pool) { |
60 | (pop @pool)->ready; |
61 | (pop @pool)->ready; |
61 | } else { |
62 | } else { |
62 | async \&handler; |
63 | async \&handler; |
63 | } |
64 | } |
… | |
… | |
72 | |
73 | |
73 | use Socket; |
74 | use Socket; |
74 | use HTTP::Date; |
75 | use HTTP::Date; |
75 | use Convert::Scalar 'weaken'; |
76 | use Convert::Scalar 'weaken'; |
76 | |
77 | |
77 | my %conn; # $conn{ip}{fh} => connobj |
78 | our %conn; # $conn{ip}{fh} => connobj |
|
|
79 | our %blocked; |
78 | |
80 | |
79 | sub new { |
81 | sub new { |
80 | my $class = shift; |
82 | my $class = shift; |
81 | my $fh = shift; |
83 | my $fh = shift; |
82 | my $self = bless { fh => $fh }, $class; |
84 | my $self = bless { fh => $fh }, $class; |
83 | my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername |
85 | my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername |
84 | or $self->err(500, "unable to get peername"); |
86 | or $self->err(500, "unable to get peername"); |
85 | $self->{remote_address} = inet_ntoa $iaddr; |
87 | $self->{remote_addr} = inet_ntoa $iaddr; |
86 | |
88 | |
87 | # enter ourselves into various lists |
89 | # enter ourselves into various lists |
88 | weaken ($conn{$self->{remote_address}}{$self*1} = $self); |
90 | weaken ($conn{$self->{remote_addr}}{$self*1} = $self); |
|
|
91 | |
89 | print $self->{remote_address}.": ".($self*1)." > ".%{$conn{$self->{remote_address}}},"\n"; |
92 | print "$self->{remote_addr}: ".($self*1)." > ".%{$conn{$self->{remote_addr}}},"\n"; |
90 | $self; |
93 | $self; |
91 | } |
94 | } |
92 | |
95 | |
93 | sub DESTROY { |
96 | sub DESTROY { |
94 | my $self = shift; |
97 | my $self = shift; |
95 | delete $conn{$self->{remote_address}}{$self*1}; |
98 | delete $conn{$self->{remote_addr}}{$self*1}; |
|
|
99 | delete $uri{$self->{uri}}{$self*1}; |
96 | } |
100 | } |
97 | |
101 | |
98 | sub slog { |
102 | sub slog { |
99 | main::slog(@_); |
103 | main::slog(@_); |
100 | } |
104 | } |
101 | |
105 | |
102 | sub print_response { |
106 | sub print_response { |
103 | my ($self, $code, $msg, $hdr, $content) = @_; |
107 | my ($self, $code, $msg, $hdr, $content) = @_; |
104 | my $res = "HTTP/1.0 $code $msg\015\012"; |
108 | my $res = "HTTP/1.0 $code $msg\015\012"; |
105 | |
109 | |
106 | $hdr->{Date} = time2str time; # slow? nah. |
110 | $hdr->{Date} = time2str $::NOW; # slow? nah. |
107 | |
111 | |
108 | while (my ($h, $v) = each %$hdr) { |
112 | while (my ($h, $v) = each %$hdr) { |
109 | $res .= "$h: $v\015\012" |
113 | $res .= "$h: $v\015\012" |
110 | } |
114 | } |
111 | $res .= "\015\012$content" if defined $content; |
115 | $res .= "\015\012$content" if defined $content; |
112 | |
116 | |
113 | print STDERR "$self->{remote_address} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d# |
117 | print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d# |
114 | |
118 | |
115 | print {$self->{fh}} $res; |
119 | print {$self->{fh}} $res; |
116 | } |
120 | } |
117 | |
121 | |
118 | sub err { |
122 | sub err { |
… | |
… | |
130 | $self->print_response($code, $msg, $hdr, $content); |
134 | $self->print_response($code, $msg, $hdr, $content); |
131 | |
135 | |
132 | die bless {}, err::; |
136 | die bless {}, err::; |
133 | } |
137 | } |
134 | |
138 | |
|
|
139 | sub err_blocked { |
|
|
140 | my $self = shift; |
|
|
141 | my $ip = $self->{remote_addr}; |
|
|
142 | my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME; |
|
|
143 | $self->err(403, "too many connections", |
|
|
144 | { "Retry-After" => $::BLOCKTIME }, |
|
|
145 | <<EOF); |
|
|
146 | You have been blocked because you opened too many connections. You |
|
|
147 | may retry at $time. Until then, |
|
|
148 | every new access will renew the block. |
|
|
149 | EOF |
|
|
150 | } |
|
|
151 | |
135 | sub handle { |
152 | sub handle { |
136 | my $self = shift; |
153 | my $self = shift; |
137 | my $fh = $self->{fh}; |
154 | my $fh = $self->{fh}; |
138 | |
155 | |
139 | #while() { |
156 | #while() { |
… | |
… | |
144 | my $req = $fh->readline("\015\012\015\012"); |
161 | my $req = $fh->readline("\015\012\015\012"); |
145 | $fh->timeout($::RES_TIMEOUT); |
162 | $fh->timeout($::RES_TIMEOUT); |
146 | |
163 | |
147 | defined $req or |
164 | defined $req or |
148 | $self->err(408, "request timeout"); |
165 | $self->err(408, "request timeout"); |
|
|
166 | |
|
|
167 | my $ip = $self->{remote_addr}; |
|
|
168 | |
|
|
169 | if ($blocked{$ip}) { |
|
|
170 | $self->err_blocked($blocked{$ip}) |
|
|
171 | if $blocked{$ip} > $::NOW; |
|
|
172 | |
|
|
173 | delete $blocked{$ip}; |
|
|
174 | } |
|
|
175 | |
|
|
176 | if (%{$conn{$ip}} > $::MAX_CONN_IP) { |
|
|
177 | $self->slog("blocked ip $ip"); |
|
|
178 | $self->err_blocked; |
|
|
179 | } |
149 | |
180 | |
150 | $req =~ /^(?:\015\012)? |
181 | $req =~ /^(?:\015\012)? |
151 | (GET|HEAD) \040+ |
182 | (GET|HEAD) \040+ |
152 | ([^\040]+) \040+ |
183 | ([^\040]+) \040+ |
153 | HTTP\/([0-9]+\.[0-9]+) |
184 | HTTP\/([0-9]+\.[0-9]+) |
… | |
… | |
178 | $self->{h}{$h} = substr $v, 1 |
209 | $self->{h}{$h} = substr $v, 1 |
179 | while ($h, $v) = each %hdr; |
210 | while ($h, $v) = each %hdr; |
180 | } |
211 | } |
181 | |
212 | |
182 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
213 | $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; |
|
|
214 | |
|
|
215 | weaken ($uri{$self->{uri}}{$self*1} = $self); |
183 | |
216 | |
184 | $self->map_uri; |
217 | $self->map_uri; |
185 | |
218 | |
186 | Coro::Event::do_timer(after => 5); |
219 | Coro::Event::do_timer(after => 5); |
187 | |
220 | |