[Perl] Cloning a VMWare Server instance

[iago]

This program is specifically for cloning an instance of VMWare Server.  I wrote it this morning, because VWare Server doesn't offer any other way to clone a virtual machine. 

This isn't really a tutorial or reference, even though it demonstrates some file management stuff in Perl.  Thus, I renamed the forum to include "Examples", which I wanted to do anyways. 

Here's the code, and incidentally it's *nix, this won't run on Winders:

#!/usr/bin/perl -w

use strict;

print "\n\n\n";

my $fullpath = "/vmware/";
my $config = "/etc/vmware/vm-list-private";

my $name = shift;
my $newname = shift;
my $user = shift;
my $group = shift;

if(!$name)
{
    print "Name of VM to clone: ";
    $name = <>;
}

if(!$newname)
{
    print "Name of clone: ";
    $newname = <>;
}

if(!$user)
{
    print "Name of user [" . getlogin() . "]: ";
    $user = <>;
    if(!$user)
    {
        $user = getlogin();
    }
}

if(!$group)
{
    print "Name of group [users]: ";
    $group = <>;
    if(!$group)
    {
        $group = 'users';
    }
}

if( ! -d "$name" )
{
    die "Couldn't find the VM: $name\n\n";
}

if( -d "$newname" )
{
    die "VM instance already exists: $newname\n\n";
}

if( $newname =~ m/-/ )
{
    die "VM name cannot contain a dash (-)\n\n";
}

my @files;
push(@files, "$name/$name.vmx");
push(@files, "$name/$name.vmdk");
push(@files, "$name/$name-flat.vmdk");

foreach my $file (@files)
{
    print "Checking $file\n";
    if( ! -e $file)
    {
        die "Couldn't find required file: $file\n\n";
    }

    if( ! -r $file)
    {
        die "Couldn't read required file: $file\n\n";
    }

    if( -e "$file.WRITELOCK")
    {
        die "File is locked (close VMWare): $file\n\n";
    }
}

mkdir($newname);

print "All files exist, copying configuration...\n";
open(OLDCONFIG, "<$name/$name.vmx") || die "Couldn't open file $name/$name.vmx: $!\n\n";
open(NEWCONFIG, ">$newname/$newname.vmx") || die "Couldn't open file $newname/$newname.vmx: $!\n\n";
foreach my $line(<OLDCONFIG>)
{
    $line =~ s/$name/$newname/g;
    print NEWCONFIG $line;
}
close(NEWCONFIG);
close(OLDCONFIG);


print "Copying the base disk file...\n";
open(OLDDISK, "<$name/$name.vmdk") || die "Couldn't open file $name/$name.vmdk: $!\n\n";
open(NEWDISK, ">$newname/$newname.vmdk") || die "Couldn't open file $newname/$newname.vmdk: $!\n\n";
foreach my $line(<OLDDISK>)
{
    $line =~ s/$name/$newname/g;
    print NEWDISK $line;
}
close(NEWDISK);
close(OLDDISK);


print "Copying any other files that need to be copied....\n";
foreach my $file (@files)
{
    my $extension = $file;
    # Replace all characters before the final . or - in the final filename
    $extension =~ s/^.*\/.*?([.-])/$1/;

    if(! -e "$newname/$newname$extension")
    {
        print "$file\t->\t$newname/$newname$extension ...\n";

        `cp '$file' '$newname/$newname$extension'`;
    }
}

print "Setting permissions\n";
`chown -R $user.$group '$newname'`;
`chmod 0700 '$newname'`;
`chmod 0700 '$newname/$newname.vmx'`;

print "Backing up registration file, just in case..\n";
my $date = `date --iso-8601`;
`cp '$config' '$config.bak-$date'`;

print "Attempting to register...\n";
if(open(CONFIG, ">>$config"))
{
    print CONFIG "\nconfig '$fullpath$newname/$newname.vmx|$user'";
    close(CONFIG);
}
else
{
    print "Unable to open configuration file '$config'\n";
    print "$!\n\n";
    print "You will have to manually register your new VMWare machine.\n\n"
}