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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.21 by root, Fri Aug 17 03:33:00 2001 UTC vs.
Revision 1.30 by root, Sun Aug 26 14:55:46 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	my $scheduler = Event->idle(
83	max => 0, min => 0, prio => 6, parked => 1,
84	cb => \&Coro::schedule);
85		93
86	our %conn; # $conn{ip}{fh} => connobj	94	our %conn; # $conn{ip}{self} => connobj
		95	our %uri; # $uri{ip}{uri}{self}
87	our %blocked;	96	our %blocked;
88	our %mimetype;	97	our %mimetype;
89		98
90	sub read_mimetypes {	99	sub read_mimetypes {
91	local *M;	100	local *M;
…		…
130	delete $conn{$self->{remote_addr}}{$self*1};	139	delete $conn{$self->{remote_addr}}{$self*1};
131	}	140	}
132		141
133	# end of connection	142	# end of connection
134	sub eoconn {	143	sub eoconn {
		144	my $self = shift;
135	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};	145	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};
136	}	146	}
137		147
138	sub slog {	148	sub slog {
139	my $self = shift;	149	my $self = shift;
140	main::slog($_[0], "$self->{remote_addr}> $_[1]");	150	main::slog($_[0], ($self->{remote_id} \|\| $self->{remote_addr}) ."> $_[1]");
141	}	151	}
142		152
143	sub response {	153	sub response {
144	my ($self, $code, $msg, $hdr, $content) = @_;	154	my ($self, $code, $msg, $hdr, $content) = @_;
145	my $res = "HTTP/1.1 $code $msg\015\012";	155	my $res = "HTTP/1.1 $code $msg\015\012";
146		156
147	#$res .= "Connection: close\015\012";	157	$self->{h}{connection} \|\|= $hdr->{Connection};
		158
148	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(	159	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
149		160
150	while (my ($h, $v) = each %$hdr) {	161	while (my ($h, $v) = each %$hdr) {
151	$res .= "$h: $v\015\012"	162	$res .= "$h: $v\015\012"
152	}	163	}
153	$res .= "\015\012";	164	$res .= "\015\012";
154		165
155	$res .= $content if defined $content and $self->{method} ne "HEAD";	166	$res .= $content if defined $content and $self->{method} ne "HEAD";
156		167
157	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;
158		172
159	$self->{written} +=	173	$self->{written} +=
160	print {$self->{fh}} $res;	174	print {$self->{fh}} $res;
161	}	175	}
162		176
…		…
174	$self->response($code, $msg, $hdr, $content);	188	$self->response($code, $msg, $hdr, $content);
175		189
176	die bless {}, err::;	190	die bless {}, err::;
177	}	191	}
178		192
179	sub err_blocked {
180	my $self = shift;
181	my $ip = $self->{remote_addr};
182	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
183
184	Coro::Event::do_timer(after => 20*rand);
185
186	$self->err(401, "too many connections",
187	{
188	"Content-Type" => "text/html",
189	"Retry-After" => $::BLOCKTIME,
190	"Warning" => "Please do NOT retry, you have been blocked",
191	"WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",
192	},
193	<<EOF);
194	<html><p>
195	You have been blocked because you opened too many connections. You
196	may retry at</p>
197
198	<p><blockquote>$time.</blockquote></p>
199
200	<p>Until then, each new access will renew the block. You might want to have a
201	look at the <a href="http://www.goof.com/pcg/marc/animefaq.html">FAQ</a>.</p>
202	</html>
203	EOF
204	}
205
206	sub handle {	193	sub handle {
207	my $self = shift;	194	my $self = shift;
208	my $fh = $self->{fh};	195	my $fh = $self->{fh};
		196
		197	my $host;
209		198
210	$fh->timeout($::REQ_TIMEOUT);	199	$fh->timeout($::REQ_TIMEOUT);
211	while() {	200	while() {
212	$self->{reqs}++;	201	$self->{reqs}++;
213		202
…		…
270		259
271	$self->{h}{$h} = substr $v, 1	260	$self->{h}{$h} = substr $v, 1
272	while ($h, $v) = each %hdr;	261	while ($h, $v) = each %hdr;
273	}	262	}
274		263
		264	# find out server name and port
		265	if ($self->{uri} =~ s/^http:\/\/([^\/?#]*)//i) {
		266	$host = $1;
		267	} else {
		268	$host = $self->{h}{host};
		269	}
		270
		271	if (defined $host) {
275	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;	272	$self->{server_port} = $host =~ s/:([0-9]+)$// ? $1 : 80;
		273	} else {
		274	($self->{server_port}, $host)
		275	= unpack_sockaddr_in $self->{fh}->getsockname
		276	or $self->err(500, "unable to get socket name");
		277	$host = inet_ntoa $host;
		278	}
		279
		280	$self->{server_name} = $host;
		281
		282	# remote id should be unique per user
		283	$self->{remote_id} = $self->{remote_addr};
		284
		285	if (exists $self->{h}{"client-ip"}) {
		286	$self->{remote_id} .= "[".$self->{h}{"client-ip"}."]";
		287	} elsif (exists $self->{h}{"x-forwarded-for"}) {
		288	$self->{remote_id} .= "[".$self->{h}{"x-forwarded-for"}."]";
		289	}
276		290
277	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);	291	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);
278		292
		293	eval {
279	$self->map_uri;	294	$self->map_uri;
280	$self->respond;	295	$self->respond;
		296	};
281		297
282	$self->eoconn;	298	$self->eoconn;
283		299
		300	die if $@ && !ref $@;
		301
284	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} lt "1.1";	302	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} < 1.1;
285		303
286	$self->slog(9, "persistent connection [".$self->{h}{"user-agent"}."][$self->{reqs}]");
287	$fh->timeout($::PER_TIMEOUT);	304	$fh->timeout($::PER_TIMEOUT);
288	}	305	}
289	}	306	}
290		307
291	# uri => path mapping	308	# uri => path mapping
292	sub map_uri {	309	sub map_uri {
293	my $self = shift;	310	my $self = shift;
294	my $host = $self->{h}{host} \|\| "default";	311	my $host = $self->{server_name};
295	my $uri = $self->{uri};	312	my $uri = $self->{uri};
296		313
297	# some massaging, also makes it more secure	314	# some massaging, also makes it more secure
298	$uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;	315	$uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
299	$uri =~ s%//+%/%g;	316	$uri =~ s%//+%/%g;
…		…
309	$self->{path} = "$::DOCROOT/$host$uri";	326	$self->{path} = "$::DOCROOT/$host$uri";
310		327
311	$self->access_check;	328	$self->access_check;
312	}	329	}
313		330
314	sub server_address {
315	my $self = shift;
316	my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname
317	or $self->err(500, "unable to get socket name");
318	((inet_ntoa $iaddr), $port);
319	}
320
321	sub server_host {
322	my $self = shift;
323	if (exists $self->{h}{host}) {
324	return $self->{h}{host};
325	} else {
326	return (($self->server_address)[0]);
327	}
328	}
329
330	sub server_hostport {
331	my $self = shift;
332	my ($host, $port);
333	if (exists $self->{h}{host}) {
334	($host, $port) = ($self->{h}{host}, $self->{server_port});
335	} else {
336	($host, $port) = $self->server_address;
337	}
338	$port = $port == 80 ? "" : ":$port";
339	$host.$port;
340	}
341
342	sub _cgi {	331	sub _cgi {
343	my $self = shift;	332	my $self = shift;
344	my $path = shift;	333	my $path = shift;
345	my $fh;	334	my $fh;
346		335
347	# no two-way xxx supported	336	# no two-way xxx supported
348	if (0 == fork) {	337	if (0 == fork) {
349	open STDOUT, ">&".fileno($self->{fh});	338	open STDOUT, ">&".fileno($self->{fh});
350	if (chdir $::DOCROOT) {	339	if (chdir $::DOCROOT) {
351	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike	340	$ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike
352	$ENV{HTTP_HOST} = $self->server_host;	341	$ENV{HTTP_HOST} = $self->{server_name};
353	$ENV{HTTP_PORT} = $self->{server_host};	342	$ENV{HTTP_PORT} = $self->{server_port};
354	$ENV{SCRIPT_NAME} = $self->{name};	343	$ENV{SCRIPT_NAME} = $self->{name};
355	exec $path;	344	exec $path;
356	}	345	}
357	Coro::State::_exit(0);	346	Coro::State::_exit(0);
358	} else {	347	} else {
		348	die;
359	}	349	}
		350	}
		351
		352	sub server_hostport {
		353	$_[0]{server_port} == 80
		354	? $_[0]{server_name}
		355	: "$_[0]{server_name}:$_[0]{server_port}";
360	}	356	}
361		357
362	sub respond {	358	sub respond {
363	my $self = shift;	359	my $self = shift;
364	my $path = $self->{path};	360	my $path = $self->{path};
…		…
374		370
375	if (-d _ && -r _) {	371	if (-d _ && -r _) {
376	# directory	372	# directory
377	if ($path !~ /\/$/) {	373	if ($path !~ /\/$/) {
378	# create a redirect to get the trailing "/"	374	# create a redirect to get the trailing "/"
379	my $host = $self->server_hostport;	375	# we don't try to avoid the :80
380	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });	376	$self->err(301, "moved permanently", { Location => "http://".$self->server_hostport."$self->{uri}/" });
381	} else {	377	} else {
382	$ims < $self->{stat}[9]	378	$ims < $self->{stat}[9]
383	or $self->err(304, "not modified");	379	or $self->err(304, "not modified");
384		380
385	if ($self->{method} eq "GET") {
386	if (-r "$path/index.html") {	381	if (-r "$path/index.html") {
387	$self->{path} .= "/index.html";	382	$self->{path} .= "/index.html";
388	$self->handle_file;	383	$self->handle_file;
389	} else {	384	} else {
390	$self->handle_dir;	385	$self->handle_dir;
391	}
392	}	386	}
393	}	387	}
394	} elsif (-f _ && -r _) {	388	} elsif (-f _ && -r _) {
395	-x _ and $self->err(403, "forbidden");	389	-x _ and $self->err(403, "forbidden");
396	$self->handle_file;	390	$self->handle_file;
…		…
429	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);	423	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);
430	} else {	424	} else {
431	($l, $h) = (0, $length - 1);	425	($l, $h) = (0, $length - 1);
432	goto ignore;	426	goto ignore;
433	}	427	}
434	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l;	428	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
435	}	429	}
436	$hdr->{"Content-Range"} = "bytes */$length";	430	$hdr->{"Content-Range"} = "bytes */$length";
		431	$hdr->{"Content-Length"} = $length;
437	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");	432	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");
438	$self->err(416, "not satisfiable", $hdr);	433	$self->err(416, "not satisfiable", $hdr, "");
439		434
440	satisfiable:	435	satisfiable:
441	# check for segmented downloads	436	# check for segmented downloads
442	if ($l && $::NO_SEGMENTED) {	437	if ($l && $::NO_SEGMENTED) {
		438	my $delay = 180;
443	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {	439	while (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
		440	if ($delay <= 0) {
		441	$self->err_segmented_download;
		442	} else {
444	Coro::Event::do_timer(after => 15);	443	Coro::Event::do_timer(after => 3); $delay -= 3;
445		444	}
446	$self->err(400, "segmented downloads are not allowed");
447	}	445	}
448	}	446	}
449		447
450	$hdr->{"Content-Range"} = "bytes $l-$h/$length";	448	$hdr->{"Content-Range"} = "bytes $l-$h/$length";
451	@code = (206, "partial content");	449	@code = (206, "partial content");
…		…
479	while ($h > 0) {	477	while ($h > 0) {
480	if (0) {	478	if (0) {
481	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h	479	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
482	or last;	480	or last;
483	} else {	481	} else {
		482	undef $buf;
		483	$aio_requests->down;
484	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),	484	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
485	$buf, 0, sub {	485	$buf, 0, sub {
486	$r = $_[0];	486	$r = $_[0];
487	$current->ready;	487	$current->ready;
488	$scheduler->now;
489	});	488	});
490	&Coro::schedule;	489	&Coro::schedule;
		490	$aio_requests->up;
491	last unless $r;	491	last unless $r;
492	}	492	}
493	my $w = $self->{fh}->syswrite($buf)	493	my $w = $self->{fh}->syswrite($buf)
494	or last;	494	or last;
495	$::written += $w;	495	$::written += $w;

Diff Legend

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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents): Revision 1.21 by root, Fri Aug 17 03:33:00 2001 UTC vs. Revision 1.30 by root, Sun Aug 26 14:55:46 2001 UTC

Diff Legend

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.21 by root, Fri Aug 17 03:33:00 2001 UTC vs.
Revision 1.30 by root, Sun Aug 26 14:55:46 2001 UTC