When I first started Joot I used LVM rather than QCOW for backing files.

gistfile2.txt

LVM.pm

package Joot;

use strict;
use warnings;

use IPC::Cmd;
use LWP::Simple;
use Log::Log4perl qw(:easy);
use YAML::Tiny; 

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $args  = shift || {};

    # initialize logging if it's not already
    my $level = $args->{verbose} ? $DEBUG : $INFO;
    if ( Log::Log4perl->initialized() ) {
        get_logger()->level($level);
    }
    else {
        Log::Log4perl->easy_init($level);
    }
    $IPC::Cmd::VERBOSE = $args->{verbose};

    # determine which config file we're going to read in
    if ( !$args->{config_file} || !-r $args->{config_file} ) {
        $args->{config_file} = ( -r "$ENV{HOME}/.joot" ) ? "$ENV{HOME}/.joot" : "/etc/joot.cfg";
    }

    my $self = bless $args, $class;
    $self->{joot_home} = $self->config("joot_home", "/var/joot");

    $self->create_joot_vg();
    return $self;
}

# return false if there is not JOOT volume group
# otherwise, return the directory that contains joot_disk
sub get_current_joot_home {
    my $self = shift;

    # return if we've already setup the JOOT volume group
    my $pvs_out = $self->run( _bin('sudo'), _bin('pvs'), '-o', 'pv_name,vg_name', '--noheadings' );

    foreach ( split "\n", $pvs_out ) {

        # /dev/loop0 JOOT
        m/(\S+)\s+(\S+)/;
        my $pv_name = $1;
        my $vg_name = $2;
        if ( $vg_name && $vg_name eq "JOOT" ) {
            my $lo_out = $self->run( _bin('sudo'), _bin('losetup'), $pv_name );

            # /dev/loop0: [0802]:14548994 (/mnt/joot/joot_disk)
            $lo_out =~ m#\((.*?)/joot_disk\)#;
            return $1;
        }
    }

    # return false; JOOT volume doesn't exist yet
    return;
}

# verify that the joot vg has been correctly initialized
# if this is the first time we've has been run, we'll set everything up
sub create_joot_vg {
    my $self = shift;

    my $joot_home = $self->{joot_home};

    DEBUG("initializing $joot_home");
    die "joot_home $joot_home doesn't exist\n" if ( !-d $joot_home );

    # return if we're already initialized
    if ( my $current_home = $self->get_current_joot_home() ) { 
        if ( $current_home ne $joot_home ) {
            die "JOOT volume already exists at $current_home; can't move to $joot_home\n.  Try \"joot --purgeall\"";
        }
        return;
    }

    my $disk = "$joot_home/joot_disk";
    DEBUG("creating JOOT volume group backed by $disk");

    # create a 1 terabyte sparse file which will be our block based LVM volume
    # TODO how did we settle on 1T for size of disk? 
    $self->run( _bin("sudo"), _bin("dd"), "if=/dev/zero", "of=$disk", qw(bs=1 count=1 seek=1T) );

    # create loop back device
    $self->run( _bin("sudo"), _bin("losetup"), '-f', "$disk" );

    # determine the path of the loop back device we just created
    my $losetup_out = $self->run( _bin("sudo"), _bin("losetup"), '-j', "$disk" );
    $losetup_out =~ m#^([^:]+):#;
    my $lo_dev = $1;

    # create the joot volume based on that device
    if ( !$lo_dev || !-b $lo_dev ) {
        die "\"losetup -j $disk\" didn't return a block device\n";
    }
    $self->run( _bin("sudo"), _bin("vgcreate"), 'JOOT', "$lo_dev" );

}

sub _bin {
    my $prog = shift;
    
    # use this search path.  die if $prog isn't in one of these dirs
    my @paths = qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin);
    foreach my $path ( @paths ) { 
        if ( -x "$path/$prog" ) {
            return "$path/$prog";
        }
    }

    die "couldn't find $prog in " . join( ":", @paths);
}

sub run {
    my $self = shift;
    my @args = @_;

    my $cmd = join( " ", @args );
    my ( $success, $err, $full_buf, $stdout_buf, $stderr_buf ) = IPC::Cmd::run( command => \@args );

    if ( !$success ) {
        FATAL "Error executing $cmd";
        if ($full_buf) {
            FATAL join( "", @{$full_buf} );
        }
        die "$err\n";
    }

    return join( "", @{$stdout_buf} );
}

# two ways to call config:
# my $cfg = $self->config();
# print "foo setting is " . $cfg->{foo};
# or
# print "foo setting is " . $self->config( "foo", "foo_default" );
# default is optional (will die if setting is missing)
sub config { 
    my $self    = shift;
    my $field   = shift;
    my $default = shift;

    # read in the config file, parse it and store it in the object
    # only do this once
    if ( !$self->{config} ) {
        DEBUG("Reading config file " . $self->{config_file} );
        $self->{config} = YAML::Tiny::LoadFile( $self->{config_file} );
    }

    # if the user requests a field, send back the value (or the default)
    # otherwise, give them the whole hash reference
    if ( defined $field ) {
        if ( exists $self->{config}->{$field} ) {
            return $self->{config}->{$field};
        }
        elsif ( defined $default ) {
            return $default;
        }
        else {
            die "Config file is missing required setting \"$field\"\n";
        }
    }

    return $self->{config};
}

sub chroot {
    my $self = shift;
    my $joot_name = shift || die "missing joot name to chroot into\n";

    die "not implemented";
}


sub install_image {
    my $self = shift;
    my $image_url = shift;
    my $image_name = shift;

    my $images = $self->images();
    if ( $images->{$image_name} ) { 
        WARN "tried to install an image that is already installed";
        return;
    }

    # TODO fetch image and untar it into $tmpfile
    # should I use curl (progress meter is nice) or LWP::Simple (part of perl base)
    my $tmpfile = "/tmp/lucid.tar";

    my $joot_home = $self->{joot_home};
    DEBUG("creating and mounting a logic volume to install $image_name into");

    # XXX how big?
    $self->run( _bin("sudo"), _bin("lvcreate"), qw(-L 1G -n), "image_$image_name", "JOOT" );
    $self->run( _bin("sudo"), _bin("mkfs.ext3"), "/dev/JOOT/image_$image_name" );
    $self->run( _bin("sudo"), _bin("mkdir"), "-p", "$joot_home/images/$image_name" );
    $self->run( _bin("sudo"), _bin("mount"), "/dev/JOOT/image_$image_name", "$joot_home/images/$image_name" );
    $self->run( _bin("sudo"), _bin("tar"), "xf", $tmpfile, "-C", "$joot_home/images/$image_name" );
    $self->run( _bin("sudo"), _bin("umount"), "/dev/JOOT/image_$image_name" );

    #TODO resize the lv to a bit larger than the space it takes?
    #XXX
    #unlink $tmpfile;
}

sub create {
    my $self      = shift;
    my $joot_name = shift or die "missing joot name to create\n";
    my $image_name     = shift;

    my $joots = $self->list();
    if ( $joots->{$joot_name} ) { 
        die "$joot_name already exists.\n";
    }

    #TODO default image name
    die "missing image name for create" if !$image_name;

    my $images = $self->images();
    if ( !exists $images->{$image_name} ) {
        die "\"$image_name\" is an invalid image name\n";
    } 

    # download and install it if it's not already installed
    if ( !$images->{$image_name} ) {

        # TODO
        $self->install_image( "XXX", "Ubuntu-10.04" );
    }

    DEBUG "snapshotting lvm logical volume to create a new joot";

    my $joot_home = $self->{joot_home};

    # TODO make the default size configurable
    $self->run( _bin("sudo"), _bin("lvcreate"), qw(-s -n), "joot_$joot_name", qw(-L 1G), "/dev/JOOT/image_$image_name" );
    $self->run( _bin("sudo"), _bin("mkdir"), "-p", "$joot_home/joots/$joot_name" );
    $self->run( _bin("sudo"), _bin("mount"), "/dev/JOOT/joot_$joot_name", "$joot_home/joots/$joot_name" );
}

sub images {
    my $self = shift;

    my $lvs = $self->lvs();
    return $lvs->{image};
}

sub list {
    my $self = shift;

    my $lvs = $self->lvs();
    return $lvs->{joot};
}

# inspect all the LVs in the JOOT volume group
# return all installed images and joots in a hash
sub lvs { 
    my $self = shift;

    my $lv = {
        joot => {},
        image => {},
    };
    my $lvs_out = $self->run( _bin('sudo'), _bin('lvs'), qw(JOOT --noheadings -o lv_name) );
    foreach ( split "\n", $lvs_out ) {
        m/\s*(joot|image)_(\S+)/;
        my $type = $1 or die "invalid lvs command output\n";
        my $name = $2 or die "invalid lvs command output\n";
        $lv->{$type}->{$name} = 1;
    }
    return $lv;
}

sub delete {
    my $self = shift;
    my $joot_name = shift || die "missing joot name to delete\n";

    die "delete not implemented";
}

sub rename {
    my $self     = shift;
    my $old_name = shift || die "rename: missing old name\n";
    my $new_name = shift || die "rename: missing new name\n";

    die "rename not implemented";

}

# delete the joot volume group and the disk that backed it
sub purgeall {
    my $self = shift;

    # confirm the user really wants to do this
    my $current_home = $self->get_current_joot_home();
    print "WARNING: this will destroy all joots installed at $current_home.  Are you sure? ";
    while ( <STDIN> ) { 
        last if $_ eq "yes\n";
        print "type \"yes\" to purge all data.  Ctrl+C otherwise.\n";
    }

    $self->run(_bin("sudo"), _bin("vgremove"), "JOOT" );
    my $lo_out = $self->run( _bin('sudo'), _bin('losetup'), "-j", "$current_home/joot_disk" );
    foreach ( split "\n", $lo_out ) {
        m/\s*([^:]+):/;
        my $dev = $1;
        $self->run( _bin('sudo'), _bin('losetup'), "-d", $dev );
    }
    
    $self->run( _bin('sudo'), _bin('rm'), "$current_home/joot_disk" );
}

1;