view release on metacpan or  search on metacpan

CAB/Server/HTTP.pm  view on Meta::CPAN

      next;
    }

    ##-- query processing starts
    $srv->{qt0} = [gettimeofday];

    ##-- re-bless client socket (for UNIX-domain server)
    bless($csock,$cclass) if ($cclass);

    ##-- got client $csock (HTTP::Daemon::ClientConn object; see HTTP::Daemon(3pm))
    $chost = $csock->peerhost();

    ##-- avoid blocking on weird EOF sockets sent e.g. by chromium: no joy
    if ($bgConnectTimeout > 0) {
      vec(($fdset=""), $csock->fileno, 1) = 1;
      if (!select($fdset,undef,undef,$bgConnectTimeout)) {
	$srv->vlog($srv->{logAttempt}, "ignoring background connection from client $chost");
	#++$srv->{nErrors};
	next;
      }
    }

    ##-- access control
    $srv->vlog($srv->{logAttempt}, "attempted connect from client $chost");
    if (!$srv->clientAllowed($csock,$chost)) {
      $srv->denyClient($csock);
      next;
    }

    ##-- track number of requests
    ++$srv->{nRequests};

    ##-- serve client: parse HTTP request
    ##
    ## Strangeness Fri, 17 May 2013 14:14:56 +0200
    ## + returning true from demo.js cabUpload() causes weird 'Client closed' errors on post-upload 'Back' clicks from chromium
    ## + problem maybe related to bizarre closed-client crashes for HTTP::Daemon::ClientConn observed elsewhere: persists even within eval BLOCK
    ## + symptom(s):
    ##   - get_request() fails after ca. 10sec
    ##   - HTTP::Daemon::DEBUG output shows "Need more data for complete header\nsysread()\n"
    ##   - no data is actually read into $csock buffer (checked with debugger)
    ##   - $csock invalidates with $csock->reason='Client closed', but $csock->opened()==1
    ##   - attempting to write to $csock in this state (e.g. by clientError()) causes immediate termination of the running server!
    ##
    ##DEBUG
    #$srv->vlog($srv->{logAttempt}, "get_request() for client $chost");
    #$HTTP::Daemon::DEBUG=1;
    ${*$csock}{'io_socket_timeout'} = 5;
    ${*$csock}{'httpd_client_proto'} = HTTP::Daemon::ClientConn::_http_version("HTTP/1.0"); ##-- HACK: force status line on send_error() from $csock->get_request()
    ##/DEBUG
    $hreq = $csock->get_request();
    if (!$hreq) {
      $srv->clientError($csock, RC_BAD_REQUEST, "could not parse HTTP request: ", xml_escape($csock->reason || 'get_request() failed'));
      ++$srv->{nErrors};
      next;
    }

    ##-- log basic request, and possibly request data
    $urikey = $hreq->uri->as_string;
    $srv->vlog($srv->{logConnect}, "client $chost: ", $hreq->method, ' ', $urikey);
    $srv->vlog($srv->{logRequestData}, "client $chost: HTTP::Request={\n", $hreq->as_string, "}");

    ##-- check global content-length limit
    if (($srv->{maxRequestSize}//-1) >= 0 && ($hreq->content_length//0) > $srv->{maxRequestSize}) {
      $srv->clientError($csock, RC_REQUEST_ENTITY_TOO_LARGE, "request exceeds server limit (max=$srv->{maxRequestSize} bytes)");
      ++$srv->{nErrors};
      next;
    }

    ##-- map request to handler
    ($handler,$localPath) = $srv->getPathHandler($hreq->uri);
    if (!defined($handler)) {
      $srv->clientError($csock, RC_NOT_FOUND, "cannot resolve URI ", xml_escape($hreq->uri));
      ++$srv->{nErrors};
      next;
    }

    ##-- check whether we can fork for this request (by default only for POST)
    $forkable = ($mode eq 'fork'
		 && $srv->{"forkOn".ucfirst(lc($hreq->method))}
		 && (!$srv->{forkMax} || scalar(keys %{$srv->{children}}) < $srv->{forkMax}));

    ##-- check cache (GET requests only)
    $cacheable = ($srv->{cache}
		  && (!defined($handler->{cacheable}) || $handler->{cacheable})
		  && $hreq->method eq 'GET'
		  && ($hreq->header('Pragma')||'') !~ /\bno-cache\b/);
    if ($cacheable
	&& ($hreq->header('Cache-Control')||'') !~ /\bno-cache\b/
	&& defined($rsp = $srv->{cache}->get($urikey)))
      {
	++$srv->{nCacheHits};
	$srv->vlog($srv->{logCache}, "using cached response");
	$rsp->header('X-Cached' => 1);
	$srv->vlog($srv->{logResponse}, "cached response: ", $rsp->as_string) if ($srv->{logResponse});
	$csock->send_response($rsp);
	next;
      }

    ##-- maybe fork
    $pid = $forkable ? fork() : undef;
    if ($pid) {
      ##-- parent code
      $srv->{children}{$pid} = undef;
      $srv->vlog($srv->{logSpawn}, "spawned subprocess $pid");
      $srv->{qt0} = undef;
      next;
    }

    ##-- child|serial code: pass request to handler
    eval {
      $rsp = $handler->run($srv,$localPath,$csock,$hreq);
    };
    if ($@) {
      $srv->clientError($csock,RC_INTERNAL_SERVER_ERROR,"handler ", (ref($handler)||$handler), "::run() died:<br/><pre>", xml_escape($@), "</pre>");
      $srv->reapClient($csock,$handler,$chost);
      ++$srv->{nErrors};
    }
    elsif (!defined($rsp)) {
      $srv->clientError($csock,RC_INTERNAL_SERVER_ERROR,"handler ", (ref($handler)||$handler), "::run() failed");
      $srv->reapClient($csock,$handler,$chost);