<commit_before>use warnings;
use strict;

package Ravada::VM;

=head1 NAME

Ravada::VM - Virtual Managers library for Ravada

=cut

use Carp qw( carp croak);
use Data::Dumper;
use Hash::Util qw(lock_hash);
use Socket qw( inet_aton inet_ntoa );
use Moose::Role;
use Net::DNS;
use IO::Socket;
use IO::Interface;
use Net::Domain qw(hostfqdn);

no warnings "experimental::signatures";
use feature qw(signatures);

requires 'connect';

# global DB Connection

our $CONNECTOR = \$Ravada::CONNECTOR;
our $CONFIG = \$Ravada::CONFIG;

our $MIN_MEMORY_MB = 128 * 1024;

# domain
requires 'create_domain';
requires 'search_domain';

requires 'list_domains';

# storage volume
requires 'create_volume';

requires 'connect';
requires 'disconnect';
requires 'import_domain';

requires 'ping';

requires 'is_active';
############################################################

has 'host' => (
          isa => 'Str'
         , is => 'ro',
    , default => 'localhost'
);

has 'default_dir_img' => (
      isa => 'String'
     , is => 'ro'
);

has 'readonly' => (
    isa => 'Str'
    , is => 'ro'
    ,default => 0
);
############################################################
#
# Method Modifiers definition
# 
#
around 'create_domain' => \&_around_create_domain;

before 'search_domain' => \&_connect;

before 'create_volume' => \&_connect;

around 'import_domain' => \&_around_import_domain;
#############################################################
#
# method modifiers
#

=head1 Constructors

=head2 open

Opens a Virtual Machine Manager (VM)

Arguments: id of the VM

=cut

sub open {
    my $proto = shift;
    my $id = shift;

    my $class=ref($proto) || $proto;

    my $self = {};
    bless($self, $class);
    my $row = $self->_do_select_vm_db( id => $id);
    lock_hash(%$row);
    confess "ERROR: I can't find VM id=$id" if !$row || !keys %$row;

    my $type = $row->{vm_type};
    $type = 'KVM'   if $type eq 'qemu';
    $class .= "::$type";
    bless ($self,$class);

    return $self->new();

}

sub _check_readonly {
    my $self = shift;
    confess "ERROR: You can't create domains in read-only mode "
        if $self->readonly 

}

sub _connect {
    my $self = shift;
    $self->connect();
}

sub _pre_create_domain {
    _check_create_domain(@_);
    _connect(@_);
}

sub _around_create_domain {
    my $orig = shift;
    my $self = shift;
    my %args = @_;

    my $id_owner = delete $args{id_owner} or confess "ERROR: Missing id_owner";
    my $owner = Ravada::Auth::SQL->search_by_id($id_owner);

    my $base;
    my $id_base = delete $args{id_base};
    $base = Ravada::Domain->open($id_base)  if $id_base;

    confess "ERROR: User ".$owner->name." not allowed to create machines"
        unless $owner->is_admin || $owner->can_create_machine()
            || ( $base && $base->is_public() &&  $owner->can_clone );

    $self->_pre_create_domain(@_);

    my $domain = $self->$orig(@_);

    $domain->add_volume_swap( size => $args{swap})  if $args{swap};

    if ($args{id_base}) {
        my $base = $self->search_domain_by_id($args{id_base});
        $domain->run_timeout($base->run_timeout)
            if defined $base->run_timeout();
    }
    my $user = Ravada::Auth::SQL->search_by_id($id_owner);
    $domain->is_volatile(1)    if $user->is_temporary();

    $domain->get_info();

    return $domain;
}

sub _around_import_domain {
    my $orig = shift;
    my $self = shift;
    my ($name, $user, $spinoff) = @_;<commit_msg>[#635] enforce create machine permissions<commit_after>use warnings;
use strict;

package Ravada::VM;

=head1 NAME

Ravada::VM - Virtual Managers library for Ravada

=cut

use Carp qw( carp croak);
use Data::Dumper;
use Hash::Util qw(lock_hash);
use Socket qw( inet_aton inet_ntoa );
use Moose::Role;
use Net::DNS;
use IO::Socket;
use IO::Interface;
use Net::Domain qw(hostfqdn);

no warnings "experimental::signatures";
use feature qw(signatures);

requires 'connect';

# global DB Connection

our $CONNECTOR = \$Ravada::CONNECTOR;
our $CONFIG = \$Ravada::CONFIG;

our $MIN_MEMORY_MB = 128 * 1024;

# domain
requires 'create_domain';
requires 'search_domain';

requires 'list_domains';

# storage volume
requires 'create_volume';

requires 'connect';
requires 'disconnect';
requires 'import_domain';

requires 'ping';

requires 'is_active';
############################################################

has 'host' => (
          isa => 'Str'
         , is => 'ro',
    , default => 'localhost'
);

has 'default_dir_img' => (
      isa => 'String'
     , is => 'ro'
);

has 'readonly' => (
    isa => 'Str'
    , is => 'ro'
    ,default => 0
);
############################################################
#
# Method Modifiers definition
# 
#
around 'create_domain' => \&_around_create_domain;

before 'search_domain' => \&_connect;

before 'create_volume' => \&_connect;

around 'import_domain' => \&_around_import_domain;
#############################################################
#
# method modifiers
#

=head1 Constructors

=head2 open

Opens a Virtual Machine Manager (VM)

Arguments: id of the VM

=cut

sub open {
    my $proto = shift;
    my $id = shift;

    my $class=ref($proto) || $proto;

    my $self = {};
    bless($self, $class);
    my $row = $self->_do_select_vm_db( id => $id);
    lock_hash(%$row);
    confess "ERROR: I can't find VM id=$id" if !$row || !keys %$row;

    my $type = $row->{vm_type};
    $type = 'KVM'   if $type eq 'qemu';
    $class .= "::$type";
    bless ($self,$class);

    return $self->new();

}

sub _check_readonly {
    my $self = shift;
    confess "ERROR: You can't create domains in read-only mode "
        if $self->readonly 

}

sub _connect {
    my $self = shift;
    $self->connect();
}

sub _pre_create_domain {
    _check_create_domain(@_);
    _connect(@_);
}

sub _around_create_domain {
    my $orig = shift;
    my $self = shift;
    my %args = @_;

    my $id_owner = delete $args{id_owner} or confess "ERROR: Missing id_owner";
    my $owner = Ravada::Auth::SQL->search_by_id($id_owner);

    my $base;
    my $id_base = delete $args{id_base};
    $base = Ravada::Domain->open($id_base)  if $id_base;

    confess "ERROR: User ".$owner->name." is not allowed to create machines"
        unless $owner->is_admin
            || $owner->can_create_machine()
            || ($base && $owner->can_clone);

    confess "ERROR: Base ".$base->name." is private"
        if !$owner->is_admin && $base && !$base->is_public();

    $self->_pre_create_domain(@_);

    my $domain = $self->$orig(@_);

    $domain->add_volume_swap( size => $args{swap})  if $args{swap};

    if ($id_base) {
        $domain->run_timeout($base->run_timeout)
            if defined $base->run_timeout();
    }
    my $user = Ravada::Auth::SQL->search_by_id($id_owner);
    $domain->is_volatile(1)    if $user->is_temporary();

    $domain->get_info();

    return $domain;
}

sub _around_import_domain {
    my $orig = shift;
    my $self = shift;
    my ($name, $user, $spinoff) = @_;
{'fraction_non_alphanumeric': 0.20527145108150693, 'fraction_numerical': 0.003867640739149119, 'mean_word_length': 3.6085808580858085, 'pattern_counts': {'":': 2, '<': 3, '<?xml version=': 0, '>': 84, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1151605', 'n_tokens_mistral': 2471, 'n_tokens_neox': 2377, 'n_words': 605}