[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.28 by root, Mon Aug 20 16:58:19 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	}
…		…
75	use Linux::AIO;	84	use Linux::AIO;
76		85
77	Linux::AIO::min_parallel $::AIO_PARALLEL;	86	Linux::AIO::min_parallel $::AIO_PARALLEL;
78		87
79	Event->io(fd => Linux::AIO::poll_fileno,	88	Event->io(fd => Linux::AIO::poll_fileno,
80	poll => 'r',	89	poll => 'r', async => 1,
81	async => 1,
82	cb => \&Linux::AIO::poll_cb );	90	cb => \&Linux::AIO::poll_cb);
83		91
84	Event->add_hooks(prepare => sub {
85	&Coro::cede while &Coro::nready;
86	1e6;
87	});
88
89	our %conn; # $conn{ip}{fh} => connobj	92	our %conn; # $conn{ip}{self} => connobj
		93	our %uri; # $uri{ip}{uri}{self}
90	our %blocked;	94	our %blocked;
91	our %mimetype;	95	our %mimetype;
92		96
93	sub read_mimetypes {	97	sub read_mimetypes {
94	local *M;	98	local *M;
…		…
127	sub DESTROY {	131	sub DESTROY {
128	my $self = shift;	132	my $self = shift;
129		133
130	$::conns--;	134	$::conns--;
131		135
		136	$self->eoconn;
132	delete $conn{$self->{remote_addr}}{$self*1};	137	delete $conn{$self->{remote_addr}}{$self*1};
		138	}
		139
		140	# end of connection
		141	sub eoconn {
		142	my $self = shift;
133	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};	143	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};
134	}	144	}
135		145
136	sub slog {	146	sub slog {
137	my $self = shift;	147	my $self = shift;
138	main::slog($_[0], "$self->{remote_addr}> $_[1]");	148	main::slog($_[0], "$self->{remote_addr}> $_[1]");
139	}	149	}
140		150
141	sub response {	151	sub response {
142	my ($self, $code, $msg, $hdr, $content) = @_;	152	my ($self, $code, $msg, $hdr, $content) = @_;
143	my $res = "HTTP/1.0 $code $msg\015\012";	153	my $res = "HTTP/1.1 $code $msg\015\012";
144		154
145	$res .= "Connection: close\015\012";	155	$self->{h}{connection} \|\|= $hdr->{Connection};
		156
146	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(	157	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
147		158
148	while (my ($h, $v) = each %$hdr) {	159	while (my ($h, $v) = each %$hdr) {
149	$res .= "$h: $v\015\012"	160	$res .= "$h: $v\015\012"
150	}	161	}
151	$res .= "\015\012";	162	$res .= "\015\012";
152		163
153	$res .= $content if defined $content and $self->{method} ne "HEAD";	164	$res .= $content if defined $content and $self->{method} ne "HEAD";
154		165
155	print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d#	166	my $log = "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";
		167
		168	print $accesslog $log if $accesslog;
		169	print STDERR $log;
156		170
157	$self->{written} +=	171	$self->{written} +=
158	print {$self->{fh}} $res;	172	print {$self->{fh}} $res;
159	}	173	}
160		174
…		…
165	unless (defined $content) {	179	unless (defined $content) {
166	$content = "$code $msg";	180	$content = "$code $msg";
167	$hdr->{"Content-Type"} = "text/plain";	181	$hdr->{"Content-Type"} = "text/plain";
168	$hdr->{"Content-Length"} = length $content;	182	$hdr->{"Content-Length"} = length $content;
169	}	183	}
		184	$hdr->{"Connection"} = "close";
170		185
171	$self->response($code, $msg, $hdr, $content);	186	$self->response($code, $msg, $hdr, $content);
172		187
173	die bless {}, err::;	188	die bless {}, err::;
174	}	189	}
…		…
176	sub err_blocked {	191	sub err_blocked {
177	my $self = shift;	192	my $self = shift;
178	my $ip = $self->{remote_addr};	193	my $ip = $self->{remote_addr};
179	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;	194	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
180		195
181	Coro::Event::do_timer(after => 15);	196	Coro::Event::do_timer(after => 20*rand);
182		197
183	$self->err(401, "too many connections",	198	$self->err(401, "too many connections",
184	{	199	{
185	"Content-Type" => "text/html",	200	"Content-Type" => "text/html",
186	"Retry-After" => $::BLOCKTIME	201	"Retry-After" => $::BLOCKTIME,
		202	"Warning" => "Please do NOT retry, you have been blocked",
		203	"WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",
		204	"Connection" => "close",
187	},	205	},
188	<<EOF);	206	<<EOF);
189	<html><p>	207	<html>
		208	<head>
		209	<title>Too many connections</title>
		210	</head>
		211	<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
		212
190	You have been blocked because you opened too many connections. You	213	<p>You have been blocked because you opened too many connections. You
191	may retry at</p>	214	may retry at</p>
192		215
193	<p><blockquote>$time.</blockquote></p>	216	<p><blockquote>$time.</blockquote></p>
194		217
195	<p>Until then, each new access will renew the block. You might want to have a	218	<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>	219	look at the <a href="http://www.goof.com/pcg/marc/animefaq.html#connectionlimit">FAQ</a>.</p>
197	</html>	220
		221	</body></html>
198	EOF	222	EOF
199	}	223	}
200		224
201	sub handle {	225	sub handle {
202	my $self = shift;	226	my $self = shift;
203	my $fh = $self->{fh};	227	my $fh = $self->{fh};
204		228
		229	$fh->timeout($::REQ_TIMEOUT);
205	#while() {	230	while() {
		231	$self->{reqs}++;
		232
		233	# read request and parse first line
		234	my $req = $fh->readline("\015\012\015\012");
		235
		236	unless (defined $req) {
		237	if (exists $self->{version}) {
		238	last;
		239	} else {
		240	$self->err(408, "request timeout");
		241	}
		242	}
		243
206	$self->{h} = {};	244	$self->{h} = {};
207		245
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);	246	$fh->timeout($::RES_TIMEOUT);
212
213	defined $req or
214	$self->err(408, "request timeout");
215
216	my $ip = $self->{remote_addr};	247	my $ip = $self->{remote_addr};
217		248
218	if ($blocked{$ip}) {	249	if ($blocked{$ip}) {
219	$self->err_blocked($blocked{$ip})	250	$self->err_blocked($blocked{$ip})
220	if $blocked{$ip} > $::NOW;	251	if $blocked{$ip} > $::NOW;
…		…
232	([^\040]+) \040+	263	([^\040]+) \040+
233	HTTP\/([0-9]+\.[0-9]+)	264	HTTP\/([0-9]+\.[0-9]+)
234	\015\012/gx	265	\015\012/gx
235	or $self->err(405, "method not allowed", { Allow => "GET,HEAD" });	266	or $self->err(405, "method not allowed", { Allow => "GET,HEAD" });
236		267
237	$2 ne "1.0"
238	or $self->err(506, "http protocol version not supported");
239
240	$self->{method} = $1;	268	$self->{method} = $1;
241	$self->{uri} = $2;	269	$self->{uri} = $2;
		270	$self->{version} = $3;
		271
		272	$3 =~ /^1\./
		273	or $self->err(506, "http protocol version $3 not supported");
242		274
243	# parse headers	275	# parse headers
244	{	276	{
245	my (%hdr, $h, $v);	277	my (%hdr, $h, $v);
246		278
…		…
261		293
262	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;	294	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;
263		295
264	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);	296	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);
265		297
		298	eval {
266	$self->map_uri;	299	$self->map_uri;
267	$self->respond;	300	$self->respond;
		301	};
		302
		303	$self->eoconn;
		304
		305	die if $@ && !ref $@;
		306
		307	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} lt "1.1";
		308
		309	$self->slog(9, "persistent connection [".$self->{h}{"user-agent"}."][$self->{reqs}]");
		310	$fh->timeout($::PER_TIMEOUT);
268	#}	311	}
269	}	312	}
270		313
271	# uri => path mapping	314	# uri => path mapping
272	sub map_uri {	315	sub map_uri {
273	my $self = shift;	316	my $self = shift;
…		…
360	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });	403	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });
361	} else {	404	} else {
362	$ims < $self->{stat}[9]	405	$ims < $self->{stat}[9]
363	or $self->err(304, "not modified");	406	or $self->err(304, "not modified");
364		407
365	if ($self->{method} eq "GET") {
366	if (-r "$path/index.html") {	408	if (-r "$path/index.html") {
367	$self->{path} .= "/index.html";	409	$self->{path} .= "/index.html";
368	$self->handle_file;	410	$self->handle_file;
369	} else {	411	} else {
370	$self->handle_dir;	412	$self->handle_dir;
371	}
372	}	413	}
373	}	414	}
374	} elsif (-f _ && -r _) {	415	} elsif (-f _ && -r _) {
375	-x _ and $self->err(403, "forbidden");	416	-x _ and $self->err(403, "forbidden");
376	$self->handle_file;	417	$self->handle_file;
…		…
409	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);	450	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);
410	} else {	451	} else {
411	($l, $h) = (0, $length - 1);	452	($l, $h) = (0, $length - 1);
412	goto ignore;	453	goto ignore;
413	}	454	}
414	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l;	455	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
415	}	456	}
416	$hdr->{"Content-Range"} = "bytes */$length";	457	$hdr->{"Content-Range"} = "bytes */$length";
		458	$hdr->{"Content-Length"} = $length;
		459	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");
417	$self->err(416, "not satisfiable", $hdr);	460	$self->err(416, "not satisfiable", $hdr, "");
418		461
419	satisfiable:	462	satisfiable:
420	# check for segmented downloads	463	# check for segmented downloads
421	if ($l && $::NO_SEGMENTED) {	464	if ($l && $::NO_SEGMENTED) {
422	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {	465	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
423	Coro::Event::do_timer(after => 15);
424
425	$self->err(400, "segmented downloads are not allowed");	466	$self->err(400, "segmented downloads are not allowed",
		467	{ "Content-Type" => "text/html", Connection => "close" }, <<EOF);
		468	<html>
		469	<head>
		470	<title>Segmented downloads are not allowed</title>
		471	</head>
		472	<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
		473
		474	<p>Segmented downloads are not allowed on this server. Please refer to the
		475	<a href="http://www.goof.com/pcg/marc/animefaq.html#segmented_downloads">FAQ</a>.</p>
		476
		477	</body></html>
		478	EOF
		479	EOF
426	}	480	}
427	}	481	}
428		482
429	$hdr->{"Content-Range"} = "bytes $l-$h/$length";	483	$hdr->{"Content-Range"} = "bytes $l-$h/$length";
430	@code = (206, "partial content");	484	@code = (206, "partial content");
…		…
447	open $fh, "<", $self->{path}	501	open $fh, "<", $self->{path}
448	or die "$self->{path}: late open failure ($!)";	502	or die "$self->{path}: late open failure ($!)";
449		503
450	$h -= $l - 1;	504	$h -= $l - 1;
451		505
		506	if (0) {
		507	if ($l) {
		508	sysseek $fh, $l, 0;
		509	}
		510	}
		511
452	while ($h > 0) {	512	while ($h > 0) {
		513	if (0) {
		514	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
		515	or last;
		516	} else {
453	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),	517	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
454	$buf, 0, sub {	518	$buf, 0, sub {
455	$r = $_[0];	519	$r = $_[0];
456	$current->ready;	520	$current->ready;
457	});	521	});
458	&Coro::schedule;	522	&Coro::schedule;
459	last unless $r;	523	last unless $r;
		524	}
460	my $w = $self->{fh}->syswrite($buf)	525	my $w = $self->{fh}->syswrite($buf)
461	or last;	526	or last;
462	$::written += $w;	527	$::written += $w;
463	$self->{written} += $w;	528	$self->{written} += $w;
464	$l += $r;	529	$l += $r;

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.28 by root, Mon Aug 20 16:58: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.28 by root, Mon Aug 20 16:58:19 2001 UTC