[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.91 by root, Thu Feb 4 22:35:47 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	};
54	my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW);	57	my $NOW = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW);
55	printf "$NOW: $format\n", @_;	58	printf "$NOW: $format\n", @_;
56	printf $errorlog "$NOW: $format\n", @_ if $errorlog;	59	printf $errorlog "$NOW: $format\n", @_ if $errorlog;
57	}	60	}
58		61
59	our $connections = new Coro::Semaphore $MAX_CONNECTS \|\| 250;	62	our $connections = new Coro::Semaphore $::MAX_CONNECTS \|\| 250;
60	our $httpevent = new Coro::Signal;	63	our $httpevent = new Coro::Signal;
61		64
62	our $queue_file = new transferqueue $MAX_TRANSFERS;	65	our $queue_file = new transferqueue $::MAX_TRANSFERS;
63	our $queue_index = new transferqueue 10;	66	our $queue_index = new transferqueue 10;
64		67
65	our $tbf_top = new tbf rate => $TBF_RATE \|\| 100000;	68	our $tbf_top = new tbf rate => $::TBF_RATE \|\| 100000;
66		69
67	my $unused_bytes = 0;	70	my $unused_bytes = 0;
68	my $unused_last = time;	71	my $unused_last = time;
69		72
70	sub unused_bandwidth {	73	sub unused_bandwidth {
71	$unused_bytes += $_[0];	74	$unused_bytes += $_[0];
72	if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {	75	if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
73	$unused_last = $NOW;	76	$unused_last = $NOW;
74	$unused_bytes = 0;	77	$unused_bytes = 0;
75	$queue_file->force_wake_next;	78	$queue_file->force_wake_next
76	slog 1, "forced filetransfer due to unused bandwidth";	79	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	}	80	}
101	}	81	}
102		82
103	sub listen_on {	83	sub listen_on {
104	my $listen = $_[0];	84	my $listen = $_[0];
…		…
108	# the "main thread"	88	# the "main thread"
109	async {	89	async {
110	slog 1, "accepting connections";	90	slog 1, "accepting connections";
111	while () {	91	while () {
112	$connections->down;	92	$connections->down;
113	push @newcons, [$listen->accept];	93	my @conn = $listen->accept;
114	#slog 3, "accepted @$connections ".scalar(@pool);	94	#slog 3, "accepted @$connections ".scalar(@pool);
115	if (@pool) {	95
116	(pop @pool)->ready;	96	async_pool {
117	} else {	97	eval {
118	async \&handler;	98	conn->new (@conn)->handle;
		99	};
		100	slog 1, "$@" if $@ && !ref $@;
		101
		102	$httpevent->broadcast; # only for testing, but doesn't matter much
		103
		104	$connections->up;
119	}	105	}
120	}	106	}
121	};	107	};
122	}	108	}
123		109
124	my $http_port = new Coro::Socket	110	my $http_port = new Coro::Socket
125	LocalAddr => $SERVER_HOST,	111	LocalAddr => $::SERVER_HOST,
126	LocalPort => $SERVER_PORT,	112	LocalPort => $::SERVER_PORT,
127	ReuseAddr => 1,	113	ReuseAddr => 1,
128	Listen => 50,	114	Listen => 50,
129	or die "unable to start server";	115	or die "unable to start server";
130		116
131	listen_on $http_port;	117	listen_on $http_port;
132		118
133	if ($SERVER_PORT2) {	119	if ($::SERVER_PORT2) {
134	my $http_port = new Coro::Socket	120	my $http_port = new Coro::Socket
135	LocalAddr => $SERVER_HOST,	121	LocalAddr => $::SERVER_HOST,
136	LocalPort => $SERVER_PORT2,	122	LocalPort => $::SERVER_PORT2,
137	ReuseAddr => 1,	123	ReuseAddr => 1,
138	Listen => 50,	124	Listen => 50,
139	or die "unable to start server";	125	or die "unable to start server";
140		126
141	listen_on $http_port;	127	listen_on $http_port;
142	}	128	}
143		129
144	package conn;	130	package conn;
145		131
146	use strict;	132	use common::sense;
147	use bytes;
148		133
149	use Socket;	134	use Socket;
150	use HTTP::Date;	135	use HTTP::Date;
151	use Convert::Scalar 'weaken';	136	use Convert::Scalar 'weaken';
152	use IO::AIO;	137	use IO::AIO;
…		…
483	} else {	468	} else {
484	$self->err (404, "not found");	469	$self->err (404, "not found");
485	}	470	}
486	} else {	471	} else {
487		472
488	stat $path	473	Coro::AIO::aio_stat $path
489	or $self->err (404, "not found");	474	and $self->err (404, "not found");
490		475
491	$self->{stat} = [stat _];	476	$self->{stat} = [stat _];
492		477
493	# idiotic netscape sends idiotic headers AGAIN	478	# idiotic netscape sends idiotic headers AGAIN
494	my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/	479	my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/
…		…
604		589
605	if ($self->{method} eq "GET") {	590	if ($self->{method} eq "GET") {
606	$self->{time} = $::NOW;	591	$self->{time} = $::NOW;
607	$self->{written} = 0;	592	$self->{written} = 0;
608		593
609	open my $fh, "<", $self->{path}	594	my $fh = Coro::AIO::aio_open $self->{path}, Fcntl::O_RDONLY, 0
610	or die "$self->{path}: late open failure ($!)";	595	or die "$self->{path}: late open failure ($!)";
611		596
612	$h -= $l - 1;	597	$h -= $l - 1;
613		598
614	my $transfer = $queue->start_transfer ($h);	599	my $transfer = $queue->start_transfer ($h);
615	my $locked;	600	my $locked;
616	my $bufsize = $::WAIT_BUFSIZE; # initial buffer size	601	my $bufsize = $::WAIT_BUFSIZE; # initial buffer size
617		602
618	while ($h > 0) {	603	while ($h > 0) {
		604	Coro::cede;
		605	my $transfer_lock = $TRANSFER_LOCK->guard ($self->{remote_id});
		606
619	unless ($locked) {	607	unless ($locked) {
620	if ($locked \|\|= $transfer->try ($::WAIT_INTERVAL)) {	608	if ($locked \|\|= $transfer->try ($::WAIT_INTERVAL)) {
621	$bufsize = $::BUFSIZE;	609	$bufsize = $::BUFSIZE;
622	$self->{time} = $::NOW;	610	$self->{time} = $::NOW;
623	$self->{written} = 0;	611	$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.91 by root, Thu Feb 4 22:35:47 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.91 by root, Thu Feb 4 22:35:47 2010 UTC