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

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.64 by root, Wed Jan 23 04:49:50 2002 UTC vs.
Revision 1.71 by root, Mon Jul 29 21:41:54 2002 UTC

… …
54our $connections = new Coro::Semaphore $MAX_CONNECTS || 250; 54our $connections = new Coro::Semaphore $MAX_CONNECTS || 250;
55our $httpevent = new Coro::Signal; 55our $httpevent = new Coro::Signal;
56 56
57our $queue_file = new transferqueue $MAX_TRANSFERS; 57our $queue_file = new transferqueue $MAX_TRANSFERS;
58our $queue_index = new transferqueue 10; 58our $queue_index = new transferqueue 10;
59
60our $tbf_top = new tbf rate => 100000;
61
62my $unused_bytes = 0;
63my $unused_last = time;
64
65sub unused_bandwidth {
66 $unused_bytes += $_[0];
67 if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
68 $unused_last = $NOW;
69 $unused_bytes = 0;
70 $queue_file->force_wake_next;
71 slog 1, "forced filetransfer due to unused bandwidth";
72 }
73}
59 74
60my @newcons; 75my @newcons;
61my @pool; 76my @pool;
62 77
63# one "execution thread" 78# one "execution thread"
… …
217 $hdr->{"Content-Length"} = length $content; 232 $hdr->{"Content-Length"} = length $content;
218 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig); 233 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig);
219 } 234 }
220 235
221 $res .= "Date: $HTTP_NOW\015\012"; 236 $res .= "Date: $HTTP_NOW\015\012";
237 $res .= "Server: $::NAME\015\012";
222 238
223 while (my ($h, $v) = each %$hdr) { 239 while (my ($h, $v) = each %$hdr) {
224 $res .= "$h: $v\015\012" 240 $res .= "$h: $v\015\012"
225 } 241 }
226 $res .= "\015\012"; 242 $res .= "\015\012";
227 243
228 $res .= $content if defined $content and $self->{method} ne "HEAD"; 244 $res .= $content if defined $content and $self->{method} ne "HEAD";
229 245
230 my $log = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $NOW). 246 my $log = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW).
231 " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.$GZ. 247 " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.$GZ.
232 " \"$self->{h}{referer}\"\n"; 248 " \"$self->{h}{referer}\"\n";
233 249
234 print $accesslog $log if $accesslog; 250 print $::accesslog $log if $::accesslog;
235 print STDERR $log; 251 print STDERR $log;
236 252
237 $self->{written} += 253 $tbf_top->request(length $res, 1e6);
238 print {$self->{fh}} $res; 254 $self->{written} += print {$self->{fh}} $res;
239} 255}
240 256
241sub err { 257sub err {
242 my $self = shift; 258 my $self = shift;
243 my ($code, $msg, $hdr, $content) = @_; 259 my ($code, $msg, $hdr, $content) = @_;
… …
298 my (%hdr, $h, $v); 314 my (%hdr, $h, $v);
299 315
300 $hdr{lc $1} .= ",$2" 316 $hdr{lc $1} .= ",$2"
301 while $req =~ /\G 317 while $req =~ /\G
302 ([^:\000-\040]+): 318 ([^:\000-\040]+):
303 [\010\040]* 319 [\011\040]*
304 ((?: [^\015\012]+ | \015\012[\010\040] )*) 320 ((?: [^\015\012]+ | \015\012[\011\040] )*)
305 \015\012 321 \015\012
306 /gxc; 322 /gxc;
307 323
308 $req =~ /\G\015\012$/ 324 $req =~ /\G\015\012$/
309 or $self->err(400, "bad request"); 325 or $self->err(400, "bad request");
… …
457 or $self->err(304, "not modified"); 473 or $self->err(304, "not modified");
458 474
459 if (-r "$path/index.html") { 475 if (-r "$path/index.html") {
460 # replace directory "size" by index.html filesize 476 # replace directory "size" by index.html filesize
461 $self->{stat} = [stat ($self->{path} .= "/index.html")]; 477 $self->{stat} = [stat ($self->{path} .= "/index.html")];
462 $self->handle_file($queue_index); 478 $self->handle_file($queue_index, $tbf_top);
463 } else { 479 } else {
464 $self->handle_dir; 480 $self->handle_dir;
465 } 481 }
466 } 482 }
467 } elsif (-f _ && -r _) { 483 } elsif (-f _ && -r _) {
… …
476 $httpevent->wait; 492 $httpevent->wait;
477 } 493 }
478 } 494 }
479 } 495 }
480 496
481 $self->handle_file($queue_file); 497 $self->handle_file($queue_file, $tbf_top);
482 } else { 498 } else {
483 $self->err(404, "not found"); 499 $self->err(404, "not found");
484 } 500 }
485 } 501 }
486} 502}
… …
497 }, 513 },
498 $idx); 514 $idx);
499} 515}
500 516
501sub handle_file { 517sub handle_file {
502 my ($self, $queue) = @_; 518 my ($self, $queue, $tbf) = @_;
503 my $length = $self->{stat}[7]; 519 my $length = $self->{stat}[7];
504 my $hdr = { 520 my $hdr = {
505 "Last-Modified" => time2str ((stat _)[9]), 521 "Last-Modified" => time2str ((stat _)[9]),
506 }; 522 };
507 523
… …
553 569
554 $self->response(@code, $hdr, ""); 570 $self->response(@code, $hdr, "");
555 571
556 if ($self->{method} eq "GET") { 572 if ($self->{method} eq "GET") {
557 $self->{time} = $::NOW; 573 $self->{time} = $::NOW;
574 $self->{written} = 0;
558 575
559 my $current = $Coro::current; 576 my $current = $Coro::current;
560 577
561 my ($fh, $buf, $r); 578 my ($fh, $buf, $r);
562 579
… …
578 while ($h > 0) { 595 while ($h > 0) {
579 unless ($locked) { 596 unless ($locked) {
580 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) { 597 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) {
581 $bufsize = $::BUFSIZE; 598 $bufsize = $::BUFSIZE;
582 $self->{time} = $::NOW; 599 $self->{time} = $::NOW;
600 $self->{written} = 0;
583 } 601 }
584 } 602 }
585 603
586 if ($blocked{$self->{remote_id}}) { 604 if ($blocked{$self->{remote_id}}) {
587 $self->{h}{connection} = "close"; 605 $self->{h}{connection} = "close";
… …
598 Coro::ready($current); 616 Coro::ready($current);
599 }); 617 });
600 &Coro::schedule; 618 &Coro::schedule;
601 last unless $r; 619 last unless $r;
602 } 620 }
621
622 $tbf->request(length $buf);
603 my $w = syswrite $self->{fh}, $buf 623 my $w = syswrite $self->{fh}, $buf
604 or last; 624 or last;
605 $::written += $w; 625 $::written += $w;
606 $self->{written} += $w; 626 $self->{written} += $w;
607 $l += $r; 627 $l += $r;

Diff Legend

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