Listing 1 lb_state.pl

#!/usr/bin/perl
#
## Name:         lb_state.pl - squid recirect_program 
#
## Author:      Tom Northcutt
## Synopsis:    squid redirect_program that implements load balancing
#               with the ability to keep state for backend applications 
## Description:
#               This version implements static pages, state and round
#               robin load balancing. Credit to: Rajeev Kumar (Sys
#               Admin V13 n.2) and Jeremy Zawodny for components of
#               this script
#
#
# user defined section ###

use strict;
$|=1;

my $debug = 1;
my $logfile = "/var/log/squid/lb_data.log";
my $serverlist = "/usr/local/squid/etc/servers-up.dat";

#get list of servers that are up
my @servers;
open SUD, "< $serverlist";
while ( <SUD> ){
    #skip comments, blank lines
    s/#.*//; 
    next if /^(\s)*$/;
    #chomp;
    push @servers, $_;
}
close SUD;
print @servers;
my $i = 0;

#use to ensure key passed is valid
my %server_name;
foreach my $key (@servers){
    chomp $key;
    $server_name{"$key"} = $key;
}

##mainloop ####
while (<>) {
  $i++;
  $i = 0 if ($i > $#servers); 
  my $line = $_;
  my $server = $servers[$i];
  if ($debug){
     open F, ">> $logfile" or die "Can't open $logfile : $!";
     print F "\n[server $server]\n$i $line";
  }

  ##section 1
  #check for URLs that should always be directed to a 
  #specific node (server1)
  if ($line =~ /some.cgi/ || $line =~ /MyWebApp/ || \ 
      $line =~ /~joes_home/  || $line =~ /appDirectory/ ){
      print $line;
      print F "--static goto server1 only \n-> $line" if $debug;
      next; 

  # a different specific node (server3)
  }elsif($line =~ /another.cgi/ || $line =~ /otherWebApp/ || \ 
      $line =~ /~toms_home/  || $line =~ /srvDirectory/ ){
      $line =~ s/server1/server3/;
      print $line;
      print F "--static goto server3 only \n-> $line" if $debug;
      next; 

  ##section 2
  #check for stateful pages
  }elsif($line =~ /lbnode/){
      #this can be done more elegantly, but I like split
      my ($null,$first) = split(/lbnode=/,$line);
      my ($second, $null) = split(/&/,$first);
      my ($node, $null) = split(/ /,$second);
     chomp $node;
     chomp $node;
      print F "--found a lbnode tag, node = $node\n" if $debug;

      my $j = $server_name{"$node"} || "server1";
      print F " --node=$node j=$j --\n" if $debug; 
      $line =~  s[^http://server1.localdomain] [http://$j.localdomain];
      print $line;
      print F "-> static lbnode node=$node j=$j  $line" if $debug;
      next;

  ##section 3    
  #round robin
  }else{
      my $k = $server_name{"$server"} || "server1";
      chomp $k;
      $line =~  s[^http://server1.localdomain] [http://$k.localdomain];
      print $line ;
      print F "--round robin, server = $k \n-> $line" if $debug;
  }
  close F if $debug;
}