This commit is contained in:
Zane C. B-H 2024-01-14 18:24:04 -06:00
förälder 226a04f2c4
incheckning c9b45c2a4c
7 ändrade filer med 217 tillägg och 96 borttagningar

1
.perlcriticrc Normal file
Visa fil

@ -0,0 +1 @@
exclude = ProhibitExplicitReturnUndef ProhibitOneArgBless ProhibitStringyEval

29
.perltidyrc Normal file
Visa fil

@ -0,0 +1,29 @@
-l=120
-i=4
-ci=4
-st
-se
-et=4
#-aws
-xci
#-dws
-vt=0
-cti=0
-bt=1
-sbt=1
-bbt=0
-nsfs
-nolq
-ce
-csc
-csci=10
-csct=40
-cb
-iscl
-sbc
-nbbc
-wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="

Visa fil

@ -2,7 +2,7 @@ Changes
lib/VM/Libvirt/CloneHelper.pm
Makefile.PL
MANIFEST This list of files
README
README.md
t/00-load.t
t/manifest.t
t/pod-coverage.t

52
README
Visa fil

@ -1,52 +0,0 @@
VM-Libvirt-CloneHelper
Easily create a bunch of similar VMs from a single base VM
and IP them via DHCP based off of the MAC address assignmented
to the VM.
The basic work flow for this is like below.
delete
clone
start
wait a bit till they are all started
snapshot
stop
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc VM::Libvirt::CloneHelper
You can also look for information at:
RT, CPAN's request tracker (report bugs here)
https://rt.cpan.org/NoAuth/Bugs.html?Dist=VM-Libvirt-CloneHelper
CPAN Ratings
https://cpanratings.perl.org/d/VM-Libvirt-CloneHelper
Search CPAN
https://metacpan.org/release/VM-Libvirt-CloneHelper
LICENSE AND COPYRIGHT
This software is Copyright (c) 2022 by Zane C. Bowers-Hadley.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)

157
README.md Normal file
Visa fil

@ -0,0 +1,157 @@
# VM-Libvirt-CloneHelper
Create a bunch of cloned VMs in via libvirt.
## SYNOPSIS
```
clonehelper [-f <config>] [-n <name>] -a <action>
```
## DESCRIPTION
The basic work flow for this is like below.
```
delete
clone
start
wait a bit till they are all started
snapshot
shutdown
```
This can automatically be done via using the action recreate. If you
wish to do it for all, you likely want to use recreate_all.
A single VM may be acted upon via using the -n switch.
## SWITCHES
### -a action
The action to perform.
### -f config
The config to use.
### -n name
Act specifically on this VM instead of them all.
## ACTIONS
### list
Print a JSON dump of VMs, maps, and IPs.
### start
Start all the VM clones.
### stop
Stop all the VM clones.
### clone
Generate the VM clones.
### delete
Delete all the VM clones.
### net_xml
Generate the XML config and print it.
### net_redefine
Remove and re-add the network using the generated config.
### recreate
Recreate the VMs.
### recreate_all
Recreate the VMs, doing them one at a time.
### snapshot
Snapshot all the VM clones.
## CONFIG
The config format is a INI file.
The variable/value defaults are shown below.
```ini
net=default
# Name of the libvirt network in question.
blank_domains=/usr/local/etc/clonehelper/blank_domains
# List of domains to blank via setting 'dnsmasq:option value='address=/foo.bar/'.
# If not this file does not exist, it will be skipped.
net_head=/usr/local/etc/clonehelper/net_head
# The top part of the net XML config that that dnsmasq options will be
# sandwhiched between.
net_tail=/usr/local/etc/clonehelper/net_tail
# The bottom part of the net XML config that that dnsmasq options will
# be sandwhiched between.
windows_blank=1
# Blank commonly used MS domains. This is handy for reducing network noise
# when testing as well as making sure they any VMs don't do something like
# run updates when one does not want it to.
mac_base=00:08:74:2d:dd:
# Base to use for the MAC.
ipv4_base=192.168.1.
# Base to use for the IPs for adding static assignments.
start=100
# Where to start in set.
to_clone=baseVM
# The name of the VM to clone.
clone_name_base=cloneVM
# Base name to use for creating the clones. 'foo' will become 'foo$current', so
# for a start of 100, the first one would be 'foo100' and with a count of 10 the
# last will be 'foo109'.
count=10
# How many clones to create.
snapshot_name=clean
# The name to use for the snapshot.
wait=360
# How long to wait if auto-doing all.
```
## INSTALL
- File::Slurp
- Config::Tiny
Via CPANM
```shell
cpanm VM::Libvirt::CloneHelper
```
Via source...
```shell
perl Makefile.PL
make
make test
make install
```

Visa fil

@ -12,11 +12,11 @@ VM::Libvirt::CloneHelper - Create a bunch of cloned VMs in via libvirt.
=head1 VERSION
Version 0.1.0
Version 0.1.1
=cut
our $VERSION = '0.1.0';
our $VERSION = '0.1.1';
=head1 SYNOPSIS
@ -145,22 +145,19 @@ sub new {
{
die( '"' . $args{mac_base} . '" does not appear to be a valid base for a MAC address' );
}
}
elsif ( $key eq 'ipv4_base' ) {
} elsif ( $key eq 'ipv4_base' ) {
# make sure we have a likely sane base for the IPv4 address
if ( $args{ipv4_base} !~ /^[0-9]+\.[0-9]+\.[0-9]+\.$/ ) {
die( '"' . $args{ipv4_base} . '" does not appear to be a valid base for a IPv4 address' );
}
}
elsif ( $key eq 'to_clone' ) {
} elsif ( $key eq 'to_clone' ) {
# make sure we have a likely sane base VM name
if ( $args{to_clone} !~ /^[A-Za-z0-9\-\.]+$/ ) {
die( '"' . $args{to_clone} . '" does not appear to be a valid VM name' );
}
}
elsif ( $key eq 'clone_name_base' ) {
} elsif ( $key eq 'clone_name_base' ) {
# make sure we have a likely sane base name to use for creating clones
if ( $args{clone_name_base} !~ /^[A-Za-z0-9\-\.]+$/ ) {
@ -170,14 +167,14 @@ sub new {
# likely good, adding
$self->{$key} = $args{$key};
}
} ## end foreach my $key (@keys)
$self->{end} = $self->{start} + $self->{count} - 1;
$self->{VMs} = $self->vm_list;
return $self;
}
} ## end sub new
=head2 clone
@ -202,8 +199,7 @@ sub clone {
die( '"' . $VMs . '" is not a known VM' );
}
push( @VM_names, $name );
}
else {
} else {
@VM_names = sort( keys( %{$VMs} ) );
}
foreach my $name (@VM_names) {
@ -217,8 +213,8 @@ sub clone {
my @args = ( 'virt-clone', '-m', $VMs->{$name}{mac}, '-o', $self->{to_clone}, '--auto-clone', '-n', $name );
system(@args) == 0 or die("system '@args' failed... $?");
}
}
} ## end foreach my $name (@VM_names)
} ## end sub clone
=head2 delete_clones
@ -251,8 +247,7 @@ sub delete_clones {
die( '"' . $VMs . '" is not a known VM' );
}
push( @VM_names, $name );
}
else {
} else {
@VM_names = sort( keys( %{$VMs} ) );
}
foreach my $name (@VM_names) {
@ -266,8 +261,8 @@ sub delete_clones {
print "Unlinking " . $image . "\n";
unlink($image) or die( 'unlinking "' . $image . '" failed... ' . $! );
}
}
}
} ## end foreach my $name (@VM_names)
} ## end sub delete_clones
=head2 net_xml
@ -314,7 +309,7 @@ sub net_xml {
<dnsmasq:option value=\'address=/skype.com/\'/>
<dnsmasq:option value=\'address=/trafficmanager.net/\'/>
';
}
} ## end if ( $self->{windows_blank} )
if ( -f $self->{blank_domains} ) {
my $blank_raw = read_file( $self->{blank_domains} ) or die( 'Failed to read "' . $self->{blank_domains} . '"' );
@ -329,7 +324,7 @@ sub net_xml {
$xml = $xml . " <dnsmasq:option value='address=/" . $domain . "/'/>\n";
}
}
}
} ## end if ( -f $self->{blank_domains} )
my @VM_names = sort( keys( %{$VMs} ) );
foreach my $name (@VM_names) {
@ -341,7 +336,7 @@ sub net_xml {
}
return $xml . $xml_tail;
}
} ## end sub net_xml
=head2 net_redefine
@ -370,7 +365,7 @@ sub net_redefine {
unlink($tmp_file) or die( 'Failed to unlink net config "' . $tmp_file . '"... ' . $@ );
return;
}
} ## end sub net_redefine
=head2 recreate
@ -403,12 +398,12 @@ sub recreate {
$self->delete_clones($name);
$self->clone($name);
$self->start_clones($name);
sleep($self->{wait});
sleep( $self->{wait} );
$self->snapshot_clones($name);
$self->stop_clones($name);
return;
}
} ## end sub recreate
=head2 recreate_all
@ -430,13 +425,13 @@ sub recreate_all {
$self->delete_clones($name);
$self->clone($name);
$self->start_clones($name);
sleep($self->{wait});
sleep( $self->{wait} );
$self->snapshot_clones($name);
$self->stop_clones($name);
}
return;
}
} ## end sub recreate_all
=head2 snapshot_clones
@ -461,8 +456,7 @@ sub snapshot_clones {
die( '"' . $VMs . '" is not a known VM' );
}
push( @VM_names, $name );
}
else {
} else {
@VM_names = sort( keys( %{$VMs} ) );
}
foreach my $name (@VM_names) {
@ -470,7 +464,7 @@ sub snapshot_clones {
my @args = ( 'virsh', 'snapshot-create-as', '--name', $self->{snapshot_name}, $name );
system(@args) == 0 or die("system '@args' failed... $?");
}
}
} ## end sub snapshot_clones
=head2 start_clones
@ -495,8 +489,7 @@ sub start_clones {
die( '"' . $VMs . '" is not a known VM' );
}
push( @VM_names, $name );
}
else {
} else {
@VM_names = sort( keys( %{$VMs} ) );
}
foreach my $name (@VM_names) {
@ -504,7 +497,7 @@ sub start_clones {
my @args = ( 'virsh', 'start', $name );
system(@args) == 0 or die("system '@args' failed... $?");
}
}
} ## end sub start_clones
=head2 stop_clones
@ -530,8 +523,7 @@ sub stop_clones {
die( '"' . $VMs . '" is not a known VM' );
}
push( @VM_names, $name );
}
else {
} else {
@VM_names = sort( keys( %{$VMs} ) );
}
foreach my $name (@VM_names) {
@ -539,7 +531,7 @@ sub stop_clones {
my @args = ( 'virsh', 'destroy', $name );
system(@args) == 0 or warn("system '@args' failed... $?");
}
}
} ## end sub stop_clones
=head2 vm_list
@ -570,10 +562,10 @@ sub vm_list {
};
$current++;
}
} ## end while ( $current <= $till )
return $VMs;
}
} ## end sub vm_list
=head1 BLANKED MS DOMAINS
@ -631,10 +623,6 @@ You can also look for information at:
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=VM-Libvirt-CloneHelper>
=item * CPAN Ratings
L<https://cpanratings.perl.org/d/VM-Libvirt-CloneHelper>
=item * Search CPAN
L<https://metacpan.org/release/VM-Libvirt-CloneHelper>

Visa fil

@ -133,8 +133,6 @@ The variable/value defaults are shown below.
wait=360
# How long to wait if auto-doing all.
temp
=cut
use strict;