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

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.12 by root, Sat Aug 11 23:10:56 2001 UTC vs.
Revision 1.27 by root, Sun Aug 19 23:57:52 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	}
…		…
43		52
44	my $http_port = new Coro::Socket	53	my $http_port = new Coro::Socket
45	LocalAddr => $SERVER_HOST,	54	LocalAddr => $SERVER_HOST,
46	LocalPort => $SERVER_PORT,	55	LocalPort => $SERVER_PORT,
47	ReuseAddr => 1,	56	ReuseAddr => 1,
48	Listen => 1,	57	Listen => 50,
49	or die "unable to start server";	58	or die "unable to start server";
50		59
51	push @listen_sockets, $http_port;	60	push @listen_sockets, $http_port;
52		61
53	# the "main thread"	62	# the "main thread"
…		…
70	package conn;	79	package conn;
71		80
72	use Socket;	81	use Socket;
73	use HTTP::Date;	82	use HTTP::Date;
74	use Convert::Scalar 'weaken';	83	use Convert::Scalar 'weaken';
		84	use Linux::AIO;
75		85
		86	Linux::AIO::min_parallel $::AIO_PARALLEL;
		87
		88	Event->io(fd => Linux::AIO::poll_fileno,
		89	poll => 'r', async => 1,
		90	cb => \&Linux::AIO::poll_cb);
		91
76	our %conn; # $conn{ip}{fh} => connobj	92	our %conn; # $conn{ip}{self} => connobj
		93	our %uri; # $uri{ip}{uri}{self}
77	our %blocked;	94	our %blocked;
78	our %mimetype;	95	our %mimetype;
79		96
80	sub read_mimetypes {	97	sub read_mimetypes {
81	local *M;	98	local *M;
…		…
104	$self->{time} = $::NOW;	121	$self->{time} = $::NOW;
105		122
106	# enter ourselves into various lists	123	# enter ourselves into various lists
107	weaken ($conn{$self->{remote_addr}}{$self*1} = $self);	124	weaken ($conn{$self->{remote_addr}}{$self*1} = $self);
108		125
		126	$::conns++;
		127
109	$self;	128	$self;
110	}	129	}
111		130
112	sub DESTROY {	131	sub DESTROY {
113	my $self = shift;	132	my $self = shift;
		133
		134	$::conns--;
		135
		136	$self->eoconn;
114	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;
115	delete $uri{$self->{uri}}{$self*1};	143	delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};
116	}	144	}
117		145
118	sub slog {	146	sub slog {
119	my $self = shift;	147	my $self = shift;
120	main::slog($_[0], "$self->{remote_addr}> $_[1]");	148	main::slog($_[0], "$self->{remote_addr}> $_[1]");
121	}	149	}
122		150
123	sub response {	151	sub response {
124	my ($self, $code, $msg, $hdr, $content) = @_;	152	my ($self, $code, $msg, $hdr, $content) = @_;
125	my $res = "HTTP/1.0 $code $msg\015\012";	153	my $res = "HTTP/1.1 $code $msg\015\012";
126		154
127	$res .= "Connection: close\015\012";	155	#$res .= "Connection: close\015\012";
128	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(	156	$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
129		157
130	while (my ($h, $v) = each %$hdr) {	158	while (my ($h, $v) = each %$hdr) {
131	$res .= "$h: $v\015\012"	159	$res .= "$h: $v\015\012"
132	}	160	}
133	$res .= "\015\012";	161	$res .= "\015\012";
134		162
135	$res .= $content if defined $content and $self->{method} eq "GET";	163	$res .= $content if defined $content and $self->{method} ne "HEAD";
136		164
137	print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d#	165	my $log = "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";
		166
		167	print $accesslog $log if $accesslog;
		168	print STDERR $log;
138		169
139	$self->{written} +=	170	$self->{written} +=
140	print {$self->{fh}} $res;	171	print {$self->{fh}} $res;
141	}	172	}
142		173
…		…
147	unless (defined $content) {	178	unless (defined $content) {
148	$content = "$code $msg";	179	$content = "$code $msg";
149	$hdr->{"Content-Type"} = "text/plain";	180	$hdr->{"Content-Type"} = "text/plain";
150	$hdr->{"Content-Length"} = length $content;	181	$hdr->{"Content-Length"} = length $content;
151	}	182	}
		183	$hdr->{"Connection"} = "close";
152		184
153	$self->response($code, $msg, $hdr, $content);	185	$self->response($code, $msg, $hdr, $content);
154		186
155	die bless {}, err::;	187	die bless {}, err::;
156	}	188	}
…		…
158	sub err_blocked {	190	sub err_blocked {
159	my $self = shift;	191	my $self = shift;
160	my $ip = $self->{remote_addr};	192	my $ip = $self->{remote_addr};
161	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;	193	my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
162		194
163	Coro::Event::do_timer(after => 5);	195	Coro::Event::do_timer(after => 20*rand);
164		196
165	$self->err(403, "too many connections",	197	$self->err(401, "too many connections",
166	{	198	{
167	"Content-Type" => "text/html",	199	"Content-Type" => "text/html",
168	"Retry-After" => $::BLOCKTIME	200	"Retry-After" => $::BLOCKTIME,
		201	"Warning" => "Please do NOT retry, you have been blocked",
		202	"WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",
169	},	203	},
170	<<EOF);	204	<<EOF);
171	<html><p>	205	<html>
		206	<head>
		207	<title>Too many connections</title>
		208	</head>
		209	<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
		210
172	You have been blocked because you opened too many connections. You	211	<p>You have been blocked because you opened too many connections. You
173	may retry at</p>	212	may retry at</p>
174		213
175	<p><blockquote>$time.</blockquote></p>	214	<p><blockquote>$time.</blockquote></p>
176		215
177	<p>Until then, each new access will renew the block. You might want to have a	216	<p>Until then, each new access will renew the block. You might want to have a
178	look at the <a href="http://www.goof.com/pcg/marc/animefaq.html">FAQ</a>.</p>	217	look at the <a href="http://www.goof.com/pcg/marc/animefaq.html">FAQ</a>.</p>
179	</html>	218
		219	</body></html>
180	EOF	220	EOF
181	}	221	}
182		222
183	sub handle {	223	sub handle {
184	my $self = shift;	224	my $self = shift;
185	my $fh = $self->{fh};	225	my $fh = $self->{fh};
186		226
		227	$fh->timeout($::REQ_TIMEOUT);
187	#while() {	228	while() {
		229	$self->{reqs}++;
		230
		231	# read request and parse first line
		232	my $req = $fh->readline("\015\012\015\012");
		233
		234	unless (defined $req) {
		235	if (exists $self->{version}) {
		236	last;
		237	} else {
		238	$self->err(408, "request timeout");
		239	}
		240	}
		241
188	$self->{h} = {};	242	$self->{h} = {};
189		243
190	# read request and parse first line
191	$fh->timeout($::REQ_TIMEOUT);
192	my $req = $fh->readline("\015\012\015\012");
193	$fh->timeout($::RES_TIMEOUT);	244	$fh->timeout($::RES_TIMEOUT);
194
195	defined $req or
196	$self->err(408, "request timeout");
197
198	my $ip = $self->{remote_addr};	245	my $ip = $self->{remote_addr};
199		246
200	if ($blocked{$ip}) {	247	if ($blocked{$ip}) {
201	$self->err_blocked($blocked{$ip})	248	$self->err_blocked($blocked{$ip})
202	if $blocked{$ip} > $::NOW;	249	if $blocked{$ip} > $::NOW;
…		…
212	$req =~ /^(?:\015\012)?	259	$req =~ /^(?:\015\012)?
213	(GET\|HEAD) \040+	260	(GET\|HEAD) \040+
214	([^\040]+) \040+	261	([^\040]+) \040+
215	HTTP\/([0-9]+\.[0-9]+)	262	HTTP\/([0-9]+\.[0-9]+)
216	\015\012/gx	263	\015\012/gx
217	or $self->err(403, "method not allowed", { Allow => "GET,HEAD" });	264	or $self->err(405, "method not allowed", { Allow => "GET,HEAD" });
218
219	$2 ne "1.0"
220	or $self->err(506, "http protocol version not supported");
221		265
222	$self->{method} = $1;	266	$self->{method} = $1;
223	$self->{uri} = $2;	267	$self->{uri} = $2;
		268	$self->{version} = $3;
		269
		270	$3 =~ /^1\./
		271	or $self->err(506, "http protocol version $3 not supported");
224		272
225	# parse headers	273	# parse headers
226	{	274	{
227	my (%hdr, $h, $v);	275	my (%hdr, $h, $v);
228		276
…		…
241	while ($h, $v) = each %hdr;	289	while ($h, $v) = each %hdr;
242	}	290	}
243		291
244	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;	292	$self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;
245		293
246	weaken ($uri{$self->{uri}}{$self*1} = $self);	294	weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);
247		295
		296	eval {
248	$self->map_uri;	297	$self->map_uri;
249	$self->respond;	298	$self->respond;
		299	};
		300
		301	$self->eoconn;
		302
		303	die if $@ && !ref $@;
		304
		305	last if $self->{h}{connection} =~ /close/ \|\| $self->{version} lt "1.1";
		306
		307	$self->slog(9, "persistent connection [".$self->{h}{"user-agent"}."][$self->{reqs}]");
		308	$fh->timeout($::PER_TIMEOUT);
250	#}	309	}
251	}	310	}
252		311
253	# uri => path mapping	312	# uri => path mapping
254	sub map_uri {	313	sub map_uri {
255	my $self = shift;	314	my $self = shift;
…		…
342	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });	401	$self->err(301, "moved permanently", { Location => "http://$host$self->{uri}/" });
343	} else {	402	} else {
344	$ims < $self->{stat}[9]	403	$ims < $self->{stat}[9]
345	or $self->err(304, "not modified");	404	or $self->err(304, "not modified");
346		405
347	if ($self->{method} eq "GET") {
348	if (-r "$path/index.html") {	406	if (-r "$path/index.html") {
349	$self->{path} .= "/index.html";	407	$self->{path} .= "/index.html";
350	$self->handle_file;	408	$self->handle_file;
351	} else {	409	} else {
352	$self->handle_dir;	410	$self->handle_dir;
353	}
354	}	411	}
355	}	412	}
356	} elsif (-f _ && -r _) {	413	} elsif (-f _ && -r _) {
357	-x _ and $self->err(403, "forbidden");	414	-x _ and $self->err(403, "forbidden");
358	$self->handle_file;	415	$self->handle_file;
…		…
391	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);	448	($l, $h) = ($1, ($2 ne "" \|\| $2 >= $length) ? $2 : $length - 1);
392	} else {	449	} else {
393	($l, $h) = (0, $length - 1);	450	($l, $h) = (0, $length - 1);
394	goto ignore;	451	goto ignore;
395	}	452	}
396	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l;	453	goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
397	}	454	}
398	$hdr->{"Content-Range"} = "bytes */$length";	455	$hdr->{"Content-Range"} = "bytes */$length";
		456	$hdr->{"Content-Length"} = $length;
		457	$self->slog(9, "not satisfiable($self->{h}{range}\|".$self->{h}{"user-agent"}.")");
399	$self->err(416, "not satisfiable", $hdr);	458	$self->err(416, "not satisfiable", $hdr, "");
400		459
401	satisfiable:	460	satisfiable:
402	# check for segmented downloads	461	# check for segmented downloads
403	if ($l && $::NO_SEGMENTED) {	462	if ($l && $::NO_SEGMENTED) {
404	if (%{$uri{$self->{uri}}} > 1) {	463	if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
405	$self->err(400, "segmented downloads are not allowed");	464	$self->err(400, "segmented downloads are not allowed");
406	}	465	}
407	}	466	}
408		467
409	$hdr->{"Content-Range"} = "bytes $l-$h/$length";	468	$hdr->{"Content-Range"} = "bytes $l-$h/$length";
…		…
420	$hdr->{"Content-Length"} = $length;	479	$hdr->{"Content-Length"} = $length;
421		480
422	$self->response(@code, $hdr, "");	481	$self->response(@code, $hdr, "");
423		482
424	if ($self->{method} eq "GET") {	483	if ($self->{method} eq "GET") {
425	my ($fh, $buf);	484	my ($fh, $buf, $r);
		485	my $current = $Coro::current;
426	open $fh, "<", $self->{path}	486	open $fh, "<", $self->{path}
427	or die "$self->{path}: late open failure ($!)";	487	or die "$self->{path}: late open failure ($!)";
428		488
429	if ($l) {
430	sysseek $fh, $l, 0
431	or die "$self->{path}: cannot seek to $l ($!)";
432	}
433
434	$h -= $l - 1;	489	$h -= $l - 1;
435		490
		491	if (0) {
		492	if ($l) {
		493	sysseek $fh, $l, 0;
		494	}
		495	}
		496
436	while ($h > 0) {	497	while ($h > 0) {
		498	if (0) {
437	$h -= sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h;	499	sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
		500	or last;
		501	} else {
		502	aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
		503	$buf, 0, sub {
		504	$r = $_[0];
		505	$current->ready;
		506	});
		507	&Coro::schedule;
		508	last unless $r;
		509	}
438	my $w = $self->{fh}->syswrite($buf)	510	my $w = $self->{fh}->syswrite($buf)
439	or last;	511	or last;
440	$::written += $w;	512	$::written += $w;
441	$self->{written} += $w;	513	$self->{written} += $w;
		514	$l += $r;
442	}	515	}
443	}	516	}
444		517
445	close $fh;	518	close $fh;
446	}	519	}

Diff Legend

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

Comparing Coro/myhttpd/httpd.pl (file contents): Revision 1.12 by root, Sat Aug 11 23:10:56 2001 UTC vs. Revision 1.27 by root, Sun Aug 19 23:57:52 2001 UTC

Diff Legend

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.12 by root, Sat Aug 11 23:10:56 2001 UTC vs.
Revision 1.27 by root, Sun Aug 19 23:57:52 2001 UTC