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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.79 by root, Fri Dec 1 03:53:33 2006 UTC vs.
Revision 1.83 by root, Sun Dec 3 17:49:22 2006 UTC

 our $accesslog;
 our $errorlog;
 our $NOW;
 our $HTTP_NOW;
+our $ERROR_LOG;
+our $ACCESS_LOG;
 Event->timer(interval => 1, hard => 1, cb => sub {
    $NOW = time;
    $HTTP_NOW = time2str $NOW;
 })->now;
 # one "execution thread"
 sub handler {
    while () {
       if (@newcons) {
          eval {
-            conn->new(@{pop @newcons})->handle;
+            conn->new (@{pop @newcons})->handle;
          };
          slog 1, "$@" if $@ && !ref $@;
          $httpevent->broadcast; # only for testing, but doesn't matter much
 my $http_port = new Coro::Socket
         LocalAddr => $SERVER_HOST,
         LocalPort => $SERVER_PORT,
         ReuseAddr => 1,
-        Listen => 50,
+        Listen    => 50,
    or die "unable to start server";
 listen_on $http_port;
 if ($SERVER_PORT2) {
    my $http_port = new Coro::Socket
            LocalAddr => $SERVER_HOST,
            LocalPort => $SERVER_PORT2,
            ReuseAddr => 1,
-           Listen => 50,
+           Listen    => 50,
       or die "unable to start server";
    listen_on $http_port;
 }
 package conn;
+use strict;
+use bytes;
 use Socket;
 use HTTP::Date;
 use Convert::Scalar 'weaken';
 use IO::AIO;
 our %uri;  # $uri{ip}{uri}{self}
 our %blocked;
 our %mimetype;
 sub read_mimetypes {
-   local *M;
-   if (open M, "<mime_types") {
+   if (open my $fh, "<mime_types") {
-      while (<M>) {
+      while (<$fh>) {
          if (/^([^#]\S+)\t+(\S+)$/) {
             $mimetype{lc $1} = $2;
          }
       }
    } else {
    my $class = shift;
    my $fh = shift;
    my $peername = shift;
    my $self = bless { fh => $fh }, $class;
    my (undef, $iaddr) = unpack_sockaddr_in $peername
-      or $self->err(500, "unable to decode 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++;
+   ++$::conns;
    $::maxconns = $::conns if $::conns > $::maxconns;
-   $self;
+   $self
 }
 sub DESTROY {
-   #my $self = shift;
+   my $self = shift;
-   $::conns--;
+   --$::conns;
 }
 sub prune_cache {
    my $hash = $_[0];
    for (keys %$hash) {
       if (ref $hash->{$_} eq HASH::) {
          prune_cache($hash->{$_});
          unless (scalar keys %{$hash->{$_}}) {
             delete $hash->{$_};
-            $d2++;
          }
       }
    }
 }
    for (keys %blocked) {
       delete $blocked{$_} unless $blocked{$_}[0] > $::NOW;
    }
 }
-Event->timer(interval => 60, cb => \&prune_caches);
+Event->timer (interval => 60, cb => \&prune_caches);
 sub slog {
    my $self = shift;
    main::slog($_[0], "$self->{remote_id}> $_[1]");
 }
       $hdr->{"Content-Type"} = "text/plain";
       $hdr->{"Content-Length"} = length $content;
    }
    $hdr->{"Connection"} = "close";
-   $self->response($code, $msg, $hdr, $content);
+   $self->response ($code, $msg, $hdr, $content);
-   die bless {}, err::;
+   die bless {}, err::
 }
 sub handle {
    my $self = shift;
    my $fh = $self->{fh};
    my $host;
    $fh->timeout($::REQ_TIMEOUT);
-   while() {
+   while () {
       $self->{reqs}++;
       # read request and parse first line
       my $req = $fh->readline("\015\012\015\012");
    if ($self->{name} =~ s%^/internal/([^/]+)%%) {
       if ($::internal{$1}) {
          $::internal{$1}->($self);
       } else {
-         $self->err(404, "not found");
+         $self->err (404, "not found");
       }
    } else {
       stat $path
-         or $self->err(404, "not found");
+         or $self->err (404, "not found");
       $self->{stat} = [stat _];
       # idiotic netscape sends idiotic headers AGAIN
       my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/
       if (-d _ && -r _) {
          # directory
          if ($path !~ /\/$/) {
             # create a redirect to get the trailing "/"
             # we don't try to avoid the :80
-            $self->err(301, "moved permanently", { Location =>  "http://".$self->server_hostport."$self->{uri}/" });
+            $self->err (301, "moved permanently", { Location =>  "http://".$self->server_hostport."$self->{uri}/" });
          } else {
             $ims < $self->{stat}[9]
-               or $self->err(304, "not modified");
+               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, $tbf_top);
+               $self->handle_file ($queue_index, $tbf_top);
             } else {
                $self->handle_dir;
             }
          }
       } elsif (-f _ && -r _) {
-         -x _ and $self->err(403, "forbidden");
+         -x _ and $self->err (403, "forbidden");
          if (keys %{$conn{$self->{remote_id}}} > $::MAX_TRANSFERS_IP) {
             my $timeout = $::NOW + 10;
             while (keys %{$conn{$self->{remote_id}}} > $::MAX_TRANSFERS_IP) {
                if ($timeout < $::NOW) {
                   $httpevent->wait;
                }
             }
          }
-         $self->handle_file($queue_file, $tbf_top);
+         $self->handle_file ($queue_file, $tbf_top);
       } else {
-         $self->err(404, "not found");
+         $self->err (404, "not found");
       }
    }
 }
 sub handle_dir {
    my $self = shift;
    my $idx = $self->diridx;
-   $self->response(200, "ok",
+   $self->response (200, "ok",
          {
             "Content-Type"   => "text/html; charset=utf-8",
             "Content-Length" => length $idx,
             "Last-Modified"  => time2str ($self->{stat}[9]),
          },
          }
          goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
       }
       $hdr->{"Content-Range"} = "bytes */$length";
       $hdr->{"Content-Length"} = $length;
-      $self->err(416, "not satisfiable", $hdr, "");
+      $self->err (416, "not satisfiable", $hdr, "");
 satisfiable:
       # check for segmented downloads
       if ($l && $::NO_SEGMENTED) {
          my $timeout = $::NOW + 15;
          while (keys %{$uri{$self->{remote_id}}{$self->{uri}}} > 1) {
             if ($timeout <= $::NOW) {
-               $self->block($::BLOCKTIME, "segmented downloads are forbidden");
+               $self->block ($::BLOCKTIME, "segmented downloads are forbidden");
                #$self->err_segmented_download;
             } else {
                $httpevent->wait;
             }
          }
    $self->{path} =~ /\.([^.]+)$/;
    $hdr->{"Content-Type"} = $mimetype{lc $1} || "application/octet-stream";
    $hdr->{"Content-Length"} = $length;
-   $self->response(@code, $hdr, "");
+   $self->response (@code, $hdr, "");
    if ($self->{method} eq "GET") {
       $self->{time} = $::NOW;
       $self->{written} = 0;
-      my $current = $Coro::current;
-      my ($fh, $buf, $r);
-      open $fh, "<", $self->{path}
+      open my $fh, "<", $self->{path}
          or die "$self->{path}: late open failure ($!)";
       $h -= $l - 1;
-      if (0) { # !AIO
-         if ($l) {
-            sysseek $fh, $l, 0;
-         }
-      }
-      my $transfer = $queue->start_transfer($h);
+      my $transfer = $queue->start_transfer ($h);
       my $locked;
       my $bufsize = $::WAIT_BUFSIZE; # initial buffer size
       while ($h > 0) {
          unless ($locked) {
-            if ($locked ||= $transfer->try($::WAIT_INTERVAL)) {
+            if ($locked ||= $transfer->try ($::WAIT_INTERVAL)) {
                $bufsize = $::BUFSIZE;
                $self->{time} = $::NOW;
                $self->{written} = 0;
             }
          }
          if ($blocked{$self->{remote_id}}) {
             $self->{h}{connection} = "close";
             die bless {}, err::;
          }
-         Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), $buf, 0
+         Coro::AIO::aio_read $fh, $l, ($h > $bufsize ? $bufsize : $h), my $buf, 0
             or last;
          $tbf->request (length $buf);
          my $w = syswrite $self->{fh}, $buf
             or last;
          $::written += $w;
          $self->{written} += $w;
-         $l += $r;
+         $l += $w;
       }
       close $fh;
    }
 }

Diff Legend

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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents): Revision 1.79 by root, Fri Dec 1 03:53:33 2006 UTC vs. Revision 1.83 by root, Sun Dec 3 17:49:22 2006 UTC

Diff Legend

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.79 by root, Fri Dec 1 03:53:33 2006 UTC vs.
Revision 1.83 by root, Sun Dec 3 17:49:22 2006 UTC