mysql-sandbox 3.2.05-1 / usr / bin / sbtool

#!/usr/bin/perl
# sbtool
#    The MySQL Sandbox
#    Copyright (C) 2006-2016 Giuseppe Maxia
#
#    Licensed under the Apache License, Version 2.0 (the "License");
#    you may not use this file except in compliance with the License.
#    You may obtain a copy of the License at
#
#        http://www.apache.org/licenses/LICENSE-2.0
#
#    Unless required by applicable law or agreed to in writing, software
#    distributed under the License is distributed on an "AS IS" BASIS,
#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#    See the License for the specific language governing permissions and
#    limitations under the License.

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/use_all 'reset master'\n";
    system "$dir/use_all 'reset master'";
    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{/$}{};
    $ENV{SANDBOX_HOME} =~ s{/$}{};
    $source =~ s/^\s*~/$ENV{HOME}/;
    unless ($source =~ m{^/} ) {
        croak_die "Source directory must be an absolute path.\n";
    }
    if ($source eq $ENV{SANDBOX_HOME} ) {
        croak_die "Source directory must not be the whole sandbox home ($ENV{SANDBOX_HOME}.)\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;
    }

    $OS_ERROR       = undef;
    $CHILD_ERROR    = 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 {
        my @sandbox_subdirectories = grep { -d $_ } glob("$source/*");
        unless (@sandbox_subdirectories)
        {
            croak_die "Directory $source does not seem to be a sandbox\n";
        }
        print "# Incomplete sandbox found at <$source> - Attempting to remove subdirectories\n";
        for my $subdir (@sandbox_subdirectories)
        {
            print "# Deleting $subdir \n";
            delete_sandbox($subdir);
        }
        system("rm -rf $source");
        if ($CHILD_ERROR or $OS_ERROR)
        {
            croak_die "error deleting sandbox at $source\n ($CHILD_ERROR - $OS_ERROR)";
        }
        print "# Upper directory at <$source> has been removed \n";
        return ;
    }
    print "$cmd1\n" if $msb->{options}{verbose};
    $OS_ERROR       = undef;
    $CHILD_ERROR    = 0;
    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;
}