NAME

Ravada::Domain - Domains ( Virtual Machines ) library for Ravada

sub id { return $_[0]->_data('id');

}

##################################################################################

sub _data { my $self = shift; my $field = shift or confess "Missing field name";

    _init_connector();

    return $self->{_data}->{$field} if exists $self->{_data}->{$field};
    $self->{_data} = $self->_select_domain_db( name => $self->name);

    confess "No DB info for domain ".$self->name    if !$self->{_data};
    confess "No field $field in domains"            if !exists$self->{_data}->{$field};

    return $self->{_data}->{$field};
}

sub __open { my $self = shift;

    my %args = @_;

    my $id = $args{id} or confess "Missing required argument id";
    delete $args{id};

    my $row = $self->_select_domain_db ( );
    return $self->search_domain($row->{name});
#    confess $row;
}

Returns if the domain is known in Ravada.

Returns the password defined for the spice viewers

Code to run before removing the domain. It can be implemented in each domain. It is not expected to run by itself, the remove function calls it before proceeding.

    $domain->pre_remove();  # This isn't likely to be necessary
    $domain->remove();      # Automatically calls the domain pre_remove method

sub is_base { my $self = shift; my $value = shift;

    $self->_select_domain_db or return 0;

    if (defined $value ) {
        my $sth = $$CONNECTOR->dbh->prepare(
            "UPDATE domains SET is_base=? "
            ." WHERE id=?");
        $sth->execute($value, $self->id );
        $sth->finish;

        return $value;
    }
    my $ret = $self->_data('is_base');
    $ret = 0 if $self->_data('is_base') =~ /n/i;

    return $ret;
};

sub is_locked { my $self = shift;

    $self->_init_connector() if !defined $$CONNECTOR;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM requests "
        ." WHERE id_domain=? AND status <> 'done'");
    $sth->execute($self->id);
    my ($id) = $sth->fetchrow;
    $sth->finish;

    return ($id or 0);
}

sub id_owner { my $self = shift; return $self->_data('id_owner',@_); }

sub id_base { my $self = shift; return $self->_data('id_base',@_); }

sub vm { my $self = shift; return $self->_data('vm'); }

sub clones { my $self = shift;

    _init_connector();

    my $sth = $$CONNECTOR->dbh->prepare("SELECT id, name FROM domains "
            ." WHERE id_base = ?");
    $sth->execute($self->id);
    my @clones;
    while (my $row = $sth->fetchrow_hashref) {
        # TODO: open the domain, now it returns only the id
        push @clones , $row;
    }
    return @clones;
}

sub has_clones { my $self = shift;

    _init_connector();

    return scalar $self->clones;
}

sub list_files_base { my $self = shift; my $with_target = shift;

    return if !$self->is_known();

    my $id;
    eval { $id = $self->id };
    return if $@ && $@ =~ /No DB info/i;
    die $@ if $@;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT file_base_img, target "
        ." FROM file_base_images "
        ." WHERE id_domain=?");
    $sth->execute($self->id);

    my @files;
    while ( my ($img, $target) = $sth->fetchrow) {
        push @files,($img)          if !$with_target;
        push @files,[$img,$target]  if $with_target;
    }
    $sth->finish;
    return @files;
}

Returns a list of the filenames and targets of this base-type domain

sub json { my $self = shift;

    my $id = $self->_data('id');
    my $data = $self->{_data};
    $data->{is_active} = $self->is_active;

    return encode_json($data);
}

sub can_screenshot { return 0; }

sub _convert_png { my $self = shift; my ($file_in ,$file_out) = @_;

    my $in = Image::Magick->new();
    my $err = $in->Read($file_in);
    confess $err if $err;

    $in->Write("png24:$file_out");

    chmod 0755,$file_out or die "$! chmod 0755 $file_out";
}

sub remove_base { my $self = shift; return $self->_do_remove_base(); }

sub _do_remove_base { my $self = shift; $self->is_base(0); for my $file ($self->list_files_base) { next if ! -e $file; unlink $file or die "$! unlinking $file"; } $self->storage_refresh() if $self->storage(); }

sub _can_remove_base { _allow_manage(@_); _check_has_clones(@_); }

sub _post_remove_base { my $self = shift; $self->_remove_base_db(@_); $self->_post_remove_base_domain(); }

sub _pre_shutdown_domain {}

sub _post_remove_base_domain {}

sub _remove_base_db { my $self = shift;

    my $sth = $$CONNECTOR->dbh->prepare("DELETE FROM file_base_images "
        ." WHERE id_domain=?");

    $sth->execute($self->id);
    $sth->finish;

}

Clones a domain

user => $user : The user that owns the clone

name => $name : Name of the new clone

Returns wether a domain supports hybernation

Adds a swap volume to the virtual machine

Arguments:

    size => $kb
    name => $name (optional)

Open iptables for a remote client

user

remote_ip

Sets or get the domain public

    $domain->is_public(1);

    if ($domain->is_public()) {
        ...
    }

Check if the domain has swap volumes defined, and clean them

    $domain->clean_swap_volumes();

List the drivers available for a domain. It may filter for a given type.

    my @drivers = $domain->drivers();
    my @video_drivers = $domain->drivers('video');

Sets the driver of a domain given it id. The id must be one from the table domain_drivers_options

    $domain->set_driver_id($id_driver);