#!/usr/bin/perl
# low_level_make_sandbox
# The MySQL Sandbox
# Copyright (C) 2006-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 English qw( -no_match_vars );
use Data::Dumper;
use Getopt::Long qw(:config no_ignore_case );
use MySQL::Sandbox qw( find_safe_port_and_directory exists_in_path runs_as_root use_env sbinstr);
use MySQL::Sandbox::Scripts;
my $DEBUG = $MySQL::Sandbox::DEBUG;
#my $install_dir;
#$install_dir = $PROGRAM_NAME;
#$install_dir =~ s{/\w+(\.pl)?$}{};
my $msb = MySQL::Sandbox->new();
runs_as_root();
check_sandbox_dir();
check_tmp_dir();
my %scripts_in_code = %{ MySQL::Sandbox::Scripts::scripts_in_code() };
my $license_text = MySQL::Sandbox::Scripts::license_text();
$msb->parse_options(MySQL::Sandbox::Scripts::parse_options_low_level_make_sandbox());
# print Dumper $msb;exit;
# my %{$msb->{options}} = map { $_ , $msb->{parse_options}{$_}{'value'}} keys %{$msb->{parse_options}};
my %default_values = %{ $msb->{options}};
my %user_values;
#print Dumper \%{$msb->{options}}; exit;
GetOptions (
map { $msb->{parse_options}{$_}{parse}, \$msb->{options}{$_} }
grep { $msb->{parse_options}{$_}{parse}} keys %{$msb->{parse_options}}
) or $msb->get_help();
##
# DEPRECATED and removed
# (April fool's edition)
#if ( $msb->{options}{query_analyzer}) {
#my $QA = <<'ENDFISH';
# o
# o
#o
# o ___/|__
#o _/ \ /|
# o/ @ \\ \/ |
# \_ // /\ |
# \_______/ \|
#
#ENDFISH
#print $QA, "Thanks for having so much faith in my skills\n";
#exit 1;
#}
#
# We are not expecting bare arguments
#
if (@ARGV){
die "unexpected arguments <@ARGV>\n";
}
$msb->get_help() if $msb->{options}{'help'};
# print Dumper(\%{$msb->{options}}, \@ARGV); exit;
$msb->{options}{globaltmpdir} = $ENV{TMPDIR};
for my $opt (keys %{$msb->{options}} ) {
#unless (defined $default_values{$opt} and defined $msb->{options}{$opt} ) {
# print Data::Dumper->Dump([ $default_values{$opt},
# $msb->{options}{$opt}, $opt], ['default','option', 'opt']);
# die "undefined option\n";
#}
# next unless $default_values{$opt};
if ((not defined $default_values{$opt})
or ($default_values{$opt} ne $msb->{options}{$opt} )) {
$user_values{$opt} = $msb->{options}{$opt};
}
}
%default_values = ();
$msb->{options}{'my_clause'} = [] unless $msb->{options}{'my_clause'} ;
# print Dumper($msb->{options}{'my_clause'});exit;
if ( $msb->{options}{'high_performance'})
{
my @perf_clauses = (
'innodb-thread-concurrency=0',
'sync_binlog=0',
'innodb-log-buffer-size=50M',
'innodb-additional-mem-pool-size=50M',
'max-connections=350',
'max_allowed_packet=48M',
'innodb_buffer_pool_size=512M',
'innodb-log-file-size=50M',
'innodb-flush-method=O_DIRECT'
);
for my $clause (@perf_clauses)
{
unshift @{ $msb->{options}{'my_clause'}}, $clause;
}
}
if ($msb->{options}{'slaveof'} or $msb->{options}{'master'})
{
for my $clause (('log-bin=mysql-bin', 'server-id=' . $msb->{options}{sandbox_port} ))
{
unshift @{ $msb->{options}{'my_clause'}}, $clause;
}
}
if ($msb->{options}{'interactive'}) {
$msb->{options}{no_confirm} = 0;
select_interactively() if $msb->{options}{'interactive'};
}
$DEBUG = 1 if $msb->{options}{'verbose'};
$msb->{options}{'verbose'} = 1 if $DEBUG;
if ( -f "$ENV{'HOME'}/.msandboxrc") {
if ( $msb->{options}{'conf_file'}) {
# conf file given. Neet to concatenate default file and
# rc file
my $tmp_conf_file = "$ENV{TMPDIR}/msandboxrc.cnf";
my $result = system (qq( cat $ENV{'HOME'}/.msandboxrc $msb->{options}{'conf_file'} > $tmp_conf_file ));
if ($result) {
die "can't create $tmp_conf_file ($CHILD_ERROR)\n";
}
$msb->{options}{'conf_file'} = $tmp_conf_file;
}
else {
$msb->{options}{'conf_file'} = "$ENV{'HOME'}/.msandboxrc";
}
}
if ( $msb->{options}{'conf_file'}) {
open my $CONF, q{<}, $msb->{options}{'conf_file'}
or die "error opening $msb->{options}{'conf_file'}. ($ERRNO)\n";
print "reading configuration file ($msb->{options}{'conf_file'})\n" if $DEBUG;
while (<$CONF>) {
next if / ^ \s* $ /x;
next if / ^ \s* [#] /x;
chomp;
my ($key, $value);
if ( /^ \s* (\S+) \s* = \s* (.+)?/x) {
($key, $value) = ($1, $2);
}
elsif ( /^ \s* ( \S+ ) \s* $/x) {
($key, $value) = ($1, '');
next unless $msb->{parse_options}{$key};
# print "++ $msb->{parse_options}{$key}{'value'} \n";
if ($msb->{parse_options}{$key}{'value'} =~ /^\d+$/) {
$value = $msb->{parse_options}{$key}{'value'} ? 0 : 1 ;
}
}
else {
next;
}
# print ">>> $key ($value)\n";
if (exists $user_values{$key}) {
# skipping file options if they have been entered in the command line
# print "skipping option $key\n";
next;
}
elsif (exists $msb->{options}{$key} ) {
$value = q{} unless defined $value;
if ( $value =~ s/^\$//x ) {
$value = $ENV{$value};
}
if ( $msb->{parse_options}{ $key }{'parse'} =~ /\@/) {
$msb->{options}{ $key } = [ split /\s*;\s*/, $value ];
}
else {
# print "assigning <$key> = '$value'\n";
$msb->{options}{$key} = $value;
}
}
else {
die "Option '$key' not recognized - File $msb->{options}{'conf_file'} - Line $.\n";
}
}
close $CONF;
}
#
# options to skip from the imported my.cnf file
#
my %skip_options = (
'user' => 1,
'port' => 1,
'socket' => 1,
'datadir' => 1,
'basedir' => 1,
'tmpdir' => 1,
'pid-file' => 1,
'server-id' => 1,
);
#
# placeholders used in the installation files
# with their corresponding values in %{$msb->{options}}
#
my %replace_options = (
_INSTALL_VERSION_ => 'install_version',
_DBUSER_ => 'db_user',
_REMOTE_ACCESS_ => 'remote_access',
_DBUSERRO_ => 'ro_user',
_DBUSERRW_ => 'rw_user',
_DBUSERREPL_ => 'repl_user',
_DBPASSWORD_ => 'db_password',
_DB_REPL_PASSWORD_ => 'repl_password',
_OSUSER_ => 'operating_system_user',
_BASEDIR_ => 'basedir',
_TMPDIR_ => 'tmpdir',
_GLOBALTMPDIR_ => 'globaltmpdir',
_BINBASH_ => 'binbash',
_BINPERL_ => 'binperl',
_HOME_DIR_ => 'upper_directory',
_SANDBOXDIR_ => 'sandbox_directory',
_SERVERPORT_ => 'sandbox_port',
_MORE_OPTIONS_ => 'more_options',
_MYSQL_PROMPT_ => 'mysql_prompt',
_MYSQLDSAFE_ => 'mysqld_safe',
_EVENTS_OPTIONS_ => 'events_options',
);
if ($msb->{options}{db_user} =~ /\@/) {
my ($user, $host) = split /\@/, $msb->{options}{db_user};
$msb->{options}{db_user} = $user;
$msb->{options}{remote_access} = $host;
}
for my $opt (qw(db_user remote_access ro_user rw_user repl_user db_password repl_password)) {
if (defined $msb->{options}{$opt}) {
$MySQL::Sandbox::default_users{$opt} = $msb->{options}{$opt};
}
}
unless (
($msb->{options}{'sandbox_port'} =~ /^ \d{3,} $ /x)
&& ($msb->{options}{'sandbox_port'} > 1024 )
&& ($msb->{options}{'sandbox_port'} <= 64000)) {
$msb->get_help( "sandbox_port option must be a port number between 1025 and 64000 (currently requested $msb->{options}{'sandbox_port'} ) \n");
}
if ($msb->{options}{check_port} and (! $msb->{options}{no_check_port}) ) {
( $msb->{options}{'sandbox_port'},
$msb->{options}{'sandbox_directory'}) =
find_safe_port_and_directory(
$msb->{options}{'sandbox_port'},
$msb->{options}{'sandbox_directory'},
$msb->{options}{'upper_directory'}) ;
}
if ($msb->{options}{datadir_from} eq 'archive') {
print "You have chosen to install with the 'archive' method.\n";
print "This option is now DEPRECATED.\n";
print "It will be removed soon. Use the 'script' method instead\n";
#chdir $sandbox_directory;
#system "tar -xzf $curdir/datadir.$msb->{options}{'install_version'}.tar.gz ";
#chdir $curdir;
}
if ($msb->{options}{datadir_from} eq 'script' and (not $msb->{options}{no_load_grants} ) ) {
$msb->{options}{load_grants} = 1;
}
if ( @{ $msb->{options}{'my_clause'} } ) {
$msb->{options}{'more_options'} .= qq(#\n# additional options passed through 'my_clause' \n#\n);
for my $clause ( @{ $msb->{options}{'my_clause'} }) {
$msb->{options}{'more_options'} .= $clause . "\n";
}
}
if ($msb->{options}{my_file} ) {
my $fname = $msb->{options}{'my_file'};
unless ( -f $fname ) {
$fname = sprintf 'my-%s.cnf', $msb->{options}{my_file};
}
my $extended_fname = sprintf '%s/support-files/%s', $msb->{options}{basedir}, $fname;
my $share_extended_fname = sprintf '%s/share/mysql/%s', $msb->{options}{basedir}, $fname;
if ( -f $fname ) {
$msb->{options}{more_options} .= get_more_options($fname);
}
elsif ( -f $extended_fname ) {
$msb->{options}{more_options} .= get_more_options($extended_fname);
}
elsif ( -f $share_extended_fname ) {
$msb->{options}{more_options} .= get_more_options($share_extended_fname);
}
else {
die "configuration file $fname not found\n";
}
}
# print Dumper(\%{$msb->{options}}); exit;
my $bash = 'bash';
unless (exists_in_path($bash)) {
$bash = 'tcsh';
}
for my $cmd ( ($bash, 'tar', 'gzip') ) {
unless ( exists_in_path($cmd) ) {
die "$cmd not found. Can't continue\n";
}
}
my $bin_bash = `which $bash`; ## no critic
if ((! $bin_bash) or ( $bin_bash =~ /^no/i) ) {
die "can't find the 'bash' shell\n";
}
chomp $bin_bash;
$msb->{options}{'binbash'} = $bin_bash;
my $bin_perl = `which perl`; ## no critic
if ((! $bin_perl) or ( $bin_perl =~ /^no/i) ) {
die "can't find the 'perl' interpreter\n";
}
chomp $bin_perl;
$msb->{options}{'binperl'} = $bin_perl;
my @supported_versions = @{ MySQL::Sandbox::supported_versions() };
#$msb->{options}{'install_version'} = '5.0' unless $msb->{options}{'install_version'};
die "server version required.\n" unless $msb->{options}{'install_version'};
unless (grep {$_ eq $msb->{options}{'install_version'} } @supported_versions ) {
get_help( "specified version ($msb->{options}{'install_version'}) not allowed. Currently accepted are [@supported_versions] ");
}
#
#
#
# print "<<$msb->{options}{ 'install_version' }>>\n";
if ($msb->{options}{ 'install_version' } ge '5.5' ) {
$msb->{options}{events_options} = ' --events ';
}
else
{
$msb->{options}{events_options} = '';
}
if ($msb->{options}{ 'install_version' } eq '3.23' ) {
$msb->{options}{'mysql_prompt'} = q{};
$msb->{options}{'mysqld_safe'} = q{safe_mysqld};
}
else {
$msb->{options}{'mysql_prompt'} = q/prompt=/ . $msb->{options}{prompt_prefix} . $msb->{options}{prompt_body};
$msb->{options}{'mysql_prompt'} =~ s/'//g;
$msb->{options}{'mysql_prompt'} =~ s/=/='/;
$msb->{options}{'mysql_prompt'} .= "'";
$msb->{options}{'mysqld_safe'} = q{mysqld_safe};
}
if ( $msb->{options}{'sandbox_directory'} ) {
if ($msb->{options}{'sandbox_directory'} =~ m{/} ) {
die "<sandbox_directory> can't be a full path. "
. "It's only the name of the directory "
. "to create inside $msb->{options}{'upper_directory'}\n";
}
unless ( $msb->{options}{ 'no_ver_after_name' } ) {
my $ver = $msb->{options}{ 'install_version' };
# $ver =~ tr/./_/d; ## no critic
$ver =~ s/\./_/g;
unless ($msb->{options}{ 'sandbox_directory'} =~ /$ver$/) {
$msb->{options}{'sandbox_directory'} .= $ver;
$msb->{options}{ 'no_ver_after_name' } = 1; # 1.6 it will prevent
# side effects when loading
# options from defaults file
}
}
}
else {
get_help ('sandbox directory not specified');
}
print $msb->credits(),
"installing with the following parameters:\n";
#open my $CURRENT_CONF , q{>}, "$install_dir/current_options.conf"
# or die "error creating current_options.conf ($ERRNO)\n";
if ($msb->{options}{no_show}) {
$msb->{options}{no_confirm} =1;
}
unless ($msb->{options}{no_show}) {
for my $key (
sort { $msb->{parse_options}{$a}{so} <=> $msb->{parse_options}{$b}{so} }
grep { $msb->{parse_options}{$_}{parse}} keys %{$msb->{parse_options}} ) {
next if grep { $key eq $_ } qw/more_options help interactive conf_file no_confirm /;
my $is_array = ref($msb->{options}{$key}) && ref($msb->{options}{$key}) eq 'ARRAY';
printf "%-30s = %s\n", $key, $is_array ? join q{ ; },
@{ $msb->{options}{$key} } : ($msb->{options}{$key} || '');
next unless $msb->{options}{$key};
next if $msb->{options}{$key} =~ /^ \s* $/x;
}
}
my $answer = 'y';
unless ($msb->{options}{no_confirm}) {
print 'do you agree? ([Y],n) ';
$answer = <>;
chomp $answer;
if ($answer =~ / ^ \s* $ /x) {
$answer = 'y';
}
}
if (lc($answer) eq 'n') {
print "Installation interrupted at user's request\n";
# "To repeat this installation with the same options,\n"
# "use $PROGRAM_NAME --conf_file=current_options.conf\n";
exit;
}
my @file_list = ();
# my @doc_file_list = ( ['README'], ['COPYING'], ['VERSION'] );
my @MANIFEST = MySQL::Sandbox::Scripts::manifest();
#open my $MANIFEST, q{<}, "$install_dir/MANIFEST"
# or die "file MANIFEST not found\n";
my $install_section = 0;
print "reading MANIFEST files \n" if $DEBUG;
for my $filename ( @MANIFEST) {
chomp $filename;
next if $filename =~ /^ \s* $/x;
unless ($install_section) {
$install_section = 1 if $filename =~ /^ \s* [#] \s* INSTALL \s* FILES /x;
}
next if $filename =~ /^ \s* [#] /x;
print "($install_section) ", $filename, qq(\n) if $DEBUG;
my $destination = $filename;
if ( ( $scripts_in_code{$filename} ) ) {
unless ($install_section) {
push @file_list, [$filename, $destination];
}
}
else {
die "listed file $filename not found. Package is not complete\n"
}
}
# set_sandbox_dir_scripts();
my $sandbox_directory = sprintf('%s/%s', $msb->{options}{'upper_directory'}, $msb->{options}{'sandbox_directory'});
#if ($curdir eq $sandbox_directory) {
# die "installation directory and destination directory are the same. Can't install\n";
#}
if ( -d $sandbox_directory ) {
if ($msb->{options}{'force'} ) {
warn "$sandbox_directory already exists. Overwriting its contents\n" if $DEBUG;
if ( -f "$sandbox_directory/clear") {
system("$sandbox_directory/clear");
}
if ( -d "$sandbox_directory/data/mysql") {
system("rm -rf $sandbox_directory/data/mysql");
}
}
else {
die "$sandbox_directory already exists.\n'--force' option not specified.\nInstallation halted\n";
}
}
else {
print "creating $sandbox_directory\n" if $DEBUG;
my $result = mkdir $sandbox_directory;
if (! $result ) {
die "error creating $sandbox_directory\n";
}
}
my $sandbox_tmpdir = sprintf '%s/tmp', $sandbox_directory;
if ($msb->{options}{'tmpdir'}) {
$sandbox_tmpdir = $msb->{options}{'tmpdir'};
}
else {
$msb->{options}{'tmpdir'} = $sandbox_tmpdir;
}
if ( -f $sandbox_tmpdir) {
die "Can't create directory $sandbox_tmpdir (a file of the same name exists)\n";
}
unless (-d $sandbox_tmpdir) {
mkdir $sandbox_tmpdir
or die "Error creating $sandbox_tmpdir ($!)\n";
}
set_sandbox_dir_scripts();
for my $file_spec ( @file_list) { #, @doc_file_list) {
copy_and_replace($file_spec->[0], $sandbox_directory, $file_spec->[1]);
}
if ($msb->{options}{datadir_from} eq 'script' ) {
my $script = sprintf '%s/scripts/mysql_install_db', $msb->{options}{basedir} ;
unless ( -x $script ) {
if ( -e $script ) {
die "$script is not executable\n";
}
$script = sprintf '%s/bin/mysql_install_db', $msb->{options}{basedir} ;
}
if ( -x $script ) {
my $osx_options = '';
if ($OSNAME =~ /darwin/) {
$osx_options = '--lower_case_table_names=2';
}
my $additional_options ="$osx_options";
my $cmd = sprintf '%s --no-defaults --user=%s --basedir=%s --datadir=%s/data --tmpdir=%s/tmp',
$script,
$msb->{options}{operating_system_user},
$msb->{options}{basedir},
$sandbox_directory,
$sandbox_directory;
if ($DEBUG) {
print "$cmd $additional_options\n";
}
my $result = qx($cmd $additional_options 2>&1);
if (($CHILD_ERROR) or ($result && ($result =~ /\berror\b/i))) {
die "error while creating grant tables\n$result\n";
}
if ($DEBUG)
{
while ($result =~/(.*warning.*)/ig)
{
print "++ $1\n";
}
}
for my $table_name (qw(user db tables_priv columns_priv)) {
die "table $table_name not installed\n"
unless -f "$sandbox_directory/data/mysql/$table_name.frm";
}
for my $logfile (qw(ib_logfile0 ib_logfile1))
{
if ( -f "$sandbox_directory/data/$logfile")
{
unlink "$sandbox_directory/data/$logfile";
}
}
}
else {
if ( -e $script ) {
die "$script is not executable\n";
}
die "$script not found\n";
}
}
elsif ($msb->{options}{datadir_from} =~ /dir: (.+) /x ) {
my $origin = $1;
if (-d $origin ) {
if ( -f sprintf '%s/mysql/user.MYD', $origin) {
my $sandbox_datadir = sprintf '%s/data', $sandbox_directory;
if (-d $sandbox_datadir) {
if ($msb->{options}{'force'}) {
warn "directory $sandbox_datadir already exists. Overwriting its contents\n" if $DEBUG;
}
else {
die "directory $sandbox_datadir already exists. Option --force not specified. Installation halted\n"
}
}
else {
mkdir $sandbox_datadir
or die "error creating $sandbox_datadir ($!)\n";
}
system sprintf 'cp %s %s/* %s/', $msb->{options}{'verbose'} ? q{-vr} : q{-r}, $origin, $sandbox_datadir;
}
else {
die "mysql user table not found in $origin\n";
}
}
else {
die "directory $origin not found\n";
}
}
else {
die "unrecognized value for option 'datadir_from' ($msb->{options}{datadir_from})\n";
}
if ($msb->{options}{load_grants}) {
print "loading grants\n";
system "$sandbox_directory/start"
and die "can't start server\n";
# sleep command replaced by internal timeout in the "start" script
# sleep 3;
system "$sandbox_directory/load_grants"
and die "can't load grants\n";
if ($msb->{options}{master}) {
system "$sandbox_directory/use -e 'reset master'";
}
if ($msb->{options}{slaveof}) {
my $cmt = 'CHANGE MASTER TO ';
my %cmt_clauses = (
master_host => '127.0.0.1',
master_port => undef,
master_user => 'rsandbox',
master_password => 'rsandbox',
master_log_file => undef,
master_log_pos => undef,
);
my %apply_clauses = map { $_,$cmt_clauses{$_} } grep { $cmt_clauses{$_} } keys %cmt_clauses;
for my $clause ( keys %cmt_clauses) {
if ($msb->{options}{slaveof} =~ /$clause\s*=([^,]+)/i)
{
$apply_clauses{$clause}=$1;
}
}
my $count =0;
for my $clause (keys %apply_clauses) {
if ($count) {
$cmt .= ',';
}
else {
$count++;
}
$cmt .= ' ' . $clause . '=' . quote_clause($apply_clauses{$clause});
}
if ($apply_clauses{master_port}) {
system "$sandbox_directory/use -e '$cmt; start slave'";
}
}
if ($msb->{options}{no_run}) {
print "stopping server\n";
system "$sandbox_directory/stop"
and die "can't stop server\n";
}
}
print
# "installation options saved to current_options.conf.\n",
#"To repeat this installation with the same options,\n",
#"use $PROGRAM_NAME --conf_file=current_options.conf\n",
#('-' x 40), "\n",
"Your sandbox server was installed in ", use_env($sandbox_directory), "\n";
sbinstr( "sandbox installed in " . use_env($sandbox_directory));
sub quote_clause {
my ($string) = @_;
if ($string =~ /^\d+$/) {
return $string;
}
if ($string =~ /^["'].*['"]$/) {
return $string;
}
return qq("$string");
}
sub copy_and_replace {
my ($filename, $destination_dir, $destination_filename) = @_ ;
$destination_filename = $filename unless $destination_filename;
my $newname = sprintf('%s/%s', $destination_dir, $destination_filename);
#unless ( $scripts_in_code{$filename} ) {
# $scripts_in_code{$filename} = '';
# unless ( -f $filename) {
# $filename = "$install_dir/$filename";
# }
# open my $FROM, q{<}, $filename
# or die "error opening $filename ($ERRNO)\n";
# while (<$FROM>) {
# for my $key ( keys %replace_options) {
# s/ $key /$msb->{options}{$replace_options{$key}}/xg;
# }
# $scripts_in_code{$filename} .= $_ ;
# }
# close $FROM;
#}
open my $TO, q{>}, $newname
or die "error creating $newname ($ERRNO)\n";
print "copying $filename into $destination_dir\n" if $DEBUG;
my $script_content = $scripts_in_code{$filename}
or die "invalid script content for <$filename>\n";
$script_content =~ s/__LICENSE__/$license_text/;
my $SBINSTR_SH_TEXT = $MySQL::Sandbox::SBINSTR_SH_TEXT;
$script_content =~ s/__SBINSTR_SH__/$SBINSTR_SH_TEXT/;
for my $key ( keys %replace_options) {
my $new_value = $msb->{options}{$replace_options{$key}};
if ( ($key eq '_DBUSER_')
and ($destination_filename =~ /my\.sandbox.cnf/)) {
$new_value =~ s/\@.*//g;
}
unless (defined $new_value)
{
die "can't find a value for '$key'\n";
}
$script_content =~ s/ $key /$new_value/xg;
}
print $TO $script_content;
close $TO;
if ($newname =~ / \. (?: sh | pl ) $ /x) {
print "changing attributes to $newname\n" if $DEBUG;
chmod 0755, $newname; ## no critic
my $better_name = $newname;
$better_name =~ s/\.(?:sh|pl)$//;
rename $newname, $better_name;
}
return;
}
sub get_more_options {
my ($fname) = @_;
my $text = qq(#\n# additional options from $fname \n#\n);
open my $MYFILE, q{<}, $fname
or die "can't open $fname ($!)\n";
my $start = 0;
while (<$MYFILE>) {
if ($start ) {
last if m/ ^ \s* \[ /x;
my ($var) = m/^ \s* (\S+) \s* = /x;
next if ( $var && exists ($skip_options{$var} ));
$text .= $_;
}
else {
$start = m/ ^ \[mysqld\] /x;
}
}
close $MYFILE;
return $text;
}
sub select_interactively {
print "Enter the values for each option\n",
"* To leave the interactive choice and accept default values \n",
" for the remaining options, enter 'default'\n",
"* To go to the previous item, enter 'back'\n",
"* To quit the installation without any action, enter 'quit'\n\n";
my @options_list =
sort { $msb->{parse_options}{$a}{'so'} <=> $msb->{parse_options}{$b}{'so'} }
grep { $_ !~ /(?:interactive|help|no_check_port|no_load_grants)/}
grep { $msb->{parse_options}{$_}{'parse'}} keys %{$msb->{parse_options}} ;
my $opnum =0;
OPTION_CHOICE:
while( $opnum < @options_list ) {
my $op = $options_list[$opnum];
my $original_default = $msb->{options}{$op} ;
my $default = $original_default;
$default = $msb->{parse_options}{$op}{'value'} unless defined $default;
my $is_array = 0;
if (ref($default) && ref($default) eq 'ARRAY') {
$default = join(q{ ; } , @{$default});
$is_array=1;
}
my $chosen = q{};
my ($number_wanted) = $msb->{parse_options}{$op}{'parse'} =~ m/ = (i) /x;
print q{-} x 65;
print "\n$op\n";
my $text_items = $msb->{parse_options}{$op}{help};
for my $titem (@{$text_items}) {
print " $titem \n" if $titem;
}
print "Your choice: (current value [$default]) ";
if ($is_array) {
print "(You can enter multiple values separated by ';') ";
}
$chosen = <>;
chomp($chosen);
if ($chosen eq 'quit') {
exit;
}
elsif ($chosen eq 'back') {
$opnum--;
if ($opnum < 0 ) {
$opnum = 0;
}
redo OPTION_CHOICE;
}
elsif ($chosen eq 'default') {
last;
}
elsif ($chosen =~ m/ ^ \s* $ /x) {
$msb->{options}{$op} = $original_default;
}
elsif ($number_wanted) {
if ($chosen =~ m/ ^ \d+ $ /x ) {
$msb->{options}{$op} = $chosen;
}
else {
print q{*} x 65,
"\n" ,
"**** option $op requires a numeric value\n" ,
q{*} x 65,
"\n";
redo OPTION_CHOICE;
}
}
else {
if($is_array){
$msb->{options}{$op} = [ split /\s*;\s*/, $chosen ] ;
}
else {
$msb->{options}{$op} = $chosen;
}
}
$opnum++;
}
return;
}
sub check_sandbox_dir {
my $sandboxdir = $ENV{'SANDBOX_HOME'} || "$ENV{'HOME'}/sandboxes";
if (! -d $sandboxdir) {
mkdir $sandboxdir;
if ( $CHILD_ERROR) {
die ("can't set sandbox directory $sandboxdir ($CHILD_ERROR)\n");
}
}
}
sub check_tmp_dir {
my $tmpdir = $ENV{'TMPDIR'} || $ENV{'TEMPDIR'};
# print ">>$tmpdir\n";
if (! -d $tmpdir) {
die ("can't find tmp directory $tmpdir\n");
}
}
sub set_sandbox_dir_scripts {
my $sandboxdir = $ENV{'SANDBOX_HOME'}
or return;
if ( $ENV{'SANDBOX_HOME'} eq $ENV{'HOME'} ) {
return;
}
copy_and_replace('sandbox_action.pl', $sandboxdir);
copy_and_replace('plugin.conf', $sandboxdir);
for my $name (qw(start stop clear use send_kill restart status )) {
open my $FH, q{>}, "$sandboxdir/${name}_all"
or die "can't create ${name}_all in $sandboxdir\n";
print $FH "#!$msb->{options}{'binbash'}\n";
print $FH qq($sandboxdir/sandbox_action $name "\$\@"\n);
close $FH;
chmod 0755, "$sandboxdir/${name}_all";
}
}