$st{$sck}{req_orig} =~ /^Connection:\s*close/im ) {
$st{$sck}{persist} = 0; # disable koneksi persistent
}
# Proxy authentication rule
if ( $aut and
( $st{$sck}{req_fields} !~ /^Proxy-Authorization:\s*(\S*)\s*(\S*)/im or
decode_b64($2) ne $aut_cre)) {
$st{$sck}{resp} = "HTTP/1.1 407 Proxy Authorization\r\nProxy-Authenticate: Basic realm=\"legalif/11\"\r\nVia:
$viastring\r\nConnection: close\r\n\r\n";
$st{$sck}{resp_len} = length $st{$sck}{resp};
$sl_read->remove($sck);
$sl_write->add($sck);
next READ_FHS;
}
# OPTIONS method rule
if ( $st{$sck}{metode} eq "OPTIONS" and
( $st{$sck}{uri} eq "*" or $st{$sck}{req_fields} =~ /^Max-Forwards:\s*0/im)) {
$st{$sck}{resp} = "HTTP/1.1 200 OK\r\nAllow: GET, HEAD, POST, PUT, OPTION, TRACE\r\nVia: $viastring\r\nConnection:
close\r\nContent-Length: 0\r\n\r\n";
$st{$sck}{resp_len} = length $st{$sck}{resp};
$sl_read->remove($sck);
$sl_write->add($sck);
next READ_FHS;
}
# TRACE method rule
if ( $st{$sck}{metode} eq "TRACE" and
( $st{$sck}{uri} eq "*" or $st{$sck}{req_fields} =~ m/^Max-Forwards:\s*0/im)) {
my $len = length $st{$sck}{req_orig};
$st{$sck}{resp} = "HTTP/1.1 200 OK\r\nContent-Type: message/http\r\nVia: $viastring\r\nConnection:
close\r\nContent-Length: $len\r\n\r\n$st{$sck}{req_orig}";
delete $st{$sck}{req_orig};
$st{$sck}{resp_len} = length $st{$sck}{resp};
$sl_read->remove($sck);
$sl_write->add($sck);
next READ_FHS;
}
delete $st{$sck}{req_orig};
# add new request fields
$st{$sck}{req_fields} .= "Via: $viastring\r\nConnection: close\r\n";
# POST and PUT method handler
if ( ($st{$sck}{metode} eq "POST" or $st{$sck}{metode} eq "PUT") and
$st{$sck}{req_fields} =~ m/^Content-Length:\s*(\S*)/im ) {
$st{$sck}{req_bodylen} = $1;
}
$st{$sck}{mark} = 3;
}
if ($st{$sck}{mark} == 3) { # finale phase
if (defined $st{$sck}{req_bodylen}) { # get body client (if available)
if ($st{$sck}{req_bodylen} > length($st{$sck}{req})) {
debug "Client send partial body...getting some more",$sck;
next READ_FHS;
}
}
debug "Request message complete",$sck;
debug "Connecting to Server ($st{$sck}{uri_hostname}:$st{$sck}{uri_port})",$sck;
$st{$sck}{req} = join "", $st{$sck}{req_line}, $st{$sck}{req_fields}, "\r\n", $st{$sck}{req};
$st{$sck}{req_len} = length $st{$sck}{req};
$st{$sck}{req_offset} = 0;
delete $st{$sck}{req_line};
delete $st{$sck}{req_fields};
my $sck2;
if ($proxy) {
$sck2 = new IO::Socket::INET (PeerAddr => $proxy, Proto => 'tcp');
}
else {
$sck2 = new IO::Socket::INET (PeerAddr => $st{$sck}{uri_hostname},
PeerPort => $st{$sck}{uri_port},
Proto => 'tcp');
}
if ($sck2) {
fcntl $sck2, F_SETFL(), O_NONBLOCK() if $non_block; # non-block-kan
# prepare select to write Server
$sl_read->remove($sck);
$sl_write->add($sck2);
$st{$sck2}{ch} = $sck; $st{$sck}{ch} = $sck2; #exchange socket name
$st{$sck2}{tipe} = 2; # 2 is Server connection
$st{$sck2}{peerhost} = "$st{$sck}{uri_hostname}:$st{$sck}{uri_port}";
$st{$sck}{mark} = 1;
debug "Connected to Server",$sck;
}
else {
$@ =~ /INET:(.*)$/;
debug "Connecting to Server error: $1",$sck;
quickresp 502, $1, $sck;
next READ_FHS;
}
}
}
elsif ($st{$sck}{tipe} == 2) { # Server is ready to read
debug "#select# => Server readable",$sck,1;
# let's read Server until Server closes the connection
my $buffer;
my $index = 0;
my $byte_read;
while (1) {
++$index;
=3= |