Merge branch 'main' into feature/network

etc/rvd_front.conf.example

@@ -37,10 +37,4 @@
       ,file => '/var/log/ravada/rvd_front.log'
       ,level => 'debug'
   }
-# Insert widget in /js/custom/insert_here_widget.js
-# this widget embed js in templates/bootstrap/scripts.html.ep
-  ,widget => ''
-# Content-Security-Policy HTTP response header helps you reduce XSS risks
-# define custom directives. More info https://content-security-policy.com/
-  ,security_policy => 'foo.bar.com'
 };

lib/Ravada.pm

@@ -2572,6 +2572,7 @@ sub _sql_insert_defaults($self){
             }
             ,{  id_parent => $id_frontend
                 ,name => "widget"
+                ,value => $conf->{widget}
             }
             ,{
                 id_parent => $id_frontend
@@ -3932,6 +3933,7 @@ sub _timeout_requests($self) {
         ." FROM requests "
         ." WHERE ( status = 'working' or status = 'stopping' )"
         ."  AND date_changed >= ? "
+        ."  AND command <> 'move_volume'"
         ." ORDER BY date_req "
     );
     $sth->execute(_date_now(-30));
@@ -4067,6 +4069,7 @@ sub _kill_dead_process($self) {
         ." AND ( status like 'working%' OR status like 'downloading%'"
         ."      OR status like 'start%' ) "
         ." AND pid IS NOT NULL "
+        ." AND command <> 'move_volume'"
     );
     $sth->execute(time - 2);
     while (my ($id, $pid, $command, $start_time) = $sth->fetchrow) {
@@ -4172,7 +4175,7 @@ sub _execute {
         return;
     }
 
-    $self->_wait_pids;
+    $self->_wait_pids();
     return if !$self->_can_fork($request);
 
     my $pid = fork();
@@ -4527,7 +4530,9 @@ sub _wait_pids($self) {
     my @done;
     for my $type ( keys %{$self->{pids}} ) {
         for my $pid ( keys %{$self->{pids}->{$type}}) {
+            next if kill(0,$pid);
             my $kid = waitpid($pid , WNOHANG);
+            next if kill(0,$pid);
             push @done, ($pid) if $kid == $pid || $kid == -1;
         }
     }
@@ -6311,6 +6316,7 @@ sub _req_method {
     ,import_domain => \&_cmd_import
     ,list_unused_volumes => \&_cmd_list_unused_volumes
     ,remove_files => \&_cmd_remove_files
+    ,move_volume => \&_cmd_move_volume
     ,update_iso_urls => \&_cmd_update_iso_urls
 
     ,list_networks => \&_cmd_list_virtual_networks
@@ -6857,6 +6863,45 @@ sub _cmd_create_storage_pool($self, $request) {
 
 }
 
+sub _cmd_move_volume($self, $request) {
+
+    my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
+    die "Error: ".$user->name." not authorized to move volumes"
+        if !$user->is_admin;
+
+    my $domain = Ravada::Domain->open($request->args('id_domain'));
+    die "Error: I can not move volume while machine running ".$domain->name."\n"
+    if $domain->is_active;
+
+    my $volume = $request->args('volume');
+    my @volumes = $domain->list_volumes_info();
+    my $found;
+    my $n_found = 0;
+    for my $vol (@volumes) {
+        if ($vol->file eq $volume ) {
+            $found = $vol;
+            last;
+        }
+        $n_found++;
+    }
+    die "Volume $volume not found in ".$domain->name."\n".Dumper([map { $_->file } @volumes]) if !$found;
+
+    my $vm = $domain->_vm;
+    my $storage = $request->args('storage');
+    my $dst_path = $vm->_storage_path($storage);
+    my ($filename) = $volume =~ m{.*/(.*)};
+    my $dst_vol = "$dst_path/$filename";
+
+    die "Error: file '$dst_vol' already exists in ".$vm->name."\n" if $vm->file_exists($dst_vol);
+
+    my $new_file = $vm->copy_file_storage($volume, $storage);
+
+    $domain->change_hardware('disk', $n_found, { file => $new_file });
+    if ($volume !~ /\.iso$/) {
+        $vm->remove_file($volume);
+    }
+}
+
 =head2 set_debug_value
 
 Sets debug global variable from setting

lib/Ravada/Domain/KVM.pm

@@ -392,7 +392,8 @@ sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
 
         my ($boot_node) = $disk->findnodes('boot');
         my $info = {};
-        eval { $info = $self->_volume_info($file) if $file && $device eq 'disk' };
+        eval { $info = $self->_volume_info($file)
+            if $file && $device eq 'disk' or $device eq 'cdrom' };
         die $@ if $@ && $@ !~ /not found/i;
         $info->{device} = $device;
         if (!$info->{name} ) {
@@ -437,7 +438,7 @@ sub _pool_refresh($pool) {
         eval { $pool->refresh };
         return if !$@;
 
-        return if ref($@) && $@->code == 1;
+        return if ref($@) && ($@->code == 1 || $@->code == 55 );#55: not active;
 
         warn "WARNING: on vol remove , pool refresh $@" if $@;
         sleep 1;
@@ -450,11 +451,16 @@ sub _volume_info($self, $file, $refresh=0) {
     my ($name) = $file =~ m{.*/(.*)};
 
     my $vol;
+    my $storage_pool;
     for my $pool ( $self->_vm->vm->list_storage_pools ) {
         _pool_refresh($pool) if $refresh;
         eval { $vol = $pool->get_volume_by_name($name) };
         warn $@ if $@ && $@ !~ /^libvirt error code: 50,/;
-        last if $vol;
+        if ( $vol ) {
+            next if $vol->get_path ne $file;
+            $storage_pool = $pool->get_name();
+            last;
+        }
     }
     if (!$vol && !$refresh) {
         return $self->_volume_info($file, ++$refresh);
@@ -470,6 +476,7 @@ sub _volume_info($self, $file, $refresh=0) {
     warn "WARNING: $@" if $@ && $@ !~ /^libvirt error code: 50,/;
     $info->{file} = $file;
     $info->{name} = $name;
+    $info->{storage_pool} = $storage_pool;
 
     return $info;
 }

lib/Ravada/Domain/Void.pm

@@ -553,7 +553,20 @@ sub _create_volume($self, $file, $format, $data=undef) {
     confess "Undefined format" if !defined $format;
     if ($format =~ /iso|raw|void/) {
         $data->{format} = $format;
-        $self->_vm->write_file($file, Dump($data)),
+        if ( $format eq 'raw' && $data->{capacity} && $self->is_local) {
+            my $capacity = Ravada::Utils::number_to_size($data->{capacity});
+            my ($count,$unit) = $capacity =~ /^(\d+)(\w)$/;
+            die "Error, I can't find count and unit from $capacity"
+            if !$count || !$unit;
+
+            my @cmd = ("dd","if=/dev/zero","of=$file","count=$count","bs=1$unit"
+            ,"status=none");
+            my ($in, $out, $err);
+            run3(\@cmd, \$in, \$out, \$err);
+            warn "@cmd $err" if $err;
+        } else {
+            $self->_vm->write_file($file, Dump($data)),
+        }
     } elsif ($format eq 'qcow2') {
         my @cmd = ('qemu-img','create','-f','qcow2', $file, $data->{capacity});
         my ($out, $err) = $self->_vm->run_command(@cmd);
@@ -679,6 +692,7 @@ sub list_volumes_info($self, $attribute=undef, $value=undef) {
         } else {
             $dev->{driver}->{type} = 'void';
         }
+        $dev->{storage_pool} = $self->_vm->_find_storage_pool($dev->{file});
         my $vol = Ravada::Volume->new(
             file => $dev->{file}
             ,info => $dev

lib/Ravada/Request.pm

@@ -166,12 +166,14 @@ our %VALID_ARG = (
     ,update_iso_urls => { uid => 1 }
     ,list_unused_volumes => {uid => 1, id_vm => 1, start => 2, limit => 2 }
     ,remove_files => { uid => 1, id_vm => 1, files => 1 }
-
+    ,move_volume => { uid => 1, id_domain => 1, volume => 1, storage => 1 }
+
     ,list_networks => { uid => 1, id_vm => 1}
     ,new_network => { uid => 1, id_vm => 1, name => 2 }
     ,create_network => { uid => 1, id_vm => 1, data => 1 }
     ,remove_network => { uid => 1, id => 1, id_vm => 2, name => 2 }
     ,change_network => { uid => 1, data => 1 }
+
 );
 
 $VALID_ARG{shutdown} = $VALID_ARG{shutdown_domain};
@@ -223,7 +225,7 @@ our %COMMAND = (
     # list from low to high priority
     ,disk_low_priority => {
         limit => 2
-        ,commands => ['rsync_back','check_storage', 'refresh_vms']
+        ,commands => ['rsync_back','check_storage', 'refresh_vms','move_volume']
         ,priority => 30
     }
     ,disk => {

lib/Ravada/VM.pm

@@ -12,6 +12,7 @@ Ravada::VM - Virtual Managers library for Ravada
 use utf8;
 use Carp qw( carp confess croak cluck);
 use Data::Dumper;
+use File::Copy qw(copy);
 use File::Path qw(make_path);
 use Hash::Util qw(lock_hash);
 use IPC::Run3 qw(run3);
@@ -162,6 +163,8 @@ around 'remove_network' => \&_around_remove_network;
 around 'list_virtual_networks' => \&_around_list_networks;
 around 'change_network' => \&_around_change_network;
 
+around 'copy_file_storage' => \&_around_copy_file_storage;
+
 #############################################################
 #
 # method modifiers
@@ -2249,6 +2252,42 @@ sub shared_storage($self, $node, $dir) {
 
     return $shared;
 }
+
+=head2 copy_file_storage
+
+Copies a volume file to another storage
+
+Args:
+
+=over
+
+=item * file
+
+=item * storage
+
+=back
+
+=cut
+
+sub copy_file_storage($self, $file, $storage) {
+    die "Error: file '$file' does not exist" if !$self->file_exists($file);
+
+    my ($pool) = grep { $_->{name} eq $storage } $self->list_storage_pools(1);
+    die "Error: storage pool $storage does not exist" if !$pool;
+
+    my $path = $pool->{path};
+
+    die "TODO remote" if !$self->is_local;
+
+    copy($file, $path) or die "$! $file -> $path";
+
+    my ($filename) = $file =~ m{.*/(.*)};
+    die "Error: file '$file' not copied to '$path'" if ! -e "$path/$filename";
+
+    return "$path/$filename";
+
+}
+
 sub _fetch_tls_host_subject($self) {
     return '' if !$self->dir_cert();
 
@@ -2790,6 +2829,28 @@ sub list_unused_volumes($self) {
     return @vols;
 }
 
+sub _around_copy_file_storage($orig, $self, $file, $storage) {
+    my $sth = $self->_dbh->prepare("SELECT id,info FROM volumes"
+        ." WHERE file=? "
+    );
+    $sth->execute($file);
+    my ($id,$infoj) = $sth->fetchrow;
+
+    my $new_file = $self->$orig($file, $storage);
+
+    if ($id) {
+        my $info = decode_json($infoj);
+        $info->{file} = $new_file;
+        my $sth_update = $self->_dbh->prepare(
+            "UPDATE volumes set info=?,file=?"
+            ." WHERE id=?"
+        );
+        $sth_update->execute(encode_json($info), $new_file, $id);
+    }
+
+    return $new_file;
+}
+
 1;
 
 

lib/Ravada/VM/KVM.pm

@@ -15,6 +15,7 @@ use Data::Dumper;
 use Digest::MD5;
 use Encode;
 use Encode::Locale;
+use File::Copy qw(copy);
 use File::Path qw(make_path);
 use Fcntl qw(:flock O_WRONLY O_EXCL O_CREAT);
 use Hash::Util qw(lock_hash);
@@ -2916,6 +2917,46 @@ sub _is_ip_nat($self, $ip0) {
     return 0;
 }
 
+sub copy_file_storage($self, $file, $storage) {
+    my $vol = $self->search_volume($file);
+    die "Error: volume $file not found" if !$vol;
+
+    my $sp = $self->vm->get_storage_pool_by_name($storage);
+    die "Error: storage pool $storage not found" if !$sp;
+
+    my ($name) = $vol->get_name();
+    my $xml = $vol->get_xml_description();
+    my $doc = XML::LibXML->load_xml(string => $xml);
+
+    my $vol_capacity = $vol->get_info()->{capacity};
+
+    my $pool_capacity = $sp->get_info()->{capacity};
+
+    die "Error: '$file' too big to fit in $storage ".Ravada::Utils::number_to_size($vol_capacity)." > ".Ravada::Utils::number_to_size($pool_capacity)."\n"
+    if $vol_capacity>$pool_capacity;
+
+    my ($format) = $doc->findnodes("/volume/target/format");
+    if ($format ne 'qcow2') {
+        die "Error: I can't copy $format on remote nodes"
+        unless $self->is_local;
+
+        my $dst_file = $self->_storage_path($storage)."/".$name;
+        copy($file,$dst_file);
+        $self->refresh_storage();
+        return $dst_file;
+    }
+
+    my $vol_dst;
+    eval { $vol_dst= $sp->get_volume_by_name($name) };
+    die $@ if $@ && !(ref($@) && $@->code == 50);
+
+    warn 1;
+    $vol_dst= $sp->clone_volume($vol->get_xml_description);
+    warn 2;
+
+    return $vol_dst->get_path();
+}
+
 sub get_library_version($self) {
     return $self->vm->get_library_version();
 }

lib/Ravada/VM/Void.pm

@@ -599,6 +599,25 @@ sub _init_storage_pool_default($self) {
 
 }
 
+sub _find_storage_pool($self, $file) {
+
+    my ($path) = $file =~ m{(.*)/};
+
+    return $self->{_storage_pool_path}->{$path}
+    if $self->{_storage_pool_path} && exists $self->{_storage_pool_path}->{$path};
+
+    my $found;
+    for my $sp ($self->list_storage_pools(1)) {
+        if ($sp->{path} eq $path) {
+            $found = $sp->{name};
+            last;
+        }
+    }
+    return '' if !$found;
+    $self->{_storage_pool_path}->{$path} = $found;
+    return $found;
+}
+
 sub list_storage_pools($self, $info=0) {
     my @list;
     my $config_dir = Ravada::Front::Domain::Void::_config_dir();