Feat: bundle virtual machines

lib/Ravada.pm

@@ -1651,6 +1651,12 @@ sub _add_indexes_generic($self) {
             ,"index(date_changed)"
             ,"index(id_owner)"
         ]
+        ,bundles => [
+            "unique (name)"
+        ]
+        ,domains_bundle => [
+            "unique (id_bundle, id_domain)"
+        ]
     );
     my $if_not_exists = '';
     $if_not_exists = ' IF NOT EXISTS ' if $CONNECTOR->dbh->{Driver}{Name} =~ /sqlite|mariadb/i;
@@ -2382,6 +2388,21 @@ sub _sql_create_tables($self) {
             }
         ]
         ,
+        [
+            bundles => {
+                id => 'integer PRIMARY KEY AUTO_INCREMENT',
+                name => 'char(255) NOT NULL',
+                private_network => 'integer NOT NULL default 0'
+            }
+        ],
+        [
+            domains_bundle => {
+                id => 'integer PRIMARY KEY AUTO_INCREMENT',
+                id_bundle => 'integer NOT NULL references `bundles` (`id`) ON DELETE CASCADE',
+                id_domain => 'integer NOT NULL references `domains` (`id`) ON DELETE CASCADE',
+            }
+        ]
+        ,
         [virtual_networks => {
                 id => 'integer PRIMARY KEY AUTO_INCREMENT',
                 ,id_vm => 'integer NOT NULL references `vms` (`id`) ON DELETE CASCADE',
@@ -3291,6 +3312,13 @@ sub create_domain {
         $base = Ravada::Domain->open($id_base)
             or confess "Unknown base id: $id_base";
         $vm = $base->_vm;
+
+        my $net_bundle = $self->_net_bundle($base, $id_owner);
+        if ($net_bundle) {
+            unlock_hash(%args);
+            $args{options}->{network} = $net_bundle->{name};
+            lock_hash(%args);
+        }
     }
     my $user = Ravada::Auth::SQL->search_by_id($id_owner)
         or confess "Error: Unkown user '$id_owner'";
@@ -4624,6 +4652,25 @@ sub _cmd_remove {
     $self->remove_domain(name => $request->args('name'), uid => $request->args('uid'));
 }
 
+sub _cmd_remove_clones($self, $request) {
+
+    my $uid = $request->args('uid');
+    my $user = Ravada::Auth::SQL->search_by_id($uid);
+
+    my $id_domain = $request->args('id_domain');
+
+    die "Error: user ".$user->name." not authorized to remove clones"
+    unless $user->is_admin();
+
+    my $domain = Ravada::Front::Domain->open($id_domain);
+    for my $clone ( $domain->clones ) {
+        Ravada::Request->remove_domain(
+            uid => $uid
+            ,name => $clone->{name}
+        );
+    }
+}
+
 sub _cmd_restore_domain($self,$request) {
     my $domain = Ravada::Domain->open($request->args('id_domain'));
     return $domain->restore(Ravada::Auth::SQL->search_by_id($request->args('uid')));
@@ -4714,22 +4761,66 @@ sub _cmd_clone($self, $request) {
 
     $args->{alias} = $alias if $alias;
 
+    my $net_bundle = $self->_net_bundle($domain, $user);
+
+    $args->{options}->{network} = $net_bundle->{name} if $net_bundle;
+
     my $clone = $domain->clone(
         name => $name
         ,%$args
     );
 
     $request->id_domain($clone->id) if $clone;
+    my $req_next = $request;
 
     Ravada::Request->start_domain(
         uid => $user->id
         ,id_domain => $clone->id
         ,remote_ip => $request->defined_arg('remote_ip')
-        ,after_request => $request->id
+        ,after_request => $req_next->id
     ) if $request->defined_arg('start');
 
 }
 
+sub _net_bundle($self, $domain, $user0) {
+    my $bundle = $domain->bundle();
+
+    return unless $bundle && exists $bundle->{private_network}
+    && $bundle->{private_network};
+
+    my $user = $user0;
+    $user = Ravada::Auth::SQL->search_by_id($user0) if !ref($user);
+
+    my ($net) = grep { $_->{id_owner} == $user->id }
+        $domain->_vm->list_virtual_networks();
+
+    return $net if $net;
+
+    my $req_new_net = Ravada::Request->new_network(
+        uid => Ravada::Utils::user_daemon->id
+        ,id_vm => $domain->_vm->id
+        ,name => $bundle->{name}."-".$user->name
+    );
+    $self->_cmd_new_network($req_new_net);
+    my $data = decode_json($req_new_net->output);
+    $req_new_net->status('done');
+
+    my $req_network = Ravada::Request->create_network(
+        uid => Ravada::Utils::user_daemon->id
+        ,id_vm => $domain->_vm->id
+        ,data => $data
+    );
+    $self->_cmd_create_network($req_network);
+    $req_network->status('done');
+
+    ($net) = grep { $_->{name} eq $data->{name} }
+        $domain->_vm->list_virtual_networks();
+
+    $domain->_vm->_update_network_db($net, {id_owner => $user->id });
+
+    return $net;
+}
+
 sub _new_clone_name($self, $base,$user) {
     my $name;
     my $alias = $base->name;
@@ -5487,7 +5578,7 @@ sub _cmd_check_storage($self, $request) {
             my $path = ''.$vm->_storage_path($storage);
             _check_mounted($path,\%fstab,\%mtab);
             my ($ok,$err) = $vm->write_file("$path/check_storage",$contents);
-            die "Error on starage pool $storage : $err. Retry.\n" if $err;
+            die "Error on storage pool $storage : $err. Retry.\n" if $err;
         }
     }
 }
@@ -5860,7 +5951,10 @@ sub _refresh_active_vms ($self) {
             next;
         }
         $active_vm{$vm->id} = 1;
-        $vm->list_virtual_networks();
+        eval {
+            $vm->list_virtual_networks();
+        };
+        warn $@ if $@;
     }
     return \%active_vm;
 }
@@ -5912,6 +6006,7 @@ sub _refresh_down_nodes($self, $request = undef ) {
         my $vm;
         eval { $vm = Ravada::VM->open($id) };
         warn $@ if $@;
+        $vm->is_active() if $vm;
     }
 }
 
@@ -6272,6 +6367,8 @@ sub _req_method {
          ,pause => \&_cmd_pause
         ,create => \&_cmd_create
         ,remove => \&_cmd_remove
+        ,remove_domain => \&_cmd_remove
+        ,remove_clones => \&_cmd_remove_clones
         ,restore_domain => \&_cmd_restore_domain
         ,resume => \&_cmd_resume
        ,dettach => \&_cmd_dettach
@@ -6526,6 +6623,7 @@ sub _enforce_limits_active($self, $request) {
 
     my %domains;
     for my $domain ($self->list_domains( active => 1 )) {
+        next if $domain->is_in_bundle();
         push @{$domains{$domain->id_owner}},$domain;
         $domain->client_status();
     }

lib/Ravada/Auth/SQL.pm

@@ -1106,7 +1106,7 @@ sub can_remove_clones($self, $id_domain=undef) {
     return $self->can_do('remove_clones') if !$id_domain;
 
     my $domain = Ravada::Front::Domain->open($id_domain);
-    confess "ERROR: domain is not a base "  if !$domain->id_base;
+    confess "ERROR: domain ".$domain->name." is not a base "  if !$domain->id_base;
 
     return 1 if $self->can_remove_clone_all();
 

lib/Ravada/Domain.pm

@@ -529,8 +529,9 @@ sub _search_already_started($self, $fast = 0) {
     $sth->execute($self->_vm->type);
     my %started;
     while (my ($id) = $sth->fetchrow) {
-        my $vm = Ravada::VM->open($id);
-        next if !$vm->enabled;
+        my $vm;
+        eval { $vm = Ravada::VM->open($id) };
+        next if !$vm || !$vm->enabled;
 
         my $vm_active;
         eval {
@@ -539,7 +540,7 @@ sub _search_already_started($self, $fast = 0) {
         my $error = $@;
         if ($error) {
             warn $error;
-            $vm->enabled(0) if !$vm->is_local;
+            $vm->enabled(0) if !$vm->is_local && !$vm->ping;
             next;
         }
         next if !$vm_active;
@@ -2406,13 +2407,15 @@ sub _remove_domain_cascade($self,$user, $cascade = 1) {
         next if $instance->{id_vm} == $self->_vm->id;
         my $vm;
         eval { $vm = Ravada::VM->open($instance->{id_vm}) };
-        die $@ if $@ && $@ !~ /I can't find VM/i;
-        next if !$vm || !$vm->is_active;
+        die $@ if $@ && $@ !~ /I can't find VM ||libvirt error code: 38,/i;
         my $domain;
         $@ = '';
         eval { $domain = $vm->search_domain($domain_name) } if $vm;
         warn $@ if $@;
-        $domain->remove($user, $cascade) if $domain;
+        eval {
+            $domain->remove($user, $cascade) if $domain;
+        };
+        warn $@ if $@;
         $sth_delete->execute($instance->{id});
     }
 }
@@ -2876,6 +2879,7 @@ sub clone {
     my $id_owner = delete $args{id_owner};
     my $alias = delete $args{alias};
     my $options = delete $args{options};
+    my $storage = delete $args{storage};
 
     confess "ERROR: Unknown args ".join(",",sort keys %args)
         if keys %args;
@@ -2909,7 +2913,9 @@ sub clone {
     push @args_copy, ( remote_ip => $remote_ip) if $remote_ip;
     push @args_copy, ( from_pool => $from_pool) if defined $from_pool;
     push @args_copy, ( add_to_pool => $add_to_pool) if defined $add_to_pool;
-    push @args_copy, ( options => $options ) if defined $options;
+    push @args_copy, ( storage => $storage)     if $storage;
+    push @args_copy, ( options => $options)     if $options;
+
     if ( $self->volatile_clones && !defined $volatile ) {
         $volatile = 1;
     }
@@ -2960,6 +2966,7 @@ sub _copy_clone($self, %args) {
     my $id_owner = delete $args{id_owner};
     $id_owner = $user->id if (! $id_owner);
     my $alias = delete $args{alias};
+    my $options = delete $args{options};
 
     confess "ERROR: Unknown arguments ".join(",",sort keys %args)
         if keys %args;
@@ -2970,6 +2977,7 @@ sub _copy_clone($self, %args) {
     push @copy_arg, ( alias => $alias )   if $alias;
     push @copy_arg, ( memory => $memory ) if $memory;
     push @copy_arg, ( volatile => $volatile ) if $volatile;
+    push @copy_arg, ( options => $options ) if $options;
 
     $request->status("working","Copying domain ".$self->name
         ." to $name")   if $request;
@@ -3253,7 +3261,10 @@ sub _around_is_active($orig, $self) {
         }
     }
     my $is_active = 0;
+    eval {
     $is_active = $self->$orig();
+    };
+    warn $@ if $@;
 
     return $is_active if $self->readonly
         || !$self->is_known
@@ -5318,7 +5329,8 @@ sub _pre_clone($self,%args) {
 
     confess "ERROR: Missing user owner of new domain"   if !$user;
 
-    for (qw(is_pool start add_to_pool from_pool with_cd volatile id_owner alias options)) {
+    for (qw(is_pool start add_to_pool from_pool with_cd volatile id_owner
+        alias storage options)) {
         delete $args{$_};
     }
     confess "ERROR: Unknown arguments ".join(",",sort keys %args)   if keys %args;
@@ -7720,4 +7732,29 @@ sub list_shares($self) {
     return @shares;
 }
 
+sub bundle($self) {
+    my $sth = $self->_dbh->prepare("SELECT * FROM bundles "
+        ." WHERE id IN (SELECT id_bundle FROM domains_bundle "
+        ."              WHERE id_domain=?)"
+    );
+    $sth->execute($self->id);
+    my $bundle = $sth->fetchrow_hashref;
+    return if !keys %$bundle;
+    lock_hash(%$bundle);
+    return $bundle;
+
+}
+
+sub is_in_bundle($self) {
+    my $id=( $self->id_base or $self->id);
+    my $sth = $self->_dbh->prepare("SELECT id FROM bundles "
+        ." WHERE id IN (SELECT id_bundle FROM domains_bundle "
+        ."              WHERE id_domain=?)"
+    );
+    $sth->execute($id);
+    my ($id_bundle) = $sth->fetchrow;
+    return $id_bundle;
+
+}
+
 1;

lib/Ravada/Domain/Void.pm

@@ -692,7 +692,9 @@ sub list_volumes_info($self, $attribute=undef, $value=undef) {
         } else {
             $dev->{driver}->{type} = 'void';
         }
-        $dev->{storage_pool} = $self->_vm->_find_storage_pool($dev->{file});
+        $dev->{storage_pool} = $self->_vm->_find_storage_pool($dev->{file})
+        if $dev->{file};
+
         my $vol = Ravada::Volume->new(
             file => $dev->{file}
             ,info => $dev
@@ -739,7 +741,7 @@ sub _new_mac($mac='ff:54:00:a7:49:71') {
     return join(":",@macparts);
 }
 
-sub _set_default_info($self, $listen_ip=undef) {
+sub _set_default_info($self, $listen_ip=undef, $network=undef) {
     my $info = {
             max_mem => 512*1024
             ,memory => 512*1024,
@@ -754,12 +756,22 @@ sub _set_default_info($self, $listen_ip=undef) {
     $self->_set_display($listen_ip);
     my $hardware = $self->_value('hardware');
 
+    my @nets = $self->_vm->list_virtual_networks();
+    my ($net) = grep { $_->{name} eq 'default'} @nets;
+    $net = $nets[0] if !$net;
+    if ($network) {
+        ($net) = grep { $_->{name} eq $network } @nets;
+
+        die "Error: network $network not found ".join(" , ",@nets)
+        if !$net;
+    }
+
     $hardware->{network}->[0] = {
         hwaddr => $info->{mac}
         ,address => $info->{ip}
         ,type => 'nat'
         ,driver => 'virtio'
-        ,name => "net1"
+        ,name => $net->{name}
     };
     $self->_store(hardware => $hardware );