#!/usr/bin/perl
# MySQL Binlog purge script.
# Copyright 2009 Robin H. Johnson <robbat2@isohunt.com>
#
# Run as: ... --master $MASTER --slaves $SLAVE1,$SLAVE2
#
# Other options:
# --debug
# --dry-run
# --username
# --password
# --warn-max-logs

use DBI;
use strict;
use warnings;
use Data::Dumper;
use File::Path::Expand;
use Carp qw(confess);
use Getopt::Long;
use Config::Tiny;

my $master = undef;
my @slaves = undef;
my %dbh;
my @binlogs;
my %binlog_progress;
my $msg_buffer;
my $active_logs = 999999; # high number so we print on failure
my $error = 0;

# GetOpt variables:
our $DEBUG = 0;
our $DRYRUN = 0;
our $CONFIRM_NO_SLAVES = 0;
our $SLAVES = '';
our $MASTER = '';
our $PASSWORD = '';
our $USERNAME = 'root';
our $WARN_MAX_LOGS = 3;

# Extract from config files
my @mysql_cnf = ('/etc/mysql/my.cnf', '~/.my.cnf');
foreach my $cfgfile (@mysql_cnf) {
	$cfgfile = expand_filename($cfgfile);
	if(-f $cfgfile) {
		#printf "File %s\n", $cfgfile;
		my $cfg = Config::Tiny->read($cfgfile);
		next unless $cfg;
		foreach my $sect (keys %$cfg) {
			next unless $sect =~ /^client$/ or $sect =~ /^mysql$/;
			$USERNAME = $cfg->{$sect}->{username} if defined $cfg->{$sect}->{username};
			$PASSWORD = $cfg->{$sect}->{password} if defined $cfg->{$sect}->{password};
		}
	}
}

# GetOpt funtime
my $result = GetOptions(
	"debug" => \$DEBUG,
	"dry-run" => \$DRYRUN,
	"confirm-no-slaves" => \$CONFIRM_NO_SLAVES,
	"slaves=s" => \$SLAVES,
	"master=s" => \$MASTER,
	"username=s" => \$USERNAME,
	"password=s" => \$PASSWORD,
	"warn-max-logs=s" => \$WARN_MAX_LOGS,
);
@slaves = split /[,\s]+/,$SLAVES;
$master = $MASTER;
unless(length($master) > 0) {
	print STDERR "No master given!\n";
	exit(-2);
}
# printf "slaves = %s (%s) %d\n",$SLAVES, join('/', @slaves), $slaves_size;
unless(@slaves > 0 or $CONFIRM_NO_SLAVES) {
	print STDERR "No slaves given!\n";
	exit(-3);
}

# end of globals

dprintf("# Installing driver\n");
my $drh = DBI->install_driver("mysql");

foreach my $hostname (@slaves, $master) {
	dprintf("# Connecting to $hostname\n");
	my $dsn = 'DBI:mysql:database=mysql;host='.$hostname;
	my $tmp_dbh = DBI->connect($dsn, $USERNAME, $PASSWORD);
	if($tmp_dbh) {
		$dbh{$hostname} = $tmp_dbh;
	} else {
		$dbh{$hostname} = -1;
		$error = 1;
	}
}

# Get the full list of logs from the master
{
	dprintf("# Grabbing master binlog list on $master\n");
	my $sth = $dbh{$master}->prepare("SHOW BINARY LOGS");
	$sth->execute;
	while (my $ref = $sth->fetchrow_hashref()) {
		push @binlogs, $ref->{Log_name};
	}
	$sth->finish;
	$msg_buffer .= dprintf("# Available logs:\n");
	my $i = 0;
	$msg_buffer .= dprintf(join('',map { sprintf "# %d => %s\n", $i++, $_; } @binlogs));
}
# Record master position in binlog progress implicitly.
$binlog_progress{$master} = $#binlogs;

foreach my $hostname (@slaves) {
	dprintf("# Check slave binlog list on $hostname\n");
	my $pos = 0;
	if($dbh{$hostname} == -1) {
		$msg_buffer .= dprintf(sprintf "# Host %s is not reachable, assuming completely out of date\n", $hostname);
		$pos = -1;
		$error = 1;
	} else {
		my $sth = $dbh{$hostname}->prepare("SHOW SLAVE STATUS");
		$sth->execute;
		my $ref = $sth->fetchrow_hashref();
		#print Dumper($ref);
		my $logfile1 = $ref->{Relay_Master_Log_File};
		my $logfile2 = $ref->{Master_Log_File};
		$sth->finish;
		my ($logfile1_pos, $logfile2_pos);
		$logfile1_pos = compare($logfile1, \@binlogs);
		$logfile2_pos = compare($logfile2, \@binlogs);
		$pos = min($logfile1_pos, $logfile2_pos);
		my %badlogs;
		$badlogs{$logfile1} = 1 if $logfile1_pos == -1;
		$badlogs{$logfile2} = 1 if $logfile2_pos == -1;

		if($logfile1_pos == -1 || $logfile2_pos == -1) {
			$msg_buffer .= dprintf(sprintf "# Host %s has probably lost sync due to too-fast binlog purging (looking for: %s)\n", $hostname, join(', ', keys(%badlogs)));
			$error = 1;
		}
		
		# DEBUG
		#printf "%s %s %d\n",$hostname,$logfile1,$logfile1_pos;
		#printf "%s %s %d\n",$hostname,$logfile2,$logfile2_pos;
	}
	$binlog_progress{$hostname} = $pos;
}


# DEBUG
#print join(',',keys(%dbh))."\n";
my $min_pos = 999999999;
my $min_pos_valid = 0;
$msg_buffer .= dprintf("# Box status:\n");
foreach my $hostname (@slaves, $master) {
	my $pos = $binlog_progress{$hostname};
	$msg_buffer .= dprintf(sprintf "# %s: %d => %s\n", $hostname, $pos, ($pos >= 0) ? $binlogs[$pos] : '');
	$min_pos = min($min_pos,$pos) if defined($pos);
	$min_pos_valid = 1;
}
# Sanity check
unless($min_pos_valid) {
	#print Dumper(@binlogs);
	$min_pos = 1;
}
$active_logs = ($#binlogs-$min_pos+1);

$msg_buffer .= dprintf(sprintf "# Earliest active log position is %d\n", $min_pos);
$msg_buffer .= dprintf(sprintf "# Active logs: %d\n", $active_logs);
if((($active_logs == 0) || ($active_logs == 1)) && $min_pos <= 0) {
	$msg_buffer .= dprintf(sprintf "# Not running, no logs to purge.\n");
} elsif($min_pos > 0) {
	my $sql = sprintf "PURGE MASTER LOGS TO '%s';", $binlogs[$min_pos];
	if($DRYRUN == 0) {
		$msg_buffer .= dprintf(sprintf "# Running SQL: %s\n", $sql);
		my $sth = $dbh{$master}->prepare($sql);
		my $failed = 0;
		$sth->execute or $failed = 1;
		if($failed) {
			$msg_buffer .= dprintf(sprintf "# Failed to execute SQL %s\n",$sql); 
			$error = 1;
		};
		$sth->finish;
	} else {
		$msg_buffer .= dprintf(sprintf "# Pretend running SQL: %s\n", $sql);
	}
} else {
	$msg_buffer .= dprintf(sprintf "# Not running, some logs are not present!\n");
	$error = 1;
}

sub compare {
	my $needle = shift;
	$_ = shift;
	my @haystack = @$_;
	if($needle lt $haystack[0]) {
		return -1;
	}
	my $i = 0;
	foreach my $hay (@haystack) {
		if($needle eq $hay) {
			return $i;
		}
		$i++;
	}
	return $i;
}
sub min {
	my ($a,$b, $def_a, $def_b);
	$a = shift;
	$b = shift;
	$def_a = defined($a);
	$def_b = defined($b);
	if($def_a and not $def_b) {
		return $a;
	} 
	if(not $def_a and $def_b) {
		return $b;
	}
	if($def_a and $def_b) {
		if($a > $b) {
			return $b;
		} else {
			return $a;
		}
	}
	confess;
}

sub dprintf {
	my $s = shift;
	if($DEBUG == 1) {
		print STDERR $s;
	}
	return $s;
}

END {
	if($active_logs >= $WARN_MAX_LOGS || $error == 1) {
		print $msg_buffer if $msg_buffer;
		$msg_buffer = '';
	}
}