#!/usr/bin/perl
#    The MySQL Sandbox
#    Copyright (C) 2009 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( 
                is_a_sandbox 
                is_sandbox_running
                get_sandbox_params 
                get_ports
                get_ranges
                get_option_file_contents 
                get_sb_info);

use MySQL::Sandbox::Scripts;


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',
#);

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;
}

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 "invalid value '$msb->{options}{$op}' for option <$op>\n";
            }
        }
    }
}

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 "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} ) {
            die "option <$opt> is incompatible with the requested operation (delete)\n";
        }
    }
    delete_sandbox( $msb->{options}{source_dir});
}
else {
    croak "unsupported operation ($msb->{options}{operation})\n";
}

sub get_help {
    my ($msg) = @_;
    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 "you must set the directory using the 'tree_dir' option\n";
    }
    unless ( -d $dir ) {
        croak "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 " master not defined in tree_nodes\n";
        } 
        if ($mid) {
            $msb->{options}{mid_nodes} = $mid;
        }
        else {
            croak " middle nodes not defined in tree_nodes\n";
        } 
        if ($leaf) {
            $msb->{options}{leaf_nodes} = $leaf;
        }
        else {
            croak " leaf nodes not defined in tree_nodes\n";
        } 
    
    }
    my @MID_NODES = split ' ', $msb->{options}{mid_nodes}
        or croak "no mid nodes selected. Use the --mid_nodes option\n"; 
    for my $mid (@MID_NODES) {
        croak "middle nodes must be numeric" unless $mid =~ /^\d+$/;
    }
    my @LEAF_NODES = ();
    
    my @chunks = split /\|/, $msb->{options}{leaf_nodes}
        or croak "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 "empty leaf node\n" unless @leaf;
        for my $ln (@leaf) {
            croak "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 "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 "node $node does not exist\n";
        }
    }

    my ($N1INFO, $N1PORT)=get_node_info($dir, $master);

    unless ($N1PORT) {
         croak "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=$N1PORT" >> $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); 
            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) = @_;
    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=$master_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 "Need a source directory (--source_dir)\n";
    }
    unless ($dest) {
        croak "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 "Source and destination directories must be absolute paths.\n"; 
    }
    unless ( -d $source )  {
        croak "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 "directory $source does not seem to be a sandbox\n";
    }
}

sub move_multiple_sandbox {
    my ($old_dir, $new_dir) = @_;
    unless ( -d $old_dir ) {
        croak " directory $old_dir doesn't exist\n";
    }
    if ( -d $new_dir ) {
        croak "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 "$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 "directory $od is not a sandbox created with version 2.0.15+\n";
        }
    }
    my $result = system "mv $old_dir $new_dir";
    if ($result) {
        croak "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 "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 " directory $old_dir doesn't exist\n";
        }
    }
    if ( -d $new_dir && (! $already_moved ) ) {
        croak "directory $new_dir already exists\n";
    }
    unless ( (-e "$old_dir/change_paths") 
             or ( $already_moved && -e "$new_dir/change_paths")  ) {
        croak   "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 "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 "new port must be numerical ($msb->{options}{new_port})\n";
        }
        if (($msb->{options}{new_port} <= 1024) or ( $msb->{options}{new_port} > 32000)) {
            croak   "new port out of range ($msb->{options}{new_port}) - "
                  . "it must be between 1025 and 32000\n";
        }
        unless ( -e "$new_dir/change_ports" ) {
            croak   "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 "sandbox in $sbdir is still running. Unable to stop it\n";
        }
    }
    else {
        croak "$sbdir does not seem to contain a sandbox\n";
    }
}

sub clone_sandbox_data {
    my ($source_dir, $dest_dir) = @_;
    croak "source directory missing\n" unless $source_dir;
    croak "destination directory missing\n" unless $dest_dir;
    $source_dir =~ s{/\s*$}{};
    unless (-d $source_dir) {
        croak "<$source_dir> is not a valid directory\n";
    }
    unless (-d $dest_dir) {
        croak "<$dest_dir> is not a valid directory\n";
    }
    # checking if it is a valid data directory
    unless (-d "$source_dir/mysql") {
        croak "<$source_dir> is not a valid data directory\n"
    }
    my @pids = glob( "$source_dir/*.pid" );
    if (@pids) {
        croak "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,
            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 "<$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 "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 "error copying file $!\n";
                    }
                }
                else {
                    croak "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 "option 'new_port' is not supported with 'copy'\n";
    }
    unless ( $source_dir) {
        croak " source directory missing\n";
    }
    unless ( -d $source_dir) {
        croak " <$source_dir> not found\n";
    }
    unless ( $dest_dir) {
        croak " destination directory missing\n";
    }
    unless ( -d $dest_dir) {
        croak " 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 "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 "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 "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 "Need a source directory (--source_dir)\n";
    }
    $source =~ s/^\s//;
    $source =~ s/\s*$//;
    $source =~ s/^\s*~/$ENV{HOME}/;
    unless ($source =~ m{^/} ) {
        croak "Source directory must be an absolute path.\n"; 
    }
    unless ( -d $source )  {
        croak "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 "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) {
        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) {
        die "error clearing sandbox at $source\n ($CHILD_ERROR - $OS_ERROR)";        
    }
    system("rm -rf $source");
    if ($CHILD_ERROR or $OS_ERROR) {
        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 "Need a source directory (--source_dir)\n";
    }
    $source =~ s/^\s//;
    $source =~ s/\s*$//;
    $source =~ s/^\s*~/$ENV{HOME}/;
    unless ($source =~ m{^/} ) {
        croak "Source directory must be an absolute path.\n"; 
    }
    unless ( -d $source )  {
        croak "directory $source does not exist\n";
    }
    if (( -e "$source/no_clear") or (-e "$source/no_clear_all" ) ) {
        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 "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 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 "Need a source directory (--source_dir)\n";
    }
    $source =~ s/^\s//;
    $source =~ s/\s*$//;
    $source =~ s/^\s*~/$ENV{HOME}/;
    unless ($source =~ m{^/} ) {
        croak "Source directory must be an absolute path.\n"; 
    }
    unless ( -d $source )  {
        croak "directory $source does not exist\n";
    }
    if (( ! -e "$source/no_clear") and (! -e "$source/no_clear_all" ) ) {
        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 "directory $source does not seem to be a sandbox\n";
    }
    my $new_clear = $old_clear;
    $new_clear =~ s/^no_//;
    unless (-f "$source/$new_clear") {
        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";
}


