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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.20 by root, Thu Aug 16 21:55:35 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	}
…		…
74	use Convert::Scalar 'weaken';	83	use Convert::Scalar 'weaken';
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
		88	my $aio_requests = new Coro::Semaphore $::AIO_PARALLEL * 4;
		89
79	Event->io(fd => Linux::AIO::poll_fileno,	90	Event->io(fd => Linux::AIO::poll_fileno,
80	poll => 'r', async => 1,	91	poll => 'r', async => 1,
81	cb => \&Linux::AIO::poll_cb );	92	cb => \&Linux::AIO::poll_cb);
82		93
83	our %conn; # $conn{ip}{fh} => connobj	94	our %conn; # $conn{ip}{self} => connobj
		95	our %uri; # $uri{ip}{uri}{self}
84	our %blocked;	96	our %blocked;
85	our %mimetype;	97	our %mimetype;
86		98
87	sub read_mimetypes {	99	sub read_mimetypes {
88	local *M;	100	local *M;
…		…
127	delete $conn{$self->{remote_addr}}{$self*1};	139	delete $conn{$self->{remote_addr}}{$self*1};
128	}	140	}
129		141
130	# end of connection	142	# end of connection
131	sub eoconn {	143	sub eoconn {
		144	my $self = shift;
132	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};	145	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};
133	}	146	}
134		147
135	sub slog {	148	sub slog {
136	my $self = shift;	149	my $self = shift;
137	main::slog($_[0], "$self->{remote_addr}> $_[1]");	150	main::slog($_[0], ($self->{remote_id} \|\| $self->{remote_addr}) ."> $_[1]");
138	}	151	}
139		152
140	sub response {	153	sub response {
141	my ($self, $code, $msg, $hdr, $content) = @_;	154	my ($self, $code, $msg, $hdr, $content) = @_;
142	my $res = "HTTP/1.1 $code $msg\015\012";	155	my $res = "HTTP/1.1 $code $msg\015\012";
143		156
144	#$res .= "Connection: close\015\012";	157	$self->{h}{connection} \|\|= $hdr->{Connection};
		158
145	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(	159	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
146		160
147	while (my ($h, $v) = each %$hdr) {	161	while (my ($h, $v) = each %$hdr) {
148	$res .= "$h: $v\015\012"	162	$res .= "$h: $v\015\012"
149	}	163	}
150	$res .= "\015\012";	164	$res .= "\015\012";
151		165
152	$res .= $content if defined $content and $self->{method} ne "HEAD";	166	$res .= $content if defined $content and $self->{method} ne "HEAD";
153		167
154	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";
		169
		170	print $accesslog $log if $accesslog;
		171	print STDERR $log;
155		172
156	$self->{written} +=	173	$self->{written} +=
157	print {$self->{fh}} $res;	174	print {$self->{fh}} $res;
158	}	175	}
159		176
…		…
184	{	201	{
185	"Content-Type" => "text/html",	202	"Content-Type" => "text/html",
186	"Retry-After" => $::BLOCKTIME,	203	"Retry-After" => $::BLOCKTIME,
187	"Warning" => "Please do NOT retry, you have been blocked",	204	"Warning" => "Please do NOT retry, you have been blocked",
188	"WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",	205	"WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",
		206	"Connection" => "close",
189	},	207	},
190	<<EOF);	208	<<EOF);
191	<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
192	You have been blocked because you opened too many connections. You	215	<p>You have been blocked because you opened too many connections. You
193	may retry at</p>	216	may retry at</p>
194		217
195	<p><blockquote>$time.</blockquote></p>	218	<p><blockquote>$time.</blockquote></p>
196		219
197	<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
198	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>
199	</html>	222
		223	</body></html>
200	EOF	224	EOF
201	}	225	}
202		226
203	sub handle {	227	sub handle {
204	my $self = shift;	228	my $self = shift;
205	my $fh = $self->{fh};	229	my $fh = $self->{fh};
		230
		231	my $host;
206		232
207	$fh->timeout($::REQ_TIMEOUT);	233	$fh->timeout($::REQ_TIMEOUT);
208	while() {	234	while() {
209	$self->{reqs}++;	235	$self->{reqs}++;
210		236
…		…
267		293
268	$self->{h}{$h} = substr $v, 1	294	$self->{h}{$h} = substr $v, 1
269	while ($h, $v) = each %hdr;	295	while ($h, $v) = each %hdr;
270	}	296	}
271		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) {
272	$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	}
		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	}
273		324
274	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);	325	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);
275		326
		327	eval {
276	$self->map_uri;	328	$self->map_uri;
277	$self->respond;	329	$self->respond;
		330	};
278		331
279	$self->eoconn;	332	$self->eoconn;
280		333
		334	die if $@ && !ref $@;
		335
281	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} lt "1.1";	336	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} < 1.1;
282		337
283	$self->slog(9, "persistent connection [".$self->{h}{"user-agent"}."][$self->{reqs}]");
284	$fh->timeout($::PER_TIMEOUT);	338	$fh->timeout($::PER_TIMEOUT);
285	}	339	}
286	}	340	}
287		341
288	# uri => path mapping	342	# uri => path mapping
289	sub map_uri {	343	sub map_uri {
290	my $self = shift;	344	my $self = shift;
291	my $host = $self->{h}{host} \|\| "default";	345	my $host = $self->{server_name};
292	my $uri = $self->{uri};	346	my $uri = $self->{uri};
293		347
294	# some massaging, also makes it more secure	348	# some massaging, also makes it more secure
295	$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;
296	$uri =~ s%//+%/%g;	350	$uri =~ s%//+%/%g;
…		…
306	$self->{path} = "$::DOCROOT/$host$uri";	360	$self->{path} = "$::DOCROOT/$host$uri";
307		361
308	$self->access_check;	362	$self->access_check;
309	}	363	}
310		364
311	sub server_address {
312	my $self = shift;
313	my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname
314	or $self->err(500, "unable to get socket name");
315	((inet_ntoa $iaddr), $port);
316	}
317
318	sub server_host {
319	my $self = shift;
320	if (exists $self->{h}{host}) {
321	return $self->{h}{host};
322	} else {
323	return (($self->server_address)[0]);
324	}
325	}
326
327	sub server_hostport {
328	my $self = shift;
329	my ($host, $port);
330	if (exists $self->{h}{host}) {
331	($host, $port) = ($self->{h}{host}, $self->{server_port});
332	} else {
333	($host, $port) = $self->server_address;
334	}
335	$port = $port == 80 ? "" : ":$port";
336	$host.$port;
337	}
338
339	sub _cgi {	365	sub _cgi {
340	my $self = shift;	366	my $self = shift;
341	my $path = shift;	367	my $path = shift;
342	my $fh;	368	my $fh;
343		369
344	# no two-way xxx supported	370	# no two-way xxx supported
345	if (0 == fork) {	371	if (0 == fork) {
346	open STDOUT, ">&".fileno($self->{fh});	372	open STDOUT, ">&".fileno($self->{fh});
347	if (chdir $::DOCROOT) {	373	if (chdir $::DOCROOT) {
348	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike	374	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike
349	$ENV{HTTP_HOST} = $self->server_host;	375	$ENV{HTTP_HOST} = $self->{server_name};
350	$ENV{HTTP_PORT} = $self->{server_host};	376	$ENV{HTTP_PORT} = $self->{server_port};
351	$ENV{SCRIPT_NAME} = $self->{name};	377	$ENV{SCRIPT_NAME} = $self->{name};
352	exec $path;	378	exec $path;
353	}	379	}
354	Coro::State::_exit(0);	380	Coro::State::_exit(0);
355	} else {	381	} else {
		382	die;
356	}	383	}
		384	}
		385
		386	sub server_hostport {
		387	$_[0]{server_port} == 80
		388	? $_[0]{server_name}
		389	: "$_[0]{server_name}:$_[0]{server_port}";
357	}	390	}
358		391
359	sub respond {	392	sub respond {
360	my $self = shift;	393	my $self = shift;
361	my $path = $self->{path};	394	my $path = $self->{path};
…		…
371		404
372	if (-d _ && -r _) {	405	if (-d _ && -r _) {
373	# directory	406	# directory
374	if ($path !~ /\/$/) {	407	if ($path !~ /\/$/) {
375	# create a redirect to get the trailing "/"	408	# create a redirect to get the trailing "/"
376	my $host = $self->server_hostport;	409	# we don't try to avoid the :80
377	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });	410	$self->err(301, "moved permanently", { Location => "http://".$self->server_hostport."$self->{uri}/" });
378	} else {	411	} else {
379	$ims < $self->{stat}[9]	412	$ims < $self->{stat}[9]
380	or $self->err(304, "not modified");	413	or $self->err(304, "not modified");
381		414
382	if ($self->{method} eq "GET") {
383	if (-r "$path/index.html") {	415	if (-r "$path/index.html") {
384	$self->{path} .= "/index.html";	416	$self->{path} .= "/index.html";
385	$self->handle_file;	417	$self->handle_file;
386	} else {	418	} else {
387	$self->handle_dir;	419	$self->handle_dir;
388	}
389	}	420	}
390	}	421	}
391	} elsif (-f _ && -r _) {	422	} elsif (-f _ && -r _) {
392	-x _ and $self->err(403, "forbidden");	423	-x _ and $self->err(403, "forbidden");
393	$self->handle_file;	424	$self->handle_file;
…		…
426	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);	457	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);
427	} else {	458	} else {
428	($l, $h) = (0, $length - 1);	459	($l, $h) = (0, $length - 1);
429	goto ignore;	460	goto ignore;
430	}	461	}
431	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l;	462	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
432	}	463	}
433	$hdr->{"Content-Range"} = "bytes */$length";	464	$hdr->{"Content-Range"} = "bytes */$length";
		465	$hdr->{"Content-Length"} = $length;
434	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");	466	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");
435	$self->err(416, "not satisfiable", $hdr);	467	$self->err(416, "not satisfiable", $hdr, "");
436		468
437	satisfiable:	469	satisfiable:
438	# check for segmented downloads	470	# check for segmented downloads
439	if ($l && $::NO_SEGMENTED) {	471	if ($l && $::NO_SEGMENTED) {
		472	my $delay = 60;
440	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {	473	while (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
441	Coro::Event::do_timer(after => 15);	474	if ($delay <= 0) {
442
443	$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	}
444	}	491	}
445	}	492	}
446		493
447	$hdr->{"Content-Range"} = "bytes $l-$h/$length";	494	$hdr->{"Content-Range"} = "bytes $l-$h/$length";
448	@code = (206, "partial content");	495	@code = (206, "partial content");
…		…
476	while ($h > 0) {	523	while ($h > 0) {
477	if (0) {	524	if (0) {
478	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h	525	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
479	or last;	526	or last;
480	} else {	527	} else {
		528	undef $buf;
		529	$aio_requests->down;
481	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),	530	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
482	$buf, 0, sub {	531	$buf, 0, sub {
483	$r = $_[0];	532	$r = $_[0];
484	$current->ready;	533	$current->ready;
485	});	534	});
486	&Coro::schedule;	535	&Coro::schedule;
		536	$aio_requests->up;
487	last unless $r;	537	last unless $r;
488	}	538	}
489	my $w = $self->{fh}->syswrite($buf)	539	my $w = $self->{fh}->syswrite($buf)
490	or last;	540	or last;
491	$::written += $w;	541	$::written += $w;

Diff Legend

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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents): Revision 1.20 by root, Thu Aug 16 21:55:35 2001 UTC vs. Revision 1.29 by root, Sat Aug 25 15:14:03 2001 UTC

Diff Legend

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.20 by root, Thu Aug 16 21:55:35 2001 UTC vs.
Revision 1.29 by root, Sat Aug 25 15:14:03 2001 UTC