#!/usr/bin/perl
# sbtool
# The MySQL Sandbox
# Copyright (C) 2009-2010 Giuseppe Maxia
# Contacts: http://datacharmer.org
#
# 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 of the License
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
use strict;
use warnings;
use Carp;
use English qw( -no_match_vars );
use Data::Dumper;
use Getopt::Long qw(:config no_ignore_case );
use File::Copy qw/cp/;
use File::Find;
use MySQL::Sandbox qw(
runs_as_root
is_a_sandbox
is_sandbox_running
get_sandbox_params
get_ports
get_ranges
get_option_file_contents
sbinstr
get_sb_info);
use MySQL::Sandbox::Scripts;
runs_as_root();
my $DEBUG = $MySQL::Sandbox::DEBUG;
my $sandbox_options_file = $MySQL::Sandbox::sandbox_options_file;
# my $sandbox_current_options = $MySQL::Sandbox::sandbox_current_options;
my %supported_operations = %MySQL::Sandbox::Scripts::sbtool_supported_operations;
# ports => 'lists ports used by the Sandbox',
# range => 'finds N consecutive ports not yet used by the Sandbox',
# info => 'returns configuration options from a Sandbox',
# tree => 'creates a replication tree',
# copy => 'copies data from one Sandbox to another',
# move => 'moves a Sandbox to a different location',
# port => 'Changes a Sandbox port',
# delete => 'removes a sandbox completely',
# preserve => 'makes a sandbox permanent',
# unpreserve => 'makes a sandbox not permanent',
# plugin => adds plugin support to a sandbox (innodb,semisynch)
#);
my %supported_formats = %MySQL::Sandbox::Scripts::sbtool_supported_formats;
# text => 'plain text dump of requested information',
# perl => 'fully structured information in Perl code',
#);
my $msb = MySQL::Sandbox->new();
$msb->parse_options(MySQL::Sandbox::Scripts::parse_options_sbtool());
# my %{$msb->{options}} = map { $_, $msb->{parse_options}{$_}{value} } keys %{$msb->{parse_options}};
GetOptions( map { $msb->{parse_options}{$_}{parse}, \$msb->{options}{$_} }
keys %{$msb->{parse_options}} )
or get_help();
get_help() if $msb->{options}{help} or ! $msb->{options}{operation};
if ($msb->{options}{verbose}) {
$DEBUG = $msb->{options}{verbose} unless $DEBUG;
}
sub croak_die {
my ($msg) = @_;
if ($DEBUG) {
croak $msg;
}
else {
die $msg;
}
}
for my $op ( keys %{$msb->{parse_options}} ) {
if ( $msb->{parse_options}{$op}{accepted} ) {
my %accepted = %{ $msb->{parse_options}{$op}{accepted} };
for my $ak ( keys %accepted ) {
unless ( exists $accepted{ $msb->{options}{$op} } ) {
croak_die "invalid value '$msb->{options}{$op}' for option <$op>\n";
}
}
}
}
sbinstr( ' operation ' . $msb->{options}{operation} );
for my $dir (qw(source_dir dest_dir tree_dir search_path)) {
if ($msb->{options}{$dir}) {
$msb->{options}{$dir} =~ s/^\s*~/$ENV{HOME}/;
}
}
if ( $msb->{options}{operation} eq 'ports' ) {
get_ports(\%{$msb->{options}});
}
elsif ( $msb->{options}{operation} eq 'info' ) {
$msb->{options}{all_info} = 1;
$msb->{options}{format} = 'perl';
get_ports(\%{$msb->{options}});
}
elsif ( $msb->{options}{operation} eq 'range' ) {
get_ranges(\%{$msb->{options}})
}
elsif ( $msb->{options}{operation} eq 'tree' ) {
make_tree($msb->{options}{tree_dir} )
}
elsif ( $msb->{options}{operation} eq 'move' ) {
move_sandbox( $msb->{options}{source_dir}, $msb->{options}{dest_dir} );
}
elsif ( $msb->{options}{operation} eq 'port' ) {
unless ($msb->{options}{new_port}) {
croak_die "operation 'port' requires new_port option\n";
}
move_sandbox( $msb->{options}{source_dir}, $msb->{options}{source_dir}, 'alreday_moved' );
}
elsif ( $msb->{options}{operation} eq 'copy' ) {
copy_single_sandbox( $msb->{options}{source_dir}, $msb->{options}{dest_dir} );
}
elsif ( $msb->{options}{operation} eq 'preserve' ) {
preserve_sandbox($msb->{options}{source_dir})
}
elsif ( $msb->{options}{operation} eq 'unpreserve' ) {
unpreserve_sandbox($msb->{options}{source_dir})
}
elsif ( $msb->{options}{operation} eq 'delete' ) {
for my $opt (qw(dest_dir new_port only_used all_info )) {
if ( $msb->{options}{$opt} ) {
croak_die "option <$opt> is incompatible with the requested operation (delete)\n";
}
}
delete_sandbox( $msb->{options}{source_dir});
}
elsif ($msb->{options}{operation} eq 'plugin') {
add_plugin(
$msb->{options}{source_dir},
$msb->{options}{plugin},
$msb->{options}{plugin_file}
);
}
else {
croak_die "unsupported operation ($msb->{options}{operation})\n";
}
sub get_help {
my ($msg) = @_;
print MySQL::Sandbox::credits();
if ($msg) {
print '*' x 50;
print "\n", $msg, "\n";
print '*' x 50;
print "\n";
}
print "usage: $PROGRAM_NAME [options] \n";
for my $op ( sort { $msb->{parse_options}{$a}{so} <=> $msb->{parse_options}{$b}{so} }
keys %{$msb->{parse_options}} )
{
my $val = $msb->{options}{$op};
my $parse = $msb->{parse_options}{$op}{parse};
my $expected = '-';
if ( $parse =~ s/=(.+)// ) {
$expected = $1;
}
my ( $short, $long ) = split /\|/, $parse;
unless ($long) {
$long = $short ;
$short = '';
}
printf "\t%s%-5s --%-15s (%s) <%s> - %s\n",
($short? '-' : ' '),
$short,
$long,
$expected,
$val || '',
$msb->{parse_options}{$op}{help} || '';
if ( $msb->{parse_options}{$op}{accepted} ) {
my %accepted = %{ $msb->{parse_options}{$op}{accepted} };
for my $ao ( keys %accepted ) {
printf "\t\t %-10s %s\n", "'$ao'", $accepted{$ao};
}
}
}
exit 1;
}
sub make_tree {
my ($dir) = @_;
unless ( $dir) {
croak_die "you must set the directory using the 'tree_dir' option\n";
}
unless ( -d $dir ) {
croak_die "directory ($dir) does not exist\n";
}
my $master = $msb->{options}{master_node} || 1;
if ($msb->{options}{tree_nodes} ) {
my ($m, $mid, $leaf) = split /-/, $msb->{options}{tree_nodes};
if ($m) {
$master = $m;
}
else {
croak_die " master not defined in tree_nodes\n";
}
if ($mid) {
$msb->{options}{mid_nodes} = $mid;
}
else {
croak_die " middle nodes not defined in tree_nodes\n";
}
if ($leaf) {
$msb->{options}{leaf_nodes} = $leaf;
}
else {
croak_die " leaf nodes not defined in tree_nodes\n";
}
}
my @MID_NODES = split ' ', $msb->{options}{mid_nodes}
or croak_die "no mid nodes selected. Use the --mid_nodes option\n";
for my $mid (@MID_NODES) {
croak_die "middle nodes must be numeric" unless $mid =~ /^\d+$/;
}
my @LEAF_NODES = ();
my @chunks = split /\|/, $msb->{options}{leaf_nodes}
or croak_die "no leaf nodes selected. Use the --leaf_nodes option\n";
# print Data::Dumper->Dump([\@chunks], ['chunks']);
for my $c (@chunks) {
my @leaf = split ' ', $c;
croak_die "empty leaf node\n" unless @leaf;
for my $ln (@leaf) {
croak_die "leaf nodes must be numeric" unless $ln =~ /^\d+$/;
}
push @LEAF_NODES, [@leaf];
}
# print Data::Dumper->Dump([\@MID_NODES], ['MID_NODES']);
# print Data::Dumper->Dump([\@LEAF_NODES], ['LEAF_NODES']);
if ( @LEAF_NODES != @MID_NODES) {
croak_die "you must specify at least one leaf node for each middle node\n";
}
for my $node (( $master, @MID_NODES, map {@$_} @LEAF_NODES)) {
if ( ! -d "$dir/node$node" ) {
croak_die "node $node does not exist\n";
}
}
my ($N1INFO, $N1PORT)=get_node_info($dir, $master);
unless ($N1PORT) {
croak_die "can't get the port for node$master\n"
. "make sure the node is running\n";
}
my $CHANGE_MASTER_Q= "CHANGE MASTER TO master_host='127.0.0.1', "
. "master_user='msandbox', master_password='msandbox',"
. "master_port=";
print "$dir/stop_all\n";
system "$dir/stop_all";
print "node $master is master\n";
unless ( -e $N1INFO->{opt}{socket}) {
system "$dir/node$master/start"
}
system qq(echo "$dir/use_all 'stop slave'" > $dir/clear_all);
system qq(echo "$dir/use_all 'stop slave'" > $dir/stop_all);
system qq(echo "" > $dir/send_kill_all);
system qq(echo "$dir/node$master/start" > $dir/start_all);
for my $mid_node ( @MID_NODES ) {
my ($MID_NODE_INFO, $MID_NODE_PORT)=get_node_info($dir, $mid_node);
unless ( -e $MID_NODE_INFO->{opt}{socket}) {
system "$dir/node$mid_node/start";
}
my $HAS_UPDATES=`grep log_slave_updates $dir/node$mid_node/my.sandbox.cnf`;
my $HAS_REPORT=`grep "report-host" $dir/node$mid_node/my.sandbox.cnf`;
unless ($HAS_REPORT) {
system qq( echo "report-host=node$mid_node" >> $dir/node$mid_node/my.sandbox.cnf) ;
system qq( echo "report-port=$MID_NODE_PORT" >> $dir/node$mid_node/my.sandbox.cnf) ;
}
unless ( $HAS_UPDATES) {
print "enabling node $mid_node to relay updates\n";
system qq(echo "log_slave_updates" >> $dir/node$mid_node/my.sandbox.cnf) ;
system qq($dir/node$mid_node/restart) ;
}
system qq($dir/n$mid_node -e "stop slave") ;
system qq($dir/n$mid_node -e "$CHANGE_MASTER_Q $N1PORT") ;
system qq($dir/n$mid_node -e "start slave") ;
print " node $mid_node is slave of node $master\n";
my $l_nodes = shift @LEAF_NODES;
system qq(echo "$dir/node$mid_node/start" >> $dir/start_all);
for my $leaf_node (@$l_nodes) {
my ($LEAF_NODE_INFO, $LN_PORT) = get_node_info($dir, $leaf_node);
unless ( -e $LEAF_NODE_INFO->{opt}{socket}) {
system "$dir/node$leaf_node/start";
}
check_report($dir,$leaf_node, 1, $MID_NODE_PORT, $LN_PORT);
system qq($dir/n$leaf_node -e "stop slave");
system qq($dir/n$leaf_node -e "$CHANGE_MASTER_Q $MID_NODE_PORT");
system qq($dir/n$leaf_node -e "start slave");
print " node $leaf_node is slave of node $mid_node\n";
system qq(echo "$dir/node$leaf_node/stop" >> $dir/stop_all);
system qq(echo "$dir/node$leaf_node/clear" >> $dir/clear_all);
system qq(echo "$dir/node$leaf_node/send_kill" >> $dir/send_kill_all);
system qq(echo "$dir/node$leaf_node/start" >> $dir/start_all);
}
system qq(echo "$dir/node$mid_node/stop" >> $dir/stop_all);
system qq(echo "$dir/node$mid_node/clear" >> $dir/clear_all);
system qq(echo "$dir/node$mid_node/send_kill" >> $dir/send_kill_all);
}
system qq(echo "$dir/node$master/stop" >> $dir/stop_all);
system qq(echo "$dir/node$master/clear" >> $dir/clear_all);
system qq(echo "$dir/node$master/send_kill" >> $dir/send_kill_all);
}
sub check_report {
my ($dir, $node, $restart, $master_port, $this_node_port) = @_;
my $HAS_REPORT=`grep "report-host" $dir/node$node/my.sandbox.cnf`;
unless ($HAS_REPORT) {
system qq(echo "report-host=node$node" >> $dir/node$node/my.sandbox.cnf);
system qq(echo "report-port=$this_node_port" >> $dir/node$node/my.sandbox.cnf);
if ($restart) {
system qq($dir/node$node/restart);
}
}
}
sub get_node_info {
my ($dir, $node) = @_;
my ( $info ) = get_sandbox_params("$dir/node$node");
# print Dumper($ports, $all_info);
confess "can't read port for node $node" unless $info;
return ($info, $info->{opt}{port});
}
sub move_sandbox {
my ($source, $dest) = @_;
unless ($source) {
croak_die "Need a source directory (--source_dir)\n";
}
unless ($dest) {
croak_die "Need a destination directory (--dest_dir)\n";
}
$dest =~ s/^\s//;
$dest =~ s/\s*$//;
$source =~ s/^\s//;
$source =~ s/\s*$//;
$source =~ s/^\s*~/$ENV{HOME}/;
$dest =~ s/^\s*~/$ENV{HOME}/;
unless (($source =~ m{^/}) && ($dest =~ m{^/}) ) {
croak_die "Source and destination directories must be absolute paths.\n";
}
unless ( -d $source ) {
croak_die "directory $source does not exist\n";
}
if ( -x "$source/start") {
if (( $source eq $dest) and $msb->{options}{new_port}) {
move_single_sandbox($source, $dest, "already_moved");
}
else {
move_single_sandbox($source, $dest);
}
}
elsif ( -x "$source/start_all") {
move_multiple_sandbox($source, $dest);
}
else {
croak_die "directory $source does not seem to be a sandbox\n";
}
}
sub move_multiple_sandbox {
my ($old_dir, $new_dir) = @_;
unless ( -d $old_dir ) {
croak_die " directory $old_dir doesn't exist\n";
}
if ( -d $new_dir ) {
croak_die "directory $new_dir already exists\n";
}
if ( -x "$old_dir/stop_all" ) {
system "$old_dir/stop_all";
my $timeout = 5;
while ( file_exists($old_dir, '\.pid$')) {
$timeout--;
sleep 1;
}
}
else {
croak_die "$old_dir does not seem to contain a multiple sandbox\n";
}
my @old_subdirs = grep { -d $_ } glob("$old_dir/*/");
for my $od (@old_subdirs) {
unless ( -x "$od/change_paths" ) {
croak_die "directory $od is not a sandbox created with version 2.0.15+\n";
}
}
my $result = system "mv $old_dir $new_dir";
if ($result) {
croak_die "unable to move sandbox $old_dir to $new_dir ($OS_ERROR)\n";
}
my @new_subdirs = ();
for my $od (@old_subdirs) {
my $nd = $od;
if (($nd =~ s/$old_dir/$new_dir/ ) && ( -d $nd )) {
push @new_subdirs, [$od, $nd];
}
else {
# reverting to old directory
system "mv $new_dir $old_dir";
croak_die "can't move directory $od to $nd\n";
}
}
for my $sd (@new_subdirs) {
move_single_sandbox( $sd->[0], $sd->[1], "already_moved" );
}
chdir $new_dir;
unless ($old_dir =~ m{/$} ) {
$old_dir .= '/';
}
unless ($new_dir =~ m{/$} ) {
$new_dir .= '/';
}
my @nodes = glob("n[0-9]*");
my @slaves = glob("s[0-9]*");
my @scripts = qw(m start_all stop_all clear_all send_kill_all
check_slaves use_all initialize_slaves);
for my $script (( @nodes, @slaves, @scripts ) ) {
if ( -x $script ) {
system q(perl -i.bak -pe 'BEGIN{$old=shift;$new=shift};s/$old/$new/g')
. " $old_dir $new_dir $script " ;
}
}
}
sub file_exists {
my ($dir,$pattern) = @_;
my $file_count =0;
find (
sub {
$file_count++ if $File::Find::name =~ /$pattern/;
},
$dir
);
return $file_count;
}
sub move_single_sandbox {
my ($old_dir, $new_dir, $already_moved) = @_;
unless ( $already_moved) {
unless ( -d $old_dir ) {
croak_die " directory $old_dir doesn't exist\n";
}
}
if ( -d $new_dir && (! $already_moved ) ) {
croak_die "directory $new_dir already exists\n";
}
unless ( (-e "$old_dir/change_paths")
or ( $already_moved && -e "$new_dir/change_paths") ) {
croak_die "script 'change_paths' not found. "
. "Please get it from any Sandbox installed with version 2.0.15+\n";
}
if ($already_moved) {
if (is_sandbox_running($new_dir)) {
stop_sandbox($new_dir);
}
}
else {
stop_sandbox($old_dir);
my $result = system qq(mv $old_dir $new_dir) ;
if ($result) {
croak_die "unable to move sandbox $old_dir to $new_dir ($OS_ERROR)\n";
}
}
chdir $new_dir;
unless ( $old_dir eq $new_dir) {
system "./change_paths $old_dir $new_dir";
}
if ($msb->{options}{new_port}) {
unless ($msb->{options}{new_port} =~ /^\d+$/) {
croak_die "new port must be numerical ($msb->{options}{new_port})\n";
}
if (($msb->{options}{new_port} <= 1024) or ( $msb->{options}{new_port} > 32000)) {
croak_die "new port out of range ($msb->{options}{new_port}) - "
. "it must be between 1025 and 32000\n";
}
unless ( -e "$new_dir/change_ports" ) {
croak_die "script 'change_ports' not found. "
. "Please get it from any Sandbox installed with version 2.0.18+\n";
}
system "./change_ports $msb->{options}{new_port}";
}
}
sub stop_sandbox {
my ($sbdir) = @_;
my ($info) = get_sandbox_params($sbdir);
if ( -x "$sbdir/stop" ) {
system "$sbdir/stop";
my $timeout = 5;
while ($timeout && ( -e $info->{opt}{socket} )) {
$timeout--;
sleep 1;
}
if ( -e $info->{opt}{socket} ) {
croak_die "sandbox in $sbdir is still running. Unable to stop it\n";
}
}
else {
croak_die "$sbdir does not seem to contain a sandbox\n";
}
}
sub clone_sandbox_data {
my ($source_dir, $dest_dir) = @_;
croak_die "source directory missing\n" unless $source_dir;
croak_die "destination directory missing\n" unless $dest_dir;
$source_dir =~ s{/\s*$}{};
unless (-d $source_dir) {
croak_die "<$source_dir> is not a valid directory\n";
}
unless (-d $dest_dir) {
croak_die "<$dest_dir> is not a valid directory\n";
}
# checking if it is a valid data directory
unless (-d "$source_dir/mysql") {
croak_die "<$source_dir> is not a valid data directory\n"
}
my @pids = glob( "$source_dir/*.pid" );
if (@pids) {
croak_die "it seems that your sandbox is running. Please stop it and try again\n";
}
my @skip_files = map {qr/$_/} (
'^relay-log\.info$',
'\.err$',
'-bin\.\d+$',
'-bin\.index$',
'-relay-bin\.\d+$',
'-relay-bin\.index+$',
);
find (
{
no_chdir => 1,
follow => 1,
wanted => sub {
my $dir = $File::Find::dir;
my $fname = $File::Find::name;
$dir =~ s{/$}{};
$dir =~ s{.*/}{};
$fname =~ s{.*/}{};
# print "<$File::Find::name><$File::Find::dir> [$dir] [$fname]\n";
return if $dir =~ /^\./;
return if $File::Find::name eq $source_dir;
for my $skip (@skip_files) {
return if $fname =~ $skip ;
}
if ( -d $File::Find::name ) {
if ( -d "$dest_dir/$fname" ) {
return;
}
elsif ( -f "$dest_dir/$fname" ) {
croak_die "<$dest_dir/$fname> already exists and it is not a directory\n";
}
print_debug( "creating $dest_dir/$fname\n");
my $result = mkdir "$dest_dir/$fname";
unless ($result) {
croak_die "error creating directory ($!)\n";
}
}
elsif ( -f $File::Find::name ) {
# print "$Find::File::dir eq $source_dir\n";
if ((! $File::Find::dir) or ($File::Find::dir eq $source_dir)) {
$dir = '';
}
print_debug( "$File::Find::name -> $dest_dir/$dir/$fname\n");
my $result = cp $File::Find::name, "$dest_dir/$dir/$fname";
unless ($result) {
croak_die "error copying file $!\n";
}
}
else {
croak_die "unhandled file $File::Find::name\n";
}
}
},
$source_dir
);
}
sub print_debug {
my ($msg, $level) = @_;
$level |= 1;
if ($DEBUG >= $level) {
print $msg;
}
}
sub copy_single_sandbox {
my ($source_dir, $dest_dir) = @_;
if ($msb->{options}{new_port}) {
croak_die "option 'new_port' is not supported with 'copy'\n";
}
unless ( $source_dir) {
croak_die " source directory missing\n";
}
unless ( -d $source_dir) {
croak_die " <$source_dir> not found\n";
}
unless ( $dest_dir) {
croak_die " destination directory missing\n";
}
unless ( -d $dest_dir) {
croak_die " destination directory <$dest_dir> not found\n";
}
my ($srunning, $ssboptions) = is_sandbox_running($source_dir);
my ($drunning, $dsboptions) = is_sandbox_running($dest_dir);
my ($source_version, $dest_version);
unless ($srunning) {
system "$source_dir/start";
unless ( -e $ssboptions->{opt}{'pid_file'} ) {
croak_die "unable to start source sandbox\n";
}
}
$source_version = `$source_dir/use -B -N -e "select version()"`;
system "$source_dir/stop";
if ( -e $ssboptions->{opt}{'pid_file'} ) {
system "$source_dir/send_kill";
}
unless ($drunning) {
system "$dest_dir/start";
unless ( -e $ssboptions->{opt}{'pid_file'} ) {
croak_die "unable to start destination sandbox\n";
}
}
$dest_version = `$dest_dir/use -B -N -e "select version()"`;
system "$dest_dir/stop";
if ( -e $dsboptions->{opt}{'pid_file'} ) {
system "$dest_dir/send_kill";
}
if (substr($source_version, 0,3) ne substr($dest_version,0,3)) {
croak_die "can't copy from $source_dir to $dest_dir. Not the same major version\n";
}
clone_sandbox_data( "$source_dir/data", "$dest_dir/data");
}
sub delete_sandbox {
my ($source) = @_;
unless ($source) {
croak_die "Need a source directory (--source_dir)\n";
}
$source =~ s/^\s//;
$source =~ s/\s*$//;
$source =~ s/^\s*~/$ENV{HOME}/;
unless ($source =~ m{^/} ) {
croak_die "Source directory must be an absolute path.\n";
}
unless ( -d $source ) {
croak_die "directory $source does not exist\n";
}
my $cmd1 = undef;
my $cmd2 = undef;
if (( -e "$source/no_clear" ) or ( -e "$source/no_clear_all")) {
print "<no_clear> script found.\nDirectory <$source> can't be deleted. It's a permanent sandbox.\n";
exit 0;
}
if ( (-x "$source/clear") && (-x "$source/stop" )) {
$cmd1 = "$source/stop";
$cmd2 = "$source/clear";
}
elsif ( (-x "$source/clear_all") && (-x "$source/stop_all")) {
$cmd1 = "$source/stop_all";
$cmd2 = "$source/clear_all";
}
else {
croak_die "directory $source does not seem to be a sandbox\n";
}
$OS_ERROR = undef;
$CHILD_ERROR = 0;
print "$cmd1\n" if $msb->{options}{verbose};
system($cmd1);
if ($CHILD_ERROR or $OS_ERROR) {
croak_die "error stopping sandbox at $source\n ($CHILD_ERROR - $OS_ERROR)";
}
print "$cmd2\n" if $msb->{options}{verbose};
system($cmd2);
if ($CHILD_ERROR or $OS_ERROR) {
croak_die "error clearing sandbox at $source\n ($CHILD_ERROR - $OS_ERROR)";
}
system("rm -rf $source");
if ($CHILD_ERROR or $OS_ERROR) {
croak_die "error deleting sandbox at $source\n ($CHILD_ERROR - $OS_ERROR)";
}
print "sandbox at <$source> has been removed\n";
}
sub preserve_sandbox {
my ($source) = @_;
unless ($source) {
croak_die "Need a source directory (--source_dir)\n";
}
$source =~ s/^\s//;
$source =~ s/\s*$//;
$source =~ s/^\s*~/$ENV{HOME}/;
unless ($source =~ m{^/} ) {
croak_die "Source directory must be an absolute path.\n";
}
unless ( -d $source ) {
croak_die "directory $source does not exist\n";
}
if (( -e "$source/no_clear") or (-e "$source/no_clear_all" ) ) {
croak_die "<no_clear> script found.\nDirectory <$source> is already a permanent sandbox.\n";
}
my $old_clear = undef;
if ( -x "$source/clear") {
$old_clear = 'clear';
}
elsif ( -x "$source/clear_all") {
$old_clear = 'clear_all';
}
else {
croak_die "directory $source does not seem to be a sandbox\n";
}
if ($old_clear eq "clear_all") {
my @dirs = grep { (-d $_) && ( -e "$_/clear" ) } glob("$source/*");
for my $dir (@dirs) {
preserve_sandbox($dir);
}
}
chdir $source;
rename $old_clear, "no_$old_clear";
open my $CLEAR, q{>}, $old_clear
or croak_die "can't create $old_clear";
print $CLEAR qq(echo "This sandbox is permanent."\n);
print $CLEAR qq(echo "The '$old_clear' command has been disabled."\n);
print $CLEAR qq(echo "The contents of the old '$old_clear' command are in the 'no_$old_clear' file"\n);
close $CLEAR;
chmod 0755, $old_clear;
chmod 0644, "no_$old_clear";
print "sandbox at <$source> is now permanent\n";
}
sub unpreserve_sandbox {
my ($source) = @_;
unless ($source) {
croak_die "Need a source directory (--source_dir)\n";
}
$source =~ s/^\s//;
$source =~ s/\s*$//;
$source =~ s/^\s*~/$ENV{HOME}/;
unless ($source =~ m{^/} ) {
croak_die "Source directory must be an absolute path.\n";
}
unless ( -d $source ) {
croak_die "directory $source does not exist\n";
}
if (( ! -e "$source/no_clear") and (! -e "$source/no_clear_all" ) ) {
croak_die "<no_clear> script not found.\nDirectory <$source> is not a permanent sandbox.\n";
}
my $old_clear = undef;
if ( -f "$source/no_clear") {
$old_clear = 'no_clear';
}
elsif ( -f "$source/no_clear_all") {
$old_clear = 'no_clear_all';
}
else {
croak_die "directory $source does not seem to be a sandbox\n";
}
my $new_clear = $old_clear;
$new_clear =~ s/^no_//;
unless (-f "$source/$new_clear") {
croak_die "Can't find the '$new_clear' script. This may not be a preserved sandbox.\n";
}
if ($old_clear eq "no_clear_all") {
my @dirs = grep { (-d $_) && ( -e "$_/no_clear" ) } glob("$source/*");
for my $dir (@dirs) {
unpreserve_sandbox($dir);
}
}
chdir $source;
system "rm -f $new_clear";
rename $old_clear, $new_clear;
chmod 0755, $new_clear;
print "sandbox at <$source> is now NOT PERMANENT\n";
}
#
# ---- Plugin
#
sub add_plugin {
my ($source_dir, $plugin, $plugin_file) = @_;
unless ($source_dir) {
croak_die "Need a source directory (--source_dir)\n";
}
unless ($plugin) {
croak_die "Need a plugin (--plugin)\n";
}
$plugin =~ s/^\s//;
$plugin =~ s/\s*$//;
$source_dir =~ s/^\s//;
$source_dir =~ s/\s*$//;
$source_dir =~ s/\/$//;
$source_dir =~ s/^\s*~/$ENV{HOME}/;
unless ( -d $source_dir ) {
croak_die "directory $source_dir does not exist\n";
}
if ( exist_all($source_dir, [qw(start stop restart use clear)]) ) {
add_plugin_single($source_dir, $plugin, $plugin_file);
}
elsif ( exist_all($source_dir, [
qw(start_all stop_all restart_all use_all clear_all)]) ) {
add_plugin_multiple($source_dir, $plugin, $plugin_file);
}
else {
croak_die "directory $source_dir does not seem to be a sandbox\n";
}
}
#
# Finds the plugin configuration file (or uses an explicit one)
#
# Gets the contents of the plugin configuration file
#
sub get_plugin_conf {
my ($directory, $plugin, $plugin_conf_file) = @_;
if ($plugin_conf_file) {
unless ( -f $plugin_conf_file) {
croak_die "could not find $plugin_conf_file \n";
}
}
else {
$plugin_conf_file = "$directory/plugin.conf";
unless ( -f $plugin_conf_file) {
$plugin_conf_file = "$ENV{'SANDBOX_HOME'}/plugin.conf";
}
unless ( -f $plugin_conf_file) {
croak_die "could not find plugin.conf "
. "in $directory or in $ENV{'SANDBOX_HOME'}\n";
}
}
our $plugin_definition;
open my $FH, '<', $plugin_conf_file
or croak_die "can't open $plugin_conf_file ($!)\n";
my $contents ='';
while (my $line = <$FH>) {
$contents .= $line;
}
close $FH;
eval $contents;
if ($@) {
croak_die "error processing plugin configuration file $plugin_conf_file\n"
. "$@\n";
}
unless (exists $plugin_definition->{$plugin}) {
croak_die "the required plugin ($plugin) was not found in the "
. "configuration file ($plugin_conf_file)\n";
}
unless (
ref($plugin_definition->{$plugin})
&&
(ref( $plugin_definition->{$plugin}) eq 'HASH'))
{
croak_die "the definition of plugin '$plugin' must be a hash ref\n";
}
return ($plugin_conf_file, $plugin_definition->{$plugin});
}
#
# Returns true if a given option is set in a hash.
# The option could be written with dashes ('-')
# or underscores ('_')
#
sub is_option_set {
my ($href, $value) = @_;
my $value1 = $value;
my $value2 = $value;
$value1 =~ s/[_-]/-/g;
$value2 =~ s/[_-]/_/g;
# print "<$value1> <$value2>\n";exit;
return (defined($href->{$value1}) or defined($href->{$value2})) ;
}
sub add_plugin_single {
my ($directory, $plugin, $plugin_conf_file) = @_;
my $is_slave = 0;
my $is_master = 0;
my $options_from_file = get_option_file_contents("$directory/my.sandbox.cnf");
# print Dumper $options_from_file;
#
# it is a slave if slave related options
# are found in the options file
#
if (($options_from_file->{prompt} =~ /slave/)
&&
is_option_set( $options_from_file, 'report-host')
)
{
$is_slave =1;
}
#
# covers circular replication where a slave can also be a master
#
if ($is_slave
&&
is_option_set($options_from_file, 'auto_increment_increment')
&&
is_option_set($options_from_file, 'auto_increment_offset')
&&
is_option_set($options_from_file, 'replicate-same-server-id')
&&
is_option_set($options_from_file, 'log-slave-updates')
)
{
$is_master = 1;
}
#
# The normal case: a master is such when its directory
# is called *master/ and there is a prompt named "master"
# something in its options file
#
elsif ( ( $directory =~ m{master/?} )
&&
( $options_from_file->{prompt} =~ /master/ )
)
{
$is_master =1;
}
my $plugin_conf;
#
# reads the plugin configuration file
#
($plugin_conf_file, $plugin_conf) = get_plugin_conf(
$directory,
$plugin,
$plugin_conf_file);
#
# Looks for plugin libraries inside the options
#
my %plugin_libs = ();
for my $mode (qw(all_servers master slave)) {
next unless defined $plugin_conf->{$mode};
for my $item (
qw(operation_sequence options_file sql_commands startup_file )) {
unless ($plugin_conf->{ $item }) {
$plugin_conf->{$item} = [];
}
unless (ref($plugin_conf->{$item}) eq 'ARRAY') {
croak_die "$item must be an array ref\n";
}
}
for my $line ( @{$plugin_conf->{$mode}{options_file}},
@{$plugin_conf->{$mode}{sql_commands}}) {
while ( $line =~ /([-\w]+\.so)/g ) {
$plugin_libs{ $1 }++;
}
}
}
#
# looks for the plugin directory
#
my $basedir = get_basedir($directory);
my $plugindir = "$basedir/lib/plugin";
unless ( -d $plugindir ) {
$plugindir = "$basedir/lib/mysql/plugin";
croak_die "could not find $plugindir\n" unless -d $plugindir;
}
#
# makes sure that the plugin libraries
# mentioned in the configuration file exist
#
for my $lib (keys %plugin_libs) {
unless ( -f "$plugindir/$lib" ) {
croak_die "could not find plugin '$lib' in $plugindir\n";
}
}
# All elements found. Now we can do the deed.
#
# Defines which installation modes to use
#
my @install_defs = ();
if ($plugin_conf->{'all_servers'}) {
push @install_defs, 'all_servers';
}
if ($is_master) {
push @install_defs, 'master';
}
if ($is_slave) {
push @install_defs, 'slave';
}
unless (@install_defs) {
croak_die "No installation instructions found\n"
. "You must define one or more of "
. "'all_servers', 'master', or 'slave'\n";
}
#
# Runs the installation parts
#
for my $inst_def (@install_defs) {
next unless defined $plugin_conf->{$inst_def};
my $opseq = $plugin_conf->{$inst_def}{operation_sequence};
# print Dumper $plugin_conf;exit;
#
# Makes sure that the plugin configuration
# contains a sequence of desired operations
#
unless ( defined $opseq ) {
croak_die "plugin definition in $plugin_conf_file "
. "($plugin, $inst_def) must "
. "contain 'operation_sequence'\n";
}
#
# Loops through the requested operations
#
for my $op (@$opseq) {
#
# If it is a script found in the sandbox, run it
#
if ( grep { $op eq $_} qw(start stop clear restart) ) {
my $result = system "$directory/$op";
croak_die "error executing $op\n" if $result;
}
#
# Runs an update of the options file
#
elsif ( $op eq 'options_file' ) {
#print "<<$plugindir>>\n";
update_options_file(
"$directory/my.sandbox.cnf",
'mysqld',
$plugin_conf->{$inst_def}{'options_file'},
$plugindir
);
}
#
# Creates a startup file
#
elsif ( $op eq 'startup_file' ) {
fill_startup_file(
"$directory/data/startup.sql",
$plugin_conf->{$inst_def}{'startup_file'}
);
}
#
# Runs a batch of SQL commands
#
elsif ( $op eq 'sql_commands' ) {
run_sql_commands ($directory,
$plugin_conf->{$inst_def}{'sql_commands'}
);
}
#
# Nothing else is recognized.
#
else {
croak_die "unrecognized command $op in operation_sequence\n";
}
}
}
}
sub run_sql_commands {
my ($directory, $queries) = @_;
unless ( -x "$directory/use" ) {
croak_die "can't execute sql queries in $directory "
. "('./use' script not found)\n";
}
my $tmp_file = "$directory/tmpqueries0";
while (-f $tmp_file) {
$tmp_file =~ s/(\d+)$/$1 + 1/e;
}
#
# Creates a temporary files, filled with queries
#
open my $FH, '>', $tmp_file
or croak_die "can't open $tmp_file";
my $semicolon_found = 0;
for my $query (@$queries) {
print $FH $query;
if ($query =~ /\s*;$/) {
$semicolon_found =1;
}
}
close $FH;
if ($semicolon_found) {
#
# Runs the queries
#
my $result = system "$directory/use -vv -e 'source $tmp_file' ";
unlink $tmp_file;
if ($result) {
croak_die "error running queries\n";
}
}
else {
unlink $tmp_file;
croak_die "Could not find any semicolon in the SQL list.\n"
. "Please add at least one semicolon at the end of the"
. " last line\n";
}
}
sub update_options_file {
my ( $fname, $section, $contents, $plugindir ) = @_;
# print "<<* $plugindir>>\n";
my @old_contents ;
unless (-f $fname) {
croak_die "can't find file $fname\n";
}
open my $FH, '<', $fname
or croak_die "can't open $fname\n";
@old_contents = <$FH>;
close $FH;
my $found_section = 0;
my $found_plugindir = 0;
#
# Checks for the wanted section to be updated
# And for already existing commands in the options file
#
for my $old_line (@old_contents) {
chomp $old_line;
if ($old_line =~ /\[$section\]/) {
$found_section =1;
}
for my $new_line (@$contents) {
chomp $new_line;
if ($old_line =~ /^\s*(plugin[_-]dir)\s*=\s*(.*)/) {
my $key = $1;
my $old_plugindir = $2;
$old_plugindir =~ s/\s*$//;
$old_plugindir =~ s/\/$//;
$plugindir =~ s/\s*$//;
$plugindir =~ s/\/$//;
if ($old_plugindir ne $plugindir) {
$old_line = "$key = $plugindir";
}
$found_plugindir = 1;
next;
}
if ($old_line eq $new_line) {
croak_die "option file already contains the line <$old_line>\n";
}
}
}
unless ($found_section) {
croak_die "could not find section [$section] in $fname\n";
}
rename $fname, "$fname.bak"
or croak_die "could not rename $fname to $fname.bak ($!)\n";
open $FH, '>', $fname
or croak_die "can't create $fname\n";
#
# If there was no plugin_dir in the old file
# the we add it to the new options
#
unless ($found_plugindir && $plugindir) {
unshift @$contents, "plugin_dir = $plugindir";
}
my $in_wanted_section = 0;
#
# Writes the updated options file
#
for my $old_line (@old_contents) {
if ($old_line =~ /^\s*\[$section\]/) {
$in_wanted_section =1;
}
#
# If a new section starts,
# the new options are inserted
#
elsif ($old_line =~ /^\s*\[/) {
if ($in_wanted_section) {
$in_wanted_section = 0;
insert_new_options ($FH, $contents);
}
}
print $FH $old_line, "\n";
}
#
# If we reached the end of the file without
# new sections, it means that we are still in the
# wanted section and we add the new options here.
if ($in_wanted_section) {
$in_wanted_section =0;
insert_new_options($FH, $contents);
}
close $FH;
}
sub insert_new_options {
my ($FH, $contents) = @_;
print $FH "#\n# Lines added on ", scalar(localtime), "\n#\n";
for my $nl (@$contents) {
print $FH $nl, "\n";
}
print $FH "#\n# --- END \n#\n";
}
sub fill_startup_file {
my ( $fname, $contents ) = @_;
my @old_contents ;
if (-f $fname) {
open my $FH, '<', $fname
or croak_die "can't open $fname\n";
@old_contents = <$FH>;
close $FH;
for my $old_line (@old_contents) {
chomp $old_line;
for my $new_line (@$contents) {
chomp $new_line;
if ($old_line eq $new_line) {
croak_die "startup file already contains the line <$old_line>\n";
}
}
}
rename $fname, "$fname.bak"
or croak_die "could not rename $fname to $fname.bak ($!)\n";
}
open my $FH, '>>', $fname
or croak_die "can't create $fname\n";
insert_new_options($FH, $contents);
close $FH;
}
sub add_plugin_multiple {
my ($directory, $plugin, $plugin_file) = @_;
my @dirs = grep { -d $_ } glob( "$directory/*/" ) ;
my $result = system "$directory/stop_all";
croak_die "error running stop_all in $directory\n" if $result;
for my $dir (@dirs) {
if ( exist_all($dir, [qw(start stop restart use clear)]) ) {
print "Installing <$plugin> in <$dir>\n";
add_plugin_single($dir, $plugin, $plugin_file);
}
else {
print STDERR "WARNING: directory $dir is not a sandbox\n";
}
}
}
sub get_basedir {
my ($dir) = @_;
unless ( -f "$dir/start" ) {
croak_die "can't find file 'start' in $dir\n";
}
open my $FH, '<', "$dir/start"
or croak_die "can't open $dir/start ($!)\n";
my $basedir = undef;
while ( (!$basedir) && (my $line =<$FH>)) {
chomp $line;
if ($line =~ /^BASEDIR=(\S+)/) {
$basedir = $1;
$basedir =~ s/^['" ]//;
$basedir =~ s{['"/ ]+$}{};
}
}
close $FH;
croak_die "could not find BASEDIR in $dir/start\n" unless $basedir;
return $basedir;
}
sub exist_all {
my ($directory, $files) = @_;
for my $file ( @$files ) {
unless ( -x "$directory/$file" ) {
return 0;
}
}
return 1;
}