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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.26 by root, Sun Aug 19 22:59:35 2001 UTC vs.
Revision 1.30 by root, Sun Aug 26 14:55:46 2001 UTC

 # at least on my machine, this thingy serves files
 # quite a bit faster than apache, ;)
 # and quite a bit slower than thttpd :(
 $SIG{PIPE} = 'IGNORE';
+our $accesslog;
+if ($ACCESS_LOG) {
+   use IO::Handle;
+   open $accesslog, ">>$ACCESS_LOG"
+     or die "$ACCESS_LOG: $!";
+   $accesslog->autoflush(1);
+}
 sub slog {
    my $level = shift;
    my $format = shift;
    printf "---: $format\n", @_;
 }
 use Convert::Scalar 'weaken';
 use Linux::AIO;
 Linux::AIO::min_parallel $::AIO_PARALLEL;
+my $aio_requests = new Coro::Semaphore $::AIO_PARALLEL * 4;
 Event->io(fd => Linux::AIO::poll_fileno,
           poll => 'r', async => 1,
           cb => \&Linux::AIO::poll_cb);
 our %conn; # $conn{ip}{self} => connobj
    delete $uri{$self->{remote_addr}}{$self->{uri}}{$self*1};
 }
 sub slog {
    my $self = shift;
-   main::slog($_[0], "$self->{remote_addr}> $_[1]");
+   main::slog($_[0], ($self->{remote_id} || $self->{remote_addr}) ."> $_[1]");
 }
 sub response {
    my ($self, $code, $msg, $hdr, $content) = @_;
    my $res = "HTTP/1.1 $code $msg\015\012";
-   #$res .= "Connection: close\015\012";
+   $self->{h}{connection} ||= $hdr->{Connection};
    $res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
    while (my ($h, $v) = each %$hdr) {
       $res .= "$h: $v\015\012"
    }
    $res .= "\015\012";
    $res .= $content if defined $content and $self->{method} ne "HEAD";
-   print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";
+   my $log = "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";
+   print $accesslog $log if $accesslog;
+   print STDERR $log;
    $self->{written} +=
       print {$self->{fh}} $res;
 }
    $self->response($code, $msg, $hdr, $content);
    die bless {}, err::;
 }
-sub err_blocked {
-   my $self = shift;
-   my $ip = $self->{remote_addr};
-   my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
-   Coro::Event::do_timer(after => 20*rand);
-   $self->err(401, "too many connections",
-              {
-                 "Content-Type" => "text/html",
-                 "Retry-After" => $::BLOCKTIME,
-                 "Warning" => "Please do NOT retry, you have been blocked",
-                 "WWW-Authenticate" => "Basic realm=\"Please do NOT retry, you have been blocked\"",
-              },
-              <<EOF);
-<html><p>
-You have been blocked because you opened too many connections. You
-may retry at</p>
-   <p><blockquote>$time.</blockquote></p>
-<p>Until then, each new access will renew the block. You might want to have a
-look at the <a href="http://www.goof.com/pcg/marc/animefaq.html">FAQ</a>.</p>
-</html>
-EOF
-}
 sub handle {
    my $self = shift;
    my $fh = $self->{fh};
+   my $host;
    $fh->timeout($::REQ_TIMEOUT);
    while() {
       $self->{reqs}++;
          $self->{h}{$h} = substr $v, 1
             while ($h, $v) = each %hdr;
       }
+      # find out server name and port
+      if ($self->{uri} =~ s/^http:\/\/([^\/?#]*)//i) {
+         $host = $1;
+      } else {
+         $host = $self->{h}{host};
+      }
+      if (defined $host) {
-      $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80;
+         $self->{server_port} = $host =~ s/:([0-9]+)$// ? $1 : 80;
+      } else {
+         ($self->{server_port}, $host)
+            = unpack_sockaddr_in $self->{fh}->getsockname
+               or $self->err(500, "unable to get socket name");
+         $host = inet_ntoa $host;
+      }
+      $self->{server_name} = $host;
+      # remote id should be unique per user
+      $self->{remote_id} = $self->{remote_addr};
+      if (exists $self->{h}{"client-ip"}) {
+         $self->{remote_id} .= "[".$self->{h}{"client-ip"}."]";
+      } elsif (exists $self->{h}{"x-forwarded-for"}) {
+         $self->{remote_id} .= "[".$self->{h}{"x-forwarded-for"}."]";
+      }
       weaken ($uri{$self->{remote_addr}}{$self->{uri}}{$self*1} = $self);
       eval {
          $self->map_uri;
       $self->eoconn;
       die if $@ && !ref $@;
-      last if $self->{h}{connection} =~ /close/ || $self->{version} lt "1.1";
+      last if $self->{h}{connection} =~ /close/ || $self->{version} < 1.1;
-      $self->slog(9, "persistent connection [".$self->{h}{"user-agent"}."][$self->{reqs}]");
       $fh->timeout($::PER_TIMEOUT);
    }
 }
 # uri => path mapping
 sub map_uri {
    my $self = shift;
-   my $host = $self->{h}{host} || "default";
+   my $host = $self->{server_name};
    my $uri = $self->{uri};
    # some massaging, also makes it more secure
    $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
    $uri =~ s%//+%/%g;
    $self->{path} = "$::DOCROOT/$host$uri";
    $self->access_check;
 }
-sub server_address {
-   my $self = shift;
-   my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname
-      or $self->err(500, "unable to get socket name");
-   ((inet_ntoa $iaddr), $port);
-}
-sub server_host {
-   my $self = shift;
-   if (exists $self->{h}{host}) {
-      return $self->{h}{host};
-   } else {
-      return (($self->server_address)[0]);
-   }
-}
-sub server_hostport {
-   my $self = shift;
-   my ($host, $port);
-   if (exists $self->{h}{host}) {
-      ($host, $port) = ($self->{h}{host}, $self->{server_port});
-   } else {
-      ($host, $port) = $self->server_address;
-   }
-   $port = $port == 80 ? "" : ":$port";
-   $host.$port;
-}
 sub _cgi {
    my $self = shift;
    my $path = shift;
    my $fh;
    # no two-way xxx supported
    if (0 == fork) {
       open STDOUT, ">&".fileno($self->{fh});
       if (chdir $::DOCROOT) {
          $ENV{SERVER_SOFTWARE} = "thttpd-myhttpd"; # we are thttpd-alike
-         $ENV{HTTP_HOST}       = $self->server_host;
+         $ENV{HTTP_HOST}       = $self->{server_name};
-         $ENV{HTTP_PORT}       = $self->{server_host};
+         $ENV{HTTP_PORT}       = $self->{server_port};
          $ENV{SCRIPT_NAME}     = $self->{name};
          exec $path;
       }
       Coro::State::_exit(0);
    } else {
+      die;
    }
+}
+sub server_hostport {
+   $_[0]{server_port} == 80
+      ? $_[0]{server_name}
+      : "$_[0]{server_name}:$_[0]{server_port}";
 }
 sub respond {
    my $self = shift;
    my $path = $self->{path};
    if (-d _ && -r _) {
       # directory
       if ($path !~ /\/$/) {
          # create a redirect to get the trailing "/"
-         my $host = $self->server_hostport;
+         # we don't try to avoid the :80
-         $self->err(301, "moved permanently", { Location =>  "http://$host$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");
          if (-r "$path/index.html") {
       $self->err(416, "not satisfiable", $hdr, "");
 satisfiable:
       # check for segmented downloads
       if ($l && $::NO_SEGMENTED) {
+         my $delay = 180;
-         if (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
+         while (%{$uri{$self->{remote_addr}}{$self->{uri}}} > 1) {
-            $self->err(400, "segmented downloads are not allowed");
+            if ($delay <= 0) {
+               $self->err_segmented_download;
+            } else {
+               Coro::Event::do_timer(after => 3); $delay -= 3;
+            }
          }
       }
       $hdr->{"Content-Range"} = "bytes $l-$h/$length";
       @code = (206, "partial content");
       while ($h > 0) {
          if (0) {
             sysread $fh, $buf, $h > $::BUFSIZE ? $::BUFSIZE : $h
                or last;
          } else {
+            undef $buf;
+            $aio_requests->down;
             aio_read($fh, $l, ($h > $::BUFSIZE ? $::BUFSIZE : $h),
                      $buf, 0, sub {
                         $r = $_[0];
                         $current->ready;
                      });
             &Coro::schedule;
+            $aio_requests->up;
             last unless $r;
          }
          my $w = $self->{fh}->syswrite($buf)
             or last;
          $::written += $w;

Diff Legend

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

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents): Revision 1.26 by root, Sun Aug 19 22:59:35 2001 UTC vs. Revision 1.30 by root, Sun Aug 26 14:55:46 2001 UTC

Diff Legend

Comparing cvsroot/Coro/myhttpd/httpd.pl (file contents):
Revision 1.26 by root, Sun Aug 19 22:59:35 2001 UTC vs.
Revision 1.30 by root, Sun Aug 26 14:55:46 2001 UTC