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

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.5 by root, Fri Aug 10 15:58:04 2001 UTC vs.
Revision 1.29 by root, Sat Aug 25 15:14:03 2001 UTC

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

Diff Legend

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

Comparing Coro/myhttpd/httpd.pl (file contents): Revision 1.5 by root, Fri Aug 10 15:58:04 2001 UTC vs. Revision 1.29 by root, Sat Aug 25 15:14:03 2001 UTC

Diff Legend

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.5 by root, Fri Aug 10 15:58:04 2001 UTC vs.
Revision 1.29 by root, Sat Aug 25 15:14:03 2001 UTC