#!/usr/bin/perl


#Load balancing 
#You've hit the big time, and your site is getting more hits than you ever dreamed of. 
#Millions, zillions of hits. What's that? System load just passed 50 and response time is getting kinda' s-l-o-w-w-w? 
#Perl to the rescue. Set up several replica Web servers with different hostnames and IP addresses. 
#Run this script on the ``main'' site and watch it round-robin the requests to the replica servers. 
#It uses IO::Socket to listen for incoming requests on port 80. It then changes its privileges to run as 
#nobody.nogroup, just like a real Web server. Next it preforks itself a few times (and you always thought 
#preforking was something fancy, didn't you?), and goes into an accept() loop. Each time an incoming session comes in, 
#it forks off another child to handle the request. The child reads the HTTP request and issues an HTTP redirection to 
#send the browser to a randomly selected server. 

#NOTE: Another way to do this is to have multiple ``A'' records defined for your server's hostname and let DNS caching distribute the load. 

#---------------- Script I.4.1: A Load Balancing ``Web Server'' --------- 

use CGI qw/:standard/;



print "Content-type:text/html\n\n";
print "hello", "\n";
 
 # list of hosts to balance between
my @HOSTS = qw/www1.mydomain.com www2.mydomain.com www3.mydomain.com www4.mydomain.com/;  




use IO::Socket;
$SIG{CHLD} = sub { wait() };
$ENV{'PATH'}='/bin:/usr/bin';  


chomp($hostname = `/bin/hostname`);  


print $hostname, "\n";

# Listen on port 80
$sock = IO::Socket::INET->new(Listen  => 5,
                             LocalPort => 80,  
                             LocalAddr => $hostname,  
                             Reuse     => 1,
                             Proto    => 'tcp');

# become "nobody"
$nobody  = (getpwnam('nobody'))[2]  || die "nobody is nobody";
$nogroup = (getgrnam('nogroup'))[2] || die "can't grok nogroup";
($<,$() = ($>,$)) = ($nobody,$nogroup); # get rid of root privileges!
($\,$/) = ("\r\n","\r\n\r\n");          # CR/LF on output/input

# Go into server mode
close STDIN; close STDOUT; close STDERR;

# prefork -- gee is that all there is to it?
fork() && fork() && fork() && fork() && exit 0;

# start accepting connections
while (my $s = $sock->accept()) {
    do { $s->close; next; } if fork();
    my $request = <$s>;
	print $request, "\n";
    redirect($1,$s) if $request=~/(?:GET|POST|HEAD|PUT)\s+(\S+)/;
    $s->flush;
    undef $s;
    exit 0;
}

sub redirect {
    my ($url,$s) = @_;
    my $host = $HOSTS[rand(@HOSTS)];
    print $s, "HTTP/1.0 301 Moved Temporarily", "\n";
    print $s, "Server: Lincoln's Redirector/1.0", "\n";
    print $s, "Location: http://${host}${url}", "\n";
    print $s, "", "\n";
}