bclone support all good now

This commit is contained in:
Zane C. B-H 2021-10-16 14:59:04 -05:00
parent 43a1868d59
commit ab39f72b75
3 changed files with 102 additions and 1 deletions

View File

@ -94,9 +94,30 @@ of seconds a lease for the VM name should last. The default is 30.
# the same thing, but with a 60 second lease time
vm 'freejname' => 'foo', lease_time => '60';
=head2 bhyve
=head2 bclone
This closnes a VM.
old - The VM to clone.
new - The name of the new VM.
checkstate - 0 do not check for VM online. Default is 1 - check
promote - Promotes clone to no longer be dependent from origin: 0 or 1.
Default is 0 (not promote). This means new new VM operates in
copy-on-write mode and will be promoted upon removal of the
original.
mac_reinit - 0,1 (default 1). 0 - leave old MAC.
1 set mac to re-generate
This will will die upon error.
vm 'bclone' old => 'foo', 'new' => 'bar';
=head3 bcreate
Creates a new VM.

View File

@ -0,0 +1,67 @@
#
# (c) Zane C. Bowers-Hadley <vvelox@vvelox.net>
#
package Rex::Virtualization::CBSD::bclone;
use strict;
use warnings;
our $VERSION = '0.0.1'; # VERSION
use Rex::Logger;
use Rex::Helper::Run;
use Term::ANSIColor qw(colorstrip);
sub execute {
my ( $class, %opts ) = @_;
# make sure we have the required keys
# and sane
my @required_keys = ( 'old', 'new' );
foreach my $key (@required_keys) {
if ( !defined( $opts{$key} ) ) {
die( 'Required key "' . $key . '" not defined' );
}
# make sure it does not contain any possible characters we don't want
if ( $opts{$key} =~ /[\t\ \=\\\/\'\"\n\;\&]/ ) {
die 'The variable "' . $key . '" matched /[\t\ \=\/\\\'\"\n\;\&]/, meaning it is not a valid variable name';
}
}
# the command to use
my $command = 'cbsd bclone old='.$opts{old}.' new='.$opts{new};
# make sure all the variables are sane
# and if set and sane add it
my @bool_vars = ( 'checkstate', 'promote', 'mac_reinit' );
foreach my $key (@bool_vars) {
# make sure that the it is either 0 or 1
if ( defined( $opts{$key} ) && ( $opts{$key} !~ /^[01]$/ ) ) {
die ( 'Key "'.$key.'" defined and is "'.$opts{key}.'", which does not match /^[01]$/' );
}
# if we get here it is sane and if defined, set it
if (defined( $opts{key} )) {
$command=$command.' '.$key.'='.$opts{$key};
}
}
Rex::Logger::debug( "Cloning CBSD VM via... " . $command );
my $returned = i_run( $command, fail_ok => 1 );
# the output is colorized
$returned = colorstrip($returned);
# test after no such as that will also exit non-zero
if ( $? != 0 ) {
die( "Error running '" . $command . "' returned... " . $returned );
}
return 1;
}
1;

View File

@ -0,0 +1,13 @@
#!perl
use 5.006;
use strict;
use warnings;
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Rex::Virtualization::CBSD::bclone' ) || print "Bail out!\n";
}
diag( "Testing Rex::Virtualization::CBSD::bclone $Rex::Virtualization::CBSD::bclone::VERSION, Perl $], $^X" );