#!/usr/local/bin/perl

eval 'exec /usr/local/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# This is mysql-slave-delay, a program that makes a MySQL slave lag its master.
#
# This program is copyright (c) 2007 Sergey Zhuravlev and Baron Schwartz.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA  02111-1307  USA.

use strict;
use warnings FATAL => 'all';

use DBI;
use English qw(-no_match_vars);
use Getopt::Long;
use List::Util qw(max);
use Term::ReadKey;
use sigtrap qw(handler finish untrapped normal-signals);

our $VERSION = '1.0.1';
our $DISTRIB = '1053';
our $SVN_REV = sprintf("%d", q$Revision: 864 $ =~ m/(\d+)/g);

# Each cmdline arg is GetOpt::Long spec and human-readable description.
my @opt_spec = (
   { s => 'askpass',       d => 'Prompt for password for connections' },
   { s => 'continue|c!',   d => 'Continue replication normally on exit (default)' },
   { s => 'daemonize',     d => 'Fork to background and detach (POSIX only)' },
   { s => 'delay|d=s',     d => 'Slave delay (default 1h); suffix: s/m/h/d' },
   { s => 'help',          d => 'Show this help message' },
   { s => 'interval|i=s',  d => 'Sleep interval (default 1m); suffix: s/m/h/d' },
   { s => 'quiet|q',       d => 'Suppress normal output' },
   { s => 'time|t=s',      d => 'Time to run before exiting; suffix: s/m/h/d' },
   { s => 'usemaster|u',   d => 'Get binlog positions from master, not slave' },
   { s => 'version',       d => 'Output version information and exit' },
);

# This is the container for the command-line options' values to be stored in
# after processing.  Initial values are defaults.
my %opts = (
   c => 1,
   d => '1h',
   i => '1m',
);

my %opt_seen;
foreach my $spec (@opt_spec) {
   my ( $long, $short ) = $spec->{s} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
   $spec->{k} = $short || $long;
   $spec->{l} = $long;
   $spec->{t} = $short;
   $spec->{n} = $spec->{s} =~ m/!/;
   $opts{ $spec->{k} } = undef unless defined $opts{ $spec->{k} };
   die "Duplicate option $spec->{k}" if $opt_seen{ $spec->{k} }++;
}

Getopt::Long::Configure( 'no_ignore_case', 'bundling' );
GetOptions( map { $_->{s} => \$opts{ $_->{k} } } @opt_spec )
   or $opts{help} = 1;

if ( $opts{version} ) {
   print "mysql-slave-delay  Ver $VERSION Distrib $DISTRIB Changeset $SVN_REV\n";
   exit(0);
}

my %conn = (
   h => 'host',
   P => 'port',
   S => 'mysql_socket',
   u => 'user',
   p => 'pass',
   F => 'mysql_read_default_file',
   D => 'database',
);

my ($slave_dsn, $master_dsn);
if ( @ARGV ) {
   $slave_dsn  = parse_dsn(shift @ARGV);
   $master_dsn = parse_dsn(shift(@ARGV), $slave_dsn) if @ARGV;
}

if ( !$opts{help} ) {
   if ( !$slave_dsn ) {
      warn "Missing or invalid slave host\n";
      $opts{help} = 1;
   }

   if ( !$opts{help} ) {
      my ($num, $suf ) = $opts{d} =~ m/(\d+)([smhd])$/;
      if ( !defined $num || $num <= 0 ) {
         warn "Invalid --delay argument\n";
         $opts{help} = 1;
      }
      else {
         $opts{d} = $suf eq 's' ? $num            # Seconds
                  : $suf eq 'm' ? $num * 60       # Minutes
                  : $suf eq 'h' ? $num * 3600     # Hours
                  :               $num * 86400;   # Days
      }
   }

   if ( !$opts{help} ) {
      my ($num, $suf ) = $opts{i} =~ m/(\d+)([smhd])$/;
      if ( !defined $num || $num <= 0 ) {
         warn "Invalid --interval argument\n";
         $opts{help} = 1;
      }
      else {
         $opts{i} = $suf eq 's' ? $num           # Seconds
                  : $suf eq 'm' ? $num * 60      # Minutes
                  : $suf eq 'h' ? $num * 3600    # Hours
                  :               $num * 86400;  # Days
         $opts{i} = max($opts{i}, 1);
      }
   }

   if ( !$opts{help} && $opts{t} ) {
      my ($num, $suf ) = $opts{t} =~ m/(\d+)([smhd])$/;
      if ( !defined $num || $num <= 0 ) {
         warn "Invalid --time argument\n";
         $opts{help} = 1;
      }
      else {
         $opts{t} = $suf eq 's' ? $num           # Seconds
                  : $suf eq 'm' ? $num * 60      # Minutes
                  : $suf eq 'h' ? $num * 3600    # Hours
                  :               $num * 86400;  # Days
         $opts{t} = max($opts{t}, 1);
      }
   }
}

if ( $opts{help} ) {
   print "Usage: mysql-slave-delay [OPTION]... SLAVE-HOST [MASTER-HOST]\n\n";
   my $maxw = max( map { length( $_->{l} ) + ( $_->{n} ? 4 : 0 ) } @opt_spec );
   foreach my $spec ( sort { $a->{l} cmp $b->{l} } @opt_spec ) {
      my $long  = $spec->{n} ? "[no]$spec->{l}" : $spec->{l};
      my $short = $spec->{t} ? "-$spec->{t}"    : '';
      printf( "  --%-${maxw}s %-4s %s\n", $long, $short, $spec->{d} );
   }
   print <<USAGE;

mysql-slave-delay starts and stops a slave server as needed to make it lag
behind the master.  There is a special key=value,key=value syntax for
specifying how to connect to the slave (and optionally the master).  For more
information, please read the documentation:

   perldoc mysql-slave-delay

USAGE
   exit(0);
}

# ############################################################################
# Ready to work now.
# ############################################################################
my ( $TS, $FILE, $POS ) = ( 0, 1, 2 );

my @positions;
my $now        = time();
my $next_start = 0;
my $end        = $now + ( $opts{t} || 0 );    # When we should exit
my $oktorun    = 1;

# Connect before daemonizing, in case --askpass is needed.
my ( $slave, $master );
$slave  = get_dbh($slave_dsn);
if ( $master_dsn ) {
   $master = get_dbh($master_dsn);
}
elsif ( $opts{u} ) {
   # Try to connect to the slave's master just by looking at its SLAVE STATUS.
   my $status = $slave->selectrow_hashref("SHOW SLAVE STATUS");
   if ( !$status || ! %$status ) {
      die "No SLAVE STATUS found while trying to connect to master.\n";
   }

   my $spec = "h=$status->{master_host},P=$status->{master_port}";
   $master  = get_dbh(parse_dsn($spec, $slave_dsn));
}

# Daemonize only after (potentially) asking for passwords for --askpass.
if ( $opts{daemonize} ) {
   require POSIX;
   chdir '/'                 or die "Can't chdir to /: $OS_ERROR";
   open STDIN, '/dev/null'   or die "Can't read /dev/null: $OS_ERROR";
   open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $OS_ERROR";
   defined( my $pid = fork ) or die "Can't fork: $OS_ERROR";
   exit if $pid;
   POSIX::setsid()           or die "Can't start a new session: $OS_ERROR";
   open STDERR, '>&STDOUT'   or die "Can't dup STDOUT: $OS_ERROR";
}

while (                       # Quit if:
   (!$opts{t} || $now < $end) # time is exceeded
   && $oktorun                # or instructed to quit
) {

   $now = time();

   my $status = $slave->selectrow_hashref("SHOW SLAVE STATUS");
   if ( !$status || ! %$status ) {
      die "No SLAVE STATUS found.\n";
   }

   if ( defined $status->{seconds_behind_master} ) {
      info("slave running $status->{seconds_behind_master} seconds behind");
   }

   # Get binlog position.
   if ( $master ) {
      my $res = $master->selectrow_hashref("SHOW MASTER STATUS");
      my $pos = $positions[-1];
      if ( !@positions || $pos->[$FILE] ne $res->{file} || $pos->[$POS] != $res->{position} ) {
         push @positions,
            [ $now, $res->{file}, $res->{position} ];
      }
   }
   else {
      # Use the position on master at which the I/O thread is reading.  If the
      # I/O thread is not far behind, which it usually is not, this is basically
      # the same as the master's File/Position, but it's more efficient -- one
      # fewer connections to keep open.
      my $pos = $positions[-1];
      if ( !@positions
         || $pos->[$FILE] ne $status->{master_log_file} || $pos->[$POS] != $status->{read_master_log_pos} )
      {
         push @positions,
            [ $now, $status->{master_log_file}, $status->{read_master_log_pos} ];
      }
   }

   if ( ( $status->{slave_sql_running} || '' ) eq 'No' ) {
      # Find the most recent binlog position that's older than the delay amount.
      my $pos;
      my $i = 0;
      while ( $i < @positions && $positions[$i]->[$TS] <= $now - $opts{d} ) {
         $pos = $i;
         $i++;
      }

      # Make the slave server delay if possible; otherwise sleep and check
      # again.
      if ( $now >= $next_start && defined $pos ) {
         my $position = $positions[$pos];
         if ( $position->[$FILE] ne $status->{master_log_file}
            || $position->[$POS] != $status->{read_master_log_pos} )
         {
            $slave->do(
               "START SLAVE SQL_THREAD UNTIL /*$position->[$TS]*/ "
                  . "MASTER_LOG_FILE = '$position->[$FILE]', "
                  . "MASTER_LOG_POS = $position->[$POS]"
            );

            info("START SLAVE until master "
               . ts($position->[$TS])
               . " $position->[$FILE]/$position->[$POS]");
         }
         else {
            info("no new binlog events");
         }

         # Throw away positions we're going to replicate past.
         @positions = @positions[$pos + 1 .. $#positions];
      }
      else {
         my $position = $positions[-1];
         info("slave stopped at master position $position->[$FILE]/$position->[$POS]");
      }
   }
   elsif ( ($status->{seconds_behind_master} || 0) < $opts{d} ) {
      my $position = $positions[-1];
      my $behind = $status->{seconds_behind_master} || 0;
      $next_start = $now + $opts{d} - $behind;
      # TODO: under what conditions is something here undef?
      info("STOP SLAVE until "
         . ts($next_start)
         . " at master position $position->[$FILE]/$position->[$POS]");

      $slave->do("STOP SLAVE SQL_THREAD");
   }
   else {
      my $position = $positions[-1];
      my $behind = $status->{seconds_behind_master} || 0;
      info("slave running $behind seconds behind at"
         . " master position $position->[$FILE]/$position->[$POS]");
   }

   sleep($opts{i});
}

if ( $slave && $opts{c} ) {
   info("Setting slave to run normally");
   $slave->do("START SLAVE SQL_THREAD");
}

# ############################################################################
# Subroutines
# ############################################################################

sub info {
   my ( $message ) = @_;
   print ts($now), " ", $message, "\n" unless $opts{q};
}

# Catches signals so mysql-slave-delay can exit gracefully.
sub finish {
   my ($signal) = @_;
   print STDERR "Exiting on SIG$signal.\n";
   $oktorun = 0;
}

sub ts {
   my ( $time ) = @_;
   my ( $sec, $min, $hour, $mday, $mon, $year )
      = localtime($time);
   $mon  += 1;
   $year += 1900;
   return sprintf("%d-%02d-%02dT%02d:%02d:%02d",
      $year, $mon, $mday, $hour, $min, $sec);
}

sub parse_dsn {
   my ( $dsn, $prev ) = @_;
   return unless $dsn;
   $prev ||= {};

   my %vals;
   if ( $dsn =~ m/=/ ) {
      my %hash = map {m/^(.)=(.*)$/g} split( /,/, $dsn );
      %vals = map { $_ => $hash{$_} } keys %conn;
   }
   else {
      $vals{h} = $dsn;
   }
   map { $vals{$_} ||= $prev->{$_} } keys %conn;
   die "Missing host (h) part in $dsn\n" unless $vals{h};
   return \%vals;
}

sub get_dbh {
   my ( $info, $db ) = @_;

   if ( $opts{askpass} ) {
      print "Enter password for $info->{h}: ";
      ReadMode('noecho');
      chomp ($info->{p} = <STDIN>);
      ReadMode('normal');
      print "\n";
   }

   my $db_options = {
      RaiseError => 1,
      PrintError => 0,
      AutoCommit => 1,
   };

   $info->{D} ||= '';
   my $dsn = "DBI:mysql:$info->{D};host=$info->{h};"
      . join( ';',
      map     {"$conn{$_}=$info->{$_}"}
         grep { defined $info->{$_} } qw(F h P S) )
      . ';mysql_read_default_group=mysql';
   my $dbh = DBI->connect( $dsn, @{$info}{qw(u p)}, $db_options);
   $dbh->{FetchHashKeyName} = 'NAME_lc'; # Lowercases all column names for fetchrow_hashref
   $dbh->{InactiveDestroy}  = 1;         # Don't disconnect on fork
   return $dbh;
}

# ############################################################################
# Documentation.
# ############################################################################

=pod

=head1 NAME

mysql-slave-delay - Make a MySQL slave server lag behind its master.

=head1 SYNOPSIS

To hold slavehost one minute behind its master for ten minutes:

 mysql-slave-delay --delay 1m --interval 15s --time 10m slavehost

=head1 DESCRIPTION

MySQL Slave Delay watches a slave and starts and stops its replication SQL
thread as necessary to hold it at least as far behind the master as you
request.  In practice, it will typically cause the slave to lag between
L<"--delay"> and L<"--delay">+L<"--interval"> behind the master.

It bases the delay on binlog positions in the slave's relay logs by default,
so there is no need to connect to the master.  This works well if the IO
thread doesn't lag the master much, which is typical in most replication
setups; the IO thread lag is usually milliseconds on a fast network.  If your
IO thread's lag is too large for your purposes, MySQL Slave Delay can also
connect to the master for information about binlog positions.

Note that since MySQL Slave Delay starts and stops the SQL thread, monitoring
systems may think the slave is having trouble when it's just being held back
intentionally.

There is a special syntax for connecting to MySQL servers.  Each server name
on the command line can be either just a hostname, or a key=value,key=value
string.  Keys are a single letter:

   KEY MEANING
   === =======
   h   Connect to host
   P   Port number to use for connection
   S   Socket file to use for connection
   u   User for login if not current user
   p   Password to use when connecting
   F   Only read default options from the given file

If you omit any values in MASTER-HOST, they are filled in with defaults from
SLAVE-HOST, so you don't need to specify them in both places.  MySQL Slave
Delay reads all normal MySQL option files, such as ~/.my.cnf, so you may not
need to specify username, password and other common options at all.

MySQL Slave Delay tries to exit gracefully by trapping signals such as Ctrl-C.
You cannot bypass L<"--continue"> with a trappable signal.

=head1 OPTIONS

Some options are negatable by specifying them in their long form with a --no
prefix.

Some options have a special suffix syntax.  These options accept a number
suffixed with s, m, h, or d.  The suffixes mean seconds, minutes, hours and
days respectively.

=over

=item --askpass

Prompts the user for a password when connecting to MySQL.

=item --continue

After exiting, restart the slave's SQL thread with no UNTIL condition, so it
will run as usual and catch up to the master.  This is enabled by default and
works even if you terminate MySQL Slave Delay with Control-C.

=item --daemonize

Fork to the background and detach from the shell.  This probably doesn't work
on Microsoft Windows.

=item --delay

How far the slave should lag its master.  This value is a number with a
suffix; see above for suffix syntax.

=item --help

Displays a help message.

=item --interval

How frequently MySQL Slave Delay should check whether the slave needs to be
started or stopped.  See above for suffix syntax.

=item --quiet

Do not output regular status messages.

=item --time

How long MySQL Slave Delay should run before exiting.  Default is to run
forever.  See above for suffix syntax.

=item --usemaster

Don't trust the binlog positions in the slave's relay log.  Connect to the
master and get binlog positions instead.  If you specify this option without
giving a MASTER-HOST on the command line, MySQL Slave Delay examines the
slave's SHOW SLAVE STATUS to determine the hostname and port for connecting to
the master.

MySQL Slave Delay only uses the MASTER_HOST and MASTER_PORT values from SHOW
SLAVE STATUS for the master connection.  It does not use the MASTER_USER
value.  If you want to specify a different username for the master than the
one you use to connect to the slave, you should specify the MASTER-HOST option
explicitly on the command line.

=item --version

Output version information and exit.

=back

=head1 SYSTEM REQUIREMENTS

You need Perl, DBI, DBD::mysql, and some core packages that ought to be
installed in any reasonably new version of Perl.

=head1 OUTPUT

If you specify L<"--quiet">, there is no output.  Otherwise, the normal output
is a status message consisting of a timestamp and information about what MySQL
Slave Delay is doing: starting the slave, stopping the slave, or just
observing.

=head1 BUGS

Please use the Sourceforge bug tracker, forums, and mailing lists to request
support or report bugs: L<http://sourceforge.net/projects/mysqltoolkit/>.

=head1 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright (c) 2007 Sergey Zhuravlev and Baron Schwartz.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.

=head1 AUTHOR

Sergey Zhuravlev and Baron Schwartz.

=head1 VERSION

This manual page documents Ver 1.0.1 Distrib 1053 $Revision: 864 $.

=cut