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.63 by root, Wed Jan 23 03:07:05 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"
… …
205 } 220 }
206 } 221 }
207 222
208 if ($self->{method} ne "HEAD" 223 if ($self->{method} ne "HEAD"
209 && $self->{h}{"accept-encoding"} =~ /\bgzip\b/ 224 && $self->{h}{"accept-encoding"} =~ /\bgzip\b/
225 && 400 < length $content
210 && $hdr->{"Content-Length"} == length $content 226 && $hdr->{"Content-Length"} == length $content
211 && !exists $hdr->{"Content-Encoding"} 227 && !exists $hdr->{"Content-Encoding"}
212 ) { 228 ) {
213 my $orig = length $content; 229 my $orig = length $content;
214 $hdr->{"Content-Encoding"} = "gzip"; 230 $hdr->{"Content-Encoding"} = "gzip";
… …
216 $hdr->{"Content-Length"} = length $content; 232 $hdr->{"Content-Length"} = length $content;
217 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig); 233 $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig);
218 } 234 }
219 235
220 $res .= "Date: $HTTP_NOW\015\012"; 236 $res .= "Date: $HTTP_NOW\015\012";
237 $res .= "Server: $::NAME\015\012";
221 238
222 while (my ($h, $v) = each %$hdr) { 239 while (my ($h, $v) = each %$hdr) {
223 $res .= "$h: $v\015\012" 240 $res .= "$h: $v\015\012"
224 } 241 }
225 $res .= "\015\012"; 242 $res .= "\015\012";
226 243
227 $res .= $content if defined $content and $self->{method} ne "HEAD"; 244 $res .= $content if defined $content and $self->{method} ne "HEAD";
228 245
229 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).
230 " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.$GZ. 247 " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.$GZ.
231 " \"$self->{h}{referer}\"\n"; 248 " \"$self->{h}{referer}\"\n";
232 249
233 print $accesslog $log if $accesslog; 250 print $::accesslog $log if $::accesslog;
234 print STDERR $log; 251 print STDERR $log;
235 252
236 $self->{written} += 253 $tbf_top->request(length $res, 1e6);
237 print {$self->{fh}} $res; 254 $self->{written} += print {$self->{fh}} $res;
238} 255}
239 256
240sub err { 257sub err {
241 my $self = shift; 258 my $self = shift;
242 my ($code, $msg, $hdr, $content) = @_; 259 my ($code, $msg, $hdr, $content) = @_;
… …
297 my (%hdr, $h, $v); 314 my (%hdr, $h, $v);
298 315
299 $hdr{lc $1} .= ",$2" 316 $hdr{lc $1} .= ",$2"
300 while $req =~ /\G 317 while $req =~ /\G
301 ([^:\000-\040]+): 318 ([^:\000-\040]+):
302 [\010\040]* 319 [\011\040]*
303 ((?: [^\015\012]+ | \015\012[\010\040] )*) 320 ((?: [^\015\012]+ | \015\012[\011\040] )*)
304 \015\012 321 \015\012
305 /gxc; 322 /gxc;
306 323
307 $req =~ /\G\015\012$/ 324 $req =~ /\G\015\012$/
308 or $self->err(400, "bad request"); 325 or $self->err(400, "bad request");
… …
456 or $self->err(304, "not modified"); 473 or $self->err(304, "not modified");
457 474
458 if (-r "$path/index.html") { 475 if (-r "$path/index.html") {
459 # replace directory "size" by index.html filesize 476 # replace directory "size" by index.html filesize
460 $self->{stat} = [stat ($self->{path} .= "/index.html")]; 477 $self->{stat} = [stat ($self->{path} .= "/index.html")];
461 $self->handle_file($queue_index); 478 $self->handle_file($queue_index, $tbf_top);
462 } else { 479 } else {
463 $self->handle_dir; 480 $self->handle_dir;
464 } 481 }
465 } 482 }
466 } elsif (-f _ && -r _) { 483 } elsif (-f _ && -r _) {
… …
475 $httpevent->wait; 492 $httpevent->wait;
476 } 493 }
477 } 494 }
478 } 495 }
479 496
480 $self->handle_file($queue_file); 497 $self->handle_file($queue_file, $tbf_top);
481 } else { 498 } else {
482 $self->err(404, "not found"); 499 $self->err(404, "not found");
483 } 500 }
484 } 501 }
485} 502}
… …
496 }, 513 },
497 $idx); 514 $idx);
498} 515}
499 516
500sub handle_file { 517sub handle_file {
501 my ($self, $queue) = @_; 518 my ($self, $queue, $tbf) = @_;
502 my $length = $self->{stat}[7]; 519 my $length = $self->{stat}[7];
503 my $hdr = { 520 my $hdr = {
504 "Last-Modified" => time2str ((stat _)[9]), 521 "Last-Modified" => time2str ((stat _)[9]),
505 }; 522 };
506 523
… …
552 569
553 $self->response(@code, $hdr, ""); 570 $self->response(@code, $hdr, "");
554 571
555 if ($self->{method} eq "GET") { 572 if ($self->{method} eq "GET") {
556 $self->{time} = $::NOW; 573 $self->{time} = $::NOW;
574 $self->{written} = 0;
557 575
558 my $current = $Coro::current; 576 my $current = $Coro::current;
559 577
560 my ($fh, $buf, $r); 578 my ($fh, $buf, $r);
561 579
… …
577 while ($h > 0) { 595 while ($h > 0) {
578 unless ($locked) { 596 unless ($locked) {
579 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) { 597 if ($locked ||= $transfer->try($::WAIT_INTERVAL)) {
580 $bufsize = $::BUFSIZE; 598 $bufsize = $::BUFSIZE;
581 $self->{time} = $::NOW; 599 $self->{time} = $::NOW;
600 $self->{written} = 0;
582 } 601 }
583 } 602 }
584 603
585 if ($blocked{$self->{remote_id}}) { 604 if ($blocked{$self->{remote_id}}) {
586 $self->{h}{connection} = "close"; 605 $self->{h}{connection} = "close";
… …
597 Coro::ready($current); 616 Coro::ready($current);
598 }); 617 });
599 &Coro::schedule; 618 &Coro::schedule;
600 last unless $r; 619 last unless $r;
601 } 620 }
621
622 $tbf->request(length $buf);
602 my $w = syswrite $self->{fh}, $buf 623 my $w = syswrite $self->{fh}, $buf
603 or last; 624 or last;
604 $::written += $w; 625 $::written += $w;
605 $self->{written} += $w; 626 $self->{written} += $w;
606 $l += $r; 627 $l += $r;

Diff Legend

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