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.84 by root, Sat Dec 8 21:01:16 2007 UTC vs.
Revision 1.90 by root, Wed Jan 27 20:06:57 2010 UTC

1use Coro; 1use Coro;
2use Coro::Semaphore; 2use Coro::Semaphore;
3use Coro::SemaphoreSet;
3use Coro::EV; 4use Coro::EV;
4use Coro::Socket; 5use Coro::Socket;
5use Coro::Signal; 6use Coro::Signal;
6use Coro::AIO (); 7use Coro::AIO ();
7 8
9use Fcntl;
8use HTTP::Date; 10use HTTP::Date;
9use POSIX (); 11use POSIX ();
10 12
11use Compress::Zlib (); 13use Compress::Zlib ();
12 14
13no utf8; 15use common::sense;
14use 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
22our $accesslog; 23our $accesslog;
23our $errorlog; 24our $errorlog;
25our @listen_sockets;
24 26
25our $NOW; 27our $NOW;
26our $HTTP_NOW; 28our $HTTP_NOW;
27 29
28our $ERROR_LOG; 30our $ERROR_LOG;
29our $ACCESS_LOG; 31our $ACCESS_LOG;
32our $TRANSFER_LOCK = new Coro::SemaphoreSet; # lock to be acquired per ip
30 33
31our $update_time = EV::periodic 0, 1, undef, sub { 34our $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
59our $connections = new Coro::Semaphore $MAX_CONNECTS || 250; 62our $connections = new Coro::Semaphore $::MAX_CONNECTS || 250;
60our $httpevent = new Coro::Signal; 63our $httpevent = new Coro::Signal;
61 64
62our $queue_file = new transferqueue $MAX_TRANSFERS; 65our $queue_file = new transferqueue $::MAX_TRANSFERS;
63our $queue_index = new transferqueue 10; 66our $queue_index = new transferqueue 10;
64 67
65our $tbf_top = new tbf rate => $TBF_RATE || 100000; 68our $tbf_top = new tbf rate => $::TBF_RATE || 100000;
66 69
67my $unused_bytes = 0; 70my $unused_bytes = 0;
68my $unused_last = time; 71my $unused_last = time;
69 72
70sub unused_bandwidth { 73sub unused_bandwidth {
… …
75 $queue_file->force_wake_next; 78 $queue_file->force_wake_next;
76 slog 1, "forced filetransfer due to unused bandwidth"; 79 slog 1, "forced filetransfer due to unused bandwidth";
77 } 80 }
78} 81}
79 82
80my @newcons;
81my @pool;
82
83# one "execution thread"
84sub 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 }
101}
102
103sub listen_on { 83sub listen_on {
104 my $listen = $_[0]; 84 my $listen = $_[0];
105 85
106 push @listen_sockets, $listen; 86 push @listen_sockets, $listen;
107 87
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
124my $http_port = new Coro::Socket 110my $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
131listen_on $http_port; 117listen_on $http_port;
132 118
133if ($SERVER_PORT2) { 119if ($::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
144package conn; 130package conn;
145 131
146use strict; 132use common::sense;
147use bytes;
148 133
149use Socket; 134use Socket;
150use HTTP::Date; 135use HTTP::Date;
151use Convert::Scalar 'weaken'; 136use Convert::Scalar 'weaken';
152use IO::AIO; 137use IO::AIO;
… …
424sub map_uri { 409sub map_uri {
425 my $self = shift; 410 my $self = shift;
426 my $host = $self->{server_name}; 411 my $host = $self->{server_name};
427 my $uri = $self->{uri}; 412 my $uri = $self->{uri};
428 413
414 $host =~ /[\/\\]/
415 and $self->err(400, "bad request");
416
429 # some massaging, also makes it more secure 417 # some massaging, also makes it more secure
430 $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge; 418 $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
431 $uri =~ s%//+%/%g; 419 $uri =~ s%//+%/%g;
432 $uri =~ s%/\.(?=/|$)%%g; 420 $uri =~ s%/\.(?=/|$)%%g;
433 1 while $uri =~ s%/[^/]+/\.\.(?=/|$)%%; 421 1 while $uri =~ s%/[^/]+/\.\.(?=/|$)%%;
… …
480 } else { 468 } else {
481 $self->err (404, "not found"); 469 $self->err (404, "not found");
482 } 470 }
483 } else { 471 } else {
484 472
485 stat $path 473 Coro::AIO::aio_stat $path
486 or $self->err (404, "not found"); 474 and $self->err (404, "not found");
487 475
488 $self->{stat} = [stat _]; 476 $self->{stat} = [stat _];
489 477
490 # idiotic netscape sends idiotic headers AGAIN 478 # idiotic netscape sends idiotic headers AGAIN
491 my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/ 479 my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/
… …
552 }; 540 };
553 541
554 my @code = (200, "ok"); 542 my @code = (200, "ok");
555 my ($l, $h); 543 my ($l, $h);
556 544
557 if ($self->{h}{range} =~ /^bytes=(.*)$/) { 545 if ($self->{h}{range} =~ /^bytes=(.*)$/i) {
558 for (split /,/, $1) { 546 for (split /,/, $1) {
559 if (/^-(\d+)$/) { 547 if (/^-(\d+)$/) {
560 ($l, $h) = ($length - $1, $length - 1); 548 ($l, $h) = ($length - $1, $length - 1);
561 } elsif (/^(\d+)-(\d*)$/) { 549 } elsif (/^(\d+)-(\d*)$/) {
562 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 550 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
… …
601 589
602 if ($self->{method} eq "GET") { 590 if ($self->{method} eq "GET") {
603 $self->{time} = $::NOW; 591 $self->{time} = $::NOW;
604 $self->{written} = 0; 592 $self->{written} = 0;
605 593
606 open my $fh, "<", $self->{path} 594 my $fh = Coro::AIO::aio_open $self->{path}, Fcntl::O_RDONLY, 0
607 or die "$self->{path}: late open failure ($!)"; 595 or die "$self->{path}: late open failure ($!)";
608 596
609 $h -= $l - 1; 597 $h -= $l - 1;
610 598
611 my $transfer = $queue->start_transfer ($h); 599 my $transfer = $queue->start_transfer ($h);
612 my $locked; 600 my $locked;
613 my $bufsize = $::WAIT_BUFSIZE; # initial buffer size 601 my $bufsize = $::WAIT_BUFSIZE; # initial buffer size
614 602
615 while ($h > 0) { 603 while ($h > 0) {
604 Coro::cede;
605 my $transfer_lock = $TRANSFER_LOCK->guard ($self->{remote_id});
606
616 unless ($locked) { 607 unless ($locked) {
617 if ($locked ||= $transfer->try ($::WAIT_INTERVAL)) { 608 if ($locked ||= $transfer->try ($::WAIT_INTERVAL)) {
618 $bufsize = $::BUFSIZE; 609 $bufsize = $::BUFSIZE;
619 $self->{time} = $::NOW; 610 $self->{time} = $::NOW;
620 $self->{written} = 0; 611 $self->{written} = 0;
… …
628 619
629 Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), my $buf, 0 620 Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), my $buf, 0
630 or last; 621 or last;
631 622
632 $tbf->request (length $buf); 623 $tbf->request (length $buf);
633 my $w = syswrite $self->{fh}, $buf 624 my $w = $self->{fh}->syswrite ($buf)
634 or last; 625 or last;
635 $::written += $w; 626 $::written += $w;
636 $self->{written} += $w; 627 $self->{written} += $w;
637 $l += $w; 628 $l += $w;
638 } 629 }

Diff Legend

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