[ViewVC] Diff of: cvs/Coro/myhttpd/httpd.pl

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.59 by root, Wed Dec 5 02:02:23 2001 UTC vs.
Revision 1.71 by root, Mon Jul 29 21:41:54 2002 UTC

 use Coro::Socket;
 use Coro::Signal;
 use HTTP::Date;
 use POSIX ();
+use Compress::Zlib ();
 no utf8;
 use bytes;
 # at least on my machine, this thingy serves files
 our $connections = new Coro::Semaphore $MAX_CONNECTS || 250;
 our $httpevent   = new Coro::Signal;
 our $queue_file  = new transferqueue $MAX_TRANSFERS;
 our $queue_index = new transferqueue 10;
+our $tbf_top     = new tbf rate => 100000;
+my $unused_bytes = 0;
+my $unused_last  = time;
+sub unused_bandwidth {
+   $unused_bytes += $_[0];
+   if ($unused_last < $NOW - 30 && $unused_bytes / ($NOW - $unused_last) > 50000) {
+      $unused_last = $NOW;
+      $unused_bytes = 0;
+      $queue_file->force_wake_next;
+      slog 1, "forced filetransfer due to unused bandwidth";
+   }
+}
 my @newcons;
 my @pool;
 # one "execution thread"
    my (undef, $iaddr) = unpack_sockaddr_in $peername
       or $self->err(500, "unable to decode peername");
    $self->{remote_addr} =
       $self->{remote_id} = inet_ntoa $iaddr;
    $self->{time} = $::NOW;
    weaken ($Coro::current->{conn} = $self);
    $::conns++;
 }
 sub response {
    my ($self, $code, $msg, $hdr, $content) = @_;
    my $res = "HTTP/1.1 $code $msg\015\012";
+   my $GZ = "";
    if (exists $hdr->{Connection}) {
       if ($hdr->{Connection} =~ /close/) {
          $self->{h}{connection} = "close"
       }
             $self->{h}{connection} = "close"
          }
       }
    }
+   if ($self->{method} ne "HEAD"
+       && $self->{h}{"accept-encoding"} =~ /\bgzip\b/
+       && 400 < length $content
+       && $hdr->{"Content-Length"} == length $content
+       && !exists $hdr->{"Content-Encoding"}
+   ) {
+      my $orig = length $content;
+      $hdr->{"Content-Encoding"} = "gzip";
+      $content = Compress::Zlib::memGzip(\$content);
+      $hdr->{"Content-Length"} = length $content;
+      $GZ = sprintf "GZ%02d", 100 - 100*((length $content) / $orig);
+   }
    $res .= "Date: $HTTP_NOW\015\012";
+   $res .= "Server: $::NAME\015\012";
    while (my ($h, $v) = each %$hdr) {
       $res .= "$h: $v\015\012"
    }
    $res .= "\015\012";
    $res .= $content if defined $content and $self->{method} ne "HEAD";
-   my $log = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $NOW).
+   my $log = (POSIX::strftime "%Y-%m-%d %H:%M:%S", gmtime $::NOW).
-             " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.
+             " $self->{remote_id} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}.$GZ.
              " \"$self->{h}{referer}\"\n";
-   print $accesslog $log if $accesslog;
+   print $::accesslog $log if $::accesslog;
    print STDERR $log;
-   $self->{written} +=
+   $tbf_top->request(length $res, 1e6);
-      print {$self->{fh}} $res;
+   $self->{written} += print {$self->{fh}} $res;
 }
 sub err {
    my $self = shift;
    my ($code, $msg, $hdr, $content) = @_;
          my (%hdr, $h, $v);
          $hdr{lc $1} .= ",$2"
             while $req =~ /\G
                   ([^:\000-\040]+):
-                  [\008\040]*
+                  [\011\040]*
-                  ((?: [^\015\012]+ | \015\012[\008\040] )*)
+                  ((?: [^\015\012]+ | \015\012[\011\040] )*)
                   \015\012
                /gxc;
          $req =~ /\G\015\012$/
             or $self->err(400, "bad request");
                or $self->err(304, "not modified");
             if (-r "$path/index.html") {
                # replace directory "size" by index.html filesize
                $self->{stat} = [stat ($self->{path} .= "/index.html")];
-               $self->handle_file($queue_index);
+               $self->handle_file($queue_index, $tbf_top);
             } else {
                $self->handle_dir;
             }
          }
       } elsif (-f _ && -r _) {
                   $httpevent->wait;
                }
             }
          }
-         $self->handle_file($queue_file);
+         $self->handle_file($queue_file, $tbf_top);
       } else {
          $self->err(404, "not found");
       }
    }
 }
          },
          $idx);
 }
 sub handle_file {
-   my ($self, $queue) = @_;
+   my ($self, $queue, $tbf) = @_;
    my $length = $self->{stat}[7];
    my $hdr = {
       "Last-Modified"  => time2str ((stat _)[9]),
    };
    $self->response(@code, $hdr, "");
    if ($self->{method} eq "GET") {
       $self->{time} = $::NOW;
+      $self->{written} = 0;
       my $current = $Coro::current;
       my ($fh, $buf, $r);
       while ($h > 0) {
          unless ($locked) {
             if ($locked ||= $transfer->try($::WAIT_INTERVAL)) {
                $bufsize = $::BUFSIZE;
                $self->{time} = $::NOW;
+               $self->{written} = 0;
             }
          }
          if ($blocked{$self->{remote_id}}) {
             $self->{h}{connection} = "close";
                         Coro::ready($current);
                      });
             &Coro::schedule;
             last unless $r;
          }
+         $tbf->request(length $buf);
          my $w = syswrite $self->{fh}, $buf
             or last;
          $::written += $w;
          $self->{written} += $w;
          $l += $r;

Diff Legend

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

Comparing Coro/myhttpd/httpd.pl (file contents): Revision 1.59 by root, Wed Dec 5 02:02:23 2001 UTC vs. Revision 1.71 by root, Mon Jul 29 21:41:54 2002 UTC

Diff Legend

Comparing Coro/myhttpd/httpd.pl (file contents):
Revision 1.59 by root, Wed Dec 5 02:02:23 2001 UTC vs.
Revision 1.71 by root, Mon Jul 29 21:41:54 2002 UTC