ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Coro/myhttpd/httpd.pl
(Generate patch)

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.83 by root, Sun Dec 3 17:49:22 2006 UTC vs.
Revision 1.88 by root, Thu Nov 20 14:33:57 2008 UTC

1use Coro; 1use Coro;
2use Coro::Semaphore; 2use Coro::Semaphore;
3use Coro::Event; 3use Coro::EV;
4use Coro::Socket; 4use Coro::Socket;
5use Coro::Signal; 5use Coro::Signal;
6use Coro::AIO (); 6use Coro::AIO ();
7 7
8use HTTP::Date; 8use HTTP::Date;
… …
26our $HTTP_NOW; 26our $HTTP_NOW;
27 27
28our $ERROR_LOG; 28our $ERROR_LOG;
29our $ACCESS_LOG; 29our $ACCESS_LOG;
30 30
31Event->timer(interval => 1, hard => 1, cb => sub { 31our $update_time = EV::periodic 0, 1, undef, sub {
32 $NOW = time; 32 $NOW = time;
33 $HTTP_NOW = time2str $NOW; 33 $HTTP_NOW = time2str $NOW;
34})->now; 34};
35$update_time->invoke;
35 36
36if ($ERROR_LOG) { 37if ($ERROR_LOG) {
37 use IO::Handle; 38 use IO::Handle;
38 open $errorlog, ">>$ERROR_LOG" 39 open $errorlog, ">>$ERROR_LOG"
39 or die "$ERROR_LOG: $!"; 40 or die "$ERROR_LOG: $!";
… …
74 $queue_file->force_wake_next; 75 $queue_file->force_wake_next;
75 slog 1, "forced filetransfer due to unused bandwidth"; 76 slog 1, "forced filetransfer due to unused bandwidth";
76 } 77 }
77} 78}
78 79
79my @newcons;
80my @pool;
81
82# one "execution thread"
83sub handler {
84 while () {
85 if (@newcons) {
86 eval {
87 conn->new (@{pop @newcons})->handle;
88 };
89 slog 1, "$@" if $@ && !ref $@;
90
91 $httpevent->broadcast; # only for testing, but doesn't matter much
92
93 $connections->up;
94 } else {
95 last if @pool >= $MAX_POOL;
96 push @pool, $Coro::current;
97 schedule;
98 }
99 }
100}
101
102sub listen_on { 80sub listen_on {
103 my $listen = $_[0]; 81 my $listen = $_[0];
104 82
105 push @listen_sockets, $listen; 83 push @listen_sockets, $listen;
106 84
107 # the "main thread" 85 # the "main thread"
108 async { 86 async {
109 slog 1, "accepting connections"; 87 slog 1, "accepting connections";
110 while () { 88 while () {
111 $connections->down; 89 $connections->down;
112 push @newcons, [$listen->accept]; 90 my @conn = $listen->accept;
113 #slog 3, "accepted @$connections ".scalar(@pool); 91 #slog 3, "accepted @$connections ".scalar(@pool);
114 if (@pool) { 92
115 (pop @pool)->ready; 93 async_pool {
116 } else { 94 eval {
117 async \&handler; 95 conn->new (@conn)->handle;
96 };
97 slog 1, "$@" if $@ && !ref $@;
98
99 $httpevent->broadcast; # only for testing, but doesn't matter much
100
101 $connections->up;
118 } 102 }
119 } 103 }
120 }; 104 };
121} 105}
122 106
… …
150use Convert::Scalar 'weaken'; 134use Convert::Scalar 'weaken';
151use IO::AIO; 135use IO::AIO;
152 136
153IO::AIO::min_parallel $::AIO_PARALLEL; 137IO::AIO::min_parallel $::AIO_PARALLEL;
154 138
155Event->io (fd => IO::AIO::poll_fileno, 139our $AIO_WATCHER = EV::io IO::AIO::poll_fileno, EV::READ, \&IO::AIO::poll_cb;
156 poll => 'r', async => 1,
157 cb => \&IO::AIO::poll_cb);
158 140
159our %conn; # $conn{ip}{self} => connobj 141our %conn; # $conn{ip}{self} => connobj
160our %uri; # $uri{ip}{uri}{self} 142our %uri; # $uri{ip}{uri}{self}
161our %blocked; 143our %blocked;
162our %mimetype; 144our %mimetype;
… …
222 for (keys %blocked) { 204 for (keys %blocked) {
223 delete $blocked{$_} unless $blocked{$_}[0] > $::NOW; 205 delete $blocked{$_} unless $blocked{$_}[0] > $::NOW;
224 } 206 }
225} 207}
226 208
227Event->timer (interval => 60, cb => \&prune_caches); 209our $PRUNE_WATCHER = EV::timer 60, 60, \&prune_caches;
228 210
229sub slog { 211sub slog {
230 my $self = shift; 212 my $self = shift;
231 main::slog($_[0], "$self->{remote_id}> $_[1]"); 213 main::slog($_[0], "$self->{remote_id}> $_[1]");
232} 214}
… …
425sub map_uri { 407sub map_uri {
426 my $self = shift; 408 my $self = shift;
427 my $host = $self->{server_name}; 409 my $host = $self->{server_name};
428 my $uri = $self->{uri}; 410 my $uri = $self->{uri};
429 411
412 $host =~ /[\/\\]/
413 and $self->err(400, "bad request");
414
430 # some massaging, also makes it more secure 415 # some massaging, also makes it more secure
431 $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge; 416 $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
432 $uri =~ s%//+%/%g; 417 $uri =~ s%//+%/%g;
433 $uri =~ s%/\.(?=/|$)%%g; 418 $uri =~ s%/\.(?=/|$)%%g;
434 1 while $uri =~ s%/[^/]+/\.\.(?=/|$)%%; 419 1 while $uri =~ s%/[^/]+/\.\.(?=/|$)%%;
… …
553 }; 538 };
554 539
555 my @code = (200, "ok"); 540 my @code = (200, "ok");
556 my ($l, $h); 541 my ($l, $h);
557 542
558 if ($self->{h}{range} =~ /^bytes=(.*)$/) { 543 if ($self->{h}{range} =~ /^bytes=(.*)$/i) {
559 for (split /,/, $1) { 544 for (split /,/, $1) {
560 if (/^-(\d+)$/) { 545 if (/^-(\d+)$/) {
561 ($l, $h) = ($length - $1, $length - 1); 546 ($l, $h) = ($length - $1, $length - 1);
562 } elsif (/^(\d+)-(\d*)$/) { 547 } elsif (/^(\d+)-(\d*)$/) {
563 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 548 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
… …
629 614
630 Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), my $buf, 0 615 Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), my $buf, 0
631 or last; 616 or last;
632 617
633 $tbf->request (length $buf); 618 $tbf->request (length $buf);
634 my $w = syswrite $self->{fh}, $buf 619 my $w = $self->{fh}->syswrite ($buf)
635 or last; 620 or last;
636 $::written += $w; 621 $::written += $w;
637 $self->{written} += $w; 622 $self->{written} += $w;
638 $l += $w; 623 $l += $w;
639 } 624 }

Diff Legend

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