#!/usr/bin/perl -w
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Request;
use LWP::UserAgent;
use Data::Dumper;
$| = 1;
my $finished;
$finished=0;
my @pids;
$SIG{TERM} = \&catch_control_term;
while( ! $finished )
{
my $control_port;
@hosts = do "proxy.cfg";
#print "hosts: ";
#print Dumper(@hosts);
#print "\n";
@pids=();
for my $host (@hosts)
{
# If this is the control host.
if( $host->{'control'} )
{
$control_port=$host->{'port'};
} else {
# If it's a regular host
$pid = fork();
if( $pid )
{
# We're the parent
push @pids, ( $pid );
#print Dumper( @pids );
} else {
# We're the child
#print Dumper($host);
$uri_prepend=$host->{'uri_prepend'};
$virt=$host->{'virt'};
$port=$host->{'port'};
$replace=$host->{'replace'};
my $d = HTTP::Daemon->new(
LocalPort => $port,
ReuseAddr => 1,
) || die;
print "New daemon created: $port, $virt, $uri_prepend; URL: ".$d->url."\n";
$SIG{TERM} = \&catch_term;
sub catch_term
{
print "PID $$ caught term; closing.\n";
$d->close();
exit;
}
my $ua = LWP::UserAgent->new;
#$ua->default_header('Host' => $virt );
while (my $c = $d->accept) {
while (my $r = $c->get_request) {
print "uri: ".$r->uri.".\n";
my $uri = $r->uri;
$uri = $uri_prepend . $uri;
# Remove doubled /
$uri =~ s;(?uri( $uri );
print "uri2: ".$r->uri.".\n";
$r->{"_headers"}{'host'} = $virt;
#print Dumper($r);
my $response = $ua->request($r);
if( $replace )
{
my $content =
$response->content;
my $replace_url = $d->url;
#print Dumper($content);
$content =~
s{$replace}{$replace_url}g;
$response->content( $content );
#print Dumper($content);
}
print "About to send response.\n";
#print Dumper($response);
$c->send_response( $response );
print "Done send response.\n";
}
print "No more requests.\n";
$c->close;
}
print "No more accepts.\n";
$d->close;
exit;
}
}
}
my $d = HTTP::Daemon->new(
LocalPort => $control_port,
ReuseAddr => 1,
) || die;
print "Control daemon created: $control_port; URL: ".$d->url."\n";
while( my $c = $d->accept )
{
while( my $r = $c->get_request )
{
if( $r->method eq 'GET' and $r->url->path eq "/" )
{
my $url = $d->url;
my $response = new HTTP::Response( 200, '',
HTTP::Headers->new( Host => $url ),
'
VirtProxy Control Daemon
'
);
$c->send_response($response);
} elsif( $r->method eq 'GET'
and $r->url->path eq "/status.html" ) {
my $url = $d->url;
my $response = new HTTP::Response( 200, '',
HTTP::Headers->new( Host => $url ),
'
VirtProxy Control Daemon: Status
Pids: '. Dumper(@pids) .
"\nHosts: " . Dumper(@hosts) . '
'
);
$c->send_response($response);
} elsif( $r->method eq 'GET'
and $r->url->path eq "/restart.html" ) {
my $url = $d->url;
my $response = new HTTP::Response( 200, '',
HTTP::Headers->new( Host => $url ),
'
VirtProxy Control Daemon: Restart
Pids: '. Dumper(@pids) . '
'
);
$c->send_response($response);
$c->close();
$d->close();
} elsif( $r->method eq 'GET'
and $r->url->path eq "/die.html" ) {
my $url = $d->url;
my $response = new HTTP::Response( 200, '',
HTTP::Headers->new( Host => $url ),
'
VirtProxy Control Daemon: Die
Dying.
Pids: '. Dumper(@pids) . '
'
);
$c->send_response($response);
$c->close();
$d->close();
$finished=1;
} else {
$c->send_error(RC_FORBIDDEN)
}
}
if( $c )
{
$c->close;
}
undef($c);
}
if( $d )
{
$d->close();
}
undef($d);
killall();
print "Waiting.\n";
wait;
print "All daemons dead.\n";
if( ! $finished )
{
print "Pausing before restart.\n";
sleep 10;
print "Restarting.\n";
}
}
print "Exiting.\n";
exit 0;
sub killall
{
print "Killing: \n";
for my $pid (@pids)
{
print "$pid ";
kill 15, $pid;
}
}
sub catch_control_term
{
killall();
print "Control PID $$ caught term; closing.\n";
wait;
exit;
}