package Plack::Server::Standalone::CEHPrefork;
use strict;
use base 'Net::Server::PreFork';
use Data::Dump qw(dump);
use HTTP::Status qw(status_message);
use IO::Select;
use IO::Socket qw(:crlf);
use Plack::Util;
use Plack::HTTPParser qw(parse_http_request);
use Socket;
 
use constant DEBUG        => 0;
use constant CHUNKSIZE    => 64 * 1024;
use constant READ_TIMEOUT => 5;
 
sub new {
    my($class, %opts) = @_;
 
    my $self = $class->SUPER::new;
    $self->{opts} = \%opts;
 
    return $self;
}
 
sub run {
    my($self, $app) = @_;
 
    $self->{psgi_app} = $app;
 
    # Restore ARGV since Getopt has eaten it and Net::Server needs it
    # for proper restart support
    @ARGV = %{ $self->{opts} };
 
    my %extra = ();
    if ( $self->{opts}{pid_file} ) {
        $extra{pid_file} = $self->{opts}{pid_file};
    }
    if ( $self->{opts}{background} ) {
        $extra{setsid} = $extra{background} = 1;
    }
 
    $self->SUPER::run(
        port                       => $self->{opts}{port} || 8080,
        host                       => $self->{opts}{host} || '*',
        serialize                  => 'flock',
        log_level                  => DEBUG ? 4 : 1,
        min_servers                => $self->{opts}{min_servers}       || 5,
        min_spare_servers          => $self->{opts}{min_spare_servers} || 2,
        max_spare_servers          => $self->{opts}{max_spare_servers} || 10,
        max_servers                => $self->{opts}{max_servers}       || 50,
        max_requests               => $self->{opts}{max_requests}      || 1000,
        leave_children_open_on_hup => $self->{opts}{restart_graceful}  || 0,
 
        %extra
    );
}
 
sub pre_loop_hook {
    my $self = shift;
 
    my $host = $self->{server}->{host}->[0];
    my $port = $self->{server}->{port}->[0];
 
    my $addr = $host ne '*' ? inet_aton($host) : INADDR_ANY;
    if ( $addr eq INADDR_ANY ) {
        require Sys::Hostname;
        $host = lc Sys::Hostname::hostname();
    }
    else {
        $host = gethostbyaddr( $addr, AF_INET ) || inet_ntoa($addr);
    }
 
    my $url = "http://$host";
    $url .= ":$port" unless $port == 80;
 
    warn "You can connect to your server at $url\n";
}
 
# The below methods run in the child process
 
sub post_accept_hook {
    my $self = shift;
 
    $self->{client} = {
        headerbuf => '',
        inputbuf  => '',
        keepalive => 1,
    };
}
 
sub process_request {
    my $self = shift;
    my $conn = $self->{server}->{client};
 
    while ( $self->{client}->{keepalive} ) {
        last if !$conn->connected;
 
        # Read until we see all headers
        last if !$self->_read_headers;
 
        # Parse headers
        my $env = {
            'psgi.version' => [ 1, 0 ],
            'psgi.errors'  => *STDERR,
            'psgi.url_scheme' => 'http',
            'psgi.run_once'     => Plack::Util::FALSE,
            'psgi.multithread'  => Plack::Util::FALSE,
            'psgi.multiprocess' => Plack::Util::TRUE,
            REMOTE_ADDR     => $self->{server}->{peeraddr},
            REMOTE_HOST     => $self->{server}->{peerhost} || $self->{server}->{peeraddr},
            SERVER_NAME     => $self->{server}->{sockaddr}, # XXX: needs to be resolved?
            SERVER_PORT     => $self->{server}->{port}->[0],
            SCRIPT_NAME     => '',
        };
 
        my $buf = delete $self->{client}{headerbuf};
        my $reqlen = parse_http_request($buf, $env);
 
        if ( $reqlen == -1 ) {
            # Bad request
            DEBUG && warn "[$$] Bad request\n";
            $self->_http_error(400);
            last;
        }
 
        $buf = substr $buf, $reqlen;
 
        open $env->{'psgi.input'}, "<", \$buf; # XXX should read more
        $env->{'psgi.errors'} = \*STDERR;
 
        # Determine whether we will keep the connection open after the request
        my $proto      = $env->{SERVER_PROTOCOL};
        my $connection = $env->{HTTP_CONNECTION};
        if ( $proto && $proto eq 'HTTP/1.0' ) {
            if ( $connection && $connection =~ /^keep-alive$/i ) {
                # Keep-alive only with explicit header in HTTP/1.0
                $self->{client}->{keepalive} = 1;
            }
            else {
                $self->{client}->{keepalive} = 0;
            }
        }
        elsif ( $proto && $proto eq 'HTTP/1.1' ) {
            if ( $connection && $connection =~ /^close$/i ) {
                $self->{client}->{keepalive} = 0;
            }
            else {
                # Keep-alive assumed in HTTP/1.1
                $self->{client}->{keepalive} = 1;
            }
 
            # Do we need to send 100 Continue?
            if ( $env->{HTTP_EXPECT}) {
                if ( $env->{HTTP_EXPECT} eq '100-continue' ) {
                    syswrite STDOUT, 'HTTP/1.1 100 Continue' . $CRLF . $CRLF;
                    DEBUG && warn "[$$] Sent 100 Continue response\n";
                }
                else {
                    DEBUG && warn "[$$] Invalid Expect header, returning 417\n";
                    $self->_http_error( 417, 'HTTP/1.1' );
                    last;
                }
            }
 
            unless ($env->{HTTP_HOST}) {
                # No host, bad request
                DEBUG && warn "[$$] Bad request, HTTP/1.1 without Host header\n";
                $self->_http_error( 400, 'HTTP/1.1' );
                last;
            }
        }
 
        # run PSGI app
        my $res = Plack::Util::run_app $self->{psgi_app}, $env;
 
        # TODO support keepalive and chunk
        syswrite STDOUT, "HTTP/1.1 $res->[0] @{[ HTTP::Status::status_message($res->[0]) ]}\015\012";
        Plack::Util::header_iter($res->[1], sub {
            my($k, $v) = @_;
            syswrite STDOUT, "$k: $v\015\012";
        });
        syswrite STDOUT, "\015\012";
 
        Plack::Util::foreach($res->[2], sub { syswrite STDOUT, $_[0] });
 
        DEBUG && warn "[$$] Request done\n";
 
        if ( $self->{client}->{keepalive} ) {
            # If we still have data in the input buffer it may be a pipelined request
            if ( $self->{client}->{inputbuf} ) {
                if ( $self->{client}->{inputbuf} =~ /^(?:GET|HEAD)/ ) {
                    if ( DEBUG ) {
                        warn "Pipelined GET/HEAD request in input buffer: " 
                            . dump( $self->{client}->{inputbuf} ) . "\n";
                    }
 
                    # Continue processing the input buffer
                    next;
                }
                else {
                    # Input buffer just has junk, clear it
                    if ( DEBUG ) {
                        warn "Clearing junk from input buffer: "
                            . dump( $self->{client}->{inputbuf} ) . "\n";
                    }
 
                    $self->{client}->{inputbuf} = '';
                }
            }
 
            DEBUG && warn "[$$] Waiting on previous connection for keep-alive request...\n";
 
            my $sel = IO::Select->new($conn);
            last unless $sel->can_read(1);
        }
    }
 
    DEBUG && warn "[$$] Closing connection\n";
}
 
sub _read_headers {
    my $self = shift;
 
    eval {
        local $SIG{ALRM} = sub { die "Timed out\n"; };
        alarm( READ_TIMEOUT );
        while (1) {
            # Do we have a full header in the buffer?
            # This is before sysread so we don't read if we have a pipelined request
            # waiting in the buffer
            last if $self->{client}->{inputbuf} =~ /$CRLF$CRLF/s;
 
            # If not, read some data
            my $read = sysread STDIN, my $buf, CHUNKSIZE;
 
            if ( !defined $read || $read == 0 ) {
                die "Read error: $!\n";
            }
 
            if ( DEBUG ) {
                warn "[$$] Read $read bytes: " . dump($buf) . "\n";
            }
 
            $self->{client}->{inputbuf} .= $buf;
        }
    };
 
    alarm(0);
 
    if ( $@ ) {
        if ( $@ =~ /Timed out/ ) {
            DEBUG && warn "[$$] Client connection timed out\n";
            return;
        }
 
        if ( $@ =~ /Read error/ ) {
            DEBUG && warn "[$$] Read error: $!\n";
            return;
        }
    }
 
    # Pull out the complete header into a new buffer
    $self->{client}->{headerbuf} = $self->{client}->{inputbuf};
 
    # Save any left-over data, possibly body data or pipelined requests
    $self->{client}->{inputbuf} =~ s/.*?$CRLF$CRLF//s;
 
    return 1;
}
 
sub _http_error {
    my ( $self, $code, $protocol, $reason ) = @_;
 
    my $status   = $code || 500;
    my $message  = status_message($status);
    my $response = HTTP::Response->new( $status => $message );
    $response->protocol( $protocol || 'HTTP/1.0' );
    $response->content_type( 'text/plain' );
    $response->header( Connection => 'close' );
    $response->date( time() );
 
    if ( !$reason ) {
        $reason = $message;
    }
    my $msg = "$status $reason";
 
    $response->content_length( length($msg) );
    $response->content( $msg );
 
    syswrite STDOUT, $response->as_string($CRLF);
}
 
1;
__END__