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.65 by root, Fri Jan 25 09:26:13 2002 UTC vs.
Revision 1.79 by root, Fri Dec 1 03:53:33 2006 UTC

1use Coro; 1use Coro;
2use Coro::Semaphore; 2use Coro::Semaphore;
3use Coro::Event; 3use Coro::Event;
4use Coro::Socket; 4use Coro::Socket;
5use Coro::Signal; 5use Coro::Signal;
6use Coro::AIO ();
6 7
7use HTTP::Date; 8use HTTP::Date;
8use POSIX (); 9use POSIX ();
9 10
10use Compress::Zlib (); 11use Compress::Zlib ();
… …
54our $connections = new Coro::Semaphore $MAX_CONNECTS || 250; 55our $connections = new Coro::Semaphore $MAX_CONNECTS || 250;
55our $httpevent = new Coro::Signal; 56our $httpevent = new Coro::Signal;
56 57
57our $queue_file = new transferqueue $MAX_TRANSFERS; 58our $queue_file = new transferqueue $MAX_TRANSFERS;
58our $queue_index = new transferqueue 10; 59our $queue_index = new transferqueue 10;
60
61our $tbf_top = new tbf rate => $TBF_RATE || 100000;
62
63my $unused_bytes = 0;
64my $unused_last = time;
65
66sub unused_bandwidth {
67 $unused_bytes += $_[0];
68 if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
69 $unused_last = $NOW;
70 $unused_bytes = 0;
71 $queue_file->force_wake_next;
72 slog 1, "forced filetransfer due to unused bandwidth";
73 }
74}
59 75
60my @newcons; 76my @newcons;
61my @pool; 77my @pool;
62 78
63# one "execution thread" 79# one "execution thread"
… …
95 if (@pool) { 111 if (@pool) {
96 (pop @pool)->ready; 112 (pop @pool)->ready;
97 } else { 113 } else {
98 async \&handler; 114 async \&handler;
99 } 115 }
100
101 } 116 }
102 }; 117 };
103} 118}
104 119
105my $http_port = new Coro::Socket 120my $http_port = new Coro::Socket
… …
125package conn; 140package conn;
126 141
127use Socket; 142use Socket;
128use HTTP::Date; 143use HTTP::Date;
129use Convert::Scalar 'weaken'; 144use Convert::Scalar 'weaken';
130use Linux::AIO; 145use IO::AIO;
131 146
132Linux::AIO::min_parallel $::AIO_PARALLEL; 147IO::AIO::min_parallel $::AIO_PARALLEL;
133 148
134Event->io(fd => Linux::AIO::poll_fileno, 149Event->io (fd => IO::AIO::poll_fileno,
135 poll => 'r', async => 1, 150 poll => 'r', async => 1,
136 cb => \&Linux::AIO::poll_cb); 151 cb => \&IO::AIO::poll_cb);
137 152
138our %conn; # $conn{ip}{self} => connobj 153our %conn; # $conn{ip}{self} => connobj
139our %uri; # $uri{ip}{uri}{self} 154our %uri; # $uri{ip}{uri}{self}
140our %blocked; 155our %blocked;
141our %mimetype; 156our %mimetype;
… …
178 193
179sub DESTROY { 194sub DESTROY {
180 #my $self = shift; 195 #my $self = shift;
181 $::conns--; 196 $::conns--;
182} 197}
198
199sub prune_cache {
200 my $hash = $_[0];
201
202 for (keys %$hash) {
203 if (ref $hash->{$_} eq HASH::) {
204 prune_cache($hash->{$_});
205 unless (scalar keys %{$hash->{$_}}) {
206 delete $hash->{$_};
207 $d2++;
208 }
209 }
210 }
211}
212
213sub prune_caches {
214 prune_cache \%conn;
215 prune_cache \%uri;
216
217 for (keys %blocked) {
218 delete $blocked{$_} unless $blocked{$_}[0] > $::NOW;
219 }
220}
221
222Event->timer(interval => 60, cb => \&prune_caches);
183 223
184sub slog { 224sub slog {
185 my $self = shift; 225 my $self = shift;
186 main::slog($_[0], "$self->{remote_id}> $_[1]"); 226 main::slog($_[0], "$self->{remote_id}> $_[1]");
187} 227}
… …
217 $hdr->{"Content-Length"} = length $content; 257 $hdr->{"Content-Length"} = length $content;
218 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig); 258 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig);
219 } 259 }
220 260
221 $res .= "Date: $HTTP_NOW\015\012"; 261 $res .= "Date: $HTTP_NOW\015\012";
262 $res .= "Server: $::NAME\015\012";
222 263
223 while (my ($h, $v) = each %$hdr) { 264 while (my ($h, $v) = each %$hdr) {
224 $res .= "$h: $v\015\012" 265 $res .= "$h: $v\015\012"
225 } 266 }
226 $res .= "\015\012"; 267 $res .= "\015\012";
… …
232 " \"$self->{h}{referer}\"\n"; 273 " \"$self->{h}{referer}\"\n";
233 274
234 print $::accesslog $log if $::accesslog; 275 print $::accesslog $log if $::accesslog;
235 print STDERR $log; 276 print STDERR $log;
236 277
237 $self->{written} += 278 $tbf_top->request(length $res, 1e6);
238 print {$self->{fh}} $res; 279 $self->{written} += print {$self->{fh}} $res;
239} 280}
240 281
241sub err { 282sub err {
242 my $self = shift; 283 my $self = shift;
243 my ($code, $msg, $hdr, $content) = @_; 284 my ($code, $msg, $hdr, $content) = @_;
… …
298 my (%hdr, $h, $v); 339 my (%hdr, $h, $v);
299 340
300 $hdr{lc $1} .= ",$2" 341 $hdr{lc $1} .= ",$2"
301 while $req =~ /\G 342 while $req =~ /\G
302 ([^:\000-\040]+): 343 ([^:\000-\040]+):
303 [\010\040]* 344 [\011\040]*
304 ((?: [^\015\012]+ | \015\012[\010\040] )*) 345 ((?: [^\015\012]+ | \015\012[\011\040] )*)
305 \015\012 346 \015\012
306 /gxc; 347 /gxc;
307 348
308 $req =~ /\G\015\012$/ 349 $req =~ /\G\015\012$/
309 or $self->err(400, "bad request"); 350 or $self->err(400, "bad request");
… …
457 or $self->err(304, "not modified"); 498 or $self->err(304, "not modified");
458 499
459 if (-r "$path/index.html") { 500 if (-r "$path/index.html") {
460 # replace directory "size" by index.html filesize 501 # replace directory "size" by index.html filesize
461 $self->{stat} = [stat ($self->{path} .= "/index.html")]; 502 $self->{stat} = [stat ($self->{path} .= "/index.html")];
462 $self->handle_file($queue_index); 503 $self->handle_file($queue_index, $tbf_top);
463 } else { 504 } else {
464 $self->handle_dir; 505 $self->handle_dir;
465 } 506 }
466 } 507 }
467 } elsif (-f _ && -r _) { 508 } elsif (-f _ && -r _) {
… …
476 $httpevent->wait; 517 $httpevent->wait;
477 } 518 }
478 } 519 }
479 } 520 }
480 521
481 $self->handle_file($queue_file); 522 $self->handle_file($queue_file, $tbf_top);
482 } else { 523 } else {
483 $self->err(404, "not found"); 524 $self->err(404, "not found");
484 } 525 }
485 } 526 }
486} 527}
… …
489 my $self = shift; 530 my $self = shift;
490 my $idx = $self->diridx; 531 my $idx = $self->diridx;
491 532
492 $self->response(200, "ok", 533 $self->response(200, "ok",
493 { 534 {
494 "Content-Type" => "text/html", 535 "Content-Type" => "text/html; charset=utf-8",
495 "Content-Length" => length $idx, 536 "Content-Length" => length $idx,
496 "Last-Modified" => time2str ($self->{stat}[9]), 537 "Last-Modified" => time2str ($self->{stat}[9]),
497 }, 538 },
498 $idx); 539 $idx);
499} 540}
500 541
501sub handle_file { 542sub handle_file {
502 my ($self, $queue) = @_; 543 my ($self, $queue, $tbf) = @_;
503 my $length = $self->{stat}[7]; 544 my $length = $self->{stat}[7];
504 my $hdr = { 545 my $hdr = {
505 "Last-Modified" => time2str ((stat _)[9]), 546 "Last-Modified" => time2str ((stat _)[9]),
547 "Accept-Ranges" => "bytes",
506 }; 548 };
507 549
508 my @code = (200, "ok"); 550 my @code = (200, "ok");
509 my ($l, $h); 551 my ($l, $h);
510 552
… …
553 595
554 $self->response(@code, $hdr, ""); 596 $self->response(@code, $hdr, "");
555 597
556 if ($self->{method} eq "GET") { 598 if ($self->{method} eq "GET") {
557 $self->{time} = $::NOW; 599 $self->{time} = $::NOW;
600 $self->{written} = 0;
558 601
559 my $current = $Coro::current; 602 my $current = $Coro::current;
560 603
561 my ($fh, $buf, $r); 604 my ($fh, $buf, $r);
562 605
… …
578 while ($h > 0) { 621 while ($h > 0) {
579 unless ($locked) { 622 unless ($locked) {
580 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) { 623 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) {
581 $bufsize = $::BUFSIZE; 624 $bufsize = $::BUFSIZE;
582 $self->{time} = $::NOW; 625 $self->{time} = $::NOW;
626 $self->{written} = 0;
583 } 627 }
584 } 628 }
585 629
586 if ($blocked{$self->{remote_id}}) { 630 if ($blocked{$self->{remote_id}}) {
587 $self->{h}{connection} = "close"; 631 $self->{h}{connection} = "close";
588 die bless {}, err::; 632 die bless {}, err::;
589 } 633 }
590 634
591 if (0) { # !AIO 635 Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), $buf, 0
592 sysread $fh, $buf, $h > $bufsize ? $bufsize : $h
593 or last; 636 or last;
594 } else { 637
595 aio_read($fh, $l, ($h > $bufsize ? $bufsize : $h), 638 $tbf->request (length $buf);
596 $buf, 0, sub {
597 $r = $_[0];
598 Coro::ready($current);
599 });
600 &Coro::schedule;
601 last unless $r;
602 }
603 my $w = syswrite $self->{fh}, $buf 639 my $w = syswrite $self->{fh}, $buf
604 or last; 640 or last;
605 $::written += $w; 641 $::written += $w;
606 $self->{written} += $w; 642 $self->{written} += $w;
607 $l += $r; 643 $l += $r;
… …
609 645
610 close $fh; 646 close $fh;
611 } 647 }
612} 648}
613 649
6141; 6501
651

Diff Legend

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