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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.87 by root, Wed Nov 19 11:41:06 2008 UTC vs.
Revision 1.93 by root, Sun Mar 21 00:21:14 2010 UTC

…		…
1	use Coro;	1	use Coro;
2	use Coro::Semaphore;	2	use Coro::Semaphore;
		3	use Coro::SemaphoreSet;
3	use Coro::EV;	4	use Coro::EV;
4	use Coro::Socket;	5	use Coro::Socket;
5	use Coro::Signal;	6	use Coro::Signal;
6	use Coro::AIO ();	7	use Coro::AIO ();
7		8
		9	use Fcntl;
8	use HTTP::Date;	10	use HTTP::Date;
9	use POSIX ();	11	use POSIX ();
10		12
11	use Compress::Zlib ();	13	use Compress::Zlib ();
12		14
13	no utf8;	15	use common::sense;
14	use bytes;
15		16
16	# at least on my machine, this thingy serves files	17	# at least on my machine, this thingy serves files
17	# quite a bit faster than apache, ;)	18	# quite a bit faster than apache, ;)
18	# and quite a bit slower than thttpd :(	19	# and quite a bit slower than thttpd :(
19		20
20	$SIG{PIPE} = 'IGNORE';	21	$SIG{PIPE} = 'IGNORE';
21		22
22	our $accesslog;	23	our $accesslog;
23	our $errorlog;	24	our $errorlog;
		25	our @listen_sockets;
24		26
25	our $NOW;	27	our $NOW;
26	our $HTTP_NOW;	28	our $HTTP_NOW;
27		29
28	our $ERROR_LOG;	30	our $ERROR_LOG;
29	our $ACCESS_LOG;	31	our $ACCESS_LOG;
		32	our $TRANSFER_LOCK = new Coro::SemaphoreSet; # lock to be acquired per ip
30		33
31	our $update_time = EV::periodic 0, 1, undef, sub {	34	our $update_time = EV::periodic 0, 1, undef, sub {
32	$NOW = time;	35	$NOW = time;
33	$HTTP_NOW = time2str $NOW;	36	$HTTP_NOW = time2str $NOW;
34	};	37	};
49	}	52	}
50		53
51	sub slog {	54	sub slog {
52	my $level = shift;	55	my $level = shift;
53	my $format = shift;	56	my $format = shift;
		57
		58	$format = sprintf $format, @_ if @_;
		59
54	my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW);	60	my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW);
55	printf "$NOW: $format\n", @_;	61	print "$NOW: $format\n";
56	printf $errorlog "$NOW: $format\n", @_ if $errorlog;	62	print $errorlog "$NOW: $format\n", @_ if $errorlog;
57	}	63	}
58		64
59	our $connections = new Coro::Semaphore $MAX_CONNECTS \|\| 250;	65	our $connections = new Coro::Semaphore $::MAX_CONNECTS \|\| 250;
60	our $httpevent = new Coro::Signal;	66	our $httpevent = new Coro::Signal;
61		67
62	our $queue_file = new transferqueue $MAX_TRANSFERS;	68	our $queue_file = new transferqueue $::MAX_TRANSFERS;
63	our $queue_index = new transferqueue 10;	69	our $queue_index = new transferqueue 10;
64		70
65	our $tbf_top = new tbf rate => $TBF_RATE \|\| 100000;	71	our $tbf_top = new tbf rate => $::TBF_RATE \|\| 100000;
66		72
67	my $unused_bytes = 0;	73	my $unused_bytes = 0;
68	my $unused_last = time;	74	my $unused_last = time;
69		75
70	sub unused_bandwidth {	76	sub unused_bandwidth {
71	$unused_bytes += $_[0];	77	$unused_bytes += $_[0];
72	if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {	78	if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
73	$unused_last = $NOW;	79	$unused_last = $NOW;
74	$unused_bytes = 0;	80	$unused_bytes = 0;
75	$queue_file->force_wake_next;	81	$queue_file->force_wake_next
76	slog 1, "forced filetransfer due to unused bandwidth";	82	and slog 1, "forced filetransfer due to unused bandwidth";
77	}
78	}
79
80	my @newcons;
81	my @pool;
82
83	# one "execution thread"
84	sub handler {
85	while () {
86	if (@newcons) {
87	eval {
88	conn->new (@{pop @newcons})->handle;
89	};
90	slog 1, "$@" if $@ && !ref $@;
91
92	$httpevent->broadcast; # only for testing, but doesn't matter much
93
94	$connections->up;
95	} else {
96	last if @pool >= $MAX_POOL;
97	push @pool, $Coro::current;
98	schedule;
99	}
100	}	83	}
101	}	84	}
102		85
103	sub listen_on {	86	sub listen_on {
104	my $listen = $_[0];	87	my $listen = $_[0];
…		…
108	# the "main thread"	91	# the "main thread"
109	async {	92	async {
110	slog 1, "accepting connections";	93	slog 1, "accepting connections";
111	while () {	94	while () {
112	$connections->down;	95	$connections->down;
113	push @newcons, [$listen->accept];	96	my @conn = $listen->accept;
114	#slog 3, "accepted @$connections ".scalar(@pool);	97	#slog 3, "accepted @$connections ".scalar(@pool);
115	if (@pool) {	98
116	(pop @pool)->ready;	99	async_pool {
117	} else {	100	eval {
118	async \&handler;	101	conn->new (@conn)->handle;
		102	};
		103	slog 1, "$@" if $@ && !ref $@;
		104
		105	$httpevent->broadcast; # only for testing, but doesn't matter much
		106
		107	$connections->up;
119	}	108	}
120	}	109	}
121	};	110	};
122	}	111	}
123		112
124	my $http_port = new Coro::Socket	113	my $http_port = new Coro::Socket
125	LocalAddr => $SERVER_HOST,	114	LocalAddr => $::SERVER_HOST,
126	LocalPort => $SERVER_PORT,	115	LocalPort => $::SERVER_PORT,
127	ReuseAddr => 1,	116	ReuseAddr => 1,
128	Listen => 50,	117	Listen => 50,
129	or die "unable to start server";	118	or die "unable to start server";
130		119
131	listen_on $http_port;	120	listen_on $http_port;
132		121
133	if ($SERVER_PORT2) {	122	if ($::SERVER_PORT2) {
134	my $http_port = new Coro::Socket	123	my $http_port = new Coro::Socket
135	LocalAddr => $SERVER_HOST,	124	LocalAddr => $::SERVER_HOST,
136	LocalPort => $SERVER_PORT2,	125	LocalPort => $::SERVER_PORT2,
137	ReuseAddr => 1,	126	ReuseAddr => 1,
138	Listen => 50,	127	Listen => 50,
139	or die "unable to start server";	128	or die "unable to start server";
140		129
141	listen_on $http_port;	130	listen_on $http_port;
142	}	131	}
143		132
144	package conn;	133	package conn;
145		134
146	use strict;	135	use common::sense;
147	use bytes;
148		136
149	use Socket;	137	use Socket;
150	use HTTP::Date;	138	use HTTP::Date;
151	use Convert::Scalar 'weaken';	139	use Convert::Scalar 'weaken';
152	use IO::AIO;	140	use IO::AIO;
…		…
483	} else {	471	} else {
484	$self->err (404, "not found");	472	$self->err (404, "not found");
485	}	473	}
486	} else {	474	} else {
487		475
488	stat $path	476	Coro::AIO::aio_stat $path
489	or $self->err (404, "not found");	477	and $self->err (404, "not found");
490		478
491	$self->{stat} = [stat _];	479	$self->{stat} = [stat _];
492		480
493	# idiotic netscape sends idiotic headers AGAIN	481	# idiotic netscape sends idiotic headers AGAIN
494	my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/	482	my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/
…		…
604		592
605	if ($self->{method} eq "GET") {	593	if ($self->{method} eq "GET") {
606	$self->{time} = $::NOW;	594	$self->{time} = $::NOW;
607	$self->{written} = 0;	595	$self->{written} = 0;
608		596
609	open my $fh, "<", $self->{path}	597	my $fh = Coro::AIO::aio_open $self->{path}, Fcntl::O_RDONLY, 0
610	or die "$self->{path}: late open failure ($!)";	598	or die "$self->{path}: late open failure ($!)";
611		599
612	$h -= $l - 1;	600	$h -= $l - 1;
613		601
614	my $transfer = $queue->start_transfer ($h);	602	my $transfer = $queue->start_transfer ($h);
615	my $locked;	603	my $locked;
616	my $bufsize = $::WAIT_BUFSIZE; # initial buffer size	604	my $bufsize = $::WAIT_BUFSIZE; # initial buffer size
617		605
618	while ($h > 0) {	606	while ($h > 0) {
		607	Coro::cede;
		608	my $transfer_lock = $TRANSFER_LOCK->guard ($self->{remote_id});
		609
619	unless ($locked) {	610	unless ($locked) {
620	if ($locked \|\|= $transfer->try ($::WAIT_INTERVAL)) {	611	if ($locked \|\|= $transfer->try ($::WAIT_INTERVAL)) {
621	$bufsize = $::BUFSIZE;	612	$bufsize = $::BUFSIZE;
622	$self->{time} = $::NOW;	613	$self->{time} = $::NOW;
623	$self->{written} = 0;	614	$self->{written} = 0;

Diff Legend

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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents): Revision 1.87 by root, Wed Nov 19 11:41:06 2008 UTC vs. Revision 1.93 by root, Sun Mar 21 00:21:14 2010 UTC

Diff Legend

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.87 by root, Wed Nov 19 11:41:06 2008 UTC vs.
Revision 1.93 by root, Sun Mar 21 00:21:14 2010 UTC