#!/usr/bin/perl
# Linux Director Daemon
# $Id: ldirectord,v 1.7 1999/12/04 15:09:37 jrief Exp $
# Jacob Rief <jacob.rief@tis.at>

=head1 NAME

ldirectord - Linux Director Daemon 

Daemon to monitor remote services and control Linux Virtual Server


=head1 SYNOPSIS

B<ldirectord> I<configuration> [B<-d>] B<start>|B<stop>|B<restart>|B<reload>|B<status>


=head1 DESCRIPTION

B<ldirectord> is a daemon to monitor and administer real servers in a cluster of 
load balanced virtual servers. B<ldirectord> typically is started from heartbeat 
but can also be run from the command line. On startup B<ldirectord> reads the file
B</etc/ha.d/>I<configuration>B<.cf>. After parsing the file, entries for virtual servers
are created on the LVS. Now at regular intervals the specified real servers are monitored
and if they are considered alive, added to a list for each virtual server. If a real
server fails, it is removed from that list. Only one instance of B<ldirectord> can be
started for each configuration, but more instances of B<ldirectord> may be started for
different configurations. This helps to group clusters of services.
Normally one would put an entry inside B</etc/ha.d/haresources>

I<nodename virtual-ip-address ldirectord::configuration>

to start ldirectord from heartbeat.


=head1 OPTIONS

I<configuration>
This is the name for the configuration as specified in the file B</etc/ha.d/>I<configuration>B<.cf> 

B<-d> Don't start as daemon. Useful for debugging. 

B<start> the daemon for the specified configuration.

B<stop> the daemon for the specified configuration. This is the same as sending
a TERM signal the the running daemon.

B<restart> the daemon for the specified configuration. The same as stopping and starting.

B<reload> the configuration file. This is only useful for modifications
inside a virtual server entry. It will have no effect on adding or
removing a virtual server block. This is the same as sending a HUP signal to
the running daemon.

B<status> of the running daemon for the specified configuration.


=head1 SYNTAX for the configuration file

B<virtual = >I<x.y.z.w:p>

defines a virtual service by IP-address and port,
all real services and flags for a virtual service must
follow this line immediately and be indentet.

B<timeout = >I<n>

defines the number of second until a real server is declared dead

B<checkinterval = >I<n>

Defines the number of second between server checks.

B<fallback = >I<x.y.z.w:p>

the server onto which a webservice is redirected if all real
servers are down. Typically this would be 127.0.0.1 with
an emergency page.

=head2 These commands must follow a B<virtual> entry and must
be indented (minimum 4 spaces or one tab)

B<real => I<x.y.z.w:p> B<gate>|B<masq>|B<ipip> [I<weight>]

Defines a real service by IP-address and port. The second argument
defines the forwarding method, must be gate, ipip or masq. The thrid
argument is optional and defines the weight for that real server.
More than one of these entries may be inside a virtual section.

B<service = http>|B<https>

The type of service to monitor. This defaults tp http if the port
of the real service is 80 and to https if the port is 443.

B<request = ">I<uri to requested object>B<">

This object will be requested each checkinterval seconds on each real server.
The string must be inside quotes.

B<receive = ">I<string to compare>B<">

If the requested result contains this I<string to compare>, the real server
is declared alive. The string must be inside quotes.

B<scheduler = rr>|B<wrr>|B<lc>|B<wlc>

Scheduler to be used for loadbalance.

B<persistent => I<n>

Number of seconds for persistent client connections.

B<protocol = tcp>|B<udp>

Protocol to be used.


=head1 FILES

B</etc/ha.d/>I<configuration>B<.cf>
B</var/log/ldirectord.log>
B</var/run/ldirectord.>I<configuration>B<.pid>

=head1 SEE ALSO

L<ipvsadm>, L<heartbeat>


=head1 AUTHORS

Jacob Rief <jacob.rief@tis.at>

=cut

# default values
$TIMEOUT = 10;
$CHECKINTERVALL = 10;
$IPVSADM="/usr/sbin/ipvsadm";
$LDIRLOG="/var/log/ldirectord.log";
$RUNPID="/var/run/ldirectord";
@VIRTUAL;

use Getopt::Std;
use LWP::UserAgent;
use Net::SSLeay;
getopts("d");

# main code
init();
ld_setup();
ld_start();
ld_main();


# functions
sub init
{
	# install signal handler
	$SIG{'TERM'} = \&ld_term;
	$SIG{'HUP'} = \&ld_hup;

	if ( !defined $ARGV[0] || !defined $ARGV[1] || ($ARGV[1] ne "start" && $ARGV[1] ne "stop"
	     && $ARGV[1] ne "status" && $ARGV[1] ne "restart" && $ARGV[1] ne "reload") ) {
	 	init_error("Usage ldirectord configfile \{start|stop|restart|reload|status\}");
	} else {
		$CONFIG = $ARGV[0];
		$CMD = $ARGV[1];
		my $oldpid;
		if (open(FILE, "<$RUNPID.$CONFIG.pid")) {
			$_ = <FILE>;
			chomp;
			$oldpid = $_;
			close(FILE);
		}
		if (defined $oldpid) {
			# Kill old daemon
			if ($CMD eq "stop") {
				kill 15, $oldpid;
				exit 0;
			} elsif ($CMD eq "restart") {
				kill 15, $oldpid;
				while (-f "$RUNPID.$CONFIG.pid") {
					# wait until old pid file is removed
				}
			} elsif ($CMD eq "reload") {
				kill 1, $oldpid;
				exit 0;
			} elsif ($CMD eq "status") {
				print "ldirectord for $CONFIG is running with pid: $oldpid\n";
				exit 0;
			} else {
				init_error("ldirectord for $CONFIG is already running with pid: $oldpid");
			}
		} else {
			if ($CMD eq "status") {
				print "ldirectord is not running for $CONFIG\n";
				exit 0;
			} elsif ($CMD ne "start") {
				init_error("ldirectord is not running for $CONFIG");
			}
		}
		read_config();
	}

	# Run as daemon
	if (!defined $opt_d) {
		if ($pid = fork()) {
			# the parent goes away
			open(FILE, ">$RUNPID.$CONFIG.pid") || init_error("Can not open $RUNPID.$CONFIG.pid");
			print FILE "$pid\n";
			close(FILE);
			exit 0;
		} elsif (!defined $pid) {
			init_error("ldirector could not fork: $!");
		}
	}
	open(LOGFILE, ">>$LDIRLOG");
	my $now = localtime() . "|$CONFIG";
	print LOGFILE "[$now] Starting Linux Director Daemon\n";
	close(LOGFILE);
}


sub init_error
{
	my $msg = shift;
	chomp($msg);
	if (defined $opt_d) {
		open(LOGFILE, ">>$LDIRLOG");
		print LOGFILE "$msg\n";
		close(LOGFILE);
	} else {
		print STDERR "$msg\n";
	}
	exit 1;
}


sub ld_term
{
	ld_stop();
	system("/bin/rm -f $RUNPID.$CONFIG.pid");
	open(LOGFILE, ">>$LDIRLOG");
	my $now = localtime() . "|$CONFIG";
	print LOGFILE "[$now] Linux Director Daemon terminated\n";
	close(LOGFILE);
	exit 0;
}


sub ld_hup
{
	my $now = localtime() . "|$CONFIG";
	print LOGFILE "[$now] Restarting Linux Director\n";
	read_config();
	ld_setup();
	ld_start();
}


sub read_config
{
	undef @VIRTUAL;
	open(CFGFILE, "</etc/ha.d/$CONFIG.cf") || config_error(0, "can not open file /etc/ha.d/$CONFIG.cf");
	my $line = 0;
	while(<CFGFILE>) {
		$line++;
		if ($_ =~ /^virtual\s*=\s*(.*)/) {
			$1 =~ /(\d+\.\d+\.\d+\.\d+:\d+)/
			    or config_error($line, "invalid address for virtual server");
			my (%vsrv, @rsrv);
			$vsrv{server} = $1;
			$vsrv{server} =~ /(\d+\.\d+\.\d+\.\d+):(\d+)/;
			if ($2 eq "443") {
				$vsrv{service} = "https";
			} else {
				$vsrv{service} = "http";
			}
			$vsrv{real} = \@rsrv;
			$vsrv{status} = 0;
			$vsrv{protocol} = "tcp";
			$vsrv{scheduler} = "wrr";
			$vsrv{request} = "/";
			$vsrv{receive} = "";
			push(@VIRTUAL, \%vsrv);
			while(<CFGFILE>) {
				$line++;
				$_ =~ s/\t/    /g;
				last if !($_ =~ /^ {4,}(.*)/);
				my $rcmd = $1;
				next if ($rcmd =~ /^#/);
				if ($rcmd =~ /^real\s*=\s*(.*)/) {
					$1 =~ /(\d+\.\d+\.\d+\.\d+:\d+)\s+(.*)/ 
					    or config_error($line, "invalid address for real server");
					my $rmt = $1;
					$2 =~ /(\w+)(.*)/ && ($1 eq "gate" || $1 eq "masq" || $1 eq "ipip")
					    or config_error($line, "forward method must be gate, masq or ipip");
					my $fwd = $1;
					if ($2 =~ /\s+(\d+)/) {
						push(@rsrv, {"server"=>$rmt, "forward"=>$fwd, "weight"=>$1});
					} else {
						push(@rsrv, {"server"=>$rmt, "forward"=>$fwd});
					}
				} elsif ($rcmd =~ /^request\s*=\s*\"(.*)\"/) {
					$1 =~ /(.+)/ or config_error($line, "no request string specified");
					$vsrv{request} = $1;
				} elsif ($rcmd =~ /^receive\s*=\s*\"(.*)\"/) {
					$1 =~ /(.+)/ or config_error($line, "invalid receive string");
					$vsrv{receive} = $1;
				} elsif ($rcmd =~ /^load\s*=\s*\"(.*)\"/) {
					$1 =~ /(\w+)/ or config_error($line, "invalid string for load testing");
					$vsrv{load} = $1;
				} elsif ($rcmd =~ /^scheduler\s*=\s*(.*)/) {
					lc($1);
					$1 =~ /(\w+)/ && ($1 eq "rr" || $1 eq "wrr" || $1 eq "lc" || $1 eq "wlc") 
					    or config_error($line, "scheduler must be rr, wrr, lc or wlc");
					$vsrv{scheduler} = $1;
				} elsif ($rcmd =~ /^persistent\s*=\s*(.*)/) {
					$1 =~ /(\d+)/ or config_error($line, "invalid persistent timeout");
					$vsrv{persistent} = $1;
				} elsif ($rcmd =~ /^protocol\s*=\s*(.*)/) {
					lc($1);
					$1 =~ /(\w+)/ && ($1 eq "tcp" || $1 eq "udp") 
					    or config_error($line, "protocol must be tcp or udp");
					$vsrv{protocol} = $1;
				} elsif ($rcmd =~ /^service\s*=\s*(.*)/) {
					lc($1);
					$1 =~ /(\w+)/ && ($1 eq "http" || $1 eq "https")
					    or config_error($line, "service must be http or https");
					$vsrv{service} = $1;
				} elsif ($rcmd =~ /^sitename\s*=\s*(.*)/) {
					$1 =~ /(\w+)/ or config_error($line, "invalid sitename");
					$vsrv{sitename} = $1;
				} else {
					config_error($line, "Unknown command $_");
				}
			}
		}
		next if ($_ =~ /^\s*$/ || $_ =~ /^\s*#/);
		if ($_ =~ /^timeout\s*=\s*(.*)/) {
			$1 =~ /(\d+)/ && $1 or config_error($line, "invalid timeout value");
			$TIMEOUT = $1;
		} elsif ($_ =~ /^checkinterval\s*=\s*(.*)/) {
			$1 =~ /(\d+)/ && $1 or config_error($line, "invalid checkinterval value");
			$CHECKINTERVAL = $1;
		} elsif ($_ =~ /^fallback\s*=\s*(.*)/) {
			my $tmp = $1;
			($tmp =~ /(\d+\.\d+\.\d+\.\d+:\d+)/ || $tmp =~ /(\d+\.\d+\.\d+\.\d+)/) && $1
			    or config_error($line, "invalid address for fallback server");
			$FALLBACK = $1;
		} else {
			config_error($line, "Unknown command $_");
		}
	}
	close(CFGFILE);
}


sub config_error
{
	my ($line, $msg) = @_;
	if (defined $opt_d) {
		open(LOGFILE, ">>$LDIRLOG");
		if ($line>0) {
			print LOGFILE "Error reading file $CONFIG at line $line: $msg\n";
		} else {
			print LOGFILE "Error: $msg\n";
		}
		close(LOGFILE);
	} else {
		if ($line>0) {
			print STDERR "Error reading file $CONFIG at line $line: $msg\n";
		} else {
			print STDERR "Error: $msg\n";
		}
	}
	exit 1;
}


sub ld_setup
{
	open(LOGFILE, ">>$LDIRLOG");
	foreach $v (@VIRTUAL) {
		if ($$v{protocol} eq "tcp") {
			$$v{proto} = "-t";
		} elsif ($$v{protocol} eq "udp") {
			$$v{proto} = "-u";
		}
		$$v{flags} = "$$v{proto} $$v{server} ";
		$$v{flags} .= "-s $$v{scheduler} " if defined ($$v{scheduler});
		$$v{flags} .= "-p $$v{persistent} " if defined ($$v{persistent});
		my $now = localtime() . "|$CONFIG";
		print LOGFILE "[$now] Adding virtual server: $$v{server}\n";
		my $real = $$v{real};
		foreach $r (@$real) {
			if ($$r{forward} eq "masq") {
				$$r{forw} = "-m";
			} elsif ($$r{forward} eq "gate") {
				$$r{forw} = "-g";
			} elsif ($$r{forward} eq "ipip") {
				$$r{forw} = "-i";
			} else {
				$$r{forw} = " ";
			}
			if (defined $$r{weight}) {
				 $$r{wght} = "-w $$r{weight}";
			} else {
				 $$r{wght} = " ";
			}
			$$r{status} = -1;
		}
		$$v{status} = -1;
	}
	close(LOGFILE);
}


sub ld_start
{
	open(LOGFILE, ">>$LDIRLOG");
	# read status of current ipvsadm -L -n
	open(IPVS, "$IPVSADM -L -n |");
	$_ = <IPVS>; $_ = <IPVS>; $_ = <IPVS>;
	my %oldsrv;
	while (<IPVS>) {
		my %oldreal;
		if ($_ =~ /(\w+)\s+(\d+\.\d+\.\d+\.\d+\:\d+)\s+(\w+)\s+persistent\s+(\d+)/) {
			my $prot = lc $1;
			$oldsrv{"$2 $prot"} = {"real"=>\%oldreal, "scheduler"=>$3, "persistent"=>$4};
		} elsif ($_ =~ /(\w+)\s+(\d+\.\d+\.\d+\.\d+\:\d+)\s+(\w+)/) {
			my $prot = lc $1;
			$oldsrv{"$2 $prot"} = {"real"=>\%oldreal, "scheduler"=>$3};
		} else {
			next;
		}
		while(<IPVS>) {
			last unless $_ =~ / ->\s+(\d+\.\d+\.\d+\.\d+\:\d+)\s+(\w+)\s+(\d+)/;
			my $fwd;
			if ($2 eq "Route") {
				$fwd = "gate";
			} elsif ($2 eq "Tunnel") {
				$fwd = "ipip";
			} elsif ($2 eq "Masq") {
				$fwd = "masq";
			}
			$oldreal{"$1"} = {"forward"=>$fwd, "weight"=>$3};
		}
		redo;
	}
	close(IPVS);

	# modify service, if changed 
	foreach $nv (@VIRTUAL) {
		my $nreal = $$nv{real};
		$$nv{status} = 0;
		if (exists($oldsrv{"$$nv{server} $$nv{protocol}"})) {
			# service exists, modify it
			system("$IPVSADM -E $$nv{flags}");
			my $ov = $oldsrv{"$$nv{server} $$nv{protocol}"};
			my $or = $$ov{real};
			foreach $nr (@$nreal) {
				if (exists($$or{"$$nr{server}"})) {
					system("$IPVSADM -e $$nv{proto} $$nv{server} -R $$nr{server} $$nr{forw} $$nr{wght}");
					$$nr{status} = 1;
					$$nv{status}++;
					my $now = localtime() . "|$CONFIG";
					print LOGFILE "[$now] Changing real server: $$nr{server} ($$nv{status}*$$nv{server})\n";
					delete($$or{"$$nr{server}"});
				} else {
					$$nr{status} = 0;
				}		
			}
			# remove remaining entries
			foreach $k (keys %$or) {
				system("$IPVSADM -d $$nv{proto} $$nv{server} -R $k");
			}
		} else {
			# no such service, create a new one
			system("$IPVSADM -A $$nv{flags}");
			foreach $nr (@$nreal) {
				$$nr{status} = 0;
			}
		}

		if (defined $FALLBACK && $$nv{status}==0) {
			# turn on fallback service
			system("$IPVSADM -a $$nv{proto} $$nv{server} -R $FALLBACK");
			my $now = localtime() . "|$CONFIG";
			print LOGFILE "[$now] Starting fallback server for: $$nv{server}\n";
		}
	}
	close(LOGFILE);
}


sub ld_stop
{
	open(LOGFILE, ">>$LDIRLOG");
	foreach $v (@VIRTUAL) {
		my $real = $$v{real};
		my $now = localtime() . "|$CONFIG";
		foreach $r (@$real) {
			if ($$r{status}>0) {
				system("$IPVSADM -d $$v{proto} $$v{server} -R $$r{server}");
				$$r{status} = 0;
				$$v{status}--;
				print LOGFILE "[$now] Removing real server: $$r{server} ($$v{status}*$$v{server})\n";
			}
		}
		system("$IPVSADM -D $$v{proto} $$v{server}");
		print LOGFILE "[$now] Removing virtual server: $$v{server}\n";
	}
	close(LOGFILE);
}


sub ld_main
{
	# Main failover checking code
	while (1) {
		open(LOGFILE, ">>$LDIRLOG");
		foreach $v (@VIRTUAL) {
			my $real = $$v{real};
			foreach $r (@$real) {
				check_server($v, $r);
			}
		}
		close(LOGFILE);
		sleep $CHECKINTERVALL;
	}
}



sub check_server
{
	my ($v, $r) = @_;
	my $uri = $$v{request};
	if ($$v{service} eq "http") {
		$uri =~ s/^\///g;
		my $ua = new LWP::UserAgent;
		$ua->agent("LinuxDirector/0.1" . $ua->agent);
		$ua->timeout($TIMEOUT);
		my $req;
		$req = new HTTP::Request(GET=>"http:\/\/$$r{server}\/$uri");
		my $res = $ua->request($req);
		my $receive_string = $$v{receive};
		if ($res->is_success && (!($receive_string =~ /.+/) || $res->content =~ /$receive_string/)) {
			service_up($v, $r);
		} else {
			service_down($v, $r);
		}
	} elsif ($$v{service} eq "https") {
		$$r{server} =~ /(\d+\.\d+\.\d+\.\d+):(\d+)/;
		my ($page, $result, %headers) = &Net::SSLeay::get_https($1, $2, $uri);
		my $receive_string = $$v{receive};
		if ($page =~ /$receive_string/) {
			service_up($v, $r);
		} else {
			service_down($v, $r);
		}
	}
}


sub service_up
{
	my ($v, $r) = @_;
	if ($$r{status}==0) {
		system("$IPVSADM -a $$v{proto} $$v{server} -R $$r{server} $$r{forw} $$r{wght}");
		$$r{status} = 1;
		$$v{status}++;
		my $now = localtime() . "|$CONFIG";
		print LOGFILE "[$now] Adding real server: $$r{server} ($$v{status}*$$v{server})\n";
		if ($$v{status}==1 && defined $FALLBACK) {
			# turn off fallback service
			system("$IPVSADM -d $$v{proto} $$v{server} -R $FALLBACK");
			print LOGFILE "[$now] Turning off fallback server for: $$v{server}\n";
		}

	 	# workarround because ipvs does not clear persistent connections
		if ($$v{status}==2 && defined $$v{persistent}) {
			# workarround restore persistence
			system("$IPVSADM -E $$v{flags}");
		}
	}
}


sub service_down
{
	my ($v, $r) = @_;
	if ($$r{status}==1) {
		system("$IPVSADM -d $$v{proto} $$v{server} -R $$r{server}");
		$$r{status} = 0;
		$$v{status}--;
		my $now = localtime() . "|$CONFIG";
		print LOGFILE "[$now] Removing real server: $$r{server} ($$v{status}*$$v{server})\n";
		if ($$v{status}==0 && defined $FALLBACK) {
			# turn on fallback service
			system("$IPVSADM -a $$v{proto} $$v{server} -R $FALLBACK");
			print LOGFILE "[$now] Starting fallback server for: $$v{server}\n";
		}

	 	# workarround because ipvs does not clear persistent connections
		if ($$v{status}==1 && defined $$v{persistent}) {
			my $args = "$$v{proto} $$v{server}";
			$args .= " -s $$v{scheduler}" if (defined $$v{scheduler});
			system("$IPVSADM -E $args");
		}
	}
}


