[ViewVC] Diff of: cvs/Coro/myhttpd/httpd.pl

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.16 by root, Tue Aug 14 19:38:25 2001 UTC vs.
Revision 1.45 by root, Sun Nov 11 03:32:19 2001 UTC

…		…
1	use Coro;	1	use Coro;
2	use Coro::Semaphore;	2	use Coro::Semaphore;
3	use Coro::Event;	3	use Coro::Event;
4	use Coro::Socket;	4	use Coro::Socket;
		5	use Coro::Signal;
		6
		7	use HTTP::Date;
5		8
6	no utf8;	9	no utf8;
7	use bytes;	10	use bytes;
8		11
9	# at least on my machine, this thingy serves files	12	# at least on my machine, this thingy serves files
10	# quite a bit faster than apache, ;)	13	# quite a bit faster than apache, ;)
11	# and quite a bit slower than thttpd :(	14	# and quite a bit slower than thttpd :(
12		15
13	$SIG{PIPE} = 'IGNORE';	16	$SIG{PIPE} = 'IGNORE';
14		17
		18	our $accesslog;
		19
		20	if ($ACCESS_LOG) {
		21	use IO::Handle;
		22	open $accesslog, ">>$ACCESS_LOG"
		23	or die "$ACCESS_LOG: $!";
		24	$accesslog->autoflush(1);
		25	}
		26
15	sub slog {	27	sub slog {
16	my $level = shift;	28	my $level = shift;
17	my $format = shift;	29	my $format = shift;
18	printf "---: $format\n", @_;	30	printf "---: $format\n", @_;
19	}	31	}
20		32
21	my $connections = new Coro::Semaphore $MAX_CONNECTS;	33	our $connections = new Coro::Semaphore $MAX_CONNECTS \|\| 250;
		34	our $httpevent = new Coro::Signal;
		35
		36	our $wait_factor = 0.95;
		37
		38	our @transfers = (
		39	[(new Coro::Semaphore $MAX_TRANSFERS_SMALL \|\| 50), 1],
		40	[(new Coro::Semaphore $MAX_TRANSFERS_LARGE \|\| 50), 1],
		41	);
22		42
23	my @newcons;	43	my @newcons;
24	my @pool;	44	my @pool;
25		45
26	# one "execution thread"	46	# one "execution thread"
27	sub handler {	47	sub handler {
28	while () {	48	while () {
29	my $new = pop @newcons;
30	if ($new) {	49	if (@newcons) {
31	eval {	50	eval {
32	conn->new(@$new)->handle;	51	conn->new(@{pop @newcons})->handle;
33	};	52	};
34	slog 1, "$@" if $@ && !ref $@;	53	slog 1, "$@" if $@ && !ref $@;
35	$connections->up;	54	$connections->up;
36	} else {	55	} else {
37	last if @pool >= $MAX_POOL;	56	last if @pool >= $MAX_POOL;
39	schedule;	58	schedule;
40	}	59	}
41	}	60	}
42	}	61	}
43		62
		63	sub listen_on {
		64	my $listen = $_[0];
		65
		66	push @listen_sockets, $listen;
		67
		68	# the "main thread"
		69	async {
		70	slog 1, "accepting connections";
		71	while () {
		72	$connections->down;
		73	push @newcons, [$listen->accept];
		74	#slog 3, "accepted @$connections ".scalar(@pool);
		75	if (@pool) {
		76	(pop @pool)->ready;
		77	} else {
		78	async \&handler;
		79	}
		80
		81	}
		82	};
		83	}
		84
44	my $http_port = new Coro::Socket	85	my $http_port = new Coro::Socket
45	LocalAddr => $SERVER_HOST,	86	LocalAddr => $SERVER_HOST,
46	LocalPort => $SERVER_PORT,	87	LocalPort => $SERVER_PORT,
47	ReuseAddr => 1,	88	ReuseAddr => 1,
48	Listen => 50,	89	Listen => 50,
49	or die "unable to start server";	90	or die "unable to start server";
50		91
51	push @listen_sockets, $http_port;	92	listen_on $http_port;
52		93
53	# the "main thread"	94	if ($SERVER_PORT2) {
54	async {	95	my $http_port = new Coro::Socket
55	slog 1, "accepting connections";	96	LocalAddr => $SERVER_HOST,
56	while () {	97	LocalPort => $SERVER_PORT2,
57	$connections->down;	98	ReuseAddr => 1,
58	push @newcons, [$http_port->accept];	99	Listen => 50,
59	#slog 3, "accepted @$connections ".scalar(@pool);	100	or die "unable to start server";
		101
		102	listen_on $http_port;
		103	}
		104
		105	our $NOW;
		106	our $HTTP_NOW;
		107
		108	Event->timer(interval => 1, hard => 1, cb => sub {
60	$::NOW = time;	109	$NOW = time;
61	if (@pool) {	110	$HTTP_NOW = time2str $NOW;
62	(pop @pool)->ready;	111	})->now;
63	} else {
64	async \&handler;
65	}
66
67	}
68	};
69		112
70	package conn;	113	package conn;
71		114
72	use Socket;	115	use Socket;
73	use HTTP::Date;	116	use HTTP::Date;
…		…
75	use Linux::AIO;	118	use Linux::AIO;
76		119
77	Linux::AIO::min_parallel $::AIO_PARALLEL;	120	Linux::AIO::min_parallel $::AIO_PARALLEL;
78		121
79	Event->io(fd => Linux::AIO::poll_fileno,	122	Event->io(fd => Linux::AIO::poll_fileno,
80	poll => 'r',	123	poll => 'r', async => 1,
81	async => 1,
82	cb => \&Linux::AIO::poll_cb );	124	cb => \&Linux::AIO::poll_cb);
83		125
84	Event->add_hooks(prepare => sub {
85	&Coro::cede while &Coro::nready;
86	1e6;
87	});
88
89	our %conn; # $conn{ip}{fh} => connobj	126	our %conn; # $conn{ip}{self} => connobj
		127	our %uri; # $uri{ip}{uri}{self}
90	our %blocked;	128	our %blocked;
91	our %mimetype;	129	our %mimetype;
92		130
93	sub read_mimetypes {	131	sub read_mimetypes {
94	local *M;	132	local *M;
…		…
105		143
106	read_mimetypes;	144	read_mimetypes;
107		145
108	sub new {	146	sub new {
109	my $class = shift;	147	my $class = shift;
		148	my $fh = shift;
110	my $peername = shift;	149	my $peername = shift;
111	my $fh = shift;
112	my $self = bless { fh => $fh }, $class;	150	my $self = bless { fh => $fh }, $class;
113	my (undef, $iaddr) = unpack_sockaddr_in $peername	151	my (undef, $iaddr) = unpack_sockaddr_in $peername
114	or $self->err(500, "unable to decode peername");	152	or $self->err(500, "unable to decode peername");
115		153
116	$self->{remote_addr} = inet_ntoa $iaddr;	154	$self->{remote_addr} = inet_ntoa $iaddr;
117	$self->{time} = $::NOW;	155	$self->{time} = $::NOW;
118		156
119	# enter ourselves into various lists
120	weaken ($conn{$self->{remote_addr}}{$self*1} = $self);
121
122	$::conns++;	157	$::conns++;
123		158
124	$self;	159	$self;
125	}	160	}
126		161
127	sub DESTROY {	162	sub DESTROY {
128	my $self = shift;	163	my $self = shift;
129
130	$::conns--;	164	$::conns--;
		165	$self->eoconn;
		166	}
131		167
		168	# end of connection
		169	sub eoconn {
		170	my $self = shift;
		171
		172	# clean up hints
132	delete $conn{$self->{remote_addr}}{$self*1};	173	delete $conn{$self->{remote_id}}{$self*1};
133	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};	174	delete $uri{$self->{remote_id}}{$self->{uri}}{$self*1};
		175
		176	$httpevent->broadcast;
134	}	177	}
135		178
136	sub slog {	179	sub slog {
137	my $self = shift;	180	my $self = shift;
138	main::slog($_[0], "$self->{remote_addr}> $_[1]");	181	main::slog($_[0], ($self->{remote_id} \|\| $self->{remote_addr}) ."> $_[1]");
139	}	182	}
140		183
141	sub response {	184	sub response {
142	my ($self, $code, $msg, $hdr, $content) = @_;	185	my ($self, $code, $msg, $hdr, $content) = @_;
143	my $res = "HTTP/1.0 $code $msg\015\012";	186	my $res = "HTTP/1.1 $code $msg\015\012";
144		187
145	$res .= "Connection: close\015\012";	188	$self->{h}{connection} = "close"
146	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(	189	if exists $hdr->{Connection} # to avoid "empty" header lines due to vivification
		190	and $hdr->{Connection} =~ /close/;
		191
		192	$res .= "Date: $HTTP_NOW\015\012";
147		193
148	while (my ($h, $v) = each %$hdr) {	194	while (my ($h, $v) = each %$hdr) {
149	$res .= "$h: $v\015\012"	195	$res .= "$h: $v\015\012"
150	}	196	}
151	$res .= "\015\012";	197	$res .= "\015\012";
152		198
153	$res .= $content if defined $content and $self->{method} ne "HEAD";	199	$res .= $content if defined $content and $self->{method} ne "HEAD";
154		200
155	print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d#	201	my $log = "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";
		202
		203	print $accesslog $log if $accesslog;
		204	print STDERR $log;
156		205
157	$self->{written} +=	206	$self->{written} +=
158	print {$self->{fh}} $res;	207	print {$self->{fh}} $res;
159	}	208	}
160		209
161	sub err {	210	sub err {
162	my $self = shift;	211	my $self = shift;
163	my ($code, $msg, $hdr, $content) = @_;	212	my ($code, $msg, $hdr, $content) = @_;
164		213
165	unless (defined $content) {	214	unless (defined $content) {
166	$content = "$code $msg";	215	$content = "$code $msg\n";
167	$hdr->{"Content-Type"} = "text/plain";	216	$hdr->{"Content-Type"} = "text/plain";
168	$hdr->{"Content-Length"} = length $content;	217	$hdr->{"Content-Length"} = length $content;
169	}	218	}
		219	$hdr->{"Connection"} = "close";
170		220
171	$self->response($code, $msg, $hdr, $content);	221	$self->response($code, $msg, $hdr, $content);
172		222
173	die bless {}, err::;	223	die bless {}, err::;
174	}	224	}
175		225
176	sub err_blocked {
177	my $self = shift;
178	my $ip = $self->{remote_addr};
179	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
180
181	Coro::Event::do_timer(after => 15);
182
183	$self->err(401, "too many connections",
184	{
185	"Content-Type" => "text/html",
186	"Retry-After" => $::BLOCKTIME
187	},
188	<<EOF);
189	<html><p>
190	You have been blocked because you opened too many connections. You
191	may retry at</p>
192
193	<p><blockquote>$time.</blockquote></p>
194
195	<p>Until then, each new access will renew the block. You might want to have a
196	look at the <a href="http://www.goof.com/pcg/marc/animefaq.html">FAQ</a>.</p>
197	</html>
198	EOF
199	}
200
201	sub handle {	226	sub handle {
202	my $self = shift;	227	my $self = shift;
203	my $fh = $self->{fh};	228	my $fh = $self->{fh};
204		229
		230	my $host;
		231
		232	$fh->timeout($::REQ_TIMEOUT);
205	#while() {	233	while() {
		234	$self->{reqs}++;
		235
		236	# read request and parse first line
		237	my $req = $fh->readline("\015\012\015\012");
		238
		239	unless (defined $req) {
		240	if (exists $self->{version}) {
		241	last;
		242	} else {
		243	$self->err(408, "request timeout");
		244	}
		245	}
		246
206	$self->{h} = {};	247	$self->{h} = {};
207		248
208	# read request and parse first line
209	$fh->timeout($::REQ_TIMEOUT);
210	my $req = $fh->readline("\015\012\015\012");
211	$fh->timeout($::RES_TIMEOUT);	249	$fh->timeout($::RES_TIMEOUT);
212
213	defined $req or
214	$self->err(408, "request timeout");
215
216	my $ip = $self->{remote_addr};
217
218	if ($blocked{$ip}) {
219	$self->err_blocked($blocked{$ip})
220	if $blocked{$ip} > $::NOW;
221
222	delete $blocked{$ip};
223	}
224
225	if (%{$conn{$ip}} > $::MAX_CONN_IP) {
226	$self->slog(2, "blocked ip $ip");
227	$self->err_blocked;
228	}
229		250
230	$req =~ /^(?:\015\012)?	251	$req =~ /^(?:\015\012)?
231	(GET\|HEAD) \040+	252	(GET\|HEAD) \040+
232	([^\040]+) \040+	253	([^\040]+) \040+
233	HTTP\/([0-9]+\.[0-9]+)	254	HTTP\/([0-9]+\.[0-9]+)
234	\015\012/gx	255	\015\012/gx
235	or $self->err(405, "method not allowed", { Allow => "GET,HEAD" });	256	or $self->err(405, "method not allowed", { Allow => "GET,HEAD" });
236		257
237	$2 ne "1.0"
238	or $self->err(506, "http protocol version not supported");
239
240	$self->{method} = $1;	258	$self->{method} = $1;
241	$self->{uri} = $2;	259	$self->{uri} = $2;
		260	$self->{version} = $3;
		261
		262	$3 =~ /^1\./
		263	or $self->err(506, "http protocol version $3 not supported");
242		264
243	# parse headers	265	# parse headers
244	{	266	{
245	my (%hdr, $h, $v);	267	my (%hdr, $h, $v);
246		268
…		…
257		279
258	$self->{h}{$h} = substr $v, 1	280	$self->{h}{$h} = substr $v, 1
259	while ($h, $v) = each %hdr;	281	while ($h, $v) = each %hdr;
260	}	282	}
261		283
		284	# remote id should be unique per user
		285	my $id = $self->{remote_addr};
		286
		287	if (exists $self->{h}{"client-ip"}) {
		288	$id .= "[".$self->{h}{"client-ip"}."]";
		289	} elsif (exists $self->{h}{"x-forwarded-for"}) {
		290	$id .= "[".$self->{h}{"x-forwarded-for"}."]";
		291	}
		292
		293	$self->{remote_id} = $id;
		294
		295	if ($blocked{$id}) {
		296	$self->err_blocked($blocked{$id})
		297	if $blocked{$id} > $::NOW;
		298
		299	delete $blocked{$id};
		300	}
		301
		302	if (%{$conn{$id}} >= $::MAX_CONN_IP) {
		303	my $delay = $::PER_TIMEOUT + $::NOW + 15;
		304	while (%{$conn{$id}} >= $::MAX_CONN_IP) {
		305	if ($delay < $::NOW) {
		306	$self->slog(2, "blocked ip $id");
		307	$self->err_blocked;
		308	} else {
		309	$httpevent->wait;
		310	}
		311	}
		312	}
		313
		314	# find out server name and port
		315	if ($self->{uri} =~ s/^http:\/\/([^\/?#]*)//i) {
		316	$host = $1;
		317	} else {
		318	$host = $self->{h}{host};
		319	}
		320
		321	if (defined $host) {
262	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;	322	$self->{server_port} = $host =~ s/:([0-9]+)$// ? $1 : 80;
		323	} else {
		324	($self->{server_port}, $host)
		325	= unpack_sockaddr_in $self->{fh}->sockname
		326	or $self->err(500, "unable to get socket name");
		327	$host = inet_ntoa $host;
		328	}
263		329
		330	$self->{server_name} = $host;
		331
		332	# enter ourselves into various lists
		333	weaken ($conn{$id}{$self*1} = $self);
264	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);	334	weaken ($uri{$id}{$self->{uri}}{$self*1} = $self);
265		335
		336	eval {
266	$self->map_uri;	337	$self->map_uri;
267	$self->respond;	338	$self->respond;
		339	};
		340
		341	$self->eoconn;
		342
		343	die if $@ && !ref $@;
		344
		345	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} < 1.1;
		346
		347	$httpevent->broadcast;
		348
		349	$fh->timeout($::PER_TIMEOUT);
268	#}	350	}
269	}	351	}
270		352
271	# uri => path mapping	353	# uri => path mapping
272	sub map_uri {	354	sub map_uri {
273	my $self = shift;	355	my $self = shift;
274	my $host = $self->{h}{host} \|\| "default";	356	my $host = $self->{server_name};
275	my $uri = $self->{uri};	357	my $uri = $self->{uri};
276		358
277	# some massaging, also makes it more secure	359	# some massaging, also makes it more secure
278	$uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;	360	$uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
279	$uri =~ s%//+%/%g;	361	$uri =~ s%//+%/%g;
…		…
289	$self->{path} = "$::DOCROOT/$host$uri";	371	$self->{path} = "$::DOCROOT/$host$uri";
290		372
291	$self->access_check;	373	$self->access_check;
292	}	374	}
293		375
294	sub server_address {
295	my $self = shift;
296	my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname
297	or $self->err(500, "unable to get socket name");
298	((inet_ntoa $iaddr), $port);
299	}
300
301	sub server_host {
302	my $self = shift;
303	if (exists $self->{h}{host}) {
304	return $self->{h}{host};
305	} else {
306	return (($self->server_address)[0]);
307	}
308	}
309
310	sub server_hostport {
311	my $self = shift;
312	my ($host, $port);
313	if (exists $self->{h}{host}) {
314	($host, $port) = ($self->{h}{host}, $self->{server_port});
315	} else {
316	($host, $port) = $self->server_address;
317	}
318	$port = $port == 80 ? "" : ":$port";
319	$host.$port;
320	}
321
322	sub _cgi {	376	sub _cgi {
323	my $self = shift;	377	my $self = shift;
324	my $path = shift;	378	my $path = shift;
325	my $fh;	379	my $fh;
326		380
327	# no two-way xxx supported	381	# no two-way xxx supported
328	if (0 == fork) {	382	if (0 == fork) {
329	open STDOUT, ">&".fileno($self->{fh});	383	open STDOUT, ">&".fileno($self->{fh});
330	if (chdir $::DOCROOT) {	384	if (chdir $::DOCROOT) {
331	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike	385	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike
332	$ENV{HTTP_HOST} = $self->server_host;	386	$ENV{HTTP_HOST} = $self->{server_name};
333	$ENV{HTTP_PORT} = $self->{server_host};	387	$ENV{HTTP_PORT} = $self->{server_port};
334	$ENV{SCRIPT_NAME} = $self->{name};	388	$ENV{SCRIPT_NAME} = $self->{name};
335	exec $path;	389	exec $path;
336	}	390	}
337	Coro::State::_exit(0);	391	Coro::State::_exit(0);
338	} else {	392	} else {
		393	die;
339	}	394	}
		395	}
		396
		397	sub server_hostport {
		398	$_[0]{server_port} == 80
		399	? $_[0]{server_name}
		400	: "$_[0]{server_name}:$_[0]{server_port}";
340	}	401	}
341		402
342	sub respond {	403	sub respond {
343	my $self = shift;	404	my $self = shift;
344	my $path = $self->{path};	405	my $path = $self->{path};
…		…
354		415
355	if (-d _ && -r _) {	416	if (-d _ && -r _) {
356	# directory	417	# directory
357	if ($path !~ /\/$/) {	418	if ($path !~ /\/$/) {
358	# create a redirect to get the trailing "/"	419	# create a redirect to get the trailing "/"
359	my $host = $self->server_hostport;	420	# we don't try to avoid the :80
360	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });	421	$self->err(301, "moved permanently", { Location => "http://".$self->server_hostport."$self->{uri}/" });
361	} else {	422	} else {
362	$ims < $self->{stat}[9]	423	$ims < $self->{stat}[9]
363	or $self->err(304, "not modified");	424	or $self->err(304, "not modified");
364		425
365	if ($self->{method} eq "GET") {
366	if (-r "$path/index.html") {	426	if (-r "$path/index.html") {
367	$self->{path} .= "/index.html";	427	# replace directory "size" by index.html filesize
		428	$self->{stat}[7] = (stat ($self->{path} .= "/index.html"))[7];
368	$self->handle_file;	429	$self->handle_file;
369	} else {	430	} else {
370	$self->handle_dir;	431	$self->handle_dir;
371	}
372	}	432	}
373	}	433	}
374	} elsif (-f _ && -r _) {	434	} elsif (-f _ && -r _) {
375	-x _ and $self->err(403, "forbidden");	435	-x _ and $self->err(403, "forbidden");
376	$self->handle_file;	436	$self->handle_file;
…		…
391	$idx);	451	$idx);
392	}	452	}
393		453
394	sub handle_file {	454	sub handle_file {
395	my $self = shift;	455	my $self = shift;
396	my $length = -s _;	456	my $length = $self->{stat}[7];
		457	my $queue = $::transfers[$length >= $::TRANSFER_SMALL];
397	my $hdr = {	458	my $hdr = {
398	"Last-Modified" => time2str ((stat _)[9]),	459	"Last-Modified" => time2str ((stat _)[9]),
399	};	460	};
400		461
401	my @code = (200, "ok");	462	my @code = (200, "ok");
…		…
409	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);	470	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);
410	} else {	471	} else {
411	($l, $h) = (0, $length - 1);	472	($l, $h) = (0, $length - 1);
412	goto ignore;	473	goto ignore;
413	}	474	}
414	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l;	475	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
415	}	476	}
416	$hdr->{"Content-Range"} = "bytes */$length";	477	$hdr->{"Content-Range"} = "bytes */$length";
		478	$hdr->{"Content-Length"} = $length;
417	$self->err(416, "not satisfiable", $hdr);	479	$self->err(416, "not satisfiable", $hdr, "");
418		480
419	satisfiable:	481	satisfiable:
420	# check for segmented downloads	482	# check for segmented downloads
421	if ($l && $::NO_SEGMENTED) {	483	if ($l && $::NO_SEGMENTED) {
		484	my $delay = $::NOW + $::PER_TIMEOUT + 15;
422	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {	485	while (%{$uri{$self->{remote_id}}{$self->{uri}}} > 1) {
423	Coro::Event::do_timer(after => 15);	486	if ($delay <= $::NOW) {
424		487	$self->err_segmented_download;
425	$self->err(400, "segmented downloads are not allowed");	488	} else {
		489	$httpevent->broadcast;
		490	}
426	}	491	}
427	}	492	}
428		493
429	$hdr->{"Content-Range"} = "bytes $l-$h/$length";	494	$hdr->{"Content-Range"} = "bytes $l-$h/$length";
430	@code = (206, "partial content");	495	@code = (206, "partial content");
…		…
440	$hdr->{"Content-Length"} = $length;	505	$hdr->{"Content-Length"} = $length;
441		506
442	$self->response(@code, $hdr, "");	507	$self->response(@code, $hdr, "");
443		508
444	if ($self->{method} eq "GET") {	509	if ($self->{method} eq "GET") {
		510	$self->{time} = $::NOW;
		511
		512	my $fudge = $queue->[0]->waiters;
		513	$fudge = $fudge ? ($fudge+1)/$fudge : 1;
		514
		515	$queue->[1] *= $fudge;
		516	my $transfer = $queue->[0]->guard;
		517
		518	if ($fudge != 1) {
		519	$queue->[1] /= $fudge;
		520	$queue->[1] = $queue->[1] * $::wait_factor
		521	+ ($::NOW - $self->{time}) * (1 - $::wait_factor);
		522	}
		523	$self->{time} = $::NOW;
		524
		525	$self->{fh}->writable or return;
		526
445	my ($fh, $buf, $r);	527	my ($fh, $buf, $r);
446	my $current = $Coro::current;	528	my $current = $Coro::current;
447	open $fh, "<", $self->{path}	529	open $fh, "<", $self->{path}
448	or die "$self->{path}: late open failure ($!)";	530	or die "$self->{path}: late open failure ($!)";
449		531
450	$h -= $l - 1;	532	$h -= $l - 1;
451		533
		534	if (0) {
		535	if ($l) {
		536	sysseek $fh, $l, 0;
		537	}
		538	}
		539
452	while ($h > 0) {	540	while ($h > 0) {
		541	if (0) {
		542	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
		543	or last;
		544	} else {
453	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),	545	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
454	$buf, 0, sub {	546	$buf, 0, sub {
455	$r = $_[0];	547	$r = $_[0];
456	$current->ready;	548	Coro::ready($current);
457	});	549	});
458	&Coro::schedule;	550	&Coro::schedule;
459	last unless $r;	551	last unless $r;
460	my $w = $self->{fh}->syswrite($buf)	552	}
		553	my $w = syswrite $self->{fh}, $buf
461	or last;	554	or last;
462	$::written += $w;	555	$::written += $w;
463	$self->{written} += $w;	556	$self->{written} += $w;
464	$l += $r;	557	$l += $r;
465	}	558	}
466	}
467		559
468	close $fh;	560	close $fh;
		561	}
469	}	562	}
470		563
471	1;	564	1;

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Coro/myhttpd/httpd.pl (file contents): Revision 1.16 by root, Tue Aug 14 19:38:25 2001 UTC vs. Revision 1.45 by root, Sun Nov 11 03:32:19 2001 UTC

Diff Legend

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.16 by root, Tue Aug 14 19:38:25 2001 UTC vs.
Revision 1.45 by root, Sun Nov 11 03:32:19 2001 UTC