diff --git a/.github/workflows/github-action-test.yml b/.github/workflows/github-action-test.yml index c59fe85b5..8acea7eb5 100644 --- a/.github/workflows/github-action-test.yml +++ b/.github/workflows/github-action-test.yml @@ -59,8 +59,12 @@ jobs: - name: Test mock VM run: prove -lr t/vm/60_new_args.t t/30_request.t - name: Test create from ISO - run: prove -lr t/request/25_create_from_iso.t t/vm/d10_not_download.t + run: prove -lr t/request/25_create_from_iso.t t/vm/d10_not_download.t t/repository/10_iso.t - name: Test hardware run: prove -lr t/request/30_hardware.t - name: Test Volumes run: prove -lr t/20_volumes.t + - name: Test downgrade + run: prove -lr t/downgrade_reqs.t + - name: Test Front + run: prove -lr t/front/15_misc.t diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index adff66f7b..9836e519b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -241,14 +241,14 @@ git fetch upstream Now we create a new branch: ```sh -git checkout develop -git checkout -b feature/cool_thing upstream/develop +git checkout main +git checkout -b feature/cool_thing upstream/main ``` Reset this branch, now it will be an exact replica of upstream UPC/develop: ```sh -git reset --hard upstream/develop +git reset --hard upstream/main git push --set-upstream origin feature/cool_thing ``` diff --git a/Makefile.PL b/Makefile.PL index 979f82a33..91b2cdd5c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,6 +31,7 @@ WriteMakefile( ,'DateTime::Format::DateParse'=> 0 ,'PBKDF2::Tiny' => 0 ,'HTML::Lint' => 0 + ,'Term::ReadKey' => 0 }, BUILD_REQUIRES => { 'Test::Perl::Critic' => 0 diff --git a/deb/debianize.pl b/deb/debianize.pl index 2b6fba005..d95ddefe7 100755 --- a/deb/debianize.pl +++ b/deb/debianize.pl @@ -17,12 +17,14 @@ my $DIR_DST; my $DEBIAN = "DEBIAN"; my $FORCE; +my $OS; my $help; my $usage = "$0 [--help] [--force]\n"; GetOptions( force => \$FORCE ,help => \$help + ,'os=s' => \$OS ) or die $usage; if ($help) { @@ -31,7 +33,7 @@ } my %COPY_RELEASES = ( - 'ubuntu-20.04'=> ['ubuntu-22.04','ubuntu-24.04'] + 'ubuntu-20.04'=> ['ubuntu-22.04','ubuntu-24.04','ubuntu-26.04'] ,'debian-10' => ['debian-11','debian-12','debian-13'] ); my %DIR = ( @@ -365,11 +367,13 @@ sub list_dists { while ( my $file = readdir $dir ) { my ($dist) = $file =~ /control-(.*)/; + next if !$dist; + next if $OS && $dist !~ /$OS/; push @dists,($dist) if $dist; } closedir $dir; - die "Error: no dists control files found in 'debian' dir" + die "Error: no dists control files found in 'debian' dir $OS" if !@dists; return reverse @dists; @@ -418,7 +422,7 @@ sub copy_identical_releases { get_fallback(); -for my $dist (list_dists) { +for my $dist (list_dists()) { $DIR_DST = "$DIR_SRC/../ravada-$VERSION-$dist"; clean(); diff --git a/debian/control-debian-10 b/debian/control-debian-10 index 3cef433f4..e62476acf 100644 --- a/debian/control-debian-10 +++ b/debian/control-debian-10 @@ -4,7 +4,7 @@ Architecture: all Section: utils Priority: optional Maintainer: Francesc Guasch -Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, librrds-perl, rrdtool +Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, librrds-perl, rrdtool, libterm-readkey-perl Description: Remote Virtual Desktops Manager Ravada is a software that allows the user to connect to a remote virtual desktop. diff --git a/debian/control-ubuntu-18.04 b/debian/control-ubuntu-18.04 index 320c3dbbf..151a88704 100644 --- a/debian/control-ubuntu-18.04 +++ b/debian/control-ubuntu-18.04 @@ -4,7 +4,7 @@ Architecture: all Section: utils Priority: optional Maintainer: Francesc Guasch -Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, ovmf, librrds-perl, rrdtool +Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, ovmf, librrds-perl, rrdtool, libterm-readkey-perl Description: Remote Virtual Desktops Manager Ravada is a software that allows the user to connect to a remote virtual desktop. diff --git a/debian/control-ubuntu-19.04 b/debian/control-ubuntu-19.04 deleted file mode 100644 index 88c5938dc..000000000 --- a/debian/control-ubuntu-19.04 +++ /dev/null @@ -1,10 +0,0 @@ -Package: ravada -Version: 0.2.5 -Architecture: all -Section: utils -Priority: optional -Maintainer: Francesc Guasch -Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, ovmf, librrds-perl, rrdtool -Description: Remote Virtual Desktops Manager - Ravada is a software that allows the user to connect to a - remote virtual desktop. diff --git a/debian/control-ubuntu-20.04 b/debian/control-ubuntu-20.04 index 88c5938dc..73999fb22 100644 --- a/debian/control-ubuntu-20.04 +++ b/debian/control-ubuntu-20.04 @@ -4,7 +4,7 @@ Architecture: all Section: utils Priority: optional Maintainer: Francesc Guasch -Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, ovmf, librrds-perl, rrdtool +Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools, iptstate, libfile-tee-perl, ovmf, librrds-perl, rrdtool, libterm-readkey-perl Description: Remote Virtual Desktops Manager Ravada is a software that allows the user to connect to a remote virtual desktop. diff --git a/lib/Ravada.pm b/lib/Ravada.pm index d038df548..2c4e33f55 100644 --- a/lib/Ravada.pm +++ b/lib/Ravada.pm @@ -3,7 +3,7 @@ package Ravada; use warnings; use strict; -our $VERSION = '2.4.2'; +our $VERSION = '2.5.0-alpha5'; use utf8; @@ -251,8 +251,11 @@ sub _add_internal_network($self) { for my $net (split /\n/,$out) { next if $net =~ /dev virbr/; my ($address) = $net =~ m{(^[\d\.]+/\d+)}; - next if !$address || $done{address}++; - $sth->execute("internal$n",$address, ++$n+1); + next if !$address || $done{$address}++; + eval { + $sth->execute("internal$n",$address, ++$n+1); + }; + warn $@ if $@ && $@ !~ /UNIQUE constraint/; } } @@ -404,16 +407,27 @@ sub _update_isos { ,md5_url => '' ,md5 => '1d6bdf5cbc6ca98c31f02d23e418dd96' }, + arch_2603 => { + name => 'Arch Linux 26.03' + ,description => 'Arch Linux 2026.03.01 64 bits' + ,arch => 'x86_64' + ,xml => 'bionic-amd64.xml' + ,xml_volume => 'bionic64-volume.xml' + ,url => 'https://archive.archlinux.org/iso/2026.03.01/' + ,file_re => 'archlinux-2026.03.01-x86_64.iso' + ,sha256_url => '$url/sha256sums.txt' + }, mate_noble => { name => 'Ubuntu Mate 24.04 Noble Numbat 64 bits' - ,description => 'Ubuntu Mate 24.04 Noble Nubat m64 bits' + ,description => 'Ubuntu Mate 24.04 Noble Numbat 64 bits' ,arch => 'x86_64' ,xml => 'noble-amd64.xml' ,xml_volume => 'focal_fossa64-volume.xml' ,url => 'http://cdimage.ubuntu.com/ubuntu-mate/releases/24.04.*/release/ubuntu-mate-24.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 3 + ,min_ram => 4 + ,min_disk_size => '20' }, mate_jammy=> { name => 'Ubuntu Mate 22.04 Jammy Jellyfish 64 bits' @@ -424,7 +438,8 @@ sub _update_isos { ,url => 'http://cdimage.ubuntu.com/ubuntu-mate/releases/22.04.*/release/ubuntu-mate-22.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 1 + ,min_ram => 4 + ,min_disk_size => '20' }, mate_focal_fossa => { @@ -436,7 +451,8 @@ sub _update_isos { ,url => 'http://cdimage.ubuntu.com/ubuntu-mate/releases/20.04.*/release/ubuntu-mate-20.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 1 + ,min_ram => 4 + ,min_disk_size => '20' }, mate_bionic => { name => 'Ubuntu Mate 18.04 Bionic 64 bits' @@ -446,7 +462,8 @@ sub _update_isos { ,xml_volume => 'bionic64-volume.xml' ,url => 'http://cdimage.ubuntu.com/ubuntu-mate/releases/18.04.*/release/ubuntu-mate-18.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' - ,min_ram => 1 + ,min_ram => 4 + ,min_disk_size => '20' }, mate_bionic_i386 => { name => 'Ubuntu Mate 18.04 Bionic 32 bits' @@ -456,7 +473,8 @@ sub _update_isos { ,xml_volume => 'bionic32-volume.xml' ,url => 'http://cdimage.ubuntu.com/ubuntu-mate/releases/18.04.*/release/ubuntu-mate-18.04.*-desktop-i386.iso' ,sha256_url => '$url/SHA256SUMS' - ,min_ram => 1 + ,min_ram => 4 + ,min_disk_size => '20' }, ,focal_fossa=> { name => 'Ubuntu 20.04 Focal Fossa' @@ -467,8 +485,8 @@ sub _update_isos { ,url => 'http://releases.ubuntu.com/20.04/' ,file_re => '^ubuntu-20.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' - ,min_disk_size => '9' - ,min_ram => 1 + ,min_disk_size => '25' + ,min_ram => 4 ,options => { machine => 'pc-q35', bios => 'UEFI' } ,arch => 'x86_64' } @@ -481,7 +499,7 @@ sub _update_isos { ,url => 'http://releases.ubuntu.com/22.04/' ,file_re => '^ubuntu-22.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' - ,min_disk_size => '14' + ,min_disk_size => '25' ,min_ram => 4 ,options => { machine => 'pc-q35', bios => 'UEFI' } ,arch => 'x86_64' @@ -496,12 +514,27 @@ sub _update_isos { ,url => 'http://releases.ubuntu.com/24.04/' ,file_re => '^ubuntu-24.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' - ,min_disk_size => '14' + ,min_disk_size => '25' ,min_ram => 4 ,options => { machine => 'pc-q35', bios => 'UEFI' } ,arch => 'x86_64' } + ,ubuntu_resolute => { + name => 'Ubuntu 26.04 Resolute Raccoon' + ,description => 'Ubuntu 26.04 Resolute Raccoon 64 bits' + ,xml => 'noble-amd64.xml' + ,xml_volume => 'focal_fossa64-volume.xml' + ,url => 'http://releases.ubuntu.com/26.04/' + ,file_re => '^ubuntu-26.04.*-desktop-amd64.iso' + ,sha256_url => '$url/SHA256SUMS' + ,min_disk_size => '25' + ,min_ram => 6 + ,options => { machine => 'pc-q35', bios => 'UEFI' } + ,arch => 'x86_64' + + } + @@ -555,9 +588,48 @@ sub _update_isos { ,sha256_url => '$url/alpine-standard-3.16.*.iso.sha256' ,min_disk_size => '1' } + ,alpine323_64 => { + name => 'Alpine 3.23 64 bits' + ,description => 'Alpine Linux 3.23 64 bits ( Minimal Linux Distribution )' + ,arch => 'x86_64' + ,xml => 'alpine-amd64.xml' + ,xml_volume => 'alpine381_64-volume.xml' + ,url => 'http://dl-cdn.alpinelinux.org/alpine/v3.23/releases/x86_64/' + ,file_re => 'alpine-standard-3.23.*-x86_64.iso' + ,sha256_url => '$url/alpine-standard-3.23.*.iso.sha256' + ,min_disk_size => '2' + ,options => { machine => 'pc-q35', bios => 'UEFI' } + } + ,alpine323_32 => { + name => 'Alpine 3.23 32 bits' + ,description => 'Alpine Linux 3.23 32 bits ( Minimal Linux Distribution )' + ,arch => 'i686' + ,xml => 'alpine-i386.xml' + ,xml_volume => 'alpine381_32-volume.xml' + ,url => 'http://dl-cdn.alpinelinux.org/alpine/v3.23/releases/x86/' + ,options => { machine => 'pc-i440fx' } + ,file_re => 'alpine-standard-3.23.*-x86.iso' + ,sha256_url => '$url/alpine-standard-3.23.*.iso.sha256' + ,min_disk_size => '1' + } + ,kubuntu_64_resolute => { + name => 'Kubuntu 26.04 Resolute Raccoon' + ,description => 'Kubuntu 26.04 Resolute Raccoon 64 bits' + ,arch => 'x86_64' + ,xml => 'noble-amd64.xml' + ,xml_volume => 'focal_fossa64-volume.xml' + ,sha256_url => '$url/SHA256SUMS' + ,url => 'http://cdimage.ubuntu.com/kubuntu/releases/26.04.*/release/' + ,file_re => 'kubuntu-26.04.*-desktop-amd64.iso' + ,rename_file => 'kubuntu_resolute.iso' + ,options => { machine => 'pc-q35', bios => 'UEFI' } + ,min_ram => 6 + ,min_disk_size => '25' + } + ,kubuntu_64_noble => { name => 'Kubuntu 24.04 Noble Nombat' - ,description => 'Kubuntu 22.04 Noble Nombat 64 bits' + ,description => 'Kubuntu 24.04 Noble Nombat 64 bits' ,arch => 'x86_64' ,xml => 'noble-amd64.xml' ,xml_volume => 'focal_fossa64-volume.xml' @@ -566,8 +638,8 @@ sub _update_isos { ,file_re => 'kubuntu-24.04.*-desktop-amd64.iso' ,rename_file => 'kubuntu_noble.iso' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 3 - ,min_disk_size => 11 + ,min_ram => 4 + ,min_disk_size => '25' } ,kubuntu_64_jammy => { @@ -581,8 +653,8 @@ sub _update_isos { ,file_re => 'kubuntu-22.04.*-desktop-amd64.iso' ,rename_file => 'kubuntu_jammy.iso' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 3 - ,min_disk_size => 11 + ,min_ram => 4 + ,min_disk_size => '25' } ,kubuntu_64_focal_fossa => { name => 'Kubuntu 20.04 Focal Fossa 64 bits' @@ -595,7 +667,8 @@ sub _update_isos { ,file_re => 'kubuntu-20.04.*-desktop-amd64.iso' ,rename_file => 'kubuntu_focal_fossa_64.iso' ,options => { machine => 'pc-q35', bios => 'UEFI' } - ,min_ram => 1 + ,min_ram => 4 + ,min_disk_size => '25' } ,suse_15 => { name => "openSUSE Leap 15" @@ -603,10 +676,31 @@ sub _update_isos { ,arch => 'x86_64' ,xml => 'bionic-amd64.xml' ,xml_volume => 'bionic64-volume.xml' - ,url => 'https://download.opensuse.org/distribution/leap/15.4/iso/' + ,url => 'https://download.opensuse.org/distribution/leap/15.6/iso/' ,file_re => 'openSUSE-Leap-15.\d-NET-x86_64-Current.iso' + } + ,suse_16 => { + name => "openSUSE Leap 16" + ,description => "openSUSE Leap 16 64 bits" + ,arch => 'x86_64' + ,xml => 'bionic-amd64.xml' + ,xml_volume => 'bionic64-volume.xml' + ,url => 'https://download.opensuse.org/distribution/leap/16.0/installer/iso/' + ,file_re => 'agama-installer\.x86_64-.*-Leap_16\.0-Build.*\.iso' } + ,xubuntu_resolute => { + name => 'Xubuntu 26.04 Resolute Raccoon 64 bits' + ,description => 'Xubuntu 26.04 Resolute Raccoon 64 bits' + ,arch => 'x86_64' + ,xml => 'bionic-amd64.xml' + ,xml_volume => 'bionic64-volume.xml' + ,url => 'https://ftp.lysator.liu.se/ubuntu-dvd/xubuntu/releases/26.04.*/release/' + ,file_re => 'xubuntu.26.04.*desktop.*.iso' + ,options => { machine => 'pc-q35', bios => 'UEFI' } + ,min_ram => 2 + ,min_disk_size => '20' + } ,xubuntu_noble => { name => 'Xubuntu 24.04 Noble Nombat 64 bits' ,description => 'Xubuntu 24.04 Noble Nombat 64 bits' @@ -614,8 +708,10 @@ sub _update_isos { ,xml => 'bionic-amd64.xml' ,xml_volume => 'bionic64-volume.xml' ,url => 'https://ftp.lysator.liu.se/ubuntu-dvd/xubuntu/releases/24.04.*/release/' - ,file_re => 'xubuntu.*desktop.*.iso' + ,file_re => 'xubuntu.24.04.*desktop.*.iso' ,options => { machine => 'pc-q35', bios => 'UEFI' } + ,min_ram => 2 + ,min_disk_size => '20' } ,xubuntu_bionic => { name => 'Xubuntu 18.04 Bionic Beaver 32 bits' @@ -627,16 +723,32 @@ sub _update_isos { ,url => 'http://archive.ubuntu.com/ubuntu/dists/bionic/main/installer-i386/current/images/netboot/' ,file_re => 'mini.iso' ,rename_file => 'xubuntu_bionic_32.iso' + ,min_ram => 2 + ,min_disk_size => '20' + } + ,lubuntu_resolute => { + name => 'Lubuntu 26.04 Resolute Raccoon' + ,description => 'Lubuntu 26.04 Resolute Raccoon 64 bits (LTS)' + ,url => 'http://cdimage.ubuntu.com/lubuntu/releases/26.04.*/release/' + ,file_re => 'lubuntu-26.04.*-desktop-amd64.iso' + ,sha256_url => '$url/SHA256SUMS' + ,xml => 'yakkety64-amd64.xml' + ,xml_volume => 'yakkety64-volume.xml' + ,min_disk_size => '10' + ,min_ram => 2 + ,arch => 'x86_64' + ,options => { machine => 'pc-q35', bios => 'UEFI' } } ,lubuntu_noble => { name => 'Lubuntu 24.04 Noble Nombat' - ,description => 'Xubuntu 24.04 Noble Nombat 64 bits (LTS)' + ,description => 'Lubuntu 24.04 Noble Nombat 64 bits (LTS)' ,url => 'http://cdimage.ubuntu.com/lubuntu/releases/24.04.*/release/' ,file_re => 'lubuntu-24.04.*-desktop-amd64.iso' ,sha256_url => '$url/SHA256SUMS' ,xml => 'yakkety64-amd64.xml' ,xml_volume => 'yakkety64-volume.xml' ,min_disk_size => '10' + ,min_ram => 1 ,arch => 'x86_64' ,options => { machine => 'pc-q35', bios => 'UEFI' } } @@ -673,6 +785,17 @@ sub _update_isos { ,min_disk_size => '10' ,arch => 'i686' } + ,debian_stretch_64 => { + name =>'Debian 9 Stretch 64 bits' + ,description => 'Debian 9 Stretch 64 bits (XFCE desktop)' + ,url => 'https://cdimage.debian.org/cdimage/archive/^9\.1\d+.*\d$/amd64/iso-cd/' + ,file_re => 'debian-9.[\d\.]+-amd64-xfce-CD-1.iso' + ,md5_url => '$url/MD5SUMS' + ,xml => 'jessie-amd64.xml' + ,xml_volume => 'jessie-volume.xml' + ,min_disk_size => '10' + ,arch => 'x86_64' + } ,debian_buster_64=> { name =>'Debian 10 Buster 64 bits' ,description => 'Debian 10 Buster 64 bits (XFCE desktop)' @@ -758,28 +881,6 @@ sub _update_isos { ,min_ram => 3 ,options => { machine => 'pc-q35', bios => 'UEFI' } } - ,devuan_beowulf_amd64=> { - name =>'Devuan 10 Beowulf 64 bits' - ,description => 'Devuan Beowulf Desktop Live (amd64)' - ,arch => 'x86_64' - ,url => 'http://tw1.mirror.blendbyte.net/devuan-cd/devuan_beowulf/desktop-live/' - ,file_re => 'devuan_beowulf_.*_amd64_desktop-live.iso' - ,sha256_url => '$url/SHASUMS.txt' - ,xml => 'jessie-amd64.xml' - ,xml_volume => 'jessie-volume.xml' - ,min_disk_size => '10' - } - ,devuan_beowulf_i386=> { - name =>'Devuan 10 Beowulf 32 bits' - ,description => 'Devuan Beowulf Desktop Live (i386)' - ,arch => 'i686' - ,url => 'http://tw1.mirror.blendbyte.net/devuan-cd/devuan_beowulf/desktop-live/' - ,file_re => 'devuan_beowulf_.*_i386_desktop-live.iso' - ,sha256_url => '$url/SHASUMS.txt' - ,xml => 'jessie-i386.xml' - ,xml_volume => 'jessie-volume.xml' - ,min_disk_size => '10' - } ,devuan_daedalus_amd64=> { name =>'Devuan 12 Daedalus 64 bits' ,description => 'Devuan Daedalus Desktop Live (amd64)' @@ -801,17 +902,27 @@ sub _update_isos { ,xml_volume => 'jessie-volume.xml' ,min_disk_size => '10' } - - ,parrot_xfce_amd64 => { - name => 'Parrot Home Edition XFCE' - ,description => 'Parrot Home Edition XFCE 64 Bits' + ,devuan_excalibur_amd64=> { + name =>'Devuan 13 Excalibur 64 bits' + ,description => 'Devuan Excalibur Desktop Live (amd64)' ,arch => 'x86_64' + ,url => 'http://tw1.mirror.blendbyte.net/devuan-cd/devuan_excalibur/desktop-live/' + ,file_re => 'devuan_excalibur_.*_amd64_desktop-live.iso' ,xml => 'jessie-amd64.xml' ,xml_volume => 'jessie-volume.xml' - ,url => 'https://download.parrot.sh/parrot/iso/6.*/' - ,file_re => 'Parrot-home-6.*_amd64.iso' - ,sha256_url => '' - ,min_disk_size => '11' + ,min_disk_size => '10' + ,options => { machine => 'pc-q35'} + } + ,parrot_xfce_amd64 => { + name => 'Parrot Home Edition XFCE 7.1' + ,description => 'Parrot Home Edition XFCE 7.1 64 Bits' + ,arch => 'x86_64' + ,xml => 'jessie-amd64.xml' + ,xml_volume => 'jessie-volume.xml' + ,url => 'https://download.parrot.sh/parrot/iso/7.1/' + ,file_re => 'Parrot-home-7\.1.*_amd64\.iso' + ,sha256_url => '$url/signed-hashes.txt' + ,min_disk_size => '15' } ,kali_64 => { name => "Kali Linux $year" @@ -904,6 +1015,7 @@ sub _update_isos { ,xml_volume => 'jessie-volume.xml' ,min_disk_size => '0' ,has_cd => 0 + ,arch => 'i686' } ,empty_64bits => { name => 'Empty Machine 64 bits' @@ -1724,6 +1836,10 @@ sub _add_indexes_generic($self) { "index(id_vm)" ,"unique(id_vm,command,path)" ] + ,file_base_images => [ + "unique(id_domain,target)" + ,"unique(id_domain,file_base_img)" + ] ); my $if_not_exists = ''; $if_not_exists = ' IF NOT EXISTS ' if $CONNECTOR->dbh->{Driver}{Name} =~ /sqlite|mariadb/i; @@ -2056,6 +2172,14 @@ sub _upgrade_table($self, $table, $field, $definition) { ." $row->{TYPE_NAME} -> $new_type \n" ." in $table\n$definition\n" if !$FIRST_TIME_RUN && $0 !~ /\.t$/; print "-" if $FIRST_TIME_RUN && $ENV{TERM}; + + if ($table eq 'requests' && $field =~ /^after_request/ + && $row->{TYPE_NAME} =~ /TEXT|CHAR/i && $new_type =~ /int|INTEGER/i) { + my $sth_clean = $CONNECTOR->dbh->prepare( + "UPDATE requests set $field=NULL " + ); + $sth_clean->execute; + } $dbh->do("alter table $table change $field $field $definition"); $self->_create_constraints($table, [$field, $constraint]) if $constraint; @@ -2438,6 +2562,7 @@ sub _sql_create_tables($self) { ,id_domain => 'integer NOT NULL references `domains` (`id`) ON DELETE CASCADE' ,file_base_img => ' varchar(255) DEFAULT NULL' ,target => 'varchar(64) DEFAULT NULL' + ,n_order => 'int not null' } ] , @@ -2822,6 +2947,22 @@ sub _sql_insert_defaults($self){ ,name => 'startup_ram' ,value => 1 } + ,{ + id_parent => '/backend' + ,name => 'stats' + ,value => undef + } + + ,{ + id_parent => '/backend/stats' + ,name => 'cpu' + ,value => 0 + } + ,{ + id_parent => '/backend/stats' + ,name => 'memory' + ,value => 0 + } ] @@ -2936,8 +3077,8 @@ sub _upgrade_tables { $self->_upgrade_table('requests','pid','int(11) DEFAULT NULL'); $self->_upgrade_table('requests','start_time','int(11) DEFAULT NULL'); $self->_upgrade_table('requests','output','text DEFAULT NULL'); - $self->_upgrade_table('requests','after_request','int(11) DEFAULT NULL'); - $self->_upgrade_table('requests','after_request_ok','int(11) DEFAULT NULL'); + $self->_upgrade_table('requests','after_request','varchar(80) DEFAULT NULL'); + $self->_upgrade_table('requests','after_request_ok','varchar(80) DEFAULT NULL'); $self->_upgrade_table('requests','at_time','int(11) DEFAULT NULL'); $self->_upgrade_table('requests','run_time','float DEFAULT NULL'); @@ -3006,6 +3147,7 @@ sub _upgrade_tables { $self->_upgrade_table('domains','show_clones' , 'int not null default 1'); $self->_upgrade_table('domains','config_no_hd' , 'text'); $self->_upgrade_table('domains','networking' , 'varchar(32)'); + $self->_upgrade_table('domains','ports_exposed','int not null default 0'); $self->_upgrade_table('domains_network','allowed','int not null default 1'); @@ -3586,21 +3728,28 @@ sub remove_domain { my $self = shift; my %arg = @_; - my $name = delete $arg{name} or confess "Argument name required "; + my $name = delete $arg{name}; + my $id_domain = delete $arg{id_domain}; + + die "Error: Argument name or id required" if !$name && !$id_domain; confess "Argument uid required " if !$arg{uid}; lock_hash(%arg); - my $sth = $CONNECTOR->dbh->prepare("SELECT id,vm FROM domains WHERE name = ?"); - $sth->execute($name); + if (!$id_domain ) { + my $sth = $CONNECTOR->dbh->prepare("SELECT id,vm FROM domains WHERE name = ?"); + $sth->execute($name); - my ($id,$vm_type)= $sth->fetchrow; - if (!$id) { - warn "Error: Unknown domain $name, maybe already removed.\n"; - return; + ($id_domain)= $sth->fetchrow; + + if (!$id_domain) { + warn "Error: Unknown domain $name, maybe already removed.\n"; + return; + } } + my $id = $id_domain; my $user = Ravada::Auth::SQL->search_by_id( $arg{uid}); die "Error: user id:$arg{uid} removed\n" if !$user; @@ -3616,13 +3765,27 @@ sub remove_domain { warn "Warning: $@" if $@; if (!$domain0) { - warn "Warning: I can't find domain [$id ] '$name' , maybe already removed.\n" - if $ENV{TERM}; - $domain0 = Ravada::Domain->open(id => $id, _force => 1); - if (!$domain0) { + warn "Warning: I can't find domain [$id] '" + .($name or '') + ."' , maybe already removed.\n"; + + my $domain; + eval { + $domain = Ravada::Front::Domain->open($id); + }; + warn $@ if $@; + if ( !$domain ) { + die "Machine $id not found. Maybe already removed.\n"; + } + my @volumes = $domain->list_volumes(); + my $vm = Ravada::VM->open($domain->_data('id_vm')); + die "No vm ".$domain->_data('id_vm') if !$vm || !$vm->vm; + for my $vol (@volumes) { + next if $vol->file =~ /\.iso$/; + $vm->remove_file($vol->file) + } Ravada::Domain::_remove_domain_data_db($id); return; - } }; $domain0->remove( $user); @@ -4015,6 +4178,7 @@ sub process_requests { $self->_kill_stale_process(); $self->_kill_dead_process(); $self->_timeout_requests(); + $self->_finish_failed_initialized(); } my $sth = $CONNECTOR->dbh->prepare("SELECT id,id_domain,command FROM requests " @@ -4128,7 +4292,7 @@ sub _timeout_requests($self) { my $sth = $CONNECTOR->dbh->prepare( "SELECT id,pid, start_time, date_changed " ." FROM requests " - ." WHERE ( status = 'working' or status = 'stopping' )" + ." WHERE ( status = 'working' or status = 'stopping' or status = 'initializing' )" ." AND date_changed >= ? " ." AND command <> 'move_volume'" ." ORDER BY date_req " @@ -4257,6 +4421,31 @@ sub _kill_stale_process($self) { $sth->finish; } +sub _finish_failed_initialized($self) { + + my $sth = $CONNECTOR->dbh->prepare( + "SELECT id,pid,command,start_time " + ." FROM requests " + ." WHERE start_time '')" + ); + $sth->execute(time - 2); + while (my ($id, $pid, $command, $start_time) = $sth->fetchrow) { + next if -e "/proc/$pid"; + if ($pid == $$ ) { + warn "HOLY COW! I should kill pid $pid stale for ".(time - $start_time) + ." seconds, but I won't because it is myself"; + next; + } + my $request = Ravada::Request->open($id); + $request->stop(0); # do not show warning + warn "stopping ".$request->id." ".$request->command; + } + $sth->finish; +} + + sub _kill_dead_process($self) { my $sth = $CONNECTOR->dbh->prepare( @@ -4290,6 +4479,8 @@ sub _domain_working { confess "Missing request" if !defined $req; + return if $req->command =~ /list_cpu_models/; + if (!$id_domain) { $id_domain = $req->defined_arg('id_base'); if (!$id_domain) { @@ -4840,7 +5031,15 @@ sub _cmd_remove { confess "Unknown user id ".$request->args->{uid} if !defined $request->args->{uid}; - $self->remove_domain(name => $request->args('name'), uid => $request->args('uid')); + my $name = $request->defined_arg('name'); + my $id_domain = $request->defined_arg('id_domain'); + + die "Error: Missing domain name or id" if !$name && !$id_domain; + my @args; + push @args,(name => $name) if $name && !$id_domain; + push @args,(id_domain => $id_domain ) if $id_domain; + + $self->remove_domain(@args, uid => $request->args('uid')); } sub _cmd_remove_clones($self, $request) { @@ -4930,8 +5129,9 @@ sub _cmd_clone($self, $request) { if ( $request->defined_arg('number') && $request->defined_arg('number') > 1) || (! $request->defined_arg('name') && $request->defined_arg('add_to_pool')); - my $domain = $self->search_domain_by_id($request->args('id_domain')) - or die "Error: Domain ".$request->args('id_domain')." not found"; + my $domain = Ravada::Domain->open($request->args('id_domain')); + die "Error: Domain ".$request->args('id_domain')." not found" + if !$domain; my $args = $request->args(); $args->{request} = $request; @@ -5151,7 +5351,7 @@ sub _cmd_start { $domain = $self->search_domain($name) if $name && !$id_domain; $domain = $self->search_domain_by_id($id_domain) if $id_domain; - die "Error: Unknown ".($name or $id_domain) if !$domain; + die "Error: machine unknown ".($name or $id_domain) if !$domain; $domain->status('starting'); @@ -5421,12 +5621,14 @@ sub _cmd_download { $self->_download_local_and_rsync($request, $vm, $iso); } - Ravada::Request->refresh_storage(id_vm => $vm->id, uid => Ravada::Utils::user_daemon->id); + Ravada::Request->refresh_storage(id_vm => $vm->id + ,uid => Ravada::Utils->user_daemon->id + ); } sub _download_local_and_rsync($self, $request, $vm, $iso) { my $vm_local = $vm->new(host => 'localhost'); - my $found = $vm_local->search_volume_path_re(qr($iso->{file_re})); + my $found = $vm_local->search_volume_path_re(qr($iso->{device_re})); if (!$found) { my $req_local = Ravada::Request->download( @@ -5434,28 +5636,26 @@ sub _download_local_and_rsync($self, $request, $vm, $iso) { ,id_iso => $iso->{id} ,test => $request->defined_arg('test') ); - $request->after_request($req_local->id); + $request->after_request_ok($req_local->id); $request->retry(2); my $msg = "ISO pending to rsync. retry.\n"; warn $msg; die $msg; } - my ($path) = $found =~ m{(.*/)}; + my ($path, $file) = $found =~ m{(.*/)(.*)}; if ( $vm_local->shared_storage($vm, $path) ) { die "Warning: shared storage, $iso should be there"; } my $rsync = File::Rsync->new(update => 1, sparse => 1, archive => 1); - my $dst = 'root@'.$vm->host.":".$found; - warn "$found -> $dst"; + my $dst = 'root@'.$vm->host.":".$vm->dir_img()."/".$file; $rsync->exec(src => $found, dest => $dst); confess "error syncing from $found to $dst \n" .join(' ',@{$rsync->err}) if $rsync->err; - warn "rsync done"; } sub _cmd_add_hardware { @@ -5543,6 +5743,9 @@ sub _cmd_change_hardware { && $data->{n_virt_cpu} <= $info->{max_virt_cpu}) ; + die "Error: $hardware can only be changed while machine down.\n" + if $hardware eq 'disk' && $domain->is_active; + $domain->change_hardware( $request->args('hardware') ,$request->defined_arg('index') @@ -5629,7 +5832,9 @@ sub _cmd_shutdown { } else { $domain = $self->search_domain($name); } - die "Unknown domain '$name'\n" if !$domain; + if (!$domain) { + die "Unknown domain '$name'\n"; + } } if ($id_domain) { my $domain2 = Ravada::Domain->open(id => $id_domain, id_vm => $id_vm); @@ -5965,10 +6170,12 @@ sub _cmd_refresh_machine($self, $request) { return; } $domain->_fetch_networking_mode() if $domain->is_known(); + $domain->_data('ports_exposed' => 0) if $domain->_data('ports_exposed'); } $domain->info($user); $domain->client_status(1) if $is_active; $domain->_check_port_conflicts(); + $domain->_check_set_base_reqs(); Ravada::Request->refresh_machine_ports(id_domain => $domain->id, uid => $user->id ,timeout => 60, retry => 10) @@ -6161,7 +6368,7 @@ sub _cmd_list_isos($self, $request){ @isos = sort { "\L$a" cmp "\L$b" } $vm->search_volume_path_re(qr(.*\.iso$)) if $vm && $vm->vm; - $request->output(encode_json(\@isos)); + $request->output(\@isos); } sub _cmd_list_machine_types($self, $request) { @@ -6181,7 +6388,7 @@ sub _cmd_list_cpu_models($self, $request) { my $id_domain = $request->args('id_domain'); my $domain = Ravada::Domain->open($id_domain); - return [] if !$domain->_vm || !$domain->_vm->can_list_cpu_models(); + return [] if !$domain || !$domain->_vm || !$domain->_vm->can_list_cpu_models(); my $info = $domain->get_info(); my $vm = $domain->_vm->vm; @@ -6261,19 +6468,42 @@ sub _migrate_base($self, $domain, $id_node, $uid, $request) { die "Base ".$base->name." still not prepared in node $id_node. Retry\n"; } +sub _cmd_post_migrate($self, $request) { + + my $req_migrate; + my $ids = $request->after_request(); + + for my $id ( $ids ) { + $req_migrate = Ravada::Request->open($id); + last if $req_migrate->command eq 'migrate'; + $req_migrate = undef; + } + if ( $req_migrate->error ) { + my $domain_f = Ravada::Front::Domain->open($request->args('id_domain')); + my $node = Ravada::VM->open($request->args('id_node')); + my $domain = $node->search_domain($domain_f->name,1); + $domain->remove_instance($node->id); + } +} + sub _cmd_migrate($self, $request) { my $uid = $request->args('uid'); my $id_domain = $request->args('id_domain') or die "ERROR: Missing id_domain"; my $user = Ravada::Auth::SQL->search_by_id($uid); + + my $domain_f = Ravada::Front::Domain->open($id_domain); + return if $domain_f->_data('id_vm') == $request->args('id_node'); + my $domain = Ravada::Domain->open($id_domain) or confess "Error: domain $id_domain not found"; die "Error: user ".$user->name." not allowed to migrate domain ".$domain->name unless $user->is_operator; + return if $domain->_vm->id == $request->args('id_node'); + my $node = Ravada::VM->open($request->args('id_node')); - $self->_migrate_base($domain, $node, $uid, $request) if $domain->id_base; if ($domain->is_active) { if ($request->defined_arg('shutdown')) { @@ -6305,6 +6535,7 @@ sub _cmd_migrate($self, $request) { } sub _cmd_rsync_back($self, $request) { + return; my $uid = $request->args('uid'); my $id_domain = $request->args('id_domain') or die "ERROR: Missing id_domain"; @@ -6683,10 +6914,19 @@ sub _refresh_volatile_domains($self) { if ( !$domain || $domain->status eq 'down' || !$domain->is_active) { if ($domain && !$domain->is_locked ) { if ($domain->_vm && $domain->_vm->is_active(1)) { - Ravada::Request->shutdown_domain( + my $req_shutdown = Ravada::Request->shutdown_domain( uid => $USER_DAEMON->id ,id_domain => $id_domain ); + my @after; + @after = ( after_request => $req_shutdown->id) + if $req_shutdown; + Ravada::Request->remove_domain( + uid => $USER_DAEMON->id + ,id_domain => $id_domain + ,name => $name + ,@after + ) } } else { my $user; @@ -6746,6 +6986,7 @@ sub _do_cmd_set_base_vm($self, $uid, $id_vm, $id_domain, $value, $request) { ,user => $user ,value => $value ,request => $request + ,migrate => $request->defined_arg('migrate') ); } @@ -6903,6 +7144,7 @@ sub _req_method { ,start_node => \&_cmd_start_node ,connect_node => \&_cmd_connect_node ,migrate => \&_cmd_migrate + ,post_migrate => \&_cmd_post_migrate ,rsync_back => \&_cmd_rsync_back #users @@ -7296,6 +7538,7 @@ sub _cmd_remove_expose($self, $request) { sub _cmd_open_exposed_ports($self, $request) { my $domain = Ravada::Domain->open($request->id_domain) or return; return if !$domain->list_ports(); + $domain->_data('ports_exposed' => 1); my $uid = $request->args('uid'); my $user = Ravada::Auth::SQL->search_by_id( $uid ) @@ -7314,6 +7557,7 @@ sub _cmd_open_exposed_ports($self, $request) { ,id_domain => $domain->id ,retry => 20 ,timeout => 180 + ,_force => 1 ); } @@ -7388,7 +7632,7 @@ sub _cmd_list_unused_volumes($self, $request) { } my @list = map { {file => $_} } sort @files; - $request->output(encode_json({list => \@list, more => $more})) + $request->output({list => \@list, more => $more}) if $request; return @list; } @@ -7465,7 +7709,7 @@ sub _cmd_create_network($self, $request) { die "Error: node $id not avaiable.\n" if !$vm || !$vm->vm; - $request->output(encode_json({})); + $request->output({}); my $id_net = $vm->create_network($request->args('data'),$request->args('uid') , $request); $request->output(encode_json({id_network => $id_net})); diff --git a/lib/Ravada/Domain.pm b/lib/Ravada/Domain.pm index 28828b44b..3d179de34 100644 --- a/lib/Ravada/Domain.pm +++ b/lib/Ravada/Domain.pm @@ -56,6 +56,7 @@ _init_connector(); requires 'name'; requires 'remove'; +requires 'remove_instance'; requires 'display_info'; requires 'is_active'; @@ -225,6 +226,7 @@ around 'remove_controller' => \&_around_remove_hardware; around 'change_hardware' => \&_around_change_hardware; around 'name' => \&_around_name; +around 'ip' => \&_around_ip; before 'post_prepare_base' => \&_before_post_prepare_base; after 'post_prepare_base' => \&_after_post_prepare_base; @@ -331,6 +333,7 @@ sub _around_start($orig, $self, @arg) { if ( !$self->is_active ) { $self->_unlock_host_devices(0); $self->_fetch_networking_mode(); + $self->_data('ports_exposed',0); } $self->_start_preconditions(@arg); @@ -358,6 +361,7 @@ sub _around_start($orig, $self, @arg) { for (1 .. 2) { eval { $self->_start_checks(%arg, enable_host_devices => $enable_host_devices) }; my $error = $@; + warn $error if $error; if ($error) { if ( $error =~/base file not found/ && !$self->_vm->is_local) { $self->_request_set_base(); @@ -414,13 +418,15 @@ sub _around_start($orig, $self, @arg) { next if $error && ref($error) && $error->code == 1 && $error !~ /internal error.*unexpected address/ && $error !~ /process exited while connecting to monitor/ + && $error !~ /QEMU unexpectedly closed the monitor/ && $error !~ /Could not run .*swtpm/i && $error !~ /virtiofs/ && $error !~ /child process/i - && $error !~ /host doesn.t support/ - && $error !~ /device not found/ ; - + if ($error && $self->is_known && $self->id_base && !$self->is_local && $self->_vm->enabled) { + $self->_request_set_base(); + next; + } die $error; } $self->_post_start(%arg); @@ -592,13 +598,8 @@ sub _start_checks($self, @args) { # check the requested id_vm is suitable if ($id_vm) { $vm = Ravada::VM->open($id_vm); - if ( !$vm->enabled || !$vm->ping ) { - $vm = $vm_local; - $id_vm = undef; - } elsif ($enable_host_devices && !$self->_available_hds($id_vm)) { - $vm = $vm_local; - $id_vm = undef; - } + die "Error: node ".$vm->name." not available.\n" + if !$vm->enabled || !$vm->ping; } # if it is a clone ( it is not a base ) @@ -608,7 +609,6 @@ sub _start_checks($self, @args) { if ( !$vm->is_alive ) { $vm->disconnect(); $vm->connect; - $vm = $vm_local if !$vm->is_local && !$vm->is_alive; die "Error: node ".$vm->name." is not alive" if !$vm->is_alive; }; if ($id_vm) { @@ -867,12 +867,12 @@ sub _allow_shutdown { } my $user = $args{user} || confess "ERROR: Missing user arg"; + return if $user->can_shutdown_all; + if ( $self->id_base() && $user->can_shutdown_clone()) { - my $base = Ravada::Domain->open($self->id_base) + my $base = Ravada::Front::Domain->open($self->id_base) or confess "ERROR: Base domain id: ".$self->id_base." not found"; return if $base->id_owner == $user->id; - } elsif($user->can_shutdown_all) { - return; } confess "User ".$user->name." [".$user->id."] not allowed to shutdown ".$self->name ." owned by ".($self->id_owner or '') @@ -886,6 +886,9 @@ sub _around_add_volume { if scalar @_ % 2; my %args = @_; + die "Error: volumes can not be added to bases.\n" + if $self->is_base(); + my $file = ($args{file} or $args{path}); confess if $args{id_iso} && !$file; my $name = $args{name}; @@ -977,7 +980,7 @@ sub _around_list_volumes_info($orig, $self, $attribute=undef, $value=undef) { } sub prepare_base($self, @args) { - my ($user, $request, $with_cd); + my ($user, $request, $with_cd, $overwrite); if(ref($args[0]) =~/^Ravada::/) { ($user, $request) = @args; } else { @@ -985,19 +988,16 @@ sub prepare_base($self, @args) { $user = delete $args{user}; $request = delete $args{request}; $with_cd = delete $args{with_cd}; + $overwrite = delete $args{overwrite}; confess "Error: uknown args". Dumper(\%args) if keys %args; } $self->_pre_prepare_base($user, $request); - if (!$self->is_local) { - my $vm_local = $self->_vm->new( host => 'localhost' ); - $self->_vm($vm_local); - } $self->pre_prepare_base(); - my @base_img = $self->_do_prepare_base($with_cd, $request); + my @base_img = $self->_do_prepare_base($with_cd, $overwrite, $request); die "Error: No information files returned from prepare_base" - if !scalar(@base_img); + if !scalar(@base_img) && $self->list_volumes() ; my $pending_post = 0; if ($request) { @@ -1029,7 +1029,11 @@ sub prepare_base($self, @args) { $self->_set_base_vm_db($self->_vm->id, 1); $self->_after_prepare_base($user, $request); - $self->is_base(0) if $pending_post; + if ( $pending_post ) { + $self->is_base(0) + } else { + $self->is_base(1) + } } =head2 pre_prepare_base @@ -1059,18 +1063,31 @@ Prepares the virtual machine as a base: =cut -sub _do_prepare_base($self, $with_cd, $req=undef) { +sub _do_prepare_base($self, $with_cd, $overwrite, $req=undef) { my @base_img; - for my $volume ($self->list_volumes_info()) { + my @vols_info = $self->list_volumes_info(); + for my $volume (@vols_info) { next if !$volume->file; my $base_file = $volume->base_filename; next if !$base_file || $base_file =~ /\.iso$/; - confess "Error: file '$base_file' already exists in ".$self->_vm->name - if $self->_vm->file_exists($base_file); + + if ($self->_vm->file_exists($base_file)) { + if ($overwrite) { + $self->_vm->remove_file($base_file); + next; + } + confess "Error: file '$base_file' already exists in " + .$self->_vm->name; + } } + my %dupe; + for my $volume (@vols_info) { + my $target = $volume->info->{target}; + + die "Error: target duplicated ".Dumper([$self->name, \@vols_info]) + if $dupe{$target}++; - for my $volume ($self->list_volumes_info()) { next if !$volume->info->{target} && $volume->info->{device} eq 'cdrom'; next if $volume->info->{device} eq 'cdrom' && (!$with_cd || !$volume->file); confess "Undefined info->target ".Dumper($volume) @@ -1102,6 +1119,7 @@ sub post_prepare_base($self) { } sub _after_post_prepare_base($self) { $self->after_prepare_base(); + $self->is_base(1) } sub _clone_volumes_base($self) { @@ -1171,11 +1189,6 @@ sub _pre_prepare_base($self, $user, $request = undef ) { sleep 1; } } - # $self->_post_remove_base(); - if (!$self->is_local) { - my $vm_local = Ravada::VM->open( type => $self->vm ); - $self->migrate($vm_local, $request); - } $self->_check_free_space_prepare_base(); } @@ -1208,6 +1221,7 @@ sub _after_prepare_base { $self->autostart(0,$user); $self->_vm->refresh_storage_pools(); + $self->after_prepare_base(); }; =pod @@ -1224,8 +1238,6 @@ sub spinoff { $self->_check_has_clones(); $self->_do_force_shutdown() if $self->is_active; - confess "Error: spinoff from remote nodes not available. Node: ".$self->_vm->name - if !$self->is_local; for my $volume ($self->list_volumes_info ) { next if !$volume->file || $volume->file =~ /\.iso$/i; @@ -1272,7 +1284,7 @@ sub _check_has_clones { return if !$self->is_known(); my @clones = $self->clones; - die "Domain ".$self->name." has ".scalar @clones." clones.\n" + confess "Domain ".$self->name." has ".scalar @clones." clones.\n" if $#clones>=0; } @@ -1302,19 +1314,29 @@ sub _check_tmp_volumes($self) { if !$self->id_base; my $vm = $self->_vm; - my $base = Ravada::Domain->open($self->id_base); - my @volumes = $base->list_files_base_target; + $self->_vm->refresh_storage_pools(); for my $vol ( $self->list_volumes_info) { - next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\.\w+$/; - my ($file_base) = grep { $_->[1] eq $vol->info->{target} } @volumes; - next if !$file_base; - $vol->delete(); + next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\./; + next unless $vol->backing_file; + $vol->delete() ; + + my $base = Ravada::Domain->open($self->id_base); + die "Error: Base not found for ".$self->name." [id=".$self->id_base."]" + if !$base; + + my @volumes = $base->list_files_base_target; + my ($file_base) = grep { $_->[1] eq $vol->info->{target} } @volumes; + if (!$file_base) { + warn "Error: I can't find base volume for target ".$vol->info->{target} + ."\n"; + next; + } my $vol_base = Ravada::Volume->new( file => $file_base->[0] , is_base => 1 , vm => $vm ); - $vol_base->clone(file => $vol->file); + $vol_base->clone(file => $vol->file, domain => $self); } } @@ -1590,9 +1612,6 @@ sub _insert_display( $self, $display ) { confess Dumper($display) if $display->{driver} =~ /-tls/ && !$display->{is_secondary}; - $display->{listen_ip} = $self->_vm->ip - if !exists $display->{listen_ip} || !$display->{listen_ip}; - lock_hash(%$display); $self->_clean_display_order($display->{n_order}) if $display->{n_order}; @@ -1979,6 +1998,9 @@ sub _assert_update($self, $table, $field, $value) { if ($field eq 'is_base' && !$value && $self->clones ) { confess "Error: You can not set $field=$value if there are clones"; } + if ($field eq 'id_base' && defined $value && $value == $self->id) { + confess "Error: A domain can not be base of itself"; + } } =head2 open @@ -2053,21 +2075,35 @@ sub open($class, @args) { my $domain; eval { $domain = $vm->search_domain($row->{name}, $force) }; if ( !$domain ) { - return if $vm->is_local; - - $vm_local = {}; - my $vm_class = "Ravada::VM::".$row->{vm}; - bless $vm_local, $vm_class; - - $vm = $vm_local->new(); - $domain = $vm->search_domain($row->{name}, $force) or return; - $vm_changed = $vm; + $domain = _search_domain_in_instances($id, $row->{name}, $force); } $domain->_insert_db_extra() if $domain && !$domain->is_known_extra(); $domain->_data('id_vm' => $vm_changed->id) if $vm_changed; return $domain; } +sub _search_domain_in_instances($id_domain, $name, $force) { + + my ($found, $found_active); + for my $instance ( list_instances(undef, $id_domain)) { + my $vm; + eval { $vm = Ravada::VM->open($instance->{id_vm}) }; + warn $@ if $@; + next if !$vm; + my $domain = $vm->search_domain($name, $force); + next if !$domain; + if ($domain->is_active) { + $found_active = $domain; + last; + } + $found = $domain; + } + $found = $found_active if $found_active; + return if !$found; + $found->_data('id_vm' => $found->_vm->id); + return $found; +} + sub _check_proper_id_vm($self, $id, $id_vm) { my @instances = ({ id_vm => $$id_vm } , $self->list_instances($id) ); for my $instance ( @instances ) { @@ -2200,14 +2236,18 @@ sub _prepare_base_db { } my $sth = $$CONNECTOR->dbh->prepare( "INSERT INTO file_base_images " - ." (id_domain , file_base_img, target )" - ." VALUES(?,?,?)" + ." (id_domain , file_base_img, target, n_order )" + ." VALUES(?,?,?,?)" ); + my $n_order=0; for my $file_img (@file_img) { my $target; ($file_img, $target) = @$file_img if ref $file_img; next if !$file_img; - $sth->execute($self->id, $file_img, $target ); + eval { + $sth->execute($self->id, $file_img, $target, $n_order++ ); + }; + confess Dumper([$self->name,\@file_img,$@]) if $@; } $sth->finish; @@ -2446,6 +2486,7 @@ sub info($self, $user) { ,bundle => ($self->bundle() or undef) ,is_volatile => $self->_data('is_volatile') ,networking => $self->_data('networking') + ,ports_exposed => $self->_data('ports_exposed') }; $info->{alias} = ( $self->_data('alias') or $info->{name} ); @@ -2481,7 +2522,7 @@ sub info($self, $user) { #} $info->{drivers} = $self->_load_drivers(); - $info->{bases} = $self->_bases_vm(); + $info->{bases} = $self->_bases_vm_info(); $info->{clones} = $self->_clones_vm(); $info->{ports} = [$self->list_ports()]; my @cdrom = (); @@ -2715,12 +2756,14 @@ sub _after_remove_domain($self, $user, $cascade=undef) { $self->_rrd_remove(); $self->_remove_iptables( ); $self->remove_expose(); - $self->_remove_domain_cascade($user) if !$cascade; + + return if $cascade; + + $self->_remove_domain_cascade($user); my $id_base; $id_base = $self->_data('id_base') if $self->is_known(); if ($self->is_known && $self->is_base) { - # $self->_do_remove_base($user); $self->_remove_files_base(); } for my $backup ( $self->list_backups ) { @@ -2745,14 +2788,8 @@ sub _after_remove_domain($self, $user, $cascade=undef) { } sub _remove_all_volumes($self) { - my $vm_local = $self->_vm; - $vm_local = $self->_vm->new( host => 'localhost' ) if !$self->is_local; for my $vol (@{$self->{_volumes}}) { next if $vol =~ /iso$/; - if (!$self->is_local) { - my ($dir) = $vol =~ m{(.*)/}; - next if $vm_local->shared_storage($self->_vm, $dir); - } $self->remove_volume($vol); } } @@ -2763,27 +2800,47 @@ sub _remove_domain_cascade($self,$user, $cascade = 1) { my $domain_name = $self->name or confess "Unknown my self name $self ".Dumper($self->{_data}); my @instances = $self->list_instances(); + my $bases_vm = $self->_bases_vm(); + for my $id_vm ( keys %$bases_vm) { + push @instances,( { id_vm => $id_vm }); + } return if !scalar(@instances); - my $sth_delete = $$CONNECTOR->dbh->prepare("DELETE FROM domain_instances " - ." WHERE id=? "); for my $instance ( @instances ) { 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 ||libvirt error code: 38,/i; + if ( $@ && $@ !~ /I can't find VM ||libvirt error code: 38,/i ) { + warn ''.$@ if $@; + die $@; + } my $domain; $@ = ''; eval { $domain = $vm->search_domain($domain_name) } if $vm; warn $@ if $@; - eval { - $domain->remove($user, $cascade) if $domain; - }; - warn $@ if $@; - $sth_delete->execute($instance->{id}); + $domain->_remove_instance($user, $cascade, $instance->{id}) if $domain; } } +sub _remove_instance($self, $user, $cascade, $id_instance=undef) { + + my $sth = $self->_dbh->prepare( + "SELECT id FROM domain_instances WHERE id_domain=? AND id_vm=?" + ); + $sth->execute($self->id, $self->_data('id_vm')); + my ($id_instance2) = $sth->fetchrow; + $id_instance = $id_instance2 if !defined $id_instance; + my $sth_delete = $$CONNECTOR->dbh->prepare("DELETE FROM domain_instances " + ." WHERE id=? "); + + eval { + $self->remove_instance($user); + }; + warn $@ if $@; + $sth_delete->execute($id_instance) if defined $id_instance; + +} + sub _remove_domain_data_db($id, $type=undef) { _finish_requests_db($id); for my $table ( @@ -2861,7 +2918,7 @@ sub _remove_files_base { for my $file ( $self->list_files_base ) { next if $file =~ /\.iso$/; - unlink $file or die "$! $file" if -e $file; + $self->_vm->remove_file($file) if $self->_vm->file_exists($file); } } @@ -2895,10 +2952,11 @@ sub is_base { $sth->execute($value, $self->id ); $sth->finish; - if (!$value) { - $sth =$$CONNECTOR->dbh->prepare("UPDATE bases_vm SET enabled=? WHERE id_domain=?"); - $sth->execute(0, $self->id); - } + $sth =$$CONNECTOR->dbh->prepare( + "UPDATE bases_vm SET enabled=? WHERE id_domain=?" + ." AND id_vm=?" + ); + $sth->execute($value, $self->id, $self->_data('id_vm')); return $value; } my $ret = $self->_data('is_base'); @@ -2999,7 +3057,7 @@ sub clones($self, %filter) { lock_hash(%$row); push @clones , $row; } - $self->_data('has_clones' => scalar(@clones)); + $self->_data('has_clones' => scalar(@clones)) unless %filter; return @clones; } @@ -3040,15 +3098,20 @@ sub list_files_base { return if $@ && $@ =~ /No DB info/i; die $@ if $@; - my $sth = $$CONNECTOR->dbh->prepare("SELECT file_base_img, target " + my $sth = $$CONNECTOR->dbh->prepare("SELECT file_base_img, target, n_order " ." FROM file_base_images " - ." WHERE id_domain=?"); + ." WHERE id_domain=?" + ." ORDER BY n_order" + ); $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; + while ( my ($img, $target, $n_order) = $sth->fetchrow) { + if ($with_target) { + push @files,[$img,$target, $n_order]; + } else { + push @files,($img); + } } $sth->finish; return @files; @@ -3093,13 +3156,15 @@ Makes the domain a regular, non-base virtual machine and removes the base files. =cut sub remove_base($self, $user) { - return $self->_do_remove_base($user); + $self->_cascade_remove_base_in_nodes() + or $self->_do_remove_base($user); } sub _cascade_remove_base_in_nodes($self) { my $req_nodes; + my $vm_local; for my $vm ( $self->list_vms ) { - next if $vm->is_local; + next if $vm->id == $self->_vm->id; my @after; push @after,(after_request => $req_nodes->id) if $req_nodes; $req_nodes = Ravada::Request->remove_base_vm( @@ -3107,61 +3172,43 @@ sub _cascade_remove_base_in_nodes($self) { ,id_domain => $self->id ,uid => Ravada::Utils::user_daemon->id ,_force => 1 + ,migrate => 0 ,@after ); } - if ( $req_nodes ) { - my $vm_local = $self->_vm->new( host => 'localhost' ); - Ravada::Request->remove_base_vm( - id_vm => $vm_local->id - ,id_domain => $self->id - ,uid => Ravada::Utils::user_daemon->id - ,after_request => $req_nodes->id - ,_force => 1 - ); - $self->is_base(0); - } return $req_nodes; } sub _do_remove_base($self, $user) { - return - if $self->is_base && $self->is_local - && $self->_cascade_remove_base_in_nodes(); - $self->is_base(0) if $self->is_local; - my $vm_local = $self->_vm->new( host => 'localhost' ); + $self->is_base(0); for my $vol ($self->list_volumes_info) { next if !$vol->file || $vol->file =~ /\.iso$/; next if !$self->_vm->file_exists($vol->file); my ($dir) = $vol->file =~ m{(.*)/}; - next if !$self->is_local && $self->_vm->shared_storage($vm_local, $dir); my $backing_file = $vol->backing_file; next if !$backing_file; # confess "Error: no backing file for ".$vol->file if !$backing_file; - $vol->_chmod(oct(600),$backing_file); - if (!$self->is_local) { - my ($dir) = $backing_file =~ m{(.*/)}; - next if $self->_vm->shared_storage($vm_local, $dir); - $self->_vm->remove_file($vol->file); - $self->_vm->remove_file($backing_file); - $self->_vm->refresh_storage_pools(); - next; - } + my $file = $vol->file; + my $vol_backing = Ravada::Volume->new( + file => $backing_file + ,domain => $self + ); + + $vol_backing->_chmod(0o700); $vol->block_commit(); - unlink $vol->file or die "$! ".$vol->file; - my @stat = stat($backing_file) or confess "Error: missing $backing_file"; - move($backing_file, $vol->file) or die "$! $backing_file -> ".$vol->file; - $vol->_chmod(oct(600)); - } + $vol->delete(); + + + $vol_backing->copy($file, 0o600); + $vol_backing->delete(); + } for my $file ($self->list_files_base) { next if $file =~ /\.iso$/i; next if ! $self->_vm->file_exists($file); - my ($dir) = $file =~ m{(.*/)}; - next if !$self->_vm->is_local && $self->_vm->shared_storage($vm_local, $dir); $self->_vm->remove_file($file); } @@ -3184,11 +3231,9 @@ sub _pre_remove_base { sub _post_remove_base { my $self = shift; - return if !$self->_vm->is_local; $self->_remove_base_db(@_); $self->_post_remove_base_domain(); $self->_vm->refresh_storage(); - } sub _post_spinoff($self) { @@ -3271,6 +3316,17 @@ sub clone { return $self->_clone_from_pool(@_) if $from_pool; + if ($self->is_active) { + my $req = Ravada::Request->shutdown(uid => $user->id + ,id_domain => $self->id + ); + if ($request && $req) { + $request->after_request($req->id); + $request->retry(2); + } + die "Warning: virtual machine ".$self->name." is active when cloning. Retry.\n"; + } + my %args2 = @_; delete $args2{from_pool}; return $self->_copy_clone(%args2) if !$self->is_base && $self->id_base(); @@ -3304,10 +3360,6 @@ sub clone { my $vm = $self->_vm; if ($volatile) { $vm = $vm->balance_vm($uid, $self); - } elsif( !$vm->is_local ) { - for my $node ($self->_vm->list_nodes) { - $vm = $node if $node->is_local; - } } my $clone; @@ -3401,8 +3453,14 @@ sub _copy_volumes($self, $copy) { my %volumes = map { $_->info->{target} => $_->file } @volumes; my %copy_volumes = map { $_->info->{target} => $_->file } @copy_volumes; for my $target (keys %volumes) { - copy($volumes{$target}, $copy_volumes{$target}) - or die "$! $volumes{$target}, $copy_volumes{$target}" + my $dst = $copy_volumes{$target}; + $self->_vm->remove_file($dst) if $self->_vm->file_exists($dst); + $self->_vm->copy_file($volumes{$target}, $copy_volumes{$target}); + my $vol = Ravada::Volume->new( + vm => $self->_vm + ,file => $dst + ); + $vol->_chmod(0o600) } } @@ -3538,6 +3596,7 @@ sub _post_shutdown { } } + $self->_data('ports_exposed',0); if (defined $timeout && $timeout && !$self->is_removed && $is_active) { if ($timeout<2) { sleep $timeout; @@ -3569,25 +3628,13 @@ sub _post_shutdown { $self->_set_displays_active(0, $info); delete $info->{ip}; $self->_data(info => encode_json($info)); - # only if not volatile - my $request; - $request = $arg{request} if exists $arg{request}; - if ( !$self->is_local && !$self->is_volatile && $self->has_non_shared_storage()) { - my @instances = $self->list_instances(); - my ($instance_local) = grep { $_->{id_vm} == $self->_id_vm_local() } @instances; - my $req; - $req = Ravada::Request->rsync_back( - uid => Ravada::Utils::user_daemon->id - ,id_domain => $self->id - ,id_node => $self->_vm->id - ,at => time + Ravada::setting(undef,"/backend/delay_migrate_back") - ) if $instance_local; - } $self->_schedule_compact(); $self->needs_restart(0) if $self->is_known() && $self->needs_restart() && !$is_active; + + $self->_data('ports_exposed',0); } sub _id_vm_local($self) { @@ -3597,7 +3644,11 @@ sub _id_vm_local($self) { ." AND ( hostname='127.0.0.1'" ." OR hostname='localhost') " ); - $sth->execute($self->_vm->type); + my $type = $self->_data('vm'); + $type = $self->_vm->type if defined $self->_vm; + $sth->execute($type); + my ($id_vm_local) = $sth->fetchrow; + return $id_vm_local; } sub _schedule_compact($self) { @@ -4239,20 +4290,23 @@ Performs an iptables open of all the exposed ports of the domain sub open_exposed_ports($self, $remote_ip=undef) { my @ports = $self->list_ports(); - return if !@ports; - return if !$self->is_active; - return if $self->_data('networking') eq 'isolated'; + if ( !@ports || !$self->is_active || $self->_data('networking') eq 'isolated' ) { + $self->_data('ports_exposed', 0); + return; + } my $ip = $self->ip; if ( ! $ip ) { die "Error: No ip in domain ".$self->name.". Retry.\n"; } + $self->_data('ports_exposed', 1); $self->display_info(Ravada::Utils::user_daemon); for my $expose ( @ports ) { $self->_open_exposed_port($expose->{internal_port}, $expose->{name} ,$expose->{restricted}, $remote_ip); } + $self->_data('ports_exposed', 2); } sub _close_exposed_port($self,$internal_port_req=undef) { @@ -4280,6 +4334,7 @@ sub _close_exposed_port($self,$internal_port_req=undef) { $self->_close_exposed_port_nat($iptables, %port); $self->_close_exposed_port_client($iptables, %port); + $self->_data('ports_exposed',0) if $self->is_known(); $sth->finish; } @@ -4591,7 +4646,7 @@ sub _post_start { ,id_domain => $self->id ,retry => 20 ,remote_ip => $remote_ip - ) if $is_active && $remote_ip && $self->list_ports(); + ) if $remote_ip && $self->list_ports(); if ($self->run_timeout) { my $req = Ravada::Request->shutdown_domain( @@ -5059,10 +5114,11 @@ sub clean_swap_volumes { next if !$self->_vm->file_exists($vol->file); my $backing_file; eval { $backing_file = $vol->backing_file }; - confess $@ if $@ && $@ !~ /No backing file/i; + my $error = $@; + confess $error if $error && $error !~ /No backing file/i; next if !$backing_file; next if !$self->_vm->file_exists($backing_file); - $vol->restore() if !$@; + $vol->restore() if !$error; } } } @@ -5164,6 +5220,8 @@ sub get_controllers($self) { my $info; my %controllers = $self->list_controllers(); for my $name ( sort keys %controllers ) { + next if $name eq 'disk' && defined $self->_data('id_vm') + && $self->_vm && $self->_vm->id != $self->_data('id_vm'); $info->{$name} = [$self->get_controller($name)]; } @@ -5506,7 +5564,7 @@ sub rsync($self, @args) { next if _check_stat($file, $vm_local, $node); my $msg = $self->_msg_log_rsync($file, $node, "rsync", $request); - $request->status("syncing") if $request; + $request->status("working") if $request; $request->error("Syncing $file") if $request; $request->error($msg) if $request && $DEBUG_RSYNC; warn "$msg\n" if $DEBUG_RSYNC; @@ -5557,10 +5615,9 @@ sub _rsync_volumes_back($self, $node, $request=undef) { my $msg = $self->_msg_log_rsync($file, $node, "rsync_back", $request); - $request->status("syncing") if $request; + $request->status("working") if $request; $request->error($msg) if $request; warn "$msg\n" if $DEBUG_RSYNC; - my $t0 = time; $rsync->exec(src => 'root@'.$node->host.":".$file ,dest => $file ); if ( $rsync->err ) { $request->status("done",join(" ",@{$rsync->err})) if $request; @@ -5579,18 +5636,16 @@ sub _pre_migrate($self, $node, $request = undef) { $self->_internal_autostart(0); $self->check_status(); - confess "ERROR: Active domains can't be migrated" if $self->is_active; + die "ERROR: Active domains can't be migrated.\n" if $self->is_active; if ( $self->id_base ) { my $base = Ravada::Domain->open($self->id_base); confess "ERROR: base ".$base->name." not prepared in node ".$node->name if !$base->base_in_vm($node->id); confess "ERROR: base id ".$self->id_base." not found." if !$base; - - return unless $self->_check_all_parents_in_node($node); - } $node->_add_instance_db($self->id); + $node->refresh_storage_pools(); } sub _post_migrate($self, $node, $request = undef) { @@ -5598,9 +5653,11 @@ sub _post_migrate($self, $node, $request = undef) { $self->_vm($node); $self->_update_id_vm(); + $node->_add_instance_db($self->id); # TODO: update db instead set this value $self->{_migrated} = 1; + $node->refresh_storage_pools(); } sub _around_migrate($orig, $self, $node, $request=undef) { @@ -5629,18 +5686,27 @@ sub _set_base_vm_db($self, $id_vm, $value, $id_request=undef) { return if !$value && !$self->is_known; my $sth = $$CONNECTOR->dbh->prepare( "INSERT INTO bases_vm (id_domain, id_vm, enabled, id_request) " - ." VALUES(?, ?, ?, ?)" + ." VALUES(?, ?, 0, ?)" ); - $sth->execute($self->id, $id_vm, $value, $id_request); + $sth->execute($self->id, $id_vm, $id_request); $sth->finish; } else { my $sth = $$CONNECTOR->dbh->prepare( - "UPDATE bases_vm SET enabled=?, id_request=?" + "UPDATE bases_vm SET id_request=?" + ." WHERE id_domain=? AND id_vm=?" + ); + $sth->execute($id_request, $self->id, $id_vm); + $sth->finish; + } + if (defined $value) { + $is_base = $self->base_in_vm($id_vm) if !$is_base; + my $sth = $$CONNECTOR->dbh->prepare( + "UPDATE bases_vm SET enabled=?" ." WHERE id_domain=? AND id_vm=?" ); - $value = 0 if !defined $value; - $sth->execute($value, $id_request, $self->id, $id_vm); + $sth->execute($value, $self->id, $id_vm); $sth->finish; + } } @@ -5666,6 +5732,8 @@ sub set_base_vm($self, %args) { my $vm = delete $args{vm}; my $node = delete $args{node}; my $request = delete $args{request}; + my $migrate = delete $args{migrate}; + $migrate = 1 if !defined $migrate; confess "ERROR: Unknown arguments, valid are id_vm, value, user, node and vm " .Dumper(\%args) if keys %args; @@ -5676,59 +5744,133 @@ sub set_base_vm($self, %args) { confess "ERROR: user required" if !$user; - $request->status("working") if $request; $vm = $node if $node; + $id_vm = $vm->id if !defined $id_vm; + + $value = 1 if !defined $value; + + die "Error: there are already clones in this node.\n" + if !$value && $self->clones(id_vm => $id_vm); + + $request->status("working") if $request; $vm = Ravada::VM->open($id_vm) if !$vm; if ( !$vm || !$vm->is_active || !$vm->vm) { die "Error: VM ".Ravada::VM::_search_name($id_vm)." not available\n" } - $value = 1 if !defined $value; - my $id_request; if ($request) { $request->status("working"); $id_request = $request->id; } - $self->_set_base_vm_db($vm->id, $value, $id_request); - - if ($vm->is_local) { - $self->_set_vm($vm,1); # force set vm on domain - if (!$value) { - $request->status("working","Removing base") if $request; - $self->remove_base($user); - } else { - $self->prepare_base($user) if !$self->is_base(); + if ($value) { + if ( !$self->is_base() ) { $request->status("working","Preparing base") if $request; + $self->prepare_base($user) } - } elsif ($value) { - $self->_check_all_parents_in_node($vm); $request->status("working", "Syncing base volumes to ".$vm->host) if $request; + + $vm->refresh_storage_pools(); eval { $self->migrate($vm, $request); }; my $err = $@; + warn $err if $err; if ( $err ) { $self->_set_base_vm_db($vm->id, 0); die $err; } + $vm->_add_instance_db($self->id); $self->_set_clones_autostart(0); + } else { - $self->_set_vm($vm,1); # force set vm on domain - $self->_do_remove_base($user); + $request->status("working","Removing base") if $request; + + my $bases_vm = $self->_bases_vm(1); + my @nodes; + my $node2; + for my $id_vm ( keys %$bases_vm) { + if ( $id_vm != $vm->id ) { + my $node = Ravada::VM->open($id_vm); + $node2 = $node if $node->is_local(); + push @nodes,($node); + } + } + ($node2) = @nodes if !$node2; + if (!@nodes) { + $self->_vm($vm); + $self->_do_remove_base($user); + $vm->refresh_storage_pools(); + } else { + my $instance = $vm->search_domain($self->name); + $instance->_remove_instance($user,1) if $instance; + $self->_remove_files_not_shared($vm,@nodes, $self->_vm); + $self->_vm($node2); + $self->_data('id_vm' => $node2->id); + $vm->refresh_storage_pools(); + } } - if (!$vm->is_local) { - my $vm_local = $self->_vm->new( host => 'localhost' ); - $self->_set_vm($vm_local, 1); + $self->_set_base_vm_db($vm->id, $value); + + if (!$value) { + my $bases_vm = $self->_bases_vm(1); #enabled bases vm + if (!keys %$bases_vm) { + $self->_post_remove_base(); + } } - $vm->_add_instance_db($self->id); - return $self->_set_base_vm_db($vm->id, $value); } -sub _check_all_parents_in_node($self, $vm) { +sub _check_set_base_reqs($self) { + my $sth = $$CONNECTOR->dbh->prepare( + "SELECT id,id_request FROM bases_vm " + ." WHERE id_domain=? " + ." AND id_request is NOT NULL" + ); + $sth->execute($self->id); + + my $sth_update = $$CONNECTOR->dbh->prepare( + "UPDATE bases_vm SET id_request=NULL WHERE id=?" + ); + while ( my ($id, $id_request) = $sth->fetchrow ) { + my $req; + eval { $req = Ravada::Request->open($id_request)}; + + if (!$req || $req->status() eq 'done') { + $sth_update->execute($id); + } + } +} + +sub _remove_files_not_shared($self, $vm, @nodes){ + + for my $file ($self->list_volumes,$self->list_files_base) { + next if $file =~ /\.iso$/; + next if !$self->_vm->file_exists($file); + + my ($dir) = $file =~ m{(.*)/}; + my $shared=0; + for my $node(@nodes) { + next if $vm->id == $node->id; + $shared++ if $vm->shared_storage($node, $dir); + last if $shared; + } + next if $shared; + $vm->remove_file($file); + } +} + +sub _check_all_base_parents_in_node($self, $vm) { + return 1 if !$self->id_base; + + my $base = Ravada::Front::Domain->open($self->id_base); + return 0 if !$base->base_in_vm($vm->id); + return $base->_check_all_base_parents_in_node($vm); +} + +sub _check_all_parents_in_node($self, $vm, $request=undef) { my @bases; my $base = $self; for ( ;; ) { @@ -5739,10 +5881,26 @@ sub _check_all_parents_in_node($self, $vm) { } return 1 if !@bases; my $req; + if ($request && $request->after_request) { + $req = Ravada::Request->open($request->after_request); + } for my $base ( reverse @bases) { $base->_set_base_vm_db($vm->id,0); + my @instances = $base->list_instances(); + for my $i (@instances) { + next if $i->{id_vm} == $vm->id; + $base->_data(id_vm => $i->{id_vm}); + last; + } my @after_req; @after_req = ( after_request_ok => $req->id) if $req; + $req = Ravada::Request->migrate( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $base->id + ,id_node => $vm->id + ,@after_req + ); + @after_req = ( after_request_ok => $req->id) if $req; $req = Ravada::Request->set_base_vm( uid => Ravada::Utils::user_daemon->id ,id_domain => $base->id @@ -5750,6 +5908,9 @@ sub _check_all_parents_in_node($self, $vm) { ,@after_req ); } + if ($request) { + $request->after_request($req->id); + } return 0; } @@ -5782,13 +5943,7 @@ Removes a base in a Virtual Machine Manager node. =cut sub remove_base_vm($self, %args) { - my $user = delete $args{user}; - my $vm = delete $args{vm}; - $vm = delete $args{node} if !$vm; - confess "ERROR: Unknown arguments ".join(',',sort keys %args).", valid are user and vm." - if keys %args; - - return $self->set_base_vm(vm => $vm, user => $user, value => 0); + return $self->set_base_vm(%args, value => 0); } =head2 file_screenshot @@ -5826,7 +5981,6 @@ Returns a list for virtual machine managers where this domain is base =cut sub list_vms($self, $check_host_devices=0, $only_available=0) { - confess "Domain is not base" if !$self->is_base; $check_host_devices = 1 if !defined $check_host_devices; @@ -5846,7 +6000,6 @@ sub list_vms($self, $check_host_devices=0, $only_available=0) { my @host_devices = $self->list_host_devices(); while (my ($id_vm, $name_vm, $id_request, $is_active, $enabled, $cached_down) = $sth->fetchrow) { next if $only_available && ( !$is_active || !$enabled); - my $t1 = time; if ($only_available && $cached_down) { next if time-$cached_down < $self->_vm->timeout_down_cache(); } @@ -5858,7 +6011,6 @@ sub list_vms($self, $check_host_devices=0, $only_available=0) { next if $check_host_devices && !$self->_available_hds($id_vm, \@host_devices); my $vm; eval { $vm = Ravada::VM->open($id_vm) }; - warn "id_domain: ".$self->id."\n".$@ if $@; push @vms,($vm) if $vm; } return $self->_vm if !@vms && !@host_devices && $self->is_base(); @@ -5882,9 +6034,6 @@ sub base_in_vm($self,$id_vm) { confess "ERROR: id_vm must be a number, it is '$id_vm'" if $id_vm !~ /^\d+$/; - confess "ERROR: Domain ".$self->name." is not a base" - if ref($self) && !$self->is_base; - confess "Undefined id_vm " if !defined $id_vm; my $sth = $$CONNECTOR->dbh->prepare( @@ -5908,25 +6057,42 @@ sub _base_files_in_vm($self,$vm) { return 1; } -sub _bases_vm($self) { +sub _bases_vm_info($self, $only_enabled=0) { + return $self->_bases_vm($only_enabled,1); +} + +sub _bases_vm($self, $only_enabled=0, $info=0) { my $sth = $$CONNECTOR->dbh->prepare( "SELECT id, hostname FROM vms WHERE vm_type=?" ); $sth->execute($self->type); my %base; while (my ($id_vm, $hostname) = $sth->fetchrow) { - $base{$id_vm} = 0; - $base{$id_vm} = 1 if $self->is_base && $hostname =~ /localhost|127/; + if ($info ) { + $base{$id_vm} = {enabled => 0}; + } else { + $base{$id_vm} = 0; + } } $sth->finish; for my $id_vm ( sort keys %base ) { $sth = $$CONNECTOR->dbh->prepare( - "SELECT enabled FROM bases_vm WHERE id_domain=? AND id_vm=?" + "SELECT enabled,id_request FROM bases_vm WHERE id_domain=? AND id_vm=?" ); $sth->execute($self->id, $id_vm); - while (my ($enabled) = $sth->fetchrow) { - $base{$id_vm} = $enabled; + while (my $row = $sth->fetchrow_hashref) { + if ($info) { + $base{$id_vm}=$row; + } else { + $base{$id_vm} = $row->{enabled}; + } + } + } + # delete disabled entries when checking for only enabled + if ($only_enabled) { + for my $id_vm (keys %base) { + delete $base{$id_vm} if !$base{$id_vm}; } } return \%base; @@ -6193,7 +6359,10 @@ sub log_status($self, $name, $value, $time='N') { return if exists $self->{_log_status_time} && $self->{_log_status_time} == $time0; $self->{_log_status_time} = $time0; - my ($cpu_time, $mem) = $self->get_stats(); + my ($cpu_time, $mem); + ($cpu_time, $mem) = $self->get_stats() + if Ravada::Front->setting('/backend/stats/cpu') + || Ravada::Front->setting('/backend/stats/memory'); if ($cpu_time || $mem) { RRDs::update ($file , "--template", "$name:cpu:memory", "$time:$value:$cpu_time:$mem"); } else { @@ -6378,13 +6547,6 @@ sub _around_change_hardware($orig, $self, $hardware, $index=undef, $data=undef) _fix_hw_ignore_fields($data); - my $real_id_vm; - if ($hardware eq 'disk' && !$self->_vm->is_local) { - $real_id_vm = $self->_vm->id; - my $vm_local = $self->_vm->new( host => 'localhost' ); - $self->_set_vm($vm_local, 1); - } - my $is_display_builtin; if ($hardware eq 'display') { @@ -6418,11 +6580,6 @@ sub _around_change_hardware($orig, $self, $hardware, $index=undef, $data=undef) $self->_redefine_instances() if $self->is_known(); } - if ( $real_id_vm ) { - my $id_vm = $real_id_vm; - my $vm = Ravada::VM->open($id_vm); - $self->_set_vm($vm, 1); - } $self->_post_change_hardware($hardware, $index, $data); } @@ -6712,13 +6869,6 @@ sub _add_hardware_disk($orig, $self, $index, $data) { die "Error: new disk volumes can not be added to bases\n" if $self->is_base; - my $real_id_vm; - if (!$self->_vm->is_local) { - $real_id_vm = $self->_vm->id; - my $vm_local = $self->_vm->new( host => 'localhost' ); - $self->_set_vm($vm_local, 1); - } - $self->_check_duplicated_volume_name($data->{file}); $orig->($self, 'disk', $index, $data); @@ -6729,11 +6879,6 @@ sub _add_hardware_disk($orig, $self, $index, $data) { $self->list_volumes_info(); $self->_redefine_instances(); - if ( $real_id_vm ) { - my $id_vm = $real_id_vm; - my $vm = Ravada::VM->open($id_vm); - $self->_set_vm($vm, 1); - } } sub _fix_filesystem_data($self,$data) { @@ -6859,6 +7004,26 @@ sub _around_remove_hardware($orig, $self, $hardware, $index=undef, $options=unde } +sub _around_ip($orig, $self, @args) { + my $ip = $self->$orig(@args); + + if (!$self->readonly() && $self->list_ports()) { + if ($ip && !$self->_data('ports_exposed')) { + $self->_data('ports_exposed' => 1); + my $req = Ravada::Request->open_exposed_ports( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $self->id + ,retry => 20 + ,_force => 1 + ); + } + if (!$ip && $self->_data('ports_exposed')) { + $self->_data('ports_exposed' => 0); + } + } + return $ip; +} + sub _hardware_enabled($self, $name, $index, $options ) { if ( $name eq 'filesystem') { my $sth = $self->_dbh->prepare("SELECT id,enabled " @@ -7588,9 +7753,11 @@ sub list_instances($self, $id=undef) { my @instances; while (my $row = $sth->fetchrow_hashref) { + $row->{is_local} = Ravada::VM::is_local($row->{id_vm}); lock_hash(%$row); push @instances, ( $row ); } + return @instances; } @@ -8401,12 +8568,13 @@ sub _restore_base_volumes_metadata($self, $data) { my $sth = $$CONNECTOR->dbh->prepare( "INSERT INTO file_base_images " - ." (id_domain , file_base_img, target )" - ." VALUES(?,?,?)" + ." (id_domain , file_base_img, target,n_order )" + ." VALUES(?,?,?,?)" ); + my $count=0; for my $vol ( @{$data->{base_volumes}}) { - $sth->execute($self->id, $vol->[0], $vol->[1]); + $sth->execute($self->id, $vol->[0], $vol->[1],( $vol->[2] or $count++) ); } unlock_hash(%$data); delete $data->{base_volumes}; diff --git a/lib/Ravada/Domain/KVM.pm b/lib/Ravada/Domain/KVM.pm index 315647ac0..3cbdd9017 100644 --- a/lib/Ravada/Domain/KVM.pm +++ b/lib/Ravada/Domain/KVM.pm @@ -298,19 +298,7 @@ sub remove { my @volumes; if (!$self->is_removed ) { - my @vols_info; - for ( 1 .. 10 ) { - eval { @vols_info = $self->list_volumes_info }; - last if !$@; - warn "WARNING: remove, volumes info: $@"; - sleep 1; - } - for my $vol ( @vols_info ) { - push @volumes,($vol->{file}) - if exists $vol->{file} - && exists $vol->{device} - && $vol->{device} eq 'file'; - } + @volumes = grep (/!\.iso$/,$self->list_volumes()); } if (!$self->is_removed && $self->domain && $self->domain->is_active) { @@ -342,6 +330,21 @@ sub remove { } +sub remove_instance($self, $user) { + return if !$self->domain; + eval { + $self->domain->destroy() if $self->domain->is_active(); + }; + warn $@ if $@; + eval { + $self->domain->undefine(Sys::Virt::Domain::UNDEFINE_NVRAM) if $self->domain;# && !$self->is_removed + }; + warn $@ if $@; + confess $@ if $@ && $@ !~ /libvirt error code: 42/; + eval { $self->remove_disks() if $self->is_known }; + warn $@ if $@; + confess $@ if $@ && $@ !~ /libvirt error code: 42/; +} sub _remove_file_image { my $self = shift; @@ -393,8 +396,14 @@ 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' or $device eq 'cdrom') }; + eval { + $info = $self->_volume_info($file) + if $with_info + && $file && ( $device eq 'disk' or $device eq 'cdrom') + && ( !defined $self->_data('id_vm') + || $self->_vm->id == $self->_data('id_vm')) + } + ; die $@ if $@ && $@ !~ /not found/i; $info->{device} = $device; if (!$info->{name} ) { @@ -576,9 +585,10 @@ sub _set_backing_store($self, $disk, $backing_file) { sub _set_volumes_backing_store($self) { my $doc = XML::LibXML->load_xml(string - => $self->xml_description(Sys::Virt::Domain::XML_INACTIVE)) + => $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE)) or die "ERROR: $!\n"; + my ($uuid) = $doc->findnodes("/domain/uuid/text()"); my @volumes_info = grep { defined($_) && $_->file } $self->list_volumes_info; my %vol = map { $_->file => $_ } @volumes_info; for my $disk ($doc->findnodes('/domain/devices/disk')) { @@ -2528,6 +2538,7 @@ sub _set_controller_network($self, $number, $data) { my $type = ( delete $data->{type} or 'NAT' ); my $network =(delete $data->{network} or 'default'); my $bridge = (delete $data->{bridge} or ''); + my $isolated = _network_port_arguments($data); confess "Error: unkonwn fields in data ".Dumper($data) if keys %$data; @@ -2546,6 +2557,8 @@ sub _set_controller_network($self, $number, $data) { die "Error adding network, unknown type '$type'"; } + $device .= "" if $isolated; + $device .= "
@@ -2744,7 +2757,13 @@ sub _remove_device($self, $index, $device, $attribute_name0=undef, $attribute_va $msg = " $attribute_name0=$attribute_value ".join(",",@found) if defined $attribute_name0; - confess "ERROR: $device $msg ".($index or '') + my $index_text = ''; + $index_text = $index if defined $index; + + warn "ERROR: $device $msg $index_text" + ." not removed, only ".($ind)." found in ".$self->name; + + confess "ERROR: $device $msg $index_text" ." not removed, only ".($ind)." found in ".$self->name."\n"; } @@ -2884,7 +2903,8 @@ sub _check_uuid($self, $doc, $node) { my @other_uuids; for my $domain ($node->vm->list_all_domains, $self->_vm->vm->list_all_domains) { - push @other_uuids,($domain->get_uuid_string); + push @other_uuids,($domain->get_uuid_string) + unless $domain->get_name eq $self->name; } return if !(grep /^$uuid$/,@other_uuids); @@ -2902,6 +2922,7 @@ sub _check_machine($self,$doc, $node) { my ($machine_bare) = $machine =~ /(.*)-\d+\.\d+$/; my %machine_types = $node->list_machine_types; my $new_machine = $machine; + return $new_machine if !defined $machine_bare; my $arch = $os_type->getAttribute('arch'); for my $try ( @{$machine_types{$arch}} ) { @@ -2974,6 +2995,11 @@ sub internal_id($self) { return $self->domain->get_id(); } +sub _internal_uuid($self) { + confess "ERROR: Missing internal domain" if !$self->domain; + return $self->domain->get_id(); +} + sub autostart { return _internal_autostart(@_) } sub _internal_autostart($self, $value=undef, $user=undef) { @@ -3717,6 +3743,21 @@ sub _change_xml($xml, $name, $data) { return $changed; } +sub _network_port_arguments($data) { + return if !exists $data->{port}; + + my $isolated = delete $data->{port}->{isolated}; + + die "Error: wrong isolated '$isolated'. It must be 'yes' or 'no'" + if defined $isolated && !( $isolated eq 'yes' || $isolated eq 'no'); + + die "Error: Unknown arguments in port ".Dumper($data->{port}) if keys %{$data->{port}}; + + delete $data->{port}; + + return $isolated; +} + sub _change_hardware_network($self, $index, $data) { die "Error: index number si required.\n" if !defined $index; @@ -3734,14 +3775,7 @@ sub _change_hardware_network($self, $index, $data) { my $driver = lc(delete $data->{driver} or ''); my $bridge = delete $data->{bridge}; my $network = delete $data->{network}; - my $isolated = delete $data->{port}->{isolated}; - - die "Error: wrong isolated '$isolated'. It must be 'yes' or 'no'" - if defined $isolated && !( $isolated eq 'yes' || $isolated eq 'no'); - - die "Error: Unknown arguments in port ".Dumper($data->{port}) if keys %{$data->{port}}; - - delete $data->{port}; + my $isolated = _network_port_arguments($data); die "Error: Unknown arguments ".Dumper($data) if keys %$data; @@ -4346,12 +4380,20 @@ sub get_stats($self) { my $mem; my $cpu_time; - my $mem_stats = $self->domain->memory_stats(); + my @cpu_stats; + @cpu_stats = $self->domain->get_cpu_stats(-1,1) + if Ravada::Front->setting(undef,'/backend/stats/cpu'); + + $cpu_time = int($cpu_stats[0]->{cpu_time}/1024/1024); + + my $mem_stats; + $mem_stats = $self->domain->memory_stats() + if Ravada::Front->setting('/backend/stats/memory'); + if (exists $mem_stats->{rss} && exists $mem_stats->{actual_balloon}) { $mem = int(($mem_stats->{rss}/$mem_stats->{actual_balloon})*100); } - my @cpu_stats = $self->domain->get_cpu_stats(-1,1); - $cpu_time = int($cpu_stats[0]->{cpu_time}/1024/1024); + return ($cpu_time, $mem); } diff --git a/lib/Ravada/Domain/Void.pm b/lib/Ravada/Domain/Void.pm index b320d0ea9..e1ed46747 100644 --- a/lib/Ravada/Domain/Void.pm +++ b/lib/Ravada/Domain/Void.pm @@ -210,9 +210,12 @@ sub resume { return $self->_store(is_paused => 0 ); } -sub remove { - my $self = shift; +sub remove($self, $user) { + + $self->remove_instance($user); +} +sub remove_instance($self, $user) { $self->remove_disks(); my $config_file = $self->_config_file; @@ -221,8 +224,9 @@ sub remove { warn $err if $err; } if ($self->_vm->file_exists($config_file.".lock")) { - $self->_vm->run_command("/bin/rm",$config_file.".lock"); + $self->_vm->remove_file($config_file.".lock"); } + } sub can_hibernate { return 1; } @@ -348,7 +352,15 @@ sub shutdown { for my $display (@{$hardware->{'display'}}) { $display->{port} = 'auto'; } + for my $if (@{$hardware->{'network'}}) { + $if->{address} = ''; + } + $self->_store(hardware => $hardware); + + my $info = $self->_value('info'); + $info->{ip} = ''; + $self->_store(info => $info); } sub force_shutdown { @@ -1070,7 +1082,7 @@ sub _change_hardware_disk($self, $index, $data_new) { my $driver; $driver = delete $data_new->{bus} if exists $data_new->{bus}; lock_hash(%$data_new); - return $self->_change_driver_disk($index, $driver) if $driver; + $self->_change_driver_disk($index, $driver) if $driver; die "Error: volume $index not found, only ".scalar(@volumes)." found." if $index >= scalar(@volumes); @@ -1078,7 +1090,7 @@ sub _change_hardware_disk($self, $index, $data_new) { my $file = $volumes[$index]->{file}; my $new_file; $new_file = $data_new->{file} if exists $data_new->{file}; - return $self->_change_disk_data($index, file => $new_file) if defined $new_file; + $self->_change_disk_data($index, file => $new_file) if defined $new_file; return if !$file; my $data; diff --git a/lib/Ravada/Front.pm b/lib/Ravada/Front.pm index 37c78f3ba..b5b7e81cc 100644 --- a/lib/Ravada/Front.pm +++ b/lib/Ravada/Front.pm @@ -788,8 +788,8 @@ sub list_iso_images { if $row->{options}; $row->{min_ram} = 0.2 if !$row->{min_ram}; + _get_device_re($row); lock_keys(%$row); - _fix_iso_file_re($row); $row->{min_swap_size} = 0 if !$row->{min_swap_size}; push @iso,($row); @@ -798,21 +798,29 @@ sub list_iso_images { return \@iso; } -sub _fix_iso_file_re($row) { +sub _get_device_re($row) { + + return if !$row->{url}; + if ($row->{rename_file}) { - unlock_keys(%$row); - $row->{file_re_orig} = $row->{file_re}; - lock_keys(%$row); - $row->{file_re} = $row->{rename_file}; - } elsif ($row->{url} && !$row->{file_re} ) { - my ($file_re) = $row->{url} =~ m{.*/([^/]+)$}; - $row->{file_re}= $file_re if $file_re; + $row->{device_re} = $row->{rename_file}; + } elsif ($row->{file_re}) { + $row->{device_re} = $row->{file_re}; + } elsif ($row->{url} ) { + my ($url,$file_re) = $row->{url} =~ m{(.*)/([^/]+)$}; + if ($file_re && $url) { + $row->{device_re}= $file_re; + } } - if ($row->{file_re}) { - $row->{file_re} = '^'.$row->{file_re} unless $row->{file_re} =~ /\^/; - $row->{file_re} .= '$' unless $row->{file_re} =~ /\$/; - } + confess "Error: no device found in $row->{name} from " + .($row->{file_re} or '') + ." or ".($row->{rename_file} or '') + ." or ".$row->{url} + if !$row->{device_re}; + + $row->{device_re} = '^'.$row->{device_re} unless $row->{device_re} =~ /\^/; + $row->{device_re} .= '$' unless $row->{device_re} =~ /\$/; } @@ -825,13 +833,16 @@ Returns a reference to a list of the ISOs known by the system sub iso_file ($self, $id_vm, $uid) { + confess "Error: undefined id node" + if !defined $id_vm; + my $key = "list_isos_$id_vm"; my $cache = $self->_cache_get($key); return $cache if $cache; Ravada::Request->refresh_storage( id_vm=> $id_vm - ,uid => Ravada::Utils::user_daemon->id + ,uid => Ravada::Utils->user_daemon->id ); my $req = Ravada::Request->list_isos( @@ -843,7 +854,10 @@ sub iso_file ($self, $id_vm, $uid) { return [] if $req->status ne 'done'; my $isos = []; - $isos = decode_json($req->output()) if $req->output; + eval { + $isos = $req->output() if $req->output; + }; + warn $@." for request=".$req->id." ".Dumper($req->output) if $@; $self->_cache_store($key, $isos); @@ -1219,6 +1233,7 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) { || $command eq 'list_storage_pools' || $command eq 'list_cpu_models' || $command eq 'list_networks' + || $command eq 'rsync_back' ; next if ( $command eq 'force_shutdown' || $command eq 'force_reboot' @@ -1500,7 +1515,7 @@ sub list_network_interfaces($self, %args) { } return [] if $req->status ne 'done' || !length($req->output); - my $interfaces = decode_json($req->output()); + my $interfaces = $req->output; $self->{$cache_key} = $interfaces; return $interfaces; @@ -1771,7 +1786,7 @@ sub list_machine_types($self, $uid, $vm_type) { return {} if $req->status ne 'done'; my $types = {}; - $types = decode_json($req->output()) if $req->output; + $types = $req->output() if $req->output; $self->_cache_store($key,$types); @@ -1802,7 +1817,7 @@ sub list_cpu_models($self, $uid, $id_domain) { return {} if $req->status ne 'done'; my $models= {}; - $models = decode_json($req->output()) if $req->output; + $models = $req->output() if $req->output; $self->_cache_store($key,$models); @@ -1846,7 +1861,8 @@ sub list_storage_pools($self, $uid, $id_vm, $active=undef) { return _filter_active($cache, $active) if $req->status ne 'done'; my $pools = []; - $pools = decode_json($req->output()) if $req->output; + + $pools = $req->output() if $req->output; $self->_cache_store($key,$pools) if scalar(@$pools); diff --git a/lib/Ravada/Front/Domain.pm b/lib/Ravada/Front/Domain.pm index fdc223615..c15b460ea 100644 --- a/lib/Ravada/Front/Domain.pm +++ b/lib/Ravada/Front/Domain.pm @@ -173,9 +173,11 @@ sub name($self) { return $self->_data('name') } +# those should run a request sub pause { confess "TODO" } sub prepare_base { confess "TODO" } sub remove { confess "TODO" } +sub remove_instance { confess "TODO" } sub rename { confess "TODO" } sub resume { confess "TODO" } sub screenshot { confess "TODO" } @@ -269,4 +271,18 @@ sub set_time($self) { , retry => 10 ); } + +sub ip($self) { + my $info = $self->info(Ravada::Utils->user_daemon); + return $info->{ip} if exists $info->{ip}; + my @network = $self->_get_controller_network(); + return '' if !@network; + + for my $net (@network) { + return $net->{address} if exists $net->{address} && $net->{address}; + } + + return ''; +} + 1; diff --git a/lib/Ravada/Front/Domain/KVM.pm b/lib/Ravada/Front/Domain/KVM.pm index e24bbd5b4..2eca26754 100644 --- a/lib/Ravada/Front/Domain/KVM.pm +++ b/lib/Ravada/Front/Domain/KVM.pm @@ -513,4 +513,6 @@ sub xml_description($self) { return $self->_data_extra('xml'); } +sub can_hybernate { 1 }; + 1; diff --git a/lib/Ravada/I18N/ca.po b/lib/Ravada/I18N/ca.po index 7dfb7451f..e340bfb22 100644 --- a/lib/Ravada/I18N/ca.po +++ b/lib/Ravada/I18N/ca.po @@ -1962,10 +1962,11 @@ msgstr "La nova contrasenya només pot contenir paraules i nombres" msgid "Password and their confirmation do not match!" msgstr "La confirmació de la contrasenya no coincideix!" -msgid "This server has reservations for today. Machines from users out of the booking list will be shutdown." -msgstr "" -"Aquest servidor té reserves per avui. Les màquines d'usuaris fora de la " -"reserva seran aturades." +msgid "This server has reservations for today." +msgstr "Aquest servidor té reserves per avui." + +msgid "Machines from users out of the booking list will be shutdown." +msgstr "Les màquines d'usuaris fora de la reserva seran aturades." msgid "disabled" msgstr "desactivat" @@ -2249,14 +2250,6 @@ msgstr "Guardar canvis" msgid "This booking overlaps already scheduled reservations" msgstr "Aquesta reserva es superposa a les reserves ja programades" -#, fuzzy -msgid "" -"This server has reservations for today. Machines from users out of\n" -" the booking list will be shutdown." -msgstr "" -"Aquest servidor té reserves per avui. Màquines d'usuaris fora de\n" -" la llista de reserves es tancarà." - msgid "This field is required" msgstr "Aquest camp és obligatori" @@ -2352,7 +2345,7 @@ msgstr "Seguiu aquests passos per a la configuració del client Spice" msgid "Share" msgstr "Comparteix" -msgid "Mange Host Devices" +msgid "Manage Host Devices" msgstr "Gestionar dispositius amfitrions" msgid "Compact data volumes daily." @@ -2362,7 +2355,334 @@ msgid "Auto Compact" msgstr "Auto compressió" msgid "Host Devices" -msgstr "Dispositiu amfitrió" +msgstr "Dispositius amfitrions" msgid "Access denied: user not found or insufficient permissions." msgstr "Accés denegat: usuari no trobat o permissos insuficients." + +msgid "Add host device" +msgstr "Afegir dispositiu amfitrió" + +msgid "LDAP groups" +msgstr "Grups LDAP" + +msgid "Local groups" +msgstr "Grups locals" + +msgid "Create a group." +msgstr "Crea un grup." + +msgid "This virtual machine has no local group restrictions." +msgstr "Aquesta màquina virtual no té restriccions locals" + +msgid "Routes" +msgstr "Rutes" + +msgid "Storage" +msgstr "Emmagatzematge" + +msgid "list" +msgstr "llista" + +msgid "purge" +msgstr "purgar" + +msgid "default" +msgstr "per defecte" + +msgid "Enabled" +msgstr "Habilitat" + +msgid "Size" +msgstr "Espai" + +msgid "Used" +msgstr "Utilitzat" + +msgid "Available" +msgstr "Disponible" + +msgid "Path" +msgstr "Ruta" + +msgid "New Storage" +msgstr "Nou emmagatzematge" + +msgid "Unused volumes" +msgstr "Volums no utilitzats" + +msgid "Remove Selected" +msgstr "Esborrar seleccionat" + +msgid "back" +msgstr "enrere" + +msgid "IP address" +msgstr "Adreça IP" + +msgid "Netmask" +msgstr "Màscara de red" + +msgid "DHCP start" +msgstr "Inici DHCP" + +msgid "DHCP end" +msgstr "Final DHCP" + +msgid "Auto Start" +msgstr "Inici automàtic" + +msgid "Auto create users" +msgstr "Crear usuaris automàticament" + +msgid "Authenticated users are allowed to log in" +msgstr "Usuaris autenticats poden inciar sessió" + +msgid "Auth OpenID" +msgstr "Autenticació OpenID" + +msgid "Logout URL" +msgstr "URL de tancament de sessió" + +msgid "Charts" +msgstr "Gràfics" + +msgid "share" +msgstr "comparteix" + +msgid "Allow users to clone this base" +msgstr "Permet als usuaris clonar aquesta base" + +msgid "Show the base when the user already created a clone" +msgstr "Mostra la base quan l'usuari ja ha creat un clon" + +msgid "There are no groups defined." +msgstr "No hi han grups definits." + +msgid "This must be enabled in global settings too." +msgstr "També s'ha d'activar en la configuració global." + +msgid "This base is available for all users" +msgstr "Aquesta base està disponible per tots els usuaris" + +msgid "A new clone of this base will be created." +msgstr "Un nou clon d'aquesta base serà creat." + +msgid "new bundle" +msgstr "nou ramat" + +msgid "All the virtual machines in the bundle will share the same private virtual network" +msgstr "Totes les màquines virtuals en el ramat compartiran la mateixa xarxa privada" + +msgid "create" +msgstr "crear" + +msgid "Groups are required to set up bookings. No groups found." +msgstr "Els grups son necessaris per configurar reserves. No s'han trobat grups." + +msgid "Groups are required to set up bookings. Some groups were found but no members belong to them." +msgstr "Els grups son necessaris per configurar reserves. S'han trobat grups però no tenen membres." + +msgid "Add new entries here." +msgstr "Afegeix aquí noves entrades." + +msgid "Clones will inherit this value unless defined in their options." +msgstr "Els clons heretaran aquest valor tret que estigui definit a les seves opcions." + +msgid "Batch upload" +msgstr "Pujada per lots" + +msgid "upload members" +msgstr "pujar membres" + +msgid "New Route" +msgstr "Nova Ruta" + +msgid "storage" +msgstr "emmagatzematge" + +msgid "filter" +msgstr "filtre" + +msgid "apply" +msgstr "aplicar" + +msgid "You must restart already connected virtual machines to apply network changes." +msgstr "Cal reiniciar les màquines virtuals ja connectades per aplicar els canvis de xarxa." + +msgid "available" +msgstr "disponible" + +msgid "Install remmina with RDP plugin to view Windows and Linux virtual machines with RDP." +msgstr "Instal·lar remmina amb el plugin RDP per veure les màquines virtuals de Windows i Linux amb RDP." + +msgid "Another tool that works well with SPICE is remmina." +msgstr "Una altre eina que funciona bé amb SPICE és remmina." + +msgid "If you installed it for RDP support it will work for SPICE too." +msgstr "Si l'has instal·lat per suport RPD funcionarà també per SPICE." + +msgid "RDP works out of the box because the client is installed by default." +msgstr "RDP funciona des del primer moment perquè el client està instal·lat per defecte." + +msgid "Install Microsoft Remote Desktop from the Mac App Store." +msgstr "Instal·lar Microsoft Remote Desktop des de la Mac App Store." + +msgid "list command" +msgstr "comanda per llistar" + +msgid "Auto compact virtual machines." +msgstr "Auto comprimir màquines virtuals." + +msgid "Time when compact will be scheduled." +msgstr "Hora en la que es programarà la compressió." + +msgid "Directory" +msgstr "Directori" + +msgid "Only previously authorized users can log in." +msgstr "Només usuaris prèviament autoritzats poden iniciar sessió." + +msgid "You can grant access to users from the users administration form:" +msgstr "Podeu concedir accés a usuaris des del formulari d'administració d'usuaris:" + +msgid "upload" +msgstr "pujar" + +msgid "Time period" +msgstr "Període de temps" + +msgid "Groups allowed" +msgstr "Grups permesos" + +msgid "Only Host Devices" +msgstr "Només Dispositius Amfitrions" + +msgid "Upload Users" +msgstr "Puja Usuaris" + +msgid "Upload a text file with the user names and passwords separated by a colon :" +msgstr "Puja un fitxer de text amb els noms i les contrasenyes dels usuaris separats per dos punts :" + +msgid "Upload" +msgstr "Pujar" + +msgid "This virtual machine will be prepared as a base, then cloned." +msgstr "Aquesta màquina virtual es prepararà com a base i després es clonarà." + +msgid "Enables schedule server bookings for exclusive use" +msgstr "Habilita programar reserves de servidor per ús exclusiu" + +msgid "connected" +msgstr "conectat" + +msgid "Session disconnected" +msgstr "Sessió desconectada" + +msgid "connect again" +msgstr "torna a conectar" + +msgid "disconnected" +msgstr "desconnectat" + +msgid "This machine is base and all changes will be applied to its clones." +msgstr "Aquesta màquina és base i tots els canvis s'aplicaràn als seus clons." + +msgid "Private" +msgstr "Privat" + +msgid "Show all" +msgstr "Mostra tot" + +msgid "This machine is running and can't be changed" +msgstr "Aquesta màquina està en marxa i no pot ser modificada" + +msgid "Current CPUs" +msgstr "CPUs actuals" + +msgid "Used %" +msgstr "Utilitzat %" + +msgid "hours" +msgstr "hores" + +msgid "1 hour" +msgstr "1 hora" + +msgid "2 hours" +msgstr "2 hores" + +msgid "3 hours" +msgstr "3 hores" + +msgid "6 hours" +msgstr "6 hores" + +msgid "8 hours" +msgstr "8 hores" + +msgid "days" +msgstr "dies" + +msgid "1 day" +msgstr "1 dia" + +msgid "2 days" +msgstr "2 dies" + +msgid "3 days" +msgstr "3 dies" + +msgid "6 days" +msgstr "6 dies" + +msgid "weeks" +msgstr "setmanes" + +msgid "1 week" +msgstr "1 setmana" + +msgid "2 weeks" +msgstr "2 setmanes" + +msgid "3 weeks" +msgstr "3 setmanes" + +msgid "4 weeks" +msgstr "4 setmanes" + +msgid "months" +msgstr "mesos" + +msgid "1 month" +msgstr "1 mes" + +msgid "2 months" +msgstr "2 mesos" + +msgid "3 months" +msgstr "3 mesos" + +msgid "6 months" +msgstr "6 mesos" + +msgid "9 months" +msgstr "9 mesos" + +msgid "years" +msgstr "anys" + +msgid "1 year" +msgstr "1 any" + +msgid "2 years" +msgstr "2 anys" + +msgid "3 years" +msgstr "3 anys" + +msgid "4 years" +msgstr "4 anys" + +msgid "5 years" +msgstr "5 anys" diff --git a/lib/Ravada/I18N/en.po b/lib/Ravada/I18N/en.po index 7edbb271e..a48c922d1 100644 --- a/lib/Ravada/I18N/en.po +++ b/lib/Ravada/I18N/en.po @@ -1825,12 +1825,11 @@ msgstr "Password and their confirmation do not match!" msgid "Today Schedule" msgstr "Today Schedule" -msgid "" -"This server has reservations for today. Machines from users out of\n" -" the booking list will be shutdown." -msgstr "" -"This server has reservations for today. Machines from users out of\n" -" the booking list will be shutdown." +msgid "This server has reservations for today." +msgstr "This server has reservations for today." + +msgid "Machines from users out of the booking list will be shutdown." +msgstr "Machines from users out of the booking list will be shutdown." msgid "allowed" msgstr "allowed" @@ -2177,8 +2176,8 @@ msgstr "Share" msgid "Host Devices" msgstr "Host Devices" -msgid "Mange Host Devices" -msgstr "Mange Host Devices" +msgid "Manage Host Devices" +msgstr "Manage Host Devices" msgid "Auto Compact" msgstr "Auto Compact" @@ -2203,3 +2202,315 @@ msgstr "Show the base when the user already created a clone" msgid "Show Clones" msgstr "Show Clones" + +msgid "starting" +msgstr "starting" + +msgid "Add host device" +msgstr "Add host device" + +msgid "LDAP groups" +msgstr "LDAP groups" + +msgid "Local groups" +msgstr "Local groups" + +msgid "Create a group." +msgstr "Create a group." + +msgid "This virtual machine has no local group restrictions." +msgstr "This virtual machine has no local group restrictions." + +msgid "Routes" +msgstr "Routes" + +msgid "Storage" +msgstr "Storage" + +msgid "list" +msgstr "list" + +msgid "purge" +msgstr "purge" + +msgid "default" +msgstr "default" + +msgid "Enabled" +msgstr "Enabled" + +msgid "Size" +msgstr "Size" + +msgid "Used" +msgstr "Used" + +msgid "Available" +msgstr "Available" + +msgid "Path" +msgstr "Path" + +msgid "New Storage" +msgstr "New Storage" + +msgid "Unused volumes" +msgstr "Unused volumes" + +msgid "Remove Selected" +msgstr "Remove Selected" + +msgid "back" +msgstr "back" + +msgid "IP address" +msgstr "IP address" + +msgid "Netmask" +msgstr "Netmask" + +msgid "DHCP start" +msgstr "DHCP start" + +msgid "DHCP end" +msgstr "DHCP end" + +msgid "Auto Start" +msgstr "Auto Start" + +msgid "Auto create users" +msgstr "Auto create users" + +msgid "Authenticated users are allowed to log in" +msgstr "Authenticated users are allowed to log in" + +msgid "Auth OpenID" +msgstr "Auth OpenID" + +msgid "Logout URL" +msgstr "Logout URL" + +msgid "Charts" +msgstr "Charts" + +msgid "share" +msgstr "share" + +msgid "There are no groups defined." +msgstr "There are no groups defined." + +msgid "A new clone of this base will be created." +msgstr "A new clone of this base will be created." + +msgid "new bundle" +msgstr "new bundle" + +msgid "All the virtual machines in the bundle will share the same private virtual network" +msgstr "All the virtual machines in the bundle will share the same private virtual network" + +msgid "create" +msgstr "create" + +msgid "Groups are required to set up bookings. No groups found." +msgstr "Groups are required to set up bookings. No groups found." + +msgid "Groups are required to set up bookings. Some groups were found but no members belong to them." +msgstr "Groups are required to set up bookings. Some groups were found but no members belong to them." + +msgid "Add new entries here." +msgstr "Add new entries here." + +msgid "Batch upload" +msgstr "Batch upload" + +msgid "upload members" +msgstr "upload members" + +msgid "New Route" +msgstr "New Route" + +msgid "storage" +msgstr "storage" + +msgid "list command" +msgstr "list command" + +msgid "apply" +msgstr "apply" + +msgid "You must restart already connected virtual machines to apply network changes." +msgstr "You must restart already connected virtual machines to apply network changes." + +msgid "available" +msgstr "available" + +msgid "Install remmina with RDP plugin to view Windows and Linux virtual machines with RDP." +msgstr "Install remmina with RDP plugin to view Windows and Linux virtual machines with RDP." + +msgid "Another tool that works well with SPICE is remmina." +msgstr "Another tool that works well with SPICE is remmina." + +msgid "If you installed it for RDP support it will work for SPICE too." +msgstr "If you installed it for RDP support it will work for SPICE too." + +msgid "RDP works out of the box because the client is installed by default." +msgstr "RDP works out of the box because the client is installed by default." + +msgid "Install Microsoft Remote Desktop from the Mac App Store." +msgstr "Install Microsoft Remote Desktop from the Mac App Store." + +msgid "Auto compact virtual machines." +msgstr "Auto compact virtual machines." + +msgid "Time when compact will be scheduled." +msgstr "Time when compact will be scheduled." + +msgid "Directory" +msgstr "Directory" + +msgid "Only previously authorized users can log in." +msgstr "Only previously authorized users can log in." + +msgid "You can grant access to users from the users administration form:" +msgstr "You can grant access to users from the users administration form:" + +msgid "upload" +msgstr "upload" + +msgid "Time period" +msgstr "Time period" + +msgid "Groups allowed" +msgstr "Groups allowed" + +msgid "Only Host Devices" +msgstr "Only Host Devices" + +msgid "Upload Users" +msgstr "Upload Users" + +msgid "Upload a text file with the user names and passwords separated by a colon :" +msgstr "Upload a text file with the user names and passwords separated by a colon :" + +msgid "Upload" +msgstr "Upload" + +msgid "This virtual machine will be prepared as a base, then cloned." +msgstr "This virtual machine will be prepared as a base, then cloned." + +msgid "Enables schedule server bookings for exclusive use" +msgstr "Enables schedule server bookings for exclusive use" + +msgid "connected" +msgstr "connected" + +msgid "Session disconnected" +msgstr "Session disconnected" + +msgid "connect again" +msgstr "connect again" + +msgid "disconnected" +msgstr "disconnected" + +msgid "This machine is base and all changes will be applied to its clones." +msgstr "This machine is base and all changes will be applied to its clones." + +msgid "Private" +msgstr "Private" + +msgid "Show all" +msgstr "Show all" + +msgid "This machine is running and can't be changed" +msgstr "This machine is running and can't be changed" + +msgid "Current CPUs" +msgstr "Current CPUs" + +msgid "hours" +msgstr "hours" + +msgid "1 hour" +msgstr "1 hour" + +msgid "2 hours" +msgstr "2 hours" + +msgid "3 hours" +msgstr "3 hours" + +msgid "6 hours" +msgstr "6 hours" + +msgid "8 hours" +msgstr "8 hours" + +msgid "days" +msgstr "days" + +msgid "1 day" +msgstr "1 day" + +msgid "2 days" +msgstr "2 days" + +msgid "3 days" +msgstr "3 days" + +msgid "6 days" +msgstr "6 days" + +msgid "weeks" +msgstr "weeks" + +msgid "1 week" +msgstr "1 week" + +msgid "2 weeks" +msgstr "2 weeks" + +msgid "3 weeks" +msgstr "3 weeks" + +msgid "4 weeks" +msgstr "4 weeks" + +msgid "months" +msgstr "months" + +msgid "1 month" +msgstr "1 month" + +msgid "2 months" +msgstr "2 months" + +msgid "3 months" +msgstr "3 months" + +msgid "6 months" +msgstr "6 months" + +msgid "9 months" +msgstr "9 months" + +msgid "years" +msgstr "years" + +msgid "1 year" +msgstr "1 year" + +msgid "2 years" +msgstr "2 years" + +msgid "3 years" +msgstr "3 years" + +msgid "4 years" +msgstr "4 years" + +msgid "5 years" +msgstr "5 years" + +msgid "Used %" +msgstr "Used %" diff --git a/lib/Ravada/I18N/es.po b/lib/Ravada/I18N/es.po index 6c271ba85..b9c61fe50 100644 --- a/lib/Ravada/I18N/es.po +++ b/lib/Ravada/I18N/es.po @@ -2045,10 +2045,11 @@ msgstr "" msgid "Choose the virtualization type of the Virtual Machine." msgstr "Elige el tipo de virtualización para este tipo de máquinas virtuales." -msgid "This server has reservations for today. Machines from users out of the booking list will be shutdown." -msgstr "" -"Este servidor tiene reservas hoy. Las máquinas de usuarios sin reserva serán " -"apagadas." +msgid "This server has reservations for today." +msgstr "Este servidor tiene reservas hoy." + +msgid "Machines from users out of the booking list will be shutdown." +msgstr "Las máquinas de usuarios fuera de la lista de reservas se apagarán." msgid "Data" msgstr "Data" @@ -2205,13 +2206,6 @@ msgstr "" "puede cambiar los parámetros de cualquier máquina virtual clonada de una " "base en posesión." -msgid "" -"This server has reservations for today. Machines from users out of\n" -" the booking list will be shutdown." -msgstr "" -"Este servidor tiene reservas para hoy. Las máquinas de usuarios fuera de\n" -" la lista de reservas se apagarán." - msgid "options" msgstr "opciones" @@ -2296,7 +2290,7 @@ msgstr "Compartir" msgid "Host Devices" msgstr "Dispositivos anfitriones" -msgid "Mange Host Devices" +msgid "Manage Host Devices" msgstr "Administrar anfitriones" msgid "Clones will inherit this value unless defined in their options." @@ -2319,3 +2313,288 @@ msgstr "Compresión automática" msgid "Show Clones" msgstr "Mostrar clones" + +msgid "This base is available for all users" +msgstr "Esta base está disponible para todos los usuarios" + +msgid "A new clone of this base will be created." +msgstr "Un nuevo clon de esta base será creado." + +msgid "This virtual machine has no local group restrictions." +msgstr "Esta máquina virtual no tiene restricciones locales." + +msgid "share" +msgstr "compartir" + +msgid "new bundle" +msgstr "nuevo racimo" + +msgid "All the virtual machines in the bundle will share the same private virtual network" +msgstr "Todas las máquinas virtuales en el racimo compartirán la misma red virtual privada" + +msgid "create" +msgstr "crear" + +msgid "Batch upload" +msgstr "Subida por lotes" + +msgid "upload members" +msgstr "subir miembros" + +msgid "Routes" +msgstr "Rutas" + +msgid "New Route" +msgstr "Nueva Ruta" + +msgid "Storage" +msgstr "Almacenamiento" + +msgid "New Storage" +msgstr "Nuevo Almacenamiento" + +msgid "Enabled" +msgstr "Habilitado" + +msgid "Size" +msgstr "Tamaño" + +msgid "Used" +msgstr "Usado" + +msgid "Available" +msgstr "Disponible" + +msgid "Path" +msgstr "Ruta" + +msgid "Directory" +msgstr "Directorio" + +msgid "back" +msgstr "atrás" + +msgid "Remove Selected" +msgstr "Eliminar selección" + +msgid "Add host device" +msgstr "Añadir dispositivo anfitrión" + +msgid "list command" +msgstr "comando para listar" + +msgid "apply" +msgstr "aplicar" + +msgid "IP address" +msgstr "Dirección IP" + +msgid "Netmask" +msgstr "Máscara de red" + +msgid "DHCP start" +msgstr "Inicio DHCP" + +msgid "DHCP end" +msgstr "Fin DHCP" + +msgid "Auto Start" +msgstr "Inicio automático" + +msgid "You must restart already connected virtual machines to apply network changes." +msgstr "Debes reiniciar las máquinas virtuales que ya están conectadas para aplicar los cambios de red." + +msgid "Auto create users" +msgstr "Crear usuarios automáticamente" + +msgid "Authenticated users are allowed to log in" +msgstr "Usuarios autenticados pueden iniciar sesión" + +msgid "Auth OpenID" +msgstr "Autenticación OpenID" + +msgid "Logout URL" +msgstr "URL de cierre de sesión" + +msgid "Auto compact virtual machines." +msgstr "Auto comprimir máquinas virtuales." + +msgid "Time when compact will be scheduled." +msgstr "Hora en la que se progamará la compresión." + +msgid "Only previously authorized users can log in." +msgstr "Solo usuarios previamente autorizados pueden iniciar sesión." + +msgid "You can grant access to users from the users administration form:" +msgstr "Puedes conceder acceso a usuarios desde el formulario de administración de usuarios:" + +msgid "upload" +msgstr "subir" + +msgid "Charts" +msgstr "Gráficos" + +msgid "Time period" +msgstr "Periodo de tiempo" + +msgid "Install remmina with RDP plugin to view Windows and Linux virtual machines with RDP." +msgstr "Instalar remmina con el plugin RDP para visualizar las máquinas virtuales de Windows y Linux con RDP." + +msgid "Another tool that works well with SPICE is remmina." +msgstr "Otra herramienta que funciona bien con SPICE es remmina." + +msgid "If you installed it for RDP support it will work for SPICE too." +msgstr "Si lo instalaste para soporte RDP funcionará también para SPICE." + +msgid "RDP works out of the box because the client is installed by default." +msgstr "RDP funciona desde el primer momento porque el cliente está instalado por defecto." + +msgid "Install Microsoft Remote Desktop from the Mac App Store." +msgstr "Instala Microsoft Remote Desktop desde la Mac App Store." + +msgid "Groups allowed" +msgstr "Grupos permitidos" + +msgid "Only Host Devices" +msgstr "Solo Dispositivos Anfitriones" + +msgid "Groups are required to set up bookings. No groups found." +msgstr "Los grupos son necesarios para configurar reservas. No se han encontrado grupos." + +msgid "Groups are required to set up bookings. Some groups were found but no members belong to them." +msgstr "Los grupos son necesarios para configurar reservas. Se encontraron algunos grupos pero no tienen miembros." + +msgid "Add new entries here." +msgstr "Añade aquí nuevas entradas." + +msgid "Upload Users" +msgstr "Sube Usuarios" + +msgid "Upload a text file with the user names and passwords separated by a colon :" +msgstr "Sube un fichero de texto con los nombres y las contraseñas de los usuarios separadas por dos puntos :" + +msgid "Upload" +msgstr "Subir" + +msgid "This virtual machine will be prepared as a base, then cloned." +msgstr "Esta máquina virtual se preparará como base y después se clonará." + +msgid "Enables schedule server bookings for exclusive use" +msgstr "Habilita programar reservas de servidor para uso exclusivo" + +msgid "connected" +msgstr "conectado" + +msgid "Session disconnected" +msgstr "Sesión desconectada" + +msgid "connect again" +msgstr "vuelve a conectar" + +msgid "disconnected" +msgstr "desconectado" + +msgid "This machine is base and all changes will be applied to its clones." +msgstr "Esta máquina es base y todos los cambios se aplicarán a sus clones." + +msgid "Private" +msgstr "Privado" + +msgid "Show all" +msgstr "Mostrar todo" + +msgid "This machine is running and can't be changed" +msgstr "Esta máquina está en marcha y no puede ser modificada" + +msgid "Current CPUs" +msgstr "CPUs actuales" + +msgid "hours" +msgstr "horas" + +msgid "1 hour" +msgstr "1 hora" + +msgid "2 hours" +msgstr "2 horas" + +msgid "3 hours" +msgstr "3 horas" + +msgid "6 hours" +msgstr "6 horas" + +msgid "8 hours" +msgstr "8 horas" + +msgid "days" +msgstr "días" + +msgid "1 day" +msgstr "1 día" + +msgid "2 days" +msgstr "2 días" + +msgid "3 days" +msgstr "3 días" + +msgid "6 days" +msgstr "6 días" + +msgid "weeks" +msgstr "semanas" + +msgid "1 week" +msgstr "1 semana" + +msgid "2 weeks" +msgstr "2 semanas" + +msgid "3 weeks" +msgstr "3 semanas" + +msgid "4 weeks" +msgstr "4 semanas" + +msgid "months" +msgstr "meses" + +msgid "1 month" +msgstr "1 mes" + +msgid "2 months" +msgstr "2 meses" + +msgid "3 months" +msgstr "3 meses" + +msgid "6 months" +msgstr "6 meses" + +msgid "9 months" +msgstr "9 meses" + +msgid "years" +msgstr "años" + +msgid "1 year" +msgstr "1 año" + +msgid "2 years" +msgstr "2 años" + +msgid "3 years" +msgstr "3 años" + +msgid "4 years" +msgstr "4 años" + +msgid "5 years" +msgstr "5 años" + +msgid "Used %" +msgstr "Usado %" + +msgid "Unused volumes" +msgstr "Volúmenes sin utilizar" diff --git a/lib/Ravada/I18N/id.po b/lib/Ravada/I18N/id.po index 030b56a3b..f90a68cce 100644 --- a/lib/Ravada/I18N/id.po +++ b/lib/Ravada/I18N/id.po @@ -2343,7 +2343,7 @@ msgstr "Bagikan" msgid "Follow these steps for Spice client setup" msgstr "Ikuti langkah-langkah berikut untuk pengaturan klien Spice" -msgid "Mange Host Devices" +msgid "Manage Host Devices" msgstr "Kelola Perangkat Host" msgid "Auto Compact" diff --git a/lib/Ravada/I18N/tr.po b/lib/Ravada/I18N/tr.po index dd656556c..cc2b30c7c 100644 --- a/lib/Ravada/I18N/tr.po +++ b/lib/Ravada/I18N/tr.po @@ -2197,7 +2197,7 @@ msgstr "Paylaş" msgid "Host Devices" msgstr "Ana Makineler" -msgid "Mange Host Devices" +msgid "Manage Host Devices" msgstr "Ana Makineleri Yönet" msgid "Auto Compact" diff --git a/lib/Ravada/Request.pm b/lib/Ravada/Request.pm index cef77b246..6954875e9 100644 --- a/lib/Ravada/Request.pm +++ b/lib/Ravada/Request.pm @@ -9,7 +9,7 @@ Ravada::Request - Requests library for Ravada =cut -use Carp qw(confess cluck); +use Carp qw(confess cluck carp); use Data::Dumper; use Hash::Util qw(lock_hash); use JSON::XS; @@ -67,7 +67,7 @@ our %VALID_ARG = ( ,spinoff => { id_domain => 1, uid => 1 } ,pause_domain => $args_manage ,resume_domain => {%$args_manage, remote_ip => 1 } - ,remove_domain => $args_manage + ,remove_domain => {%$args_manage, id_domain => 2 } ,restore_domain => { id_domain => 1, uid => 1 } ,shutdown_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2 , check => 2 @@ -97,7 +97,7 @@ our %VALID_ARG = ( ,remove_storage_pool => { uid => 1, id_vm => 1, name => 1} ,check_storage => { uid => 1 } ,create_storage_pool => { uid => 1, id_vm => 1, name => 1, directory => 1 } - ,set_base_vm=> {uid => 1, id_vm=> 1, id_domain => 1, value => 2 } + ,set_base_vm=> {uid => 1, id_vm=> 1, id_domain => 1, value => 2, migrate => 2 } ,cleanup => { timeout => 2 } ,clone => { uid => 1, id_domain => 1, name => 2, memory => 2, number => 2, volatile => 2, id_owner => 2 # If base has pools, from_pool = 1 if undefined @@ -137,6 +137,7 @@ our %VALID_ARG = ( ,migrate => { uid => 1, id_node => 1, id_domain => 1, start => 2, remote_ip => 2 ,shutdown => 2, shutdown_timeout => 2 } + ,post_migrate => { uid => 1, id_node => 1, id_domain => 1 } ,compact => { uid => 1, id_domain => 1 , keep_backup => 2 } ,purge => { uid => 1, id_domain => 1 } ,backup => { uid => 1, id_domain => 1, compress => 2} @@ -207,6 +208,9 @@ our %CMD_SEND_MESSAGE = map { $_ => 1 } create_network change_network remove_network ); +our %CMD_DO_NOT_SEND_ERROR = map { $_ => 1 } + qw(refresh_machine_ports); + our %CMD_NO_DUPLICATE = map { $_ => 1 } qw( clone @@ -215,6 +219,7 @@ qw( rsync_back cleanup list_host_devices + list_machine_types list_storage_pools refresh_machine refresh_machine_ports @@ -227,6 +232,7 @@ qw( prepare_base wait_job download + list_cpu_models ); our $TIMEOUT_SHUTDOWN = 120; @@ -269,13 +275,16 @@ our %COMMAND = ( ,'remove_domain', 'remove', 'refresh_machine_ports' ,'connect_node','start_node','shutdown_node' ,'post_login' + ,'migrate','post_migrate' ] } ,important=> { limit => 20 ,priority => 1 - ,commands => ['clone','start','start_clones','shutdown_clones','create','open_iptables','list_network_interfaces','list_isos','ping_backend','refresh_machine'] + ,commands => ['clone','start','start_clones','shutdown_clones','create','open_iptables','list_network_interfaces','list_isos','ping_backend','refresh_machine' + ,'list_cpu_models','refresh_storage' + ] } ,iptables => { @@ -290,6 +299,8 @@ our %CMD_VALIDATE = ( clone => \&_validate_clone ,create => \&_validate_create_domain ,create_domain => \&_validate_create_domain + ,remove_domain => \&_validate_remove_domain + ,remove => \&_validate_remove_domain ,remove_hardware => \&_validate_remove_hardware ,start_domain => \&_validate_start_domain ,start => \&_validate_start_domain @@ -301,6 +312,12 @@ our %CMD_VALIDATE = ( ,spinoff => \&_validate_compact ,prepare_base => \&_validate_prepare_base ,remove_base => \&_validate_remove_base + ,migrate => \&_validate_migrate + ,set_base_vm=> \&_validate_set_base_vm + ,remove_base_vm=> \&_validate_remove_base_vm + ,open_exposed_ports => \&_validate_open_exposed_ports + ,close_exposed_ports => \&_validate_close_exposed_ports + ,download => \&_validate_download ); sub _init_connector { @@ -433,8 +450,10 @@ sub remove_domain { my $class=ref($proto) || $proto; my %args = @_; - confess "Missing domain name" if !$args{name}; - confess "Name is not scalar" if ref($args{name}); + confess "Missing domain name or id" + if !$args{name} && !$args{id_domain}; + + confess "Name is not scalar" if $args{name} && ref($args{name}); confess "Missing uid" if !$args{uid}; for (keys %args) { @@ -727,7 +746,7 @@ sub _duplicated_request($self=undef, $command=undef, $args=undef) { } confess "Error: missing command " if !$command; # delete $args_d->{uid} unless $command eq 'clone'; - delete $args_d->{uid} if $command =~ /(cleanup|refresh_vms|set_base_vm)/; + delete $args_d->{uid} if $command =~ /(cleanup|refresh_vms|set_base_vm|remove_base_vm)/; delete $args_d->{uid} if exists $args_d->{uid} && !defined $args_d->{uid}; delete $args_d->{at}; delete $args_d->{status}; @@ -769,7 +788,7 @@ sub _new_request { } my %args = @_; - $args{status} = 'requested'; + $args{status} = 'initializing'; $self->{command} = $args{command}; if ($args{name}) { @@ -846,7 +865,7 @@ sub _new_request { my $request; eval { $request = $self->open($self->{id}) }; - warn $@ if $@ && $@ !~ /I can't find id=/; + warn "Error in request=$self->{id} $@" if $@ && $@ !~ /I can't find id=/; return if !$request; $request->_validate(); $request->status('requested') if $request->status ne'done'; @@ -916,6 +935,22 @@ sub _validate($self) { $method->($self); } +sub _validate_remove_domain($self) { + my $id_domain = $self->defined_arg('id_domain'); + if (!$id_domain) { + my $name = $self->defined_arg('name'); + $id_domain = $self->_search_domain_id($name); + if (!defined $id_domain) { + $self->output("Already removed"); + $self->status('done'); + return; + } + } + my $domain = Ravada::Front::Domain->open($id_domain); + $self->_chain_remove_bases_nodes($domain) + if $domain->is_base(); +} + sub _validate_remove_base($self) { my $id_domain = $self->args('id_domain'); my $domain = Ravada::Front::Domain->open($id_domain); @@ -933,6 +968,28 @@ sub _validate_remove_base($self) { $reqs_base[-1]->status('done'); $reqs_base[-2]->status('done'); } + $self->_chain_prepare_base($domain); + $self->_chain_remove_bases_nodes($domain); +} + +sub _chain_remove_bases_nodes($self, $domain) { + my $bases_vm = $domain->_bases_vm(1); + return if keys %$bases_vm < 2; + my %done; + my $req_prev; + my $req = Ravada::Request->open($self->id); + for my $id_vm ($domain->_data('id_vm'),keys %$bases_vm ) { + next if $done{$id_vm}++; + my $req = Ravada::Request->remove_base_vm( + uid => $self->args('uid') + ,id_domain => $domain->id + ,id_vm => $id_vm + ,_force => 1 + ); + $req->after_request_ok($req_prev->id) if $req_prev; + $self->after_request_ok($req->id); + $req_prev = $req; + } } sub _validate_remove_hardware($self) { @@ -940,13 +997,21 @@ sub _validate_remove_hardware($self) { my $args = $self->args(); - die "Error: you must pass option or index" - if !exists $args->{option} && !exists $args->{index} - && !defined $args->{option} && !defined $args->{index}; + if ( !exists $args->{option} && !exists $args->{index} + && !defined $args->{option} && !defined $args->{index}) { + + $self->error("Error: you must pass option or index"); + $self->status('done'); + return; + } - die "Error: attribute value must be defined ". - join(" ", map { $_ or '' } %{$args->{option}}) - if $args->{option} && grep { !defined } values %{$args->{option}}; + if ( $args->{option} && grep { !defined } values %{$args->{option}}) { + + $self->error("Error: attribute value must be defined ". + join(" ", map { $_ or '' } %{$args->{option}})); + $self->status('done'); + return; + } } @@ -970,6 +1035,15 @@ sub _validate_start_domain($self) { sub _validate_prepare_base($self) { $self->_validate_compact(); + for my $command (qw (prepare_base post_prepare_base + set_base_vm remove_base_vm )) { + + my $req= $self->_search_request($command + , id_domain => $self->args('id_domain')); + + $self->after_request($req->id) if $req; + } + my $req_create = $self->_search_request('create' , id_base=> $self->args('id_domain')); @@ -1070,16 +1144,20 @@ sub _check_downloading($self) { my $req_download = $self->_search_request('download', id_iso => $id_iso2); if ($has_cd && !$req_download) { + my @args_vm; + push @args_vm,( vm => $self->defined_arg('vm') ) if $self->defined_arg('vm'); + push @args_vm,( id_vm => $self->defined_arg('id_vm') ) if $self->defined_arg('id_vm'); + $req_download = Ravada::Request->download( id_iso => $id_iso2 ,uid => Ravada::Utils::user_daemon->id - ,vm => $self->defined_arg('vm') + ,@args_vm ); } if (! $req_download) { _mark_iso_downloaded($id_iso2); } else { - $self->after_request($req_download->id); + $self->after_request_ok($req_download->id); } $sth = $$CONNECTOR->dbh->prepare("SELECT args FROM requests" ." WHERE id=?" @@ -1140,6 +1218,12 @@ sub _validate_clone($self , $id_base= $self->args('id_domain') , $uid=$self->args('uid')) { + my $number = $self->defined_arg('number'); + if (defined $number && ($number !~ /^\d+$/ || $number<1) ) { + $self->error("Error: $number clones requested"); + $self->status('done'); + return; + } my $base = Ravada::Front::Domain->open($id_base); if ( !$uid ) { @@ -1153,6 +1237,13 @@ sub _validate_clone($self $self->error("Error: user id='$uid' does not exist"); return; } + if ($base->is_active) { + my $req_shutdown = Ravada::Request->shutdown_domain( + uid => $uid + ,id_domain => $base->id + ); + $self->after_request($req_shutdown->id); + } my ($req_base) = grep { $_->command eq 'prepare_base' } $base->list_requests; @@ -1170,6 +1261,48 @@ sub _validate_clone($self if !$base->is_public; } +sub _validate_open_exposed_ports($self) { + + my $id_domain = $self->defined_arg('id_domain'); + return if !$id_domain; + + my $domain_f; + eval { $domain_f = Ravada::Front::Domain->open($id_domain) }; + if ($@) { + my ($line) = $@ =~ m{(.*)}m; + chomp $line; + $self->error($line); + $self->status('done'); + return; + } + $domain_f->_data('ports_exposed' => 1); +} + +sub _validate_close_exposed_ports($self) { + + my $id_domain = $self->defined_arg('id_domain'); + return if !$id_domain; + + my $domain_f; + eval { $domain_f = Ravada::Front::Domain->open($id_domain) }; + if ($@) { + my ($line) = $@ =~ m{(.*)}m; + chomp $line; + $self->error($line); + $self->status('done'); + return; + } + + $domain_f->_data('ports_exposed' => 0); +} + +sub _validate_download($self) { + if (!$self->defined_arg('id_vm') && !$self->defined_arg('vm')) { + $self->error("Error: provide either id_vm or vm"); + $self->status('done'); + } +} + sub _last_insert_id { _init_connector(); return Ravada::Utils::last_insert_id($$CONNECTOR->dbh); @@ -1217,7 +1350,8 @@ sub status { } $self->_send_message($status, $message) - if $CMD_SEND_MESSAGE{$self->command} || $self->error ; + if $CMD_SEND_MESSAGE{$self->command} + || ( $self->error && !$CMD_DO_NOT_SEND_ERROR{$self->command}); if ($status eq 'done' && $date_changed && $date_changed eq $self->date_changed) { sleep 1; @@ -1544,11 +1678,139 @@ sub set_base_vm { my $id_vm = $args->{id_vm}; $id_vm = $args->{id_node} if exists $args->{id_node} && $args->{id_node}; - $domain->_set_base_vm_db($id_vm, $args->{value}, $req->id); + $domain->_set_base_vm_db($id_vm, undef, $req->id); return $req; } +sub _validate_migrate($req) { + my $domain = Ravada::Front::Domain->open($req->args('id_domain')); + + if ( $domain->is_volatile ) { + + $req->_status_error('done' + ,"Error: unsupported volatile domains migration." + ); + return; + } + + if ($domain->_data('status') ne 'shutdown') { + my $req_shutdown = Ravada::Request->shutdown_domain( + uid => $req->args('uid') + ,id_domain => $domain->id + ,_force => 1 + ); + $req->after_request_ok($req_shutdown->id); + } + + if ($domain->_data('id_vm') == $req->args('id_node')) { + $req->status('done'); + $req->error("Already migrated"); + return; + } + my $req_post = Ravada::Request->post_migrate( + uid => $req->args('uid') + ,id_domain => $domain->id + ,id_node => $req->args('id_node') + ,after_request => $req->id + ); + + my $id_vm_local = $domain->_id_vm_local(); + if ( !defined $id_vm_local ) { + return $req->_status_error('done' + ,"Error: node local not found for ".$domain->type); + } + + my $id_node = $req->args('id_node'); + + unless ($id_node==$id_vm_local || $domain->_data('id_vm')==$id_vm_local) { + my $req_local = Ravada::Request->migrate( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $domain->id + ,id_node => $id_vm_local + ,shutdown => 1 + ); + $req->after_request_ok($req_local->id); + } + + if ($domain->_data('id_base')) { + my $base = Ravada::Front::Domain->open($domain->_data('id_base')); + if (!$base->base_in_vm($id_node)) { + my $req_prev = Ravada::Request->set_base_vm( + uid => $req->args('uid') + ,id_domain => $base->id + ,id_vm => $id_node + ); + $req->_data('after_request_ok' => $req_prev->id); + } + } + +} + + +sub _validate_set_base_vm($req) { + + my $value; + if ( $req->command eq 'set_base_vm') { + $value = 1; + my $args = $req->args(); + $value = $args->{value} if exists $args->{value}; + } elsif ($req->command eq 'remove_base_vm') { + $value = 0; + } + + return _validate_remove_base_vm($req) if !$value; + + my $domain = Ravada::Front::Domain->open($req->args('id_domain')); + + $req->_chain_prepare_base($domain); + + my $id_vm_local = $domain->_id_vm_local(); + if ( !defined $id_vm_local ) { + return $req->_status_error('done' + ,"Error: node local not found for ".$domain->type); + } + + my $id_vm = $req->defined_arg('id_vm'); + $id_vm = $req->defined_arg('id_node') if !defined $id_vm; + + my $bases_vm = $domain->_bases_vm(); + if ( $id_vm != $id_vm_local && !$bases_vm->{$id_vm_local}) { + my $req_local = Ravada::Request->set_base_vm( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $domain->id + ,id_vm => $id_vm_local + ); + $req->after_request_ok($req_local->id); + } + + return if !$domain->id_base; + my $base = Ravada::Front::Domain->open($domain->id_base); + return if $base->base_in_vm($id_vm); + + my $req_prev = Ravada::Request->set_base_vm( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $base->id + ,id_vm => $id_vm + ); + $req->after_request_ok($req_prev->id); +} + +sub _chain_prepare_base($self, $domain) { + my $sth = $$CONNECTOR->dbh->prepare( + "SELECT id FROM requests " + ." WHERE id_domain=? " + ." AND id <> ? " + ." AND ( command='prepare_base' OR command='post_prepare_base' " + ." OR command='set_base_vm' OR command='remove_base_vm' )" + ." AND ( status='requested' OR status='working' )" + ); + $sth->execute($domain->id, $self->id); + while ( my ($id) = $sth->fetchrow ) { + $self->after_request($id); + } +} + =head2 remove_base_vm Disables a base in a Virtual Manager @@ -1565,11 +1827,162 @@ sub remove_base_vm { my $self = {}; bless($self,$class); - return $self->_new_request( + my $req = $self->_new_request( command => 'remove_base_vm' , args => $args ); + my $id_vm = $req->defined_arg('id_vm'); + $id_vm = $req->defined_arg('id_node') if !defined $id_vm; + + my $domain = Ravada::Front::Domain->open($req->args('id_domain')); + $domain->_set_base_vm_db($id_vm, undef, $req->id); + + return $req; +} + +sub _node_is_active($id) { + my $sth = $$CONNECTOR->dbh->prepare( + "SELECT id FROM vms WHERE enabled=1 AND is_active=1 " + ." AND id=?" + ); + $sth->execute($id); + my ($found) = $sth->fetchrow; + return $found; +} + +sub _validate_remove_base_vm($req) { + + my $domain = Ravada::Front::Domain->open($req->args('id_domain')); + + $req->_chain_previous_set_base($domain); + $req->_chain_previous_migrate_children($domain); + $req->_chain_requested_clone( $domain->id); + + my $id_vm = $req->defined_arg('id_vm'); + $id_vm = $req->defined_arg('id_node') if !defined $id_vm; + + my $bases_vm = $domain->_bases_vm(1); + my @other_vms; + for my $id_vm_other (keys %$bases_vm) { + push @other_vms,($id_vm_other) if $id_vm_other != $id_vm && _node_is_active($id_vm_other); + } + + if ( $domain->clones ) { + if ( !@other_vms ) { + $req->error("Error: there are no other VMs to migrate clones when removing base " + .$domain->id." ".$domain->name); + $req->status('done'); + return; + } + $req->_chain_migrate_clones($domain, $id_vm, \@other_vms) + } +} + +sub _chain_previous_migrate_children($self, $domain) { + my $sth = $$CONNECTOR->dbh->prepare( + "SELECT id FROM requests " + ." WHERE id_domain=?" + ." AND id <> ? " + ." AND ( status='requested' OR status='working' ) " + ." AND ( command = 'migrate' )" + ); + $sth->execute($domain->id, $self->id); + while ( my ($id_prev) = $sth->fetchrow ) { + $self->_data('after_request_ok' => $id_prev) + } + + for my $clone ($domain->clones) { + $sth->execute($clone->{id}, $self->id); + while ( my ($id_prev) = $sth->fetchrow ) { + $self->_data('after_request_ok' => $id_prev) + } + if ( $clone->{is_base} ) { + my $domain2 = Ravada::Front::Domain->open($clone->{id}); + $self->_chain_previous_migrate_children($domain2) + } + } +} + +sub _chain_previous_set_base($self, $domain) { + my $sth = $$CONNECTOR->dbh->prepare( + "SELECT id FROM requests " + ." WHERE id_domain=?" + ." AND id <> ? " + ." AND ( status='requested' OR status='working' ) " + ." AND ( command = 'prepare_base' OR command='set_base_vm' " + ." OR command='remove_base_vm' )" + ); + $sth->execute($domain->id, $self->id); + while ( my ($id_prev) = $sth->fetchrow ) { + $self->_data('after_request_ok' => $id_prev) + } +} + +sub _chain_migrate_clones($self, $domain, $id_vm, $other_vms) { + + my ($req_migrate, $req_rm); + my ($req_migrate_prev, $req_rm_prev); + + if ( $domain->_data('id_vm') == $id_vm ) { + $req_migrate_prev = Ravada::Request->migrate( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $domain->id + ,id_node => $other_vms->[0] + ); + } + + for my $clone ($domain->clones) { + + # migrate clones to other vms + if ( $clone->{id_vm} == $id_vm ) { + my $start = 0; + $start = 1 if $clone->{status} eq 'active'; + $req_migrate = Ravada::Request->migrate( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $clone->{id} + ,id_node => $other_vms->[0] + ,shutdown => 1 + ,start => $start + ); + $req_migrate->after_request_ok($req_migrate_prev->id) if $req_migrate_prev; + $req_migrate_prev = $req_migrate; + } + + # remove child bases + if ( $clone->{is_base} ) { + $req_rm = Ravada::Request->remove_base_vm( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $clone->{id} + ,id_vm => $id_vm + ); + $req_rm->after_request_ok($req_migrate->id) if $req_migrate; + $req_rm->after_request_ok($req_rm_prev->id) if $req_rm_prev; + $req_rm_prev = $req_rm; + } + } + $self->after_request_ok($req_rm->id) if $req_rm; + $self->after_request_ok($req_migrate->id) if $req_migrate; + + +} + +sub _chain_requested_clone($req, $id_domain) { + + for my $req_clone ( + $req->_search_request('clone', id_domain => $id_domain) + , $req->_search_request('create_domain', id_base => $id_domain) + ) { + next if $req_clone->status eq 'done'; + + # if it is requested chain after this one + if ($req_clone->status eq 'requested') { + $req_clone->after_request($req->id); + # if running, chain this request after + } elsif ($req_clone->status() eq 'running') { + $req->after_request($req_clone->id); + } + } } @@ -1824,8 +2237,8 @@ sub done_recently($self, $seconds=60,$command=undef, $args=undef) { delete $args_found_d->{at}; next if join(".",sort keys %$args_d) ne join(".",sort keys %$args_found_d); - my $args_d_s = join(".",map { $args_d->{$_} } sort keys %$args_d); - my $args_found_s = join(".",map {$args_found_d->{$_} } sort keys %$args_found_d); + my $args_d_s = join(".",map { $args_d->{$_} or '' } sort keys %$args_d); + my $args_found_s = join(".",map {$args_found_d->{$_} or '' } sort keys %$args_found_d); next if $args_d_s ne $args_found_s; return Ravada::Request->open($id); @@ -1861,19 +2274,21 @@ Stops a request killing the process. =cut -sub stop($self) { +sub stop($self, $show_warn=1) { my $stale = ''; my $run_time = ''; if ($self->start_time) { $run_time = time - $self->start_time; - $stale = ", stale for $run_time seconds."; + $stale = ", stale for $run_time seconds." if $run_time; } warn "Killing ".$self->command ." , pid: ".( $self->pid or '') .$stale - ."\n"; + ."\n" if $show_warn; kill (15,$self->pid) if $self->pid; - $self->status('done',"Killed start process after $run_time seconds."); + $self->status('done'); + $self->error("Killed start process after $run_time seconds.") + if $self->pid; } sub _delete($self) { @@ -1906,22 +2321,40 @@ sub requirements_done($self) { my $ok = 0; if ($after_request) { - $ok = 0; - my $req; - eval { $req = Ravada::Request->open($self->after_request) }; - die $@ if $@ && $@!~ /I can't find|not found/i; - $ok = 1 if !$req || $req->status eq 'done'; + $ok = $self->_requirements_done_ids($after_request); + return 0 if !$ok; } if ($after_request_ok) { - $ok = 0; - my $req = Ravada::Request->open($self->after_request_ok); + $ok = $self->_requirements_done_ids($after_request_ok, 1); + } + return $ok; +} + +sub _requirements_done_ids($self, $ids, $propagate=undef) { + + $ids = [ $ids ] unless ref($ids) eq 'ARRAY'; + + my $fail = 0; + for my $id (@$ids) { + next if !_req_exists($id); + my $req = Ravada::Request->open($id); if ($req->status eq 'done' && $req->error ) { - $self->status('done'); - $self->error($req->error); + if ($propagate) { + $self->status('done'); + $self->error($req->error); + } } - $ok = 1 if $req->status eq 'done' && ( !defined $req->error || $req->error eq '' ); + return 0 if $req->status() ne 'done'; } - return $ok; + return 1; +} + +sub _req_exists($id) { + my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM requests WHERE id=?"); + $sth->execute($id); + my ($ok) = $sth->fetchrow(); + return 1 if $ok; + return 0 if !$ok; } =head2 redo @@ -1991,9 +2424,16 @@ sub remove($status, %args) { } } +sub _push($value, $id) { + my $list = $value; + $list = [$list] if !ref($list); + push @$list,($id); + return $list; +} + sub _data($self, $field, $value=undef) { - confess if $field eq 'after_request' && defined $value - && $value == $self->id; + confess "Error: recursive requirement" if $field =~ /after_request/ && defined $value + && length($value) && $value == $self->id; if (defined $value && ( @@ -2005,7 +2445,17 @@ sub _data($self, $field, $value=undef) { confess "ERROR: field $field is read only" if $FIELD_RO{$field}; + if ($field =~ /^after_request/) { + my $prev_req_id = $self->{_data}->{$field}; + $value = _push($prev_req_id, $value) if $prev_req_id; + } $self->{_data}->{$field} = $value; + my $value0 = $value; + eval { + $value = encode_json($value) if ref($value); + }; + confess Dumper([$@,$value0]) if $@; + my $sth = $$CONNECTOR->dbh->prepare( "UPDATE requests set $field=?" ." WHERE id=?" @@ -2013,7 +2463,7 @@ sub _data($self, $field, $value=undef) { $sth->execute($value, $self->id); $sth->finish; - return $value; + return $self->{_data}->{$field}; } return $self->{_data}->{$field} if exists $self->{_data}->{$field} && defined $self->{_data}->{$field}; @@ -2043,6 +2493,17 @@ sub _select_db($self) { return if !$row; + for my $key (keys %$row) { + my $value = $row->{$key}; + next if !defined $value || $value !~ /^[\[\{}]/; + my $value_decoded; + eval { + $value_decoded = decode_json($value); + }; + warn "Error decoding '$value' for request id=$row->{id} $@" if $@; + $row->{$key} = $value_decoded if defined $value_decoded; + } + return $row; } @@ -2102,6 +2563,9 @@ sub AUTOLOAD { confess "Can't locate object method $name via package $self" if !ref($self); + confess "ERROR: Unknown field $name " + if !exists $self->{$name} && !exists $FIELD{$name} && !exists $FIELD_RO{$name}; + my $value = shift; $name =~ tr/[a-z][A-Z]_/_/c; diff --git a/lib/Ravada/VM.pm b/lib/Ravada/VM.pm index c8906b43a..d58a66bd1 100644 --- a/lib/Ravada/VM.pm +++ b/lib/Ravada/VM.pm @@ -179,7 +179,8 @@ sub _init_connector { && defined $Ravada::Front::CONNECTOR; } -sub _dbh($self) { +sub _dbh($self=undef) { + _init_connector(); return $$CONNECTOR->dbh(); } @@ -211,6 +212,8 @@ sub open { } my $force = delete $args{force}; + confess "Error: wrong id '$args{id}' " if $args{id} && $args{id} !~ /^\d+$/; + confess "Error: undefind id in ".Dumper(\%args) if !$args{id}; my $class=ref($proto) || $proto; @@ -320,7 +323,6 @@ sub BUILD { } $self->id; - $self->_which_cache_fetch(); } sub _open_type { @@ -454,7 +456,7 @@ sub _connect_ssh($self) { if ( $ssh->error ) { $self->_cached_active(0); $self->_data('cached_down' => time); - # warn "Error connecting to ".$self->host." : ".$ssh->error(); + warn "ERROR: connecting to ".$self->host." : ".$ssh->error(); return; } } @@ -464,12 +466,22 @@ sub _connect_ssh($self) { sub _ssh($self) { my $ssh = $self->netssh; - return if !$ssh; - return $ssh if $ssh->check_master; - warn "WARNING: ssh error '".$ssh->error."'" if $ssh->error; - $self->netssh->disconnect; + if ($ssh) { + return $ssh if $ssh->check_master; + warn "WARNING: ssh error '".$ssh->error."'" if $ssh && $ssh->error; + $self->netssh->disconnect; + } + $self->clear_netssh(); + + $ssh = $self->netssh(); + return $ssh if $ssh && $ssh->check_master(); + + $self->disconnect(); + $self->clear_netssh(); - return $self->netssh; + $ssh = $self->netssh(); + return $ssh if $ssh; + return $self->_connect_ssh(); } sub _around_create_domain { @@ -482,7 +494,8 @@ sub _around_create_domain { my %args_create = %args; my $id_owner = delete $args{id_owner} or confess "ERROR: Missing id_owner"; - my $owner = Ravada::Auth::SQL->search_by_id($id_owner) or confess "Unknown user id: $id_owner"; + my $owner = Ravada::Auth::SQL->search_by_id($id_owner); + die "Unknown user id: $id_owner" if !$owner; my $base; my $volatile = delete $args{volatile}; my $id_base = delete $args{id_base}; @@ -514,9 +527,7 @@ sub _around_create_domain { $self->_check_duplicate_name($name, $volatile); if ($id_base) { - my $vm_local = $self; - $vm_local = $self->new( host => 'localhost') if !$vm_local->is_local; - $base = $vm_local->search_domain_by_id($id_base) + $base = $self->search_domain_by_id($id_base) or confess "Error: I can't find domain $id_base on ".$self->name; die "Error: user ".$owner->name." can not clone from ".$base->name @@ -555,20 +566,19 @@ sub _around_create_domain { return $base->_search_pool_clone($owner) if $from_pool; - if ($self->is_local && $base && $base->is_base && $args_create{volatile} && !$base->list_host_devices ) { + if ($base && $base->is_base) { $request->status("balancing") if $request; - my $vm = $self->balance_vm($owner->id, $base); + my $check_hd= ($active or $args_create{volatile} or 0); + my $vm = $self->balance_vm($owner->id, $base, undef, $check_hd); if (!$vm) { die "Error: No free nodes available.\n"; } - if (!$vm->is_local) { - if ( $base->_base_files_in_vm($vm) - && $base->_check_all_parents_in_node($vm)) { + if ( $base->_base_files_in_vm($vm) + && $base->_check_all_base_parents_in_node($vm)) { $self = $vm; - } } - $request->status("creating machine on ".$vm->name) if $request; + $request->status("creating machine on ".$self->name) if $request; $args_create{listen_ip} = $self->listen_ip($remote_ip); } @@ -687,10 +697,14 @@ sub _set_alias_unique($self, $alias) { } sub _add_instance_db($self, $id_domain) { + _add_instance_db_data($self->id, $id_domain); +} + +sub _add_instance_db_data($id_vm, $id_domain) { my $sth = $$CONNECTOR->dbh->prepare("SELECT * FROM domain_instances " ." WHERE id_domain=? AND id_vm=?" ); - $sth->execute($id_domain, $self->id); + $sth->execute($id_domain, $id_vm); my ($row) = $sth->fetchrow; return if $row; @@ -698,7 +712,7 @@ sub _add_instance_db($self, $id_domain) { ." VALUES (?, ?)" ); eval { - $sth->execute($id_domain, $self->id); + $sth->execute($id_domain, $id_vm); }; confess $@ if $@; } @@ -798,8 +812,9 @@ sub name { return $self->_data('name') if defined $self->{_data}->{name}; - my ($ref) = ref($self) =~ /.*::(.*)/; - return ($ref or ref($self))."_".$self->host; + my ($out,$err) = $self->run_command('hostname'); + chomp $out; + return $out; } =head2 search_domain_by_id @@ -1059,18 +1074,6 @@ sub _check_require_base { my %ignore_requests = map { $_ => 1 } qw(clone refresh_machine set_base_vm start_clones shutdown_clones shutdown force_shutdown refresh_machine_ports set_time open_exposed_ports manage_pools screenshot remove_clones list_cpu_models ); - my @requests; - for my $req ( $base->list_requests ) { - push @requests,($req) if !$ignore_requests{$req->command}; - } - if (@requests) { - confess "ERROR: Domain ".$base->name." has ".scalar(@requests) - ." requests.\n" - .Dumper(\@requests) - unless scalar @requests == 1 && $request - && $requests[0]->id eq $request->id; - } - die "ERROR: Domain ".$self->name." is not base" if !$base->is_base(); @@ -1159,10 +1162,12 @@ sub _get_name_by_id($id) { sub _clean($self) { my $name = $self->{_data}->{name}; my $id = $self->{_data}->{id}; + my $is_active = $self->{_data}->{is_active}; delete $self->{_data}; delete $self->{$FIELD_TIMEOUT}; $self->{_data}->{name} = $name if $name; $self->{_data}->{id} = $id if $id; + $self->{_data}->{is_active} = $is_active; return $self; } @@ -1218,6 +1223,7 @@ sub _insert_vm_db { ); my %args = @_; my $name = ( delete $args{name} or $self->name); + cluck $name if $name =~ /localhost/; my $host = ( delete $args{hostname} or $self->host ); my $public_ip = ( delete $args{public_ip} or '' ); delete $args{vm_type}; @@ -1398,10 +1404,25 @@ Returns wether this virtual manager is in the local host =cut sub is_local($self) { + if (ref($self)) { return 1 if !$self->host || $self->host eq 'localhost' || $self->host eq '127.0.0,1' ; + } elsif ($self =~ /^\d+$/) { + my $id=$self; + my $sth = _dbh->prepare("SELECT hostname " + ." FROM vms " + ." WHERE id=?" + ); + $sth->execute($id); + my ($host) = $sth->fetchrow; + return 1 if !$host + || $host eq 'localhost' + || $host eq '127.0.0,1' + ; + + } return 0; } @@ -1861,7 +1882,6 @@ sub _do_is_active($self, $force=undef) { } sub _cached_active($self, $value=undef) { - $self->_which_cache_flush() if defined $value && $value && !$self->_data('is_active'); return $self->_data('is_active', $value); } @@ -1926,10 +1946,16 @@ sub run_command($self, @command) { $command[0] .= " $args" if $args; } return $self->_run_command_local(@command) if $self->is_local(); + confess "@command" if !$exec; my $ssh = $self->_ssh or confess "Error: Error connecting to ".$self->host; - my ($out, $err) = $ssh->capture2({timeout => 10},join " ",@command); + my $timeout = 10; + + $timeout = 60*60 if $command[0] =~ /cp|qemu/; + my $t0 = time; + my ($out, $err) = $ssh->capture2({timeout => $timeout},join " ",@command); + chomp $err if $err; $err = '' if !defined $err; @@ -2375,6 +2401,8 @@ sub balance_vm($self, $uid, $base=undef, $id_domain=undef, $host_devices=1) { } return $vms_active[0] if scalar(@vms_active)==1; + die "Error: No free nodes available.\n" if !scalar(@vms_active); + if ($base && $base->_data('balance_policy') == 1 ) { my $vm = $self->_balance_already_started($uid, $id_domain, \@vms_active); return $vm if $vm; @@ -2591,6 +2619,7 @@ Arguments: =cut sub shared_storage($self, $node, $dir) { + return 0 if $self->id == $node->id; $dir .= '/' if $dir !~ m{/$}; my $shared_cache = $self->_shared_storage_cache($node, $dir); return $shared_cache if defined $shared_cache; @@ -2963,50 +2992,9 @@ sub _list_qemu_bridges($self) { return keys %bridge; } -sub _which_cache_fetch($self) { - my $sth = $self->_dbh->prepare( - "SELECT command,path FROM vm_which " - ." WHERE id_vm=?" - ); - $sth->execute($self->id); - while (my ($command, $path)) { - $self->{_which}->{$command} = $path; - } - $sth->finish; -} - - -sub _which_cache_get($self, $command) { - return $self->{_which}->{$command} if exists $self->{_which} && exists $self->{_which}->{$command}; -} - -sub _which_cache_set($self, $command, $path) { - $self->{_which}->{$command} = $path; - - eval { - my $sth = $self->_dbh->prepare( - "INSERT INTO vm_which (id_vm, command, path)" - ." VALUES (?,?,?) " - ); - $sth->execute($self->id, $command, $path); - }; - warn("Warning: $@ vm_which = ( ".$self->id.", $command, $path )") - if $@ && $@ !~ /Duplicate entry/i - && $@ !~ /UNIQUE constraint failed/i - ; -} - -sub _which_cache_flush($self) { - my $sth = $self->_dbh->prepare( - "DELETE FROM vm_which where id_vm=?" - ); - $sth->execute($self->id); -} - sub _which($self, $command) { - my $cached = $self->_which_cache_get($command); - return $cached if $cached; + return $self->{_which}->{$command} if exists $self->{_which} && exists $self->{_which}->{$command}; my $bin_which = $self->{_which}->{which}; if (!$bin_which) { @@ -3023,8 +3011,8 @@ sub _which($self, $command) { my ($out,$err) = $self->run_command(@cmd); chomp $out; - $self->_which_cache_set($command,$out); + $self->{_which}->{$command} = $out; return $out; } @@ -3194,9 +3182,29 @@ sub dir_backup($self) { die "Error on mkdir -p $dir_backup $error" if $error; } } + $self->_create_pool_backup($dir_backup); return $dir_backup; } +sub _create_pool_backup($self, $dir) { + my %pool_name; + for my $pool ($self->list_storage_pools(1)) { + my $path = $pool->{path}; + if ($path && $path eq $dir) { + return; + } + $pool_name{$pool->{name}}++; + } + my ($name0) = $dir =~ m{.*/(.*)}; + my $name = $name0; + my $cont=2; + for (;;) { + last if !$pool_name{$name}; + $name = $name0."_".$cont++; + } + $self->create_storage_pool($name, $dir); +} + sub _follow_link($self, $file) { return $self->{_is_link}->{$file} @@ -3384,6 +3392,19 @@ sub _set_active_machines_isolated($self, $network) { } } +sub _migrate_domains($self, $id_node) { + confess "Error: node undefined" if !defined $id_node; + $id_node = $id_node->id if ref($id_node); + for my $domain ( $self->list_domains) { + Ravada::Request->migrate( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $domain->id + ,id_node => $id_node + ,shutdown => 1 + ); + } +} + sub _set_iso_downloading($self, $iso,$value) { my $sth = $$CONNECTOR->dbh->prepare( "UPDATE iso_images SET downloading=?" diff --git a/lib/Ravada/VM/KVM.pm b/lib/Ravada/VM/KVM.pm index c4288fac9..d22a2500e 100644 --- a/lib/Ravada/VM/KVM.pm +++ b/lib/Ravada/VM/KVM.pm @@ -113,8 +113,9 @@ sub _connect { my $address = $con_type."+".$transport ."://".'root@'.$self->host ."/system"; - eval { - $vm = Sys::Virt->new( + for ( 1 .. 3 ) { + eval { + $vm = Sys::Virt->new( address => $address ,auth => 1 ,credlist => [ @@ -122,7 +123,11 @@ sub _connect { Sys::Virt::CRED_PASSPHRASE, ] ); - }; + }; + warn $@ if $@; + last if $vm && $vm->is_alive; + sleep 1; + } my $error = $@; my $is_alive; eval { $is_alive = $vm->is_alive if $vm }; @@ -300,6 +305,7 @@ sub search_volume($self,$file,$refresh=0) { } eval { $vol = $pool->get_volume_by_name($name) }; die $@ if $@ && $@ !~ /^libvirt error code: 50,/; + $vol = undef if $vol && $vol->get_path ne $file; } return $vol if $vol; @@ -372,7 +378,6 @@ sub search_volume_re($self,$pattern,$refresh=0) { confess $@ if $@ && $@ !~ /libvirt error code: 50,/; next if !$file || $file !~ $pattern; - return $vol if !wantarray; push @volume,($vol); } @@ -398,7 +403,7 @@ sub remove_file($self,@files) { if ($self->file_exists($file)) { $self->_remove_file_os($file); } else { - warn "Warning: '$file' not found\n"; + # warn "Warning: ".$self->name." '$file' not found\n"; } } $vol->delete if $vol; @@ -568,7 +573,13 @@ Returns true if the file exists in this virtual manager storage =cut sub file_exists($self, $file) { - return -e $file if $self->is_local; + if ($self->is_local) { + if (-e $file) { + return 1; + } else { + return 0; + } + } return $self->_file_exists_remote($file); } @@ -577,7 +588,7 @@ sub _file_exists_remote($self, $file) { return 1 if $found; $file = $self->_follow_link($file) unless $file =~ /which$/; - return if !$self->vm; + return 0 if !$self->vm; for my $pool ($self->vm->list_all_storage_pools ) { next if !$pool->is_active; $self->_wait_storage( sub { $pool->refresh() } ); @@ -595,8 +606,15 @@ sub _file_exists_remote($self, $file) { } } - die "Error: invalid file '$file'" if $file =~ /[`;(\[" ]/; - my $ssh = $self->_ssh; + confess "Error: invalid file '$file'" if $file =~ /[`;(\[" ]/; + my $ssh; + for ( 1 .. 3 ) { + $ssh = $self->_ssh; + last if $ssh; + warn "retry ssh"; + $self->disconnect(); + sleep 1; + } confess "Error: no _ssh ".$self->name if !$ssh; my ($out,$err) = $ssh->capture2("ls $file"); my @ls = split /\n/,$out; @@ -625,6 +643,8 @@ Returns the directory where disk images are stored in this Virtual Manager sub dir_img { my $self = shift; + return '/var/tmp' if $<; + my $pool; eval { $pool = $self->_load_storage_pool() }; warn $@ if $@; @@ -698,7 +718,12 @@ sub create_storage_pool($self, $name, $dir, $vm=$self->vm) { } sub remove_storage_pool($self, $name) { - my $sp = $self->vm->get_storage_pool_by_name($name); + my $sp; + eval { $sp = $self->vm->get_storage_pool_by_name($name) }; + + return if $@ && ref($@) eq 'Sys::Virt::Error' + && $@->code == 49; # Missing storage pool + die $@ if $@; return if !$sp; $sp->destroy if $sp->is_active; @@ -1026,8 +1051,8 @@ sub _domain_create_from_iso { if ( $iso_file ne "" || $iso_file ) { $device_cdrom = $iso_file; } - } elsif ($iso->{has_cd}) { - $device_cdrom = $self->search_volume_path_re(qr($iso->{file_re})); + } elsif ($iso->{has_cd} && $iso->{url}) { + $device_cdrom = $self->search_volume_path_re(qr($iso->{file_re})) if $iso->{file_re}; if (!$device_cdrom) { my $req_download = Ravada::Request->download( uid => Ravada::Utils::user_daemon->id @@ -1222,11 +1247,9 @@ sub _domain_create_from_base { confess "argument id_base or base required ".Dumper(\%args) if !$args{id_base} && !$args{base}; - my $vm_local = $self; - $vm_local = $self->new( host => 'localhost') if !$vm_local->is_local; - my $base = $args{base}; - $base = $vm_local->_search_domain_by_id($args{id_base}) if $args{id_base}; + $base = $self->_search_domain_by_id($args{id_base}) if $args{id_base}; + $base->_set_volumes_backing_store(); confess "Unknown base id: $args{id_base}" if !$base; my $volatile; @@ -1276,6 +1299,7 @@ sub _domain_create_from_base { , id_vm => $self->id ); $domain->_set_spice_password($spice_password); + $domain->_set_volumes_backing_store() if !$volatile; $domain->xml_description(); return $domain; } @@ -1336,8 +1360,6 @@ sub _iso_name($self, $iso, $req=undef, $verbose=1) { my $test = 0; $test = 1 if $req && $req->defined_arg('test'); - confess if !exists $iso->{filename}; - return if !exists $iso->{filename} || !$iso->{filename}; my $device_cdrom = $self->search_volume_path_re(qr($iso->{filename})); if ($test || ! $device_cdrom) { @@ -1392,13 +1414,15 @@ sub _iso_name($self, $iso, $req=undef, $verbose=1) { } sub _fill_url($iso) { - return if $iso->{url} =~ m{.*/[^/]+\.[^/]+$}; + return if $iso->{url} =~ m{.*/[^/]+\.iso$}; if ($iso->{file_re}) { $iso->{url} .= "/" if $iso->{url} !~ m{/$}; $iso->{url} .= $iso->{file_re}; return; } - confess "Error: Missing field file_re for ".$iso->{name}; + confess "Error: Missing field file_re for ".$iso->{name} if !$iso->{filename}; + $iso->{url} .= "/" if $iso->{url} !~ m{/$}; + $iso->{url} .= $iso->{filename}; } sub _check_md5 { @@ -1452,6 +1476,8 @@ sub _check_signature($file, $type, $expected) { sub _download_file_external_headers($self,$url) { my @cmd = ('wget',"-S","--spider",$url); + confess if $url =~ /\^/; + my ($in,$out,$err); run3(\@cmd,\$in,\$out,\$err); my ($status) = $err =~ /^\s*(HTTP.*\d+.*)/m; @@ -1464,20 +1490,15 @@ sub _download_file_external_headers($self,$url) { } sub _download_file_external($self, $url, $device, $verbose=1, $test=0) { - $url .= "/" if $url !~ m{/$} && $url !~ m{.*/([^/]+\.[^/]+)$}; - - my ($filename) = $device =~ m{.*/(.*)}; # The following regex checks if the URL does NOT end with a filename that has an extension # (e.g., 'file.iso'), distinguishing file URLs from directory URLs. - if ($url =~ m{[^*]} && $url !~ m{.*/.+\..+$}) { - my @found = $self->_search_url_file($url, $filename); + if ($url =~ m{[^*]}) { + my ($url2, $filename) = $url =~ m{(.*)/(.*)}; + my @found = $self->_search_url_file($url2, $filename); die "Error: URL not found '$url'" if !scalar @found; $url = $found[-1]; } - if ( $url =~ m{/$} ) { - $url = "$url$filename"; - } $url =~ s{/./}{/}g; if ( $test ) { @@ -1499,7 +1520,6 @@ sub _download_file_external($self, $url, $device, $verbose=1, $test=0) { # return $url; - warn join(" ",@cmd)."\n"; warn join(" ",@cmd)."\n" if $verbose; my ($out, $err) = $self->run_command(@cmd); warn "out=$out" if $out && $verbose; @@ -1535,7 +1555,7 @@ sub _search_iso($self, $id_iso, $file_iso=undef) { return $row if $file_iso && $self->file_exists($file_iso); return $row if !$row->{url}; - Ravada::Front::_fix_iso_file_re($row); + Ravada::Front::_get_device_re($row); $self->_fetch_filename($row);# if $row->{file_re}; if ($VERIFY_ISO) { @@ -1551,7 +1571,7 @@ sub _download($self, $url) { $url =~ s{(.*/)[^/]+/\.\.\/(.*)}{$1$2}; if ($url =~ m{[^*]}) { my @found = $self->_search_url_file($url); - die "Error: URL not found '$url'" if !scalar @found; + confess "Error: URL not found '$url'" if !scalar @found; $url = $found[-1]; } @@ -1666,11 +1686,12 @@ sub _fetch_filename($self, $row, $test=0) { return; } return if !$row->{file_re} && !$row->{url} && !$row->{device}; - if (!$row->{file_re}) { + if (!$row->{file_re} && !$row->{filename}) { my ($new_url, $file); ($new_url, $file) = $row->{url} =~ m{(.*)/(.*)} if $row->{url}; ($file) = $row->{device} =~ m{.*/(.*)} if !$file && $row->{device}; + confess "No filename in $row->{name} $row->{url}" if !$file; $row->{url} = $new_url; @@ -1693,11 +1714,15 @@ sub _fetch_filename($self, $row, $test=0) { die "No ".qr($row->{file_re})." found on $row->{url}" if !@found; } + @found = $self->_search_url_file($row->{url}, $row->{file_re}); + die "No ".qr($row->{file_re})." found on $row->{url}\n" if !@found; + my $url = $found[-1]; - my ($file) = $url =~ m{.*/(.*)}; + my ($url_path,$file) = $url =~ m{(.*)/(.*)}; - $row->{url} = $url; - $row->{filename} = ($row->{rename_file} or $file); + $row->{file_re} = undef; + $row->{url} = $url_path; + $row->{filename} = $file; # $row->{url} .= "/" if $row->{url} !~ m{/$}; # $row->{url} .= $file; @@ -1714,7 +1739,8 @@ sub _search_url_file($self, $url_re, $file_re=undef) { $url_re =~ s{(.*)/.*/\.\.$}{$1}; } } else { - $url_re =~ s{(.*)/.*$}{$1}; + # this failed on http://cdimage.ubuntu.com/ubuntu-mate/releases/24.04.*/release + $url_re =~ s{(.*)/.*\..*$}{$1} if $url_re =~ /\.iso$/; } $file_re .= '$' if $file_re !~ m{\$$}; @@ -1759,15 +1785,16 @@ sub _fetch_this($self, $row, $type, $file = $row->{filename}){ $file=~ s{.*/(.+)}{$1} if $file =~ m{/} && $file !~ m{/$}; - my ($url, $file2) = $row->{url} =~ m{(.*)/(.+)}; - $url = $row->{url} if $row->{url} =~ m{/$}; + my ($url, $file2); + ($url, $file2) = $row->{url} =~ m{(.*)/(.+)} if $row->{url} =~ m{\.iso.?$}; + $url = $row->{url} if !$url; my $url_orig = $row->{"${type}_url"}; $file = $file2 if $file2 && $file2 !~ /\*|\^/ && $file2 !~ m{/$}; $url_orig =~ s{(.*)\$url(.*)}{$1$url$2} if $url_orig =~ /\$url/; confess "error: file missing '$file' ".Dumper($row) if $file =~ m{/$}; - confess "error " if $url_orig =~ /\$/; + confess "error $url_orig" if $url_orig =~ /\$/; my $content = $self->_download($url_orig); @@ -3263,4 +3290,46 @@ sub change_network($self, $data) { return $changed; } +sub _search_pool_volume($self, $file) { + confess "ERROR: undefined file" if !defined $file; + + my ($name) = $file =~ m{.*/(.*)}; + $name = $file if !defined $name; + + my $vol; + for my $pool (_list_storage_pools($self->vm)) { + next if !$pool->is_active; + eval { $vol = $pool->get_volume_by_name($name) }; + die $@ if $@ && $@ !~ /^libvirt error code: 50,/; + return ($pool, $vol) if $vol; + } + +} + +sub copy_file($self, $orig, $dst, %args) { + + my $mode = delete $args{mode}; + + my ($sp,$vol) = $self->_search_pool_volume($orig); + die "Error: volume $orig not found" if !$vol; + + my $xml = XML::LibXML->load_xml(string => $vol->get_xml_description()); + + my ($name) = $dst =~ m{.*/(.*)}; + $xml->findnodes("/volume/name/text()")->[0]->setData($name); + $xml->findnodes("/volume/key/text()")->[0]->setData($dst); + $xml->findnodes("/volume/target/path/text()")->[0]->setData($dst); + + $xml->findnodes("/volume/target/permissions/mode/text()")->[0] + ->setData($mode) if $mode; + + my ($dst_path) = $dst =~ m{(.*)/.*?}; + die "Error: I can't find path in 'dst'" if !$dst_path; + my $sp_dst = $self->vm->get_storage_pool_by_target_path($dst_path); + my $vol_dst; + eval { $vol_dst = $sp_dst->clone_volume($xml, $vol) }; + confess $@ if $@; + +} + 1; diff --git a/lib/Ravada/VM/Void.pm b/lib/Ravada/VM/Void.pm index ccd570663..cd28d0ef9 100644 --- a/lib/Ravada/VM/Void.pm +++ b/lib/Ravada/VM/Void.pm @@ -1,10 +1,11 @@ package Ravada::VM::Void; -use Carp qw(carp croak); +use Carp qw(carp croak cluck); use Data::Dumper; use Encode; use Encode::Locale; use Fcntl qw(:flock O_WRONLY O_EXCL O_CREAT); +use File::Copy qw(copy); use Hash::Util qw(lock_hash); use IPC::Run3 qw(run3); use Moose; @@ -141,7 +142,9 @@ sub create_domain { ,is_base => 1 ,vm => $domain_base->_vm ); - my $vol_clone = $vol_base->clone(name => "$args{name}-$target"); + my $vol_clone = $vol_base->clone(name => "$args{name}-$target" + ."-".Ravada::Utils::random_name() + ); $domain->add_volume(name => $vol_clone->name , target => $target , file => $vol_clone->file @@ -213,15 +216,16 @@ sub _add_cdrom($self, $domain, %args) { $sth->execute($id_iso); my $row = $sth->fetchrow_hashref(); return if !$row->{has_cd}; - $iso_file = $row->{device}; + $iso_file = $self->search_volume_path_re(qr($row->{file_re})); if (!$iso_file) { - $iso_file = $row->{name}; - $iso_file =~ s/\s/_/g; - $iso_file=$self->dir_img."/".lc($iso_file).".iso"; - if (! -e $iso_file ) { - $self->write_file($iso_file,Dump({iso => "ISO mock $row->{name}"})); - } + $iso_file = $row->{file_re}; + $iso_file =~ s/\*/_/g; + $iso_file = $self->dir_img()."/".$iso_file; + open my $out,">",$iso_file or die "$! $iso_file"; + print $out Dump({ iso => $iso_file }); + close $out; } + confess "$row->{file_re} not found in ".$self->name if !$iso_file; } $iso_file = '' if $iso_file eq ''; $domain->add_volume( @@ -294,8 +298,9 @@ sub _list_domains_remote($self, %args) { my $active = delete $args{active}; confess "Wrong arguments ".Dumper(\%args) if keys %args; + my $dir = Ravada::Front::Domain::Void::_config_dir(); - my ($out, $err) = $self->run_command("ls -1 ".$self->dir_img); + my ($out, $err) = $self->run_command("ls -1 ".$dir); my @domain; for my $file (split /\n/,$out) { @@ -705,7 +710,10 @@ Returns true if the file exists in this virtual manager storage =cut sub file_exists( $self, $file ) { - return -e $file if $self->is_local; + if ( $self->is_local) { + return 1 if -e $file; + return 0; + } my $ssh = $self->_ssh; confess "Error: no ssh connection to ".$self->name if ! $ssh; @@ -729,6 +737,7 @@ sub _search_iso($self, $id, $device = undef) { $sth->execute($id); my $row = $sth->fetchrow_hashref; $row->{device} = $device if defined $device; + Ravada::Front::_get_device_re($row); return $row; } @@ -747,7 +756,7 @@ sub _iso_name($self, $iso, $request=undef, $verbose=0) { $name = $self->_storage_path($self->default_storage_pool_name)."/".$name unless $name =~ m{^/}; open my $out,">",$name or die "$! $name"; - print $out "...\n"; + print $out Dump({ iso => $name }); close $out; return $name; @@ -877,7 +886,8 @@ sub remove_storage_pool($self, $name) { $self->write_file($file_sp, Dump( \@sp2)); } -sub copy_file($self, $orig, $dst) { +sub copy_file($self, $orig, $dst, %args) { + my $mode = delete $args{mode}; if ($self->is_local) { copy($orig, $dst) or die "$! $orig $dst"; } else { diff --git a/lib/Ravada/Volume.pm b/lib/Ravada/Volume.pm index bc9fc44ad..94d858e04 100644 --- a/lib/Ravada/Volume.pm +++ b/lib/Ravada/Volume.pm @@ -221,7 +221,7 @@ sub set_info($self, $name, $value) { sub delete($self) { my $file = $self->file; - $self->vm->remove_file($file) if $file; + $self->vm->remove_file($file) if $file && $self->vm->file_exists($file); my $sth = $self->_dbh->prepare("DELETE FROM volumes WHERE file=? AND id_domain=?"); $sth->execute($file, $self->domain->id); } diff --git a/lib/Ravada/Volume/Class.pm b/lib/Ravada/Volume/Class.pm index 07c965514..eff0767a1 100644 --- a/lib/Ravada/Volume/Class.pm +++ b/lib/Ravada/Volume/Class.pm @@ -35,10 +35,10 @@ sub _post_prepare_base($self, $base_file) { return $base_file if ! $self->clone_base_after_prepare; return $base_file if !$self->vm->file_exists($base_file); - $self->_chmod(oct(400),$base_file); + $self->_chmod(0o400,$base_file); $self->vm->refresh_storage_pools(); - $self->vm->remove_file($self->file); + $self->vm->remove_file($self->file) if $self->vm->file_exists($self->file); my @domain = (); @domain = ( domain => $self->domain) if $self->domain; @@ -62,7 +62,7 @@ sub _chmod($self, $mode, $file=$self->file) { my ($out,$err) = $vm->run_command("chmod",$mode_o,$file); die $err if $err; } else { - confess if !-e $file; + confess $file if !-e $file; chmod $mode,$file or die "$! chmod $mode $file"; } } @@ -91,6 +91,7 @@ sub _new_clone_filename($self,$name0) { sub _around_clone($orig, $self, %args) { my $name = delete $args{name}; my $file_clone = ( delete $args{file} or $self->_new_clone_filename($name)); + my $domain = (delete $args{domain} or $self->domain); confess "Error: unkonwn args ".Dumper(\%args) if keys %args; confess "Error: empty clone filename" if !defined $file_clone || !length($file_clone); @@ -102,13 +103,23 @@ sub _around_clone($orig, $self, %args) { if $self->domain; confess "Error: file $file_clone already exists in domain $id_domain_file.$we" - if !$self->domain || $self->domain->id != $id_domain_file; + if !$domain || $domain->id != $id_domain_file; } + my @domain =(); + if ($domain) { + push @domain , ( domain => $domain ); + } else { + push @domain ,( vm => $self->vm ) + } my $ret = $self->new( file => $orig->($self, $file_clone) - ,vm => $self->vm + ,@domain ); + for ( 1 .. 2 ) { + last if $self->vm->file_exists($file_clone); + sleep 1; + } $self->_chmod(oct(600), $file_clone); return $ret; @@ -122,6 +133,7 @@ sub copy_file($self, $src, $dst) { my @cmd = ('/bin/cp' ,$src, $dst ); my ($out, $err) = $self->vm->run_command(@cmd); die $err if $err; + return $dst; } sub backup($self) { @@ -134,4 +146,27 @@ sub backup($self) { return $vol_backup; } +sub _copy_sys($self, $dst, $mode=undef) { + my $file = $self->file; + if ($self->vm) { + my ($out, $err) = $self->vm->run_command("cp",$file,$dst); + die $err if $err; + } else { + copy($file,$dst); + } + $self->_chmod($mode, $dst) if $mode; +} + +sub _move_sys($self, $dst, $mode=undef) { + my $file = $self->file; + if ($self->vm) { + my ($out, $err) = $self->vm->run_command("mv",$file,$dst); + die $err if $err; + } else { + copy($file,$dst) or die "$! $file -> $dst"; + unlink $file or die "$! $file"; + } + $self->_chmod($mode, $dst) if $mode; +} + 1; diff --git a/lib/Ravada/Volume/QCOW2.pm b/lib/Ravada/Volume/QCOW2.pm index 8eaa6e33d..c60d146d7 100644 --- a/lib/Ravada/Volume/QCOW2.pm +++ b/lib/Ravada/Volume/QCOW2.pm @@ -26,7 +26,8 @@ sub prepare_base($self, $req=undef) { my $base_img = $self->base_filename(); confess $base_img if $base_img !~ /\.ro/; - confess "Error: '$base_img' already exists" if -e $base_img; + confess "Error: '$base_img' already exists" + if $self->vm->file_exists($base_img); confess if $file_img =~ /\.iso$/i; my $format; @@ -35,7 +36,8 @@ sub prepare_base($self, $req=undef) { }; if ($format && $format eq 'qcow2') { - $self->_copy($base_img, '0400'); + $self->_copy_sys($base_img, '0400'); + $self->_move_sys($base_img, '0400'); } else { $self->_convert($base_img, $req); } @@ -70,6 +72,10 @@ sub _convert($self, $dst, $req=undef) { } +sub copy($self, @args) { + return $self->_copy(@args); +} + sub _copy($self, $dst, $mode=undef) { my $src = $self->file; @@ -103,7 +109,7 @@ sub _copy($self, $dst, $mode=undef) { $doc->findnodes('/volume/key/text()')->[0]->setData($dst); $doc->findnodes('/volume/target/path/text()')->[0]->setData( $dst); $doc->findnodes('/volume/target/permissions/mode/text()')->[0] - ->setData( $mode ) if $mode; + ->setData( sprintf("%o",$mode) ) if $mode; my $vol_dst; my $err; @@ -124,17 +130,6 @@ sub _copy($self, $dst, $mode=undef) { return $vol_dst; } -sub _copy_sys($self, $dst, $mode=undef) { - my $file = $self->file; - if ($self->vm) { - my ($out, $err) = $self->vm->run_command("cp",$file,$dst); - die $err if $err; - } else { - copy($file,$dst); - } - $self->_chmod($mode, $dst) if $mode; -} - sub clone($self, $file_clone) { confess if $self->file =~ /ISO$/i; confess if $file_clone =~ /ISO$/i; @@ -229,7 +224,8 @@ sub spinoff($self) { my $file = $self->file; my $volume_tmp = $self->file.".$$.tmp"; - $self->vm->remove_file($volume_tmp); + $self->vm->remove_file($volume_tmp) + if $self->vm->file_exists($volume_tmp); my @cmd = ($QEMU_IMG ,'convert' @@ -255,7 +251,7 @@ sub spinoff($self) { sub block_commit($self) { my @cmd = ($QEMU_IMG,'commit','-q','-d'); my ($out, $err) = $self->vm->run_command(@cmd, $self->file); - warn $err if $err; + die $err if $err; } sub _qemu_info($self, $field=undef) { @@ -319,4 +315,13 @@ sub compact($self, $keep_backup=1) { return int(100*($du_backup-$du)/$du_backup)." % compacted. "; } +sub delete($self) { + my $vol = $self->vm->search_volume($self->file); + if ($vol) { + $vol->delete(); + } else { + $self->vm->remove_file($self->file); + } +} + 1; diff --git a/lib/Ravada/Volume/Void.pm b/lib/Ravada/Volume/Void.pm index 6081d05df..10f24c33b 100644 --- a/lib/Ravada/Volume/Void.pm +++ b/lib/Ravada/Volume/Void.pm @@ -100,6 +100,12 @@ sub block_commit($self) { next if $key =~ /^(origin|capacity|is_base|backing_file)$/; $data_bf->{$key} = $data->{$key}; } + my $vol_backing = Ravada::Volume->new( + file => $self->backing_file + ,domain => $self->domain + ); + $vol_backing->_chmod(0o700); + $self->_save($data_bf, $self->backing_file); } @@ -109,4 +115,9 @@ sub compact($self, $keep_backup) { return $self->info->{target}." 100% compacted. "; } + +sub copy($self,@args) { + return $self->_copy_sys(@args); +} + 1; diff --git a/lib/Ravada/WebSocket.pm b/lib/Ravada/WebSocket.pm index 43a8f205f..c94560648 100644 --- a/lib/Ravada/WebSocket.pm +++ b/lib/Ravada/WebSocket.pm @@ -40,6 +40,7 @@ my %SUB = ( ,list_machines_user_including_privates => \&_list_machines_user_including_privates ,list_bases_anonymous => \&_list_bases_anonymous ,list_requests => \&_list_requests + ,list_domain_requests => \&_list_domain_requests ,machine_info => \&_get_machine_info ,node_info => \&_get_node_info ,ping_backend => \&_ping_backend @@ -58,6 +59,7 @@ our %TABLE_CHANNEL = ( ,list_machines_user_including_privates => ['domains','bookings','booking_entries' ,'booking_entry_ldap_groups', 'booking_entry_users','booking_entry_bases'] ,list_requests => 'requests' + ,list_domain_requests => 'requests.id_domain' ,machine_info => 'domains' ,log_active_domains => 'log_active_domains' ,list_networks => 'virtual_networks' @@ -457,6 +459,31 @@ sub _list_requests($rvd, $args) { return $rvd->list_requests; } +sub _list_domain_requests($rvd, $args) { + my ($id_domain) = $args->{channel} =~ m{/(\d+)}; + my $domain = $rvd->search_domain_by_id($id_domain) or do { + warn "Error: domain $id_domain not found."; + return []; + }; + + my $login = $args->{login} or die "Error: no login arg ".Dumper($args); + my $user = Ravada::Auth::SQL->new(name => $login) or die "Error: uknown user $login"; + return [] unless $user->is_operator || $user->is_admin || $domain->id_owner == $user->id; + + my $sth = $rvd->_dbh->prepare( + "SELECT id, id_domain, command, status, date_req FROM requests WHERE id_domain=? " + ." AND status <> 'done'" + ." ORDER BY date_req " + ); + $sth->execute($id_domain); + my @ret; + + while ( my $row = $sth->fetchrow_hashref ) { + push @ret,($row); + } + return \@ret; + +} sub _get_machine_info($rvd, $args) { my ($id_domain) = $args->{channel} =~ m{/(\d+)}; my $domain = $rvd->search_domain_by_id($id_domain) or do { @@ -673,12 +700,18 @@ sub _clean_info($self, $key) { $self->_old_info($key,0,0); } -sub _date_changed_table($self, $table, $id) { +sub _date_changed_table($self, $table0, $id) { + my ($table, $field_id) = $table0 =~ /(.*)\.(.*)/; + if (!defined $table ) { + $table = $table0; + $field_id = 'id'; + } + die "Error: wrong id field '$field_id' " if $field_id !~ /^[a-zA-Z_]+$/; my $rvd = $self->ravada; my $sth; if (defined $id) { $sth = $rvd->_dbh->prepare("SELECT MAX(date_changed) FROM $table " - ." WHERE id=?"); + ." WHERE $field_id=?"); $sth->execute($id); } else { $sth = $rvd->_dbh->prepare("SELECT MAX(date_changed) FROM $table"); @@ -688,7 +721,9 @@ sub _date_changed_table($self, $table, $id) { return ($date or ''); } -sub _count_table($rvd, $table) { +sub _count_table($rvd, $table0) { + my $table=$table0; + $table =~ s/\..*//; my $sth = $rvd->_dbh->prepare("SELECT count(*) FROM $table"); $sth->execute; my ($count) = $sth->fetchrow; @@ -802,6 +837,9 @@ sub subscribe($self, %args) { delete $args2{ws}; warn "Subscribe ".Dumper(\%args2) if $DEBUG; if (!exists $self->clients->{$ws}) { + die "Error: missig id_node in ".$args{channel} + if $args{channel} eq 'list_isos'; + $self->clients->{$ws} = { ws => $ws , %args @@ -835,7 +873,6 @@ sub unsubscribe($self, $ws) { sub unsubscribe_all($self) { for my $ws ( keys %{$self->clients()} ) { - warn $ws; delete $self->clients->{$ws}; } } diff --git a/public/css/sb-admin.css b/public/css/sb-admin.css index 141f92f52..51cb40bef 100644 --- a/public/css/sb-admin.css +++ b/public/css/sb-admin.css @@ -508,6 +508,15 @@ td.box{ color: orange } +ul.compact { + margin: 0; +} + +li.compact { + padding: 0; + margin: 0; +} + label.small_row { font-size: 80%; font-weight: 600; diff --git a/public/js/admin.js b/public/js/admin.js index dde91bf90..d8a132dce 100644 --- a/public/js/admin.js +++ b/public/js/admin.js @@ -260,8 +260,8 @@ ravadaApp.directive("solShowMachine", swMach) if ( $scope.swap.value < iso.min_swap_size ) { $scope.swap.value = iso.min_swap_size + 0.1; } - if (iso.file_re ) { - file_re = new RegExp(iso.file_re); + if (iso.device_re ) { + file_re = new RegExp(iso.device_re); } else { return ''; } @@ -1928,44 +1928,29 @@ ravadaApp.directive("solShowMachine", swMach) $scope.year = 0; var max_y = 10; - $scope.options_h = [ - {id:0, title: 'hours'} - ,{id:1 , title: '1 hour'} - ,{id:2 , title: '2 hours'} - ,{id:3 , title: '3 hours'} - ,{id:6 , title: '6 hours'} - ,{id:8 , title: '8 hours'} - ]; - $scope.options_d = [ - {id:0 , title: 'days'} - ,{id:1 , title: '1 day'} - ,{id:2 , title: '2 days'} - ,{id:3 , title: '3 days'} - ,{id:6 , title: '6 days'} - ]; - $scope.options_w = [ - {id:0 , title: 'weeks'} - ,{id:1 , title: '1 week'} - ,{id:2 , title: '2 weeks'} - ,{id:3 , title: '3 weeks'} - ,{id:4 , title: '4 weeks'} - ]; - $scope.options_m = [ - {id:0 , title: 'months'} - ,{id:1 , title: '1 month'} - ,{id:2 , title: '2 months'} - ,{id:3 , title: '3 months'} - ,{id:6 , title: '6 months'} - ,{id:9 , title: '9 months'} - ]; - $scope.options_y = [ - {id:0 , title: 'years'} - ,{id:1 , title: '1 year'} - ,{id:2 , title: '2 years'} - ,{id:3 , title: '3 years'} - ,{id:6 , title: '6 years'} - ,{id:9 , title: '9 years'} - ]; + var defaultTimeOptions = { + hours: [{id:0,title:'hours'},{id:1,title:'1 hour'},{id:2,title:'2 hours'},{id:3,title:'3 hours'},{id:6,title:'6 hours'},{id:8,title:'8 hours'}], + days: [{id:0,title:'days'},{id:1,title:'1 day'},{id:2,title:'2 days'},{id:3,title:'3 days'},{id:6,title:'6 days'}], + weeks: [{id:0,title:'weeks'},{id:1,title:'1 week'},{id:2,title:'2 weeks'},{id:3,title:'3 weeks'},{id:4,title:'4 weeks'}], + months: [{id:0,title:'months'},{id:1,title:'1 month'},{id:2,title:'2 months'},{id:3,title:'3 months'},{id:6,title:'6 months'},{id:9,title:'9 months'}], + years: [{id:0,title:'years'},{id:1,title:'1 year'},{id:2,title:'2 years'},{id:3,title:'3 years'},{id:6,title:'6 years'},{id:9,title:'9 years'}] + }; + + function applyTimeOptions(options) { + options = options || {}; + $scope.options_h = options.hours || defaultTimeOptions.hours; + $scope.options_d = options.days || defaultTimeOptions.days; + $scope.options_w = options.weeks || defaultTimeOptions.weeks; + $scope.options_m = options.months || defaultTimeOptions.months; + $scope.options_y = options.years || defaultTimeOptions.years; + } + + applyTimeOptions(); + $http.get('/text/time_options').then(function(response) { + applyTimeOptions(response.data); + }).catch(function() { + applyTimeOptions(); + }); var url; diff --git a/public/js/ravada.js b/public/js/ravada.js index 9f1506e97..d8d95cbb3 100644 --- a/public/js/ravada.js +++ b/public/js/ravada.js @@ -351,6 +351,7 @@ $scope.storage_pools=['default']; $scope.shared_user_count = -1 $scope.access_groups=[]; + $scope.show_lock_details=false; var fields_option=[ 'volatile_clones','autostart' ,'shutdown_disconnected','balance_policy' @@ -480,6 +481,7 @@ if (!subscribed_extra) { subscribed_extra = true; subscribe_nodes(url,data.type); + subscribe_domain_requests(url, data.id); //subscribe_bases(url); } if ($scope.edit) { $scope.lock_info = true } @@ -521,6 +523,39 @@ } }; + var domainRequestsSocket = null; + + var subscribe_domain_requests=function(url, id) { + // Close any previous socket before opening a new one + if (domainRequestsSocket && domainRequestsSocket.readyState === WebSocket.OPEN) { + try { + domainRequestsSocket.close(); + } catch (e) { + // ignore errors on close + } + } + + domainRequestsSocket = new WebSocket(url); + var ws = domainRequestsSocket; + ws.onopen = function(event) { ws.send('list_domain_requests/'+id) }; + ws.onmessage = function(event) { + var data = JSON.parse(event.data); + $scope.$apply(function () { + $scope.domain_requests = data; + }); + }; + }; + + $scope.$on('$destroy', function () { + if (domainRequestsSocket) { + try { + domainRequestsSocket.close(); + } catch (e) { + // ignore errors on close + } + domainRequestsSocket = null; + } + }); var subscribe_requests = function(url) { var ws = new WebSocket(url); ws.onopen = function(event) { ws.send('list_requests') }; @@ -856,11 +891,11 @@ $http.get("/machine/public/"+machineId+"/"+value); }; $scope.set_base= function(vmId,machineId, value) { - $scope.showmachine.bases[vmId]=value; var url = 'set_base_vm'; if (value == 0 || !value) { url = 'remove_base_vm'; } + $scope.showmachine.bases[vmId]={'enabled': value, 'id_request': -1 }; $http.get("/machine/"+url+"/" +vmId+ "/" +machineId+".json") .then(function(response) { }); diff --git a/script/rvd_back b/script/rvd_back index ac745eebb..53b922f80 100755 --- a/script/rvd_back +++ b/script/rvd_back @@ -2,6 +2,7 @@ use warnings; use strict; +use Term::ReadKey; no warnings "experimental::signatures"; use feature qw(signatures); @@ -365,9 +366,12 @@ sub add_user { my $ravada = Ravada->new( %CONFIG); print "$login password: "; + ReadMode('noecho'); my $password = ; chomp $password; + ReadMode('restore'); + print "\n"; print "is admin ? : [y/n] "; my $is_admin_q = ; my $is_admin = 0; @@ -412,8 +416,11 @@ sub add_user_ldap { my $ravada = Ravada->new( %CONFIG); print "password : "; + ReadMode('noecho'); my $password = ; chomp $password; + ReadMode('restore'); + print "\n"; Ravada::Auth::LDAP::add_user_posix(name => $login, password => $password); } @@ -530,8 +537,11 @@ sub change_password { die "ERROR: Unknown user '$login'\n" if !$user->id; print "password : "; + ReadMode('noecho'); my $password = ; chomp $password; + ReadMode('restore'); + print "\n"; $user->change_password($password); } @@ -767,13 +777,6 @@ sub start_domain { if !$found; } -sub _client_status($domain_f) { - my $domain = Ravada::Domain->open($domain_f->id) or return ''; - my $status = $domain->client_status(1); - return 'disconnected' if!defined $status || $status eq ''; - return $status; -} - sub shutdown_domain(@domains) { my $down = 0; @@ -815,27 +818,29 @@ sub shutdown_domain(@domains) { } sub _verify_connection { - my $domain_f = shift; - my $domain = Ravada::Domain->open($domain_f->id); + + my $domain = shift; + print "Verifying connection for ".$domain->name - ." ".($domain->remote_ip or '')." " - if $VERBOSE; - for ( 1 .. $TIME_CONNECTION ) { - my $status = 'disconnected'; - eval { - $status = $domain->client_status(1); - }; - warn "Error checking ".$domain_f->name." $@" if $@; - if ( $status && $status ne 'disconnected' ) { - print "\n\t".$status." ".$domain->remote_ip - ." Shutdown dismissed.\n"; - return 1; - } - print "." if $VERBOSE && !($_ % 5); - sleep 1; - } - print "\n" if $VERBOSE; + ." ".($domain->remote_ip or '')." " + if $VERBOSE; + + my $req = Ravada::Request->refresh_machine( + uid => Ravada::Utils::user_daemon->id + ,id_domain => $domain->id + ); + _wait_request($req); + + $domain = Ravada::Front::Domain->open($domain->id); + my $status = $domain->client_status(); + if ( $status && $status ne 'disconnected' ) { + print "\n\t".$status." ".$domain->remote_ip + ." Shutdown dismissed.\n" if $VERBOSE; + return 1; + } + print "\n" if $VERBOSE; return 0; + } sub _dump_ldap_entry($ldap_entry) { @@ -893,8 +898,11 @@ sub test_ldap { } print "\nType the password if you want to check the user connection or CTRL-C to stop\npassword: "; + ReadMode('noecho'); my $password = ; chomp $password; + ReadMode('restore'); + print "\n"; my $ok= Ravada::Auth::LDAP->new(name => $name, password => $password); if ($ok) { if (!$ok->{_ldap_entry}) { @@ -1047,18 +1055,18 @@ sub backup($rvd_back) { sub _wait_request(@reqs) { my $t0 = time; - for (;;) { + for ( 0 .. $TIME_CONNECTION ) { last if !@reqs; my $pending = 0; my @reqs2; for my $req (@reqs) { if ($req->status eq 'done') { - print "Finished ".$req->command; + print "Finished ".$req->command if ($req->error || $req->output); + if ($req->error) { warn $req->error."\n"; } print "\n\t".$req->output if $req->output; - print "\n"; } else { push @reqs2,($req); } @@ -1120,7 +1128,8 @@ sub _list_domains($rvd_back my %name = map { $_ => 1 } @ARGV ; my @domains; - for my $domain ($rvd_back->list_domains) { + for my $domain0 ($rvd_back->list_domains_data) { + my $domain = Ravada::Front::Domain->open($domain0->{id}); next if $domain->is_base; @@ -1130,11 +1139,12 @@ sub _list_domains($rvd_back || ( $hibernated && $domain->is_hibernated ) || ( $disconnected && $domain->is_active && !$domain->autostart - && _client_status($domain) eq 'disconnected') + && $domain->client_status() eq 'disconnected') ) { delete $name{$domain->name}; - if ( $disconnected && $domain->client_status() eq 'disconnected') { + if ( $disconnected ) { + next if $domain->client_status() ne 'disconnected'; next if _verify_connection($domain); } next if $all && $HIBERNATE_DOMAIN && !$domain->is_active; @@ -1146,7 +1156,7 @@ sub _list_domains($rvd_back next; } - if ($SHUTDOWN_DOMAIN && $domain->status eq 'down' && $VERBOSE) { + if ($SHUTDOWN_DOMAIN && !$domain->is_active && $VERBOSE) { print $domain->name." already down.\n"; next; } diff --git a/script/rvd_front b/script/rvd_front index 3b2b1cd2e..2b0a6d79a 100644 --- a/script/rvd_front +++ b/script/rvd_front @@ -752,10 +752,8 @@ any '/v2/network/new/#id_vm' => sub($c) { ); $RAVADA->wait_request($req); my $data = {}; - if ($req->status eq 'done' && $req->output && $req->output =~ /^\{/) { - eval { - $data = decode_json($req->output); - }; + if ($req->status eq 'done' && $req->output) { + $data = $req->output; warn $@ if $@; $data->{_owner} = { id => $USER->id @@ -814,7 +812,7 @@ post '/v2/network/set' => sub($c) { ); $RAVADA->wait_request($req, 120); my $out = {}; - eval { $out = decode_json($req->output) if $req->output }; + $out = $req->output if $req->output; warn $@ if $@; %data = %$out if $out && keys %$out; } @@ -2914,14 +2912,18 @@ get '/booking' => sub($c) { } if (!$groups_local && !@groups_ldap) { + my $i18n = $c->stash->{i18n}; return $c->render(template => '/ng-templates/error' - ,message => "Groups are required to set up bookings. No groups found. Add new entries here." + ,message => $i18n->localize("Groups are required to set up bookings. No groups found.") + ."".' '.$i18n->localize("Add new entries here.")."" ); } if (!$members_found) { + my $i18n = $c->stash->{i18n}; return $c->render(template => '/ng-templates/error' - ,message => "Groups are required to set up bookings. Some groups where found but no members belong to them. Add new entries here." + ,message => $i18n->localize("Groups are required to set up bookings. Some groups were found but no members belong to them.") + ."".' '.$i18n->localize("Add new entries here.")."" ) } @@ -3203,6 +3205,71 @@ get '/translations' => sub($c) { return $c->render(json => $lang_name); }; +get '/text/time_options' => sub($c) { + + my $options = _text_options($c); + + my $i18n = $c->stash->{i18n}; + for my $entry ( keys %$options ) { + my @current; + for my $item (@{$options->{$entry}}) { + $item->[1]= $i18n->localize($item->[1]); + push @current, { + id => $item->[0] + ,title => $item->[1] + }; + } + $options->{$entry} = \@current; + } + + return $c->render(json => $options); +}; + +sub _text_options($c) { + return { + hours => [ + [0, 'hours'] + ,[1, '1 hour'] + ,[2, '2 hours'] + ,[3, '3 hours'] + ,[6, '6 hours'] + ,[8, '8 hours'] + ] + ,days => [ + [0, 'days'] + ,[1, '1 day'] + ,[2, '2 days'] + ,[3, '3 days'] + ,[6, '6 days'] + ] + ,weeks => [ + [0, 'weeks'] + ,[1, '1 week'] + ,[2, '2 weeks'] + ,[3, '3 weeks'] + ,[4, '4 weeks'] + ] + ,months => [ + [0, 'months'] + ,[1, '1 month'] + ,[2, '2 months'] + ,[3, '3 months'] + ,[4, '6 months'] + ,[5, '9 months'] + ] + ,years => [ + [0, 'years'] + ,[1, '1 year'] + ,[2, '2 years'] + ,[3, '3 years'] + ,[4, '4 years'] + ,[5, '5 years'] + ] + + }; +} + + sub _translations($c) { my $lang_name = _languages(); $c->stash(lang_name => $lang_name); @@ -4673,7 +4740,6 @@ sub set_base_vm( $c, $new_value) { return $c->render(json => {message => 'access denied'}); } - $domain->_set_base_vm_db($id_vm, $new_value); if ($new_value) { my $req = Ravada::Request->set_base_vm( id_vm => $id_vm diff --git a/t/20_volumes.t b/t/20_volumes.t index c0c817672..720823635 100644 --- a/t/20_volumes.t +++ b/t/20_volumes.t @@ -484,10 +484,9 @@ sub test_no_extension($vm) { } sub test_qcow_format($vm) { - return if $vm->type ne 'KVM'; my $base = create_domain($vm); - $base->add_volume(type => 'swap', size => 1024*1024); - $base->add_volume(type => 'data', size => 1024*1024); + $base->add_volume(type => 'swap', size => 1024*1024, format => 'qcow2'); + $base->add_volume(type => 'data', size => 1024*1024, format => 'qcow2'); wait_request(); my $clone = $base->clone( @@ -497,7 +496,7 @@ sub test_qcow_format($vm) { my $QEMU_IMG = `which qemu-img`; chomp $QEMU_IMG; for my $vol ( $clone->list_volumes_info ) { - next if $vol->file && $vol->file =~ /iso$/; + next if $vol->file && $vol->file =~ /(void|iso)$/; my @cmd = ($QEMU_IMG,'create' ,'-f','qcow2' ,'-F','qcow2' @@ -511,11 +510,11 @@ sub test_qcow_format($vm) { is($bff, 'qcow2'); } eval { $clone->start(user_admin) }; - is(''.$@,''); + is(''.$@,'') or exit; $clone->shutdown_now(user_admin); for my $vol ( $clone->list_volumes_info ) { - next if !$vol->file || $vol->file =~ /iso$/; + next if !$vol->file || $vol->file =~ /(void|iso)$/; my @cmd_info = ($QEMU_IMG , 'info', $vol->file); my ($out, $err) = $clone->_vm->run_command(@cmd_info); diff --git a/t/30_request.t b/t/30_request.t index f9d379035..7b345b4ed 100644 --- a/t/30_request.t +++ b/t/30_request.t @@ -243,7 +243,10 @@ sub test_requests_by_domain { is($domain->list_requests,1) or die Dumper([$domain->list_requests]); my $req2 = Ravada::Request->remove_base(uid => user_admin->id, id_domain => $domain->id); - is($domain->list_requests, 0); + is($domain->list_requests, 2); + wait_request(debug => 0); + Ravada::Request->prepare_base(uid => user_admin->id, id_domain => $domain->id); + wait_request(debug => 0); my $clone_name = new_domain_name(); my $req_clone = Ravada::Request->create_domain ( @@ -252,11 +255,8 @@ sub test_requests_by_domain { ,id_base => $domain->id ,vm => $vm_name ); - + wait_request(); my $req4 = Ravada::Request->prepare_base(uid => user_admin->id, id_domain => $domain->id); - is($domain->list_requests,1,Dumper([map { $_->{command} } $domain->list_requests])); - - rvd_back->_process_all_requests_dont_fork(); wait_request(); is($req1->status , 'done'); diff --git a/t/device/40_mediated_device.t b/t/device/40_mediated_device.t index 887d83f7a..09f5033a7 100644 --- a/t/device/40_mediated_device.t +++ b/t/device/40_mediated_device.t @@ -25,7 +25,7 @@ $Ravada::Domain::TTL_REMOVE_VOLATILE=3; #################################################################### -sub _prepare_dir_mdev() { +sub _prepare_dir_mdev($n) { my $dir = "/run/user/"; @@ -37,7 +37,7 @@ sub _prepare_dir_mdev() { my $uuid="3913694f-ca45-a946-efbf-94124e5c09"; - for (1 .. 2 ) { + for (1 .. $n ) { open my $out, ">","$dir/$uuid$_$_ " or die $!; print $out "\n"; close $out; @@ -50,10 +50,12 @@ sub _check_mdev($vm, $hd) { my $n_dev = $hd->list_available_devices(); return _check_used_mdev($vm, $hd) if $n_dev; - my $dir = _prepare_dir_mdev(); + my $n_devs = 2; + my $dir = _prepare_dir_mdev($n_devs); $hd->_data('list_command' => "ls $dir"); $MOCK_MDEV=1 unless $vm->type eq 'Void'; + is($hd->list_available_devices,$n_devs) or die Dumper($hd); return $hd->list_available_devices;; } @@ -671,7 +673,7 @@ sub _filter_hds($hd0, $hd1) { FOUND1: for my $n ( 1 .. scalar(@devices1)-1 ) { my @words = split(/\s+/,$devices1[$n]); for my $word0 ( reverse @words ) { - next if $word0 =~ /nvidia/; + next if $word0 =~ /nvidia/ || $word0 =~ /[\(\)\{\})]/; $word0 =~ s/(\d+\:\d+\:\d+)\.\d+/$1/; next if $word0 eq $hd1->_data('list_filter'); $hd1->_data('list_filter' => $word0); @@ -721,6 +723,11 @@ sub test_change_hd_in_clone($domain) { $hd1 = _create_mdev($domain->_vm) if !$hd1; isnt($hd1->id, $hd0->id); + $hd0->_data('list_filter'=>''); + confess Dumper($hd0) if $hd0->list_devices <2; + + # set both filters empty and make sure mock devices are different + $hd1->_data('list_filter'=>''); _filter_hds($hd0, $hd1); die "Error: no available devices in ".$hd0->name @@ -730,8 +737,10 @@ sub test_change_hd_in_clone($domain) { if scalar($hd1->list_available_devices) < 1; my @args = ( uid => user_admin->id ,id_domain => $domain->id); - Ravada::Request->clone(@args, number => scalar($hd0->list_available_devices)-1); + my $req = Ravada::Request->clone(@args + , number => ( scalar($hd0->list_available_devices)-1 or 1) ); wait_request(debug => 0); + is($req->error,'') or exit; _req_start($domain->clones); @@ -748,7 +757,7 @@ sub test_change_hd_in_clone($domain) { my @clone_hd = $clone->list_host_devices; is($clone_hd[0]->id,$hd0->id); - my $req = Ravada::Request->remove_host_device( + $req = Ravada::Request->remove_host_device( uid => user_admin->id ,id_domain => $clone->id ,id_host_device => $hd0->id diff --git a/t/downgrade_reqs.t b/t/downgrade_reqs.t new file mode 100644 index 000000000..fc9a708c7 --- /dev/null +++ b/t/downgrade_reqs.t @@ -0,0 +1,44 @@ +use warnings; +use strict; + +use Data::Dumper; +use IPC::Run3 qw(run3); +use YAML qw(DumpFile LoadFile); +use Test::More; + +use lib 't/lib'; +use Test::Ravada; + +use feature qw(signatures); +no warnings "experimental::signatures"; + +####################################################################################### + +sub test_downgrade($field) { + + my $sth = connector->dbh->prepare( + "ALTER table requests change column $field $field text(80)" + ); + $sth->execute(); + my $req = Ravada::Request->refresh_vms( + uid => user_admin->id + ,$field => '[3,4]' + ); + eval { + rvd_back->_sql_create_tables(); + rvd_back->_upgrade_tables(); + }; + is($@,''); + +} + +####################################################################################### + +init('/etc/ravada.conf',0); + +test_downgrade('after_request'); +test_downgrade('after_request_ok'); + +end(); + +done_testing(); diff --git a/t/front/15_misc.t b/t/front/15_misc.t new file mode 100644 index 000000000..b71f6e8a4 --- /dev/null +++ b/t/front/15_misc.t @@ -0,0 +1,70 @@ +use warnings; +use strict; + +use Data::Dumper; +use Test::More; + +use lib 't/lib'; +use Test::Ravada; + +use feature qw(signatures); +no warnings "experimental::signatures"; + +my $RVD_BACK; +my $RVD_FRONT; + +sub _init() { + $RVD_BACK = rvd_back( ); + $RVD_FRONT = rvd_front(); + + ok($Ravada::CONNECTOR,"\$Ravada::Connector wasn't set"); + ok($Ravada::CONNECTOR,"\$Ravada::Connector wasn't set"); + + ok($RVD_BACK->connector()); +} + +#################################################################################### + +sub test_machine_types($vm_name) { + my $req = Ravada::Request->list_machine_types( + vm_type => $vm_name + ,uid => user_admin->id + ); + wait_request(debug => 0); + + isa_ok($req->output,'HASH'); + + my $types = $RVD_FRONT->list_machine_types(user_admin->id, $vm_name); + + ok(ref($types)); + isa_ok($types,'HASH') +} + +sub test_list_isos($vm_name) { + my $vm = Ravada::VM->_open_type(type => $vm_name); + + my $req = Ravada::Request->list_isos( + uid => user_admin->id + ,id_vm => $vm->id + ); + wait_request(); + isa_ok($req->output,'ARRAY'); + + my $iso = $RVD_FRONT->iso_file(user_admin->id, $vm_name); + isa_ok($iso,'ARRAY'); +} +#################################################################################### + +init(); +clean(); + +SKIP: { + _init(); + for my $vm_name ( vm_names() ) { + test_machine_types($vm_name); + test_list_isos($vm_name); + } +} + +end(); +done_testing(); diff --git a/t/front/20_create_domain.t b/t/front/20_create_domain.t index 196ede73d..1d49b2d70 100644 --- a/t/front/20_create_domain.t +++ b/t/front/20_create_domain.t @@ -23,11 +23,9 @@ my $RVD_FRONT = Ravada::Front->new( @rvd_args my $USER = create_user('foo','bar', 1); -add_ubuntu_minimal_iso(); - my %CREATE_ARGS = ( Void => { id_iso => search_id_iso('Alpine'), id_owner => $USER->id } - ,KVM => { id_iso => search_id_iso('Ubuntu % Minimal'), id_owner => $USER->id } + ,KVM => { id_iso => search_id_iso('Alpine'), id_owner => $USER->id } ,LXC => { id_template => 1, id_owner => $USER->id } ); diff --git a/t/kvm/71_description_clones.t b/t/kvm/71_description_clones.t index ed25051fa..8dda3fdbb 100644 --- a/t/kvm/71_description_clones.t +++ b/t/kvm/71_description_clones.t @@ -112,10 +112,17 @@ sub test_prepare_base { eval { $domain->remove_base( user_admin); + }; + is(''.$@,'') or exit; + + $domain->remove_base( user_admin); + is($domain->is_base,0); + + eval { $domain->prepare_base( user_admin ); $@ = ''; }; - is(''.$@,''); + is(''.$@,'') or exit; ok($domain->is_base); my $name_clone = new_domain_name(); @@ -200,6 +207,7 @@ sub test_description { my $description = "This is a description test"; my $domain2 = rvd_back->search_domain($domain->name); ok ($domain2->description eq $description, "I can't find description"); + remove_domain($domain); } sub test_remove_base { diff --git a/t/kvm/a10_pools.t b/t/kvm/a10_pools.t index f1c58adaf..23b006e7c 100644 --- a/t/kvm/a10_pools.t +++ b/t/kvm/a10_pools.t @@ -4,7 +4,6 @@ use strict; use Carp qw(confess); use Data::Dumper; use IPC::Run3; -use Mojo::JSON qw(decode_json); use Test::More; use lib 't/lib'; @@ -23,7 +22,7 @@ my $USER = create_user("foo","bar", 1); ######################################################################### -sub create_pool($vm_name, $dir="/var/tmp/".new_pool_name()) { +sub create_pool($vm_name, $dir="/var/tmp/$search_vm($vm_name) or return; @@ -107,7 +106,7 @@ sub test_req_list_sp($vm) { is($req->status,'done'); is($req->error,''); my $json_out = $req->output; - my $pools = decode_json($json_out); + my $pools = $json_out; for my $pool ( @$pools ) { like($pool,qr{^[a-z][a-z0-9]*}) or die Dumper($pools); } @@ -234,7 +233,7 @@ sub test_volumes_in_two_pools { test_base($domain); for my $file (@volumes) { - ok(-e $file,"Expecting volume $file exists, got : ".(-e $file or 0)); + ok(-e $file,"Expecting volume $file exists, got : ".(-e $file or 0)) or die $domain->name; } $domain->remove($USER); for my $file (@volumes) { @@ -666,7 +665,7 @@ sub test_pool_info($vm) { ); wait_request(); my $out = $req->output; - my $pools = decode_json($out); + my $pools = $out; my $pool = $pools->[0]; isa_ok($pool,'HASH'); @@ -730,8 +729,7 @@ sub test_pool_dupe($vm) { ); wait_request(); my $out_json = $req2->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $dir ($dir, $dir_link) { my @found = grep( {$_->{file} =~ m{^$dir/} } @{$output->{list}}); @@ -786,8 +784,7 @@ sub test_pool_dupe_linked_1($vm) { ); wait_request(); my $out_json = $req2->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $dir ($dir, $dir_link) { my @found = grep( {$_->{file} =~ m{^$dir/} } @{$output->{list}}); @@ -822,8 +819,7 @@ sub test_pool_dupe_linked($vm) { ); wait_request(); my $out_json = $req2->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $dir ($dir, $dir_link) { my @found = grep( {$_->{file} =~ m{^$dir/} } @{$output->{list}}); @@ -871,6 +867,7 @@ SKIP: { skip($msg,10) if !$vm; + test_volumes_in_two_pools($vm_name); test_create_pool_fail($vm); diff --git a/t/kvm/a20_xml.t b/t/kvm/a20_xml.t index ed14fddc2..994a3f307 100644 --- a/t/kvm/a20_xml.t +++ b/t/kvm/a20_xml.t @@ -75,6 +75,9 @@ SKIP: { my @volumes = $clone->list_volumes(); is(scalar @volumes,1); + $clone->remove(user_admin); + $clone=undef; + $domain->remove_base(user_admin); $domain->add_volume( name => $domain->name.'.vdb' , size => 1000 *1024); my @volumes_domain = $domain->list_volumes(); @@ -87,10 +90,9 @@ SKIP: { if ($clone2) { my @volumes_clone2= $clone2->list_volumes(); - is(scalar @volumes_clone2, 1); + is(scalar @volumes_clone2, 2); } - $clone->remove( user_admin ); $clone2->remove( user_admin ); $domain->remove_base( user_admin ); diff --git a/t/kvm/n10_nodes.t b/t/kvm/n10_nodes.t index e1e24ffed..1baf8627b 100644 --- a/t/kvm/n10_nodes.t +++ b/t/kvm/n10_nodes.t @@ -117,15 +117,17 @@ sub test_node($vm_name,$node) { sub test_sync { my ($vm_name, $node, $base, $clone) = @_; - eval { $clone->rsync($node) }; - is(''.$@,'') or return; + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); # TODO test synced files + is($base->base_in_vm($node->id),1); + my $clone2=Ravada::Front::Domain->open($clone->id); + is($clone2->_data('id_vm'),$node->id); - eval { $base->rsync($node) }; - is($@,'') or return; - - eval { $clone->rsync($node) }; - is($@,'') or return; } sub test_domain_ip($vm_name, $node) { @@ -158,22 +160,38 @@ sub test_domain { is($base->_vm->host, 'localhost'); $base->prepare_base(user_admin); - $base->migrate_base(node => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); my $clone = $base->clone(name => new_domain_name ,user => user_admin ); test_sync($vm_name, $node, $base, $clone); - eval { $clone->migrate($node) }; - is(''.$@ , '') or return; - - my @start_arg = ( user => user_admin ); + my @start_arg; push @start_arg , ( remote_ip => $remote_ip ) if $remote_ip; eval { $clone->start(@start_arg) }; + Ravada::Request->start_domain( + uid => user_admin->id + ,id_domain => $clone->id + ,@start_arg + ); + wait_request(); - ok(!$@,$node->name." Expecting no error, got ".($@ or '')); + for ( 1 .. 3 ) { + last if $clone->is_active; + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $clone->id + ); + wait_request(); + $clone = Ravada::Domain->open($clone->id); + } is($clone->is_active,1) or return; my $local_ip = $node->ip; @@ -198,17 +216,23 @@ sub test_iptables($node, $remote_ip, $local_ip, $local_port) { sub test_domain_on_remote { my ($vm_name, $node) = @_; - my $domain; - eval { - $domain = $node->create_domain( - name => new_domain_name - ,id_owner => user_admin->id - ,id_iso => search_id_iso('Alpine') - ); - }; - is($@,'',"Expecting no domain in remote node by now"); + my $name = new_domain_name(); + my $req_create = Ravada::Request->create_domain( + name => $name + ,id_owner => user_admin->id + ,id_iso => search_id_iso('Alpine') + ,id_vm => $node->id + ); + wait_request(); + is($req_create->error,''); + my $domain = rvd_back->search_domain($name);; - $domain->remove(user_admin) if $domain; + my $req = Ravada::Request->remove_domain( + uid => user_admin->id + ,name => $domain->name + ); + wait_request(); + is($req->error,''); } sub test_remove_domain_from_local { @@ -217,6 +241,24 @@ sub test_remove_domain_from_local { my $vm = rvd_back->search_vm($vm_name); my $domain = $vm->search_domain($domain_orig->name); + if (!$domain) { + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain_orig->id + ,id_node => $vm->id + ); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain_orig->id + ,id_node => $node->id + ,after_request => $req->id + ); + wait_request(); + $domain = $vm->search_domain($domain_orig->name); + } + + confess "Domain ".$domain_orig->name." not found in ".$vm->name + if !$domain; my @volumes = $domain->list_volumes(); @@ -510,14 +552,26 @@ sub _create_clone($node) { $clone->shutdown_now(user_admin) if $clone->is_active; is($clone->is_active,0); - eval { $base->set_base_vm(vm => $node, user => user_admin); }; - is(''.$@,'') or return; + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); + for my $volume ( $clone->list_volumes ) { ok(-e $volume,"Expecting volume $volume of machine ".$clone->name); } - eval { $clone->migrate($node); }; - is(''.$@,'') or BAIL_OUT(); + is(''.$@,'') or return; + + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); + $clone = Ravada::Domain->open($clone->id); is($clone->_vm->host, $node->host) or exit; @@ -531,6 +585,7 @@ sub test_rsync_newer { diag("Skipping: Volumes not implemented for $vm_name"); return; } + diag("test rsync newer"); my $domain = test_domain($vm_name, $node) or return; $domain->shutdown_now(user_admin) if $domain->is_active; @@ -578,28 +633,44 @@ sub test_rsync_newer { is($vol3_remote->get_info->{capacity}, $vol3->get_info->{capacity}); } - $domain->remove(user_admin); + remove_domain($domain); } sub test_bases_node { my ($vm_name, $node) = @_; + diag("Test bases node $vm_name ".$node->name); + my $vm = rvd_back->search_vm($vm_name); my $domain = create_domain($vm_name); - eval { $domain->base_in_vm($domain->_vm->id)}; - like($@,qr'is not a base'); + my $is; + eval { $is=$domain->base_in_vm($domain->_vm->id)}; + is($@,''); + is($is,0); # is($domain->base_in_vm($domain->_vm->id),1); eval { $domain->base_in_vm($node->id) }; - like($@,qr'is not a base'); - $domain->prepare_base(user_admin); + is($@,''); + is($is,0); + + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); is($domain->base_in_vm($domain->_vm->id), 1); is($domain->base_in_vm($node->id), 0); - $domain->migrate($node); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node->id + ); + wait_request(); + $domain = Ravada::Domain->open($domain->id); is($domain->_vm->id, $node->id) or exit; is($domain->base_in_vm($node->id), 1); @@ -609,18 +680,34 @@ sub test_bases_node { ok($vol_path,"[$vm_name] Expecting file '$name' in node ".$node->name) or exit; } - $domain->set_base_vm(vm => $node, value => 0, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ,value => 0 + ); + wait_request(); + is($domain->base_in_vm($node->id), 0); for my $file ( $domain->list_files_base ) { ok($vm->file_exists($file)) or die "File $file doesn't exist in ".$vm->name; } + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $vm->id + ,value => 0 + ); + wait_request(); + + $domain = Ravada::Domain->open($domain->id); - $domain->set_base_vm(vm => $vm, value => 0, user => user_admin); is($domain->is_base(),0); - eval { is($domain->base_in_vm($vm->id), 0) }; - like($@,qr'is not a base'); - eval { is($domain->base_in_vm($node->id), 0) }; - like($@,qr'is not a base'); + is($domain->base_in_vm($vm->id), 0); + is($domain->base_in_vm($node->id), 0); + my $bases_vm = $domain->_bases_vm(1); + ok(!keys %$bases_vm); + is(scalar($domain->list_files_base()),0) or exit; user_admin->mark_all_messages_read(); my $req = Ravada::Request->set_base_vm( @@ -630,7 +717,7 @@ sub test_bases_node { ); rvd_back->_process_all_requests_dont_fork(); is($req->status,'done') or die Dumper($req); - is($req->error,''); + is($req->error,'') or confess Dumper($domain->id." ".$domain->name); is($domain->base_in_vm($vm->id), 1); is(scalar user_admin->unread_messages , 2, Dumper(user_admin->unread_messages)); @@ -641,8 +728,7 @@ sub test_bases_node { ,id_domain => $domain->id ); rvd_back->_process_all_requests_dont_fork(); - eval { $domain->base_in_vm($vm->id)}; - like($@,qr'is not a base'); + is($domain->base_in_vm($vm->id),0); $domain->remove(user_admin); } @@ -657,7 +743,7 @@ sub test_clone_make_base { $domain->prepare_base(user_admin); is($domain->base_in_vm($domain->_vm->id), 1); - is($domain->base_in_vm($node->id), 0) or exit; + is($domain->base_in_vm($node->id), 0); $domain->set_base_vm(vm => $node, user => user_admin); is($domain->base_in_vm($node->id), 1); @@ -667,14 +753,28 @@ sub test_clone_make_base { ,user => user_admin ); - $clone->migrate($node); - eval { $clone->base_in_vm($node->id) }; - like($@,qr(is not a base)); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); - eval { $clone->base_in_vm($vm->id) }; - like($@,qr(is not a base)); + is($clone->base_in_vm($node->id),0); + is($clone->base_in_vm($vm->id),0); + + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $vm->id + ); + wait_request(); - $clone->prepare_base(user_admin); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain=> $clone->id + ); + wait_request(); is($clone->base_in_vm($vm->id),1); is($clone->base_in_vm($node->id),0); @@ -732,20 +832,36 @@ sub test_clone_not_in_node { $domain->prepare_base(user_admin); is($domain->base_in_vm($vm->id), 1); - $domain->set_base_vm(vm => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); wait_request(debug => 0); - is($domain->base_in_vm($node->id), 1); + $domain->_data('id_vm' => $vm->id); my @clones; for ( 1 .. 10 ) { my $clone1 = $domain->clone(name => new_domain_name, user => user_admin); - diag($clone1->name); push @clones,($clone1); - is($clone1->_vm->host, 'localhost'); - eval { $clone1->start(user_admin) }; - is(''.$@,'',"[$vm_name] Clone of ".$domain->name." failed ".$clone1->name) or return; + Ravada::Request->start_domain( + uid => user_admin->id + ,id_domain =>$clone1->id + ); + wait_request(); + for ( 1 .. 10 ) { + last if $clone1->is_active; + $clone1 = Ravada::Domain->open($clone1->id); + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $clone1->id + ); + wait_request(); + $clone1 = Ravada::Domain->open($clone1->id); + } is($clone1->is_active,1); + $clone1 = Ravada::Domain->open($clone1->id); # search the domain in the underlying VM if ($vm_name eq 'KVM') { @@ -763,13 +879,11 @@ sub test_clone_not_in_node { isnt($clones[-1]->_vm->host, $clones[0]->_vm->host,"[$vm_name] " .$clones[-1]->name ." - ".$clones[0]->name.Dumper({map {$_->name => $_->_vm->host} @clones})) or exit; - for (@clones) { - $_->remove(user_admin); - } - $domain->remove(user_admin); + remove_domain_and_clones_req($domain); } sub test_domain_already_started { + diag("test domain already started"); my ($vm_name, $node) = @_; my $vm = rvd_back->search_vm($vm_name); @@ -777,15 +891,24 @@ sub test_domain_already_started { my $domain = create_domain($vm_name); $domain->prepare_base(user_admin); - $domain->set_base_vm(vm => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); + wait_request(); is($domain->base_in_vm($node->id), 1); my $clone = $domain->clone(name => new_domain_name, user => user_admin); - is($clone->_vm->host, 'localhost'); - eval { $clone->migrate($node) }; - is(''.$@,'') or return; + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); + $clone = Ravada::Domain->open($clone->id); is($clone->_vm->host, $node->host); is($clone->_vm->id, $node->id) or return; @@ -816,6 +939,7 @@ sub test_domain_already_started { { # clone is active, it should be found in node my $clone3 = rvd_back->search_domain($clone->name); + die "Error: clone ".$clone->name." not found " if !$clone3; $clone3->check_status(); is($clone3->id, $clone->id); is($clone3->_vm->host , $node->host,"Expecting ".$clone3->name @@ -831,15 +955,13 @@ sub test_prepare_sets_vm { my $vm = rvd_back->search_vm($vm_name); my $domain = create_domain($vm_name); - eval { $domain->base_in_vm($vm->id) }; - like($@,qr'is not a base'); + is($domain->base_in_vm($vm->id),0); $domain->prepare_base(user_admin); is($domain->base_in_vm($vm->id),1); $domain->remove_base(user_admin); - eval { $domain->base_in_vm($vm->id) }; - like($@,qr'is not a base'); + is($domain->base_in_vm($vm->id),0); $domain->remove(user_admin); } @@ -860,19 +982,41 @@ sub test_remove_base($node) { is($domain->base_in_vm($vm->id),1); is($domain->base_in_vm($node->id),0); - $domain->set_base_vm(vm => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + , id_vm => $node->id + ); + wait_request(); is($domain->base_in_vm($node->id),1); + Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + , id_vm => $vm->id + ); + Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + , id_vm => $node->id + ); - $domain->remove_base_vm(user => user_admin, vm => $vm); + wait_request(); is($domain->is_base,0); - wait_request(debug => 0); + $domain = Ravada::Domain->open($domain->id); - $domain->prepare_base(user_admin); - is($domain->base_in_vm($vm->id),1); - is($domain->base_in_vm($node->id),0); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + is($domain->base_in_vm($domain->_data('id_vm')),1); - $domain->remove(user_admin); + my $id_other_vm = $node->id; + $id_other_vm = $vm->id if $id_other_vm == $domain->_data('id_vm'); + is($domain->base_in_vm($id_other_vm),0); + + remove_domain($domain); } sub test_remove_base_main($node) { @@ -881,20 +1025,47 @@ sub test_remove_base_main($node) { my $domain = create_domain($vm); $domain->prepare_base(user_admin); - $domain->set_base_vm(vm => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); + wait_request(); is($domain->base_in_vm($vm->id),1); is($domain->base_in_vm($node->id),1); - $domain->remove_base(user_admin); + Ravada::Request->remove_base( + uid => user_admin->id + ,id_domain => $domain->id + ); wait_request(debug => 0); is($domain->is_base,0); - $domain->prepare_base(user_admin); + + is($domain->base_in_vm($vm->id),0); + is($domain->base_in_vm($node->id),0); + + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $vm->id + ); + wait_request(debug => 0); + + is($domain->base_in_vm($vm->id),0); + is($domain->base_in_vm($node->id),0); + + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(debug => 0); is($domain->base_in_vm($vm->id),1); - is($domain->base_in_vm($node->id),0) or exit; + is($domain->base_in_vm($node->id),0 + ,"Expecting no base in node ".$node->name." ".$node->id) or exit; - $domain->remove(user_admin); + remove_domain($domain); } @@ -927,6 +1098,7 @@ sub test_node_inactive($vm_name, $node) { } sub test_sync_back($node) { + #TODO diag("Testing sync back on remote non shared storage node"); my $vm = rvd_back->search_vm($node->type, 'localhost'); my $domain = create_domain($vm); @@ -952,6 +1124,11 @@ sub test_sync_back($node) { _shutdown_nicely($clone); fast_forward_requests(); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $vm->id + ); wait_request(); is ( $clone->is_active, 0 ); for my $file ($clone->list_volumes) { @@ -1038,6 +1215,12 @@ sub test_shutdown($node) { my $clone2 = Ravada::Domain->open($clone->id); #open will clean internal shutdown is($clone2->is_active,0) or exit; + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $vm->id + ); + wait_request(); for my $file ($clone->list_volumes) { my $md5 = _md5($file, $vm); @@ -1113,9 +1296,9 @@ sub test_status($node) { is(''.$@,'',"[".$node->type."] expecting no error on clone shutdown"); diag("test status of local domain"); - $clone->_set_vm($vm->id, 1); - $clone->start(user_admin); - is($clone->_vm->name, $vm->name); + my $clone2 = $vm->search_domain($clone->name); + $clone2->start(user_admin); + is($clone2->_vm->name, $vm->name); my $domain_remote = $node->search_domain($clone->name); is($domain_remote->is_active, 0 ); @@ -1167,8 +1350,14 @@ SKIP: { remove_node($node); next; }; + test_domain_already_started($vm_name, $node); + test_remove_base($node); + test_domain_on_remote($vm_name, $node); + my $domain22 = test_domain($vm_name, $node); + test_remove_domain_from_local($vm_name, $node, $domain22) if $domain22; is($node->is_local,0,"Expecting ".$node->name." ".$node->ip." is remote" ) or BAIL_OUT(); + test_remove_base_main($node); test_already_started_hibernated($vm_name, $node); is($vm->is_active,1); @@ -1180,12 +1369,10 @@ SKIP: { test_migrate_back($node); test_remove_base_main($node); - test_status($node); test_bases_node($vm_name, $node); test_clone_make_base($vm_name, $node); test_sync_base($vm_name, $node); - test_sync_back($node); test_status($node); diff --git a/t/kvm/n30_nodes_front.t b/t/kvm/n30_nodes_front.t index b863b36f4..224f6ef7d 100644 --- a/t/kvm/n30_nodes_front.t +++ b/t/kvm/n30_nodes_front.t @@ -138,9 +138,9 @@ sub test_list_remote($node, $migrate=0) { my $base = create_domain($vm); $base->prepare_base(user_admin); - $base->set_base_vm(vm => $node, user => user_admin); my $domain = $base->clone(name => new_domain_name, user => user_admin); + $base->set_base_vm(vm => $node, user => user_admin); $domain->migrate($node); is($domain->_vm->host, $node->host); diff --git a/t/kvm/uefi.t b/t/kvm/uefi.t index 9a0787412..40c39d112 100644 --- a/t/kvm/uefi.t +++ b/t/kvm/uefi.t @@ -107,6 +107,10 @@ sub test_machine_types($vm) { my $iso = $vm->_search_iso($id_iso); diag("$arch $machine $iso->{name}"); + # it can not be selected by the user, so we don't test it + # pc-i440fx and UEFI will not work + next if $arch eq 'x86_64' && $machine =~ /pc-i440/ && $iso->{options}->{bios} =~ /UEFI/; + my $name = new_domain_name(); my $options = dclone($iso->{options}); @@ -162,8 +166,7 @@ sub test_req_machine_types($vm) { ,uid => user_admin->id ); wait_request(); - my $out_json = $req->output; - my $out = decode_json($out_json); + my $out = $req->output; my $n = 2; ok(scalar(keys %$out) >= $n,"Expecting at least $n machine architectures" . Dumper($out)); @@ -179,8 +182,7 @@ sub test_req_machine_types2($vm) { ,uid => user_admin->id ); wait_request(); - my $out_json = $req->output; - my $out = decode_json($out_json); + my $out = $req->output; my $n = 2; ok(scalar(keys %$out) >= $n,"Expecting at least $n machine architectures" . Dumper($out)); @@ -190,21 +192,12 @@ sub test_req_machine_types2($vm) { .Dumper($types)); } -sub _mock_device($vm,$iso, $mock_device) { - my $device = $iso->{device}; - return if $device && -e $device; - - my $sth = connector->dbh->prepare( - "UPDATE iso_images SET device=? WHERE id=?" - ); - $sth->execute($mock_device,$iso->{id}); - $iso->{device} = $mock_device; -} - sub _search_iso_alpine($vm) { my $id_alpine = search_id_iso('Alpine%32'); my $iso = $vm->_search_iso($id_alpine); - return $iso->{device}; + + my $file = $vm->search_volume_path($iso->{file_re}); + return $file; } sub test_isos($vm) { @@ -218,7 +211,7 @@ sub test_isos($vm) { like($req->output,qr/./); my $machine_types = {}; - $machine_types = decode_json($req->output()); + $machine_types = $req->output() if $req->output; my $isos = rvd_front->list_iso_images(); @@ -233,8 +226,6 @@ sub test_isos($vm) { next if !$iso->{arch} || $iso->{arch} !~ /^(i686|x86_64)$/; next if grep {$iso->{name} =~ /$_/} @skip; - _mock_device($vm,$iso, $device_iso); - die Dumper($iso) if !$iso->{device} || !-e $iso->{device}; for my $machine (@{$machine_types->{$iso->{arch}}}) { next if $machine eq 'ubuntu'; for my $uefi ( 0,1 ) { @@ -242,6 +233,10 @@ sub test_isos($vm) { next if $iso->{name} =~ /Windows 11/ && (!$uefi || $machine !~ /q35/); + + next if $uefi && $iso->{arch} ne 'x86_64'; + next if $uefi && $machine =~ /i440/; + next if !$ENV{TEST_LONG} && ( $iso->{description} =~ /Debian \d /i || $iso->{description} =~ /Mint (18|20)/i @@ -263,9 +258,10 @@ sub test_isos($vm) { , arch => $iso->{arch} , uefi => $uefi } - ,iso_file => $iso->{device} + ,iso_file => $device_iso ); wait_request(debug => 0); + is($req->error,''); my $domain = $vm->search_domain($name); ok($domain); wait_request(); @@ -288,7 +284,9 @@ sub test_isos($vm) { } $domain->start(user_admin); - test_drives($doc); + my $n_expected = 4; + $n_expected = 3 if $iso->{name} =~ /Empty Machine/; + test_drives($doc, $n_expected); $domain->shutdown_now(user_admin); $domain->remove(user_admin) if $domain; } @@ -298,9 +296,9 @@ sub test_isos($vm) { ok($found_4m,"Expected some 4M ovmf found"); } -sub test_drives($doc) { +sub test_drives($doc, $n_expected=4) { my @drives = $doc->findnodes("/domain/devices/disk"); - die "Error: only ".scalar(@drives) if scalar(@drives)<4; + die "Error: only ".scalar(@drives) if scalar(@drives)<$n_expected; my $previous = ''; my $prev_target = ''; my $prev_file = ''; diff --git a/t/lib/Test/Ravada.pm b/t/lib/Test/Ravada.pm index fdc725982..657a09e7a 100644 --- a/t/lib/Test/Ravada.pm +++ b/t/lib/Test/Ravada.pm @@ -35,6 +35,7 @@ require Exporter; create_domain create_domain_v2 create_base import_domain + import_clone test_chain_prerouting find_ip_rule search_id_iso @@ -63,6 +64,7 @@ create_domain create_ram_fs create_storage_pool + start_storage_pool local_ips wait_request @@ -76,6 +78,7 @@ create_domain remove_old_domains_req remove_domain_and_clones_req remove_domain + remove_domain_db remove_volatile_clones mojo_init mojo_clean @@ -111,6 +114,8 @@ create_domain config_host_devices qemu_fix_xml_file + check_leftovers + end ); @@ -301,6 +306,37 @@ sub import_domain($vm, $name=$BASE_NAME, $import_base=1) { return $domain; } +sub import_clone($vm, %options) { + + my $base0; + if ($vm->type eq 'Void') { + $base0 = create_domain_v2(vm => $vm, swap => 1 , data => 1); + } else { + $base0 = rvd_front()->search_domain($BASE_NAME); + $base0 = import_domain($vm->type, $BASE_NAME, 1) if !$base0; + } + return if !$base0; + my $name = new_domain_name(); + Ravada::Request->clone( + name => $name + ,uid => user_admin->id + ,id_domain => $base0->id + ); + wait_request(); + my $clone = rvd_back()->search_domain($name); + my $req = Ravada::Request->spinoff( + uid => user_admin->id + ,id_domain => $clone->id + ); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $clone->id + ,after_request => $req->id + ); + wait_request(); + return $clone; +} + sub create_base($vm) { my $domain = create_domain_v2(vm => $vm); $domain->prepare_base(user_admin); @@ -414,8 +450,6 @@ sub create_domain($vm_name, $user=$USER_ADMIN, $id_iso='Alpine%64', $swap=undef) $id_iso = search_id_iso($iso_name, $vm); warn "I can't find iso $iso_name" if !defined $id_iso; } - confess "ERROR: Domains can only be created at localhost" - if $vm->host ne 'localhost'; =pod // TODO: use create v2 from now on @@ -757,7 +791,7 @@ sub _discover() { my $out = $req->output; warn $req->error if $req->error; next if !$out; - my $discover = decode_json($out); + my $discover = $out; my @list = grep { $_ =~ /^$name/ } @$discover; for my $name (@list) { diag("Importing $name in ".$vm_name); @@ -778,7 +812,7 @@ sub _discover() { $domain = rvd_front->search_domain($name); last if $domain; sleep 1; - wait_request(debug => 1); + wait_request(debug => 0); } eval { $sth_instances->execute($domain->id, $id_vm); @@ -870,6 +904,42 @@ sub remove_domain(@bases) { } +sub remove_domain_db(@bases) { + + for my $base0 (@bases) { + confess if !defined $base0; + my $base = $base0; + + my $id = $base0->{id}; + $id = $base0->id if !defined $id; + + my $sth = $CONNECTOR->dbh->prepare( + "DELETE FROM requests " + ." WHERE id_domain=?"); + $sth->execute($id); + + $base = Ravada::Front::Domain->open($id) + unless ref($base) =~ /^Ravada::/; + + if (!defined $base) { + warn "I can't find base '$id'"; + next; + } + + for my $clone ($base->clones) { + my $d_clone = Ravada::Front::Domain->open($clone->{id}); + if ( $d_clone ) { + remove_domain_db($d_clone); + } else { + Ravada::Domain::_remove_domain_data_db($clone->{id}) + } + } + Ravada::Domain::_remove_domain_data_db($id) + } + +} + + sub remove_domain_and_clones_req($domain_data, $wait=1, $run_request=0) { my $domain; if (ref($domain_data) =~ /Ravada.*Domain/) { @@ -890,25 +960,21 @@ sub remove_domain_and_clones_req($domain_data, $wait=1, $run_request=0) { diag("Waiting for clones of domain ".$domain->name." removed " .scalar($domain->clones)) if !(time % 10); if ($run_request) { - wait_request(); + wait_request(debug => 0); } else { sleep 1; } } } - my $req_rm; - $req_rm = Ravada::Request->remove_base(uid => user_admin->id, id_domain => $domain->id) - if $domain->is_base; my @after_req; @after_req = ( after_request => $req_clone->id ) if $req_clone; - @after_req = ( after_request => $req_rm->id ) if $req_rm; my $req= Ravada::Request->remove_domain( name => $domain->name ,uid => user_admin->id ,@after_req ); - wait_request(debug => 0) if $wait; + wait_request(debug => 0,check_error => 0) if $wait; return $req; } @@ -950,6 +1016,11 @@ sub _remove_old_domains_vm($vm_name) { && $@ !~ /libvirt error code: 55,/ ; + my $domain0 = Ravada::Domain->open($domain->id); + if ($domain0 && $domain0->is_active) { + $domain0->shutdown_now(); + sleep 1; + } $domain = $vm->search_domain($domain->name); eval {$domain->remove( $USER_ADMIN ) } if $domain; warn "Error shutdown ".$domain->name." $@" if $@ && $@ !~ /No DB info/i @@ -1034,6 +1105,9 @@ sub _remove_old_domains_kvm { warn "WARNING: error $@ trying to shutdown ".$domain_name." on ".$vm->name if $@ && $@ !~ /error code: (42|55),/; + my $domain0 = rvd_back->search_domain($domain_name); + $domain0->shutdown_now() if $domain0 && $domain0->is_active; + eval { $domain->managed_save_remove() if $domain->has_managed_save_image(); @@ -1174,6 +1248,16 @@ sub wait_mojo_request($t, $url) { _wait_mojo_request($t, $url); } +sub start_storage_pool($vm, $sp_name) { + return if $vm->type eq 'Void'; + my $sp = $vm->vm->get_storage_pool_by_name($sp_name); + return if !$sp; + return $sp if $sp->is_active(); + + $sp->create(); + return $sp; +} + sub _activate_storage_pools($vm) { my @sp = $vm->vm->list_all_storage_pools(); for my $sp (@sp) { @@ -1224,10 +1308,18 @@ sub _remove_old_disks_kvm { for my $volume ( @volumes ) { next if $volume->get_name !~ /^${name}_\d+.*\.(img|raw|ro\.qcow2|qcow2|void|backup)$/; + _chmod_w($vm, $volume->get_path, $pool); eval { $volume->delete() }; if ($@) { if ($@->code == 38 ) { - $vm->remove_file($volume->get_path); + for ( 1 .. 2 ) { + eval { + $vm->remove_file($volume->get_path); + }; + warn "warning: $@" if $@; + last if !$@; + _chmod_w($vm, $volume->get_path, $pool); + } } else { warn "Error $@ removing ".$volume->get_name." in ".$vm->name if $@; } @@ -1248,6 +1340,24 @@ sub _remove_old_disks_void($node=undef){ } } +sub _chmod_w($vm, $file, $pool) { + my @stat = stat($file); + return if !$stat[2]; + my $txt_mode = sprintf("%04o",$stat[2]); + + my $ret_mode = $stat[2]; + $ret_mode &= 070; + + my $user_w = $ret_mode & 020; + + return if $user_w; + + my ($out, $err) = $vm->run_command("chmod","+w",$file) or warn "$! $file"; + warn $err if $err; + chmod(0700,$file) if -e $file; + $pool->refresh(); +} + sub _remove_old_disks_void_remote($node) { confess "Remote node must be defined" if !defined $node; return if !$node->ping(undef,0); @@ -1692,6 +1802,16 @@ sub remove_qemu_networks($vm=undef) { } +sub _remove_dir($dir) { + die $dir if $dir !~ m{/tst_}; + opendir (my $ls,$dir) or die "$! $dir"; + while (my $file = readdir $ls) { + next if $file =~ /^\./; + unlink "$dir/$file" or die "$dir/$file"; + } + closedir $ls; +} + sub remove_qemu_pools($vm=undef) { return if !$vm && (!$VM_VALID{'KVM'} || $>); return if defined $vm && $vm->type eq 'Void'; @@ -1718,6 +1838,13 @@ sub remove_qemu_pools($vm=undef) { diag("Removing ".$vm->name." storage_pool ".$pool->get_name); for my $vol ( $pool->list_volumes ) { diag("Removing ".$pool->get_name." vol ".$vol->get_name); + my $xml = XML::LibXML->load_xml(string => $vol->get_xml_description()); + my ($format_h) = $xml->findnodes("/volume/target/format"); + my $format = $format_h->getAttribute('type'); + if ( $format eq 'dir') { + my $dir = $xml->findnodes('/volume/target/path/text()'); + _remove_dir($dir); + } $vol->delete(); } } @@ -1795,7 +1922,7 @@ sub remove_old_storage_pools_req() { wait_request(); my $out = $req->output; next if !$out; - my $sp_list = decode_json($out); + my $sp_list = $out; my $name = base_pool_name(); for my $sp (@$sp_list) { next if $sp->{name} !~ /^$name/; @@ -1815,10 +1942,9 @@ sub remove_old_storage_pools_void() { return if !-e $file_sp; my $list = LoadFile($file_sp); - my $name = base_domain_name(); - - my @list2 = grep /^$name/, @$list; + my $name = base_pool_name(); + my @list2 = grep {$_->{name} !~ /^$name/ } @$list; DumpFile($file_sp,\@list2); } @@ -2380,6 +2506,7 @@ sub start_node($node) { } eval { $node2->run_command("true") }; is($@,'',"Expecting no error setting clock on ".$node->name." ".($@ or '')); + } sub remove_node($node) { @@ -2726,8 +2853,13 @@ sub _check_leftovers { } +sub check_leftovers { + _check_leftovers(); +} + sub _check_removed_nbd { return if $<; + return if !$NBD_LOADED; my ($in, $out, $err); my @cmd = ('rmmod',"nbd"); run3(\@cmd,\$in,\$out,\$err); diff --git a/t/mojo/15_list_bases.t b/t/mojo/15_list_bases.t index 2bc64e469..f76b5dad0 100644 --- a/t/mojo/15_list_bases.t +++ b/t/mojo/15_list_bases.t @@ -237,6 +237,7 @@ if (!ping_backend()) { $Test::Ravada::BACKGROUND=1; remove_old_domains_req(1); # 0=do not wait for them +clean(); $t = Test::Mojo->new($SCRIPT); $t->ua->inactivity_timeout(900); diff --git a/t/mojo/20_ws.t b/t/mojo/20_ws.t index 54970a56d..95ce64182 100644 --- a/t/mojo/20_ws.t +++ b/t/mojo/20_ws.t @@ -214,7 +214,7 @@ sub test_list_machines_non_admin($t, $bases) { } sub test_shutdown($user, $clone) { - if ($clone->{status} eq 'active') { + if ($clone->{status} && $clone->{status} eq 'active') { my $req = Ravada::Request->shutdown( uid => $user->id ,id_domain => $clone->{id} @@ -444,6 +444,76 @@ sub test_node_info($vm_name) { } +sub test_domain_requests($t, $base) { + my $user = create_user(); + my $other_user = create_user(); + my $is_base = $base->is_base(); + if (!$is_base) { + Ravada::Request->shutdown_domain(uid => user_admin->id + ,id_domain => $base->id); + Ravada::Request->prepare_base(uid => user_admin->id + ,id_domain => $base->id); + } + + my $is_public = $base->is_public(1); + mojo_login($t, $user->name,"$$"); + + $t->websocket_ok("/ws/subscribe")->send_ok("list_domain_requests/".$base->id)->message_ok->finish_ok; + is($t->message->[1],'[]'); + + mojo_request($t, "clone", { id_domain => $base->id }); + my ($clone) = grep { $_->{id_owner} == $user->id } $base->clones; + Ravada::Request->start_domain(uid => $user->id + ,id_domain => $clone->{id}); + Ravada::Request->shutdown_domain(uid => $user->id + ,name => $clone->{name}); + Ravada::Request->prepare_base(uid => user_admin->id + ,id_domain => $clone->{id}); + + $t->websocket_ok("/ws/subscribe")->send_ok("list_domain_requests/".$clone->{id})->message_ok->finish_ok; + my $list0 = $t->message->[1]; + my $list= decode_json($list0); + isa_ok($list,'ARRAY'); + ok(@$list,"Expecting pending requests for owner"); + for my $request (@$list) { + is_deeply([sort keys %$request],[qw(command date_req id id_domain status)]); + ok($request->{id} =~ /^\d+$/); + ok($request->{id} > 0); + is($request->{id_domain},$clone->{id}); + ok($request->{command}); + like($request->{date_req}, qr/^\d{4}-\d{2}-\d{2}/); + isnt($request->{status},'done'); + } + + mojo_login($t, $other_user->name,"$$"); + $t->websocket_ok("/ws/subscribe")->send_ok("list_domain_requests/".$clone->{id})->message_ok->finish_ok; + is($t->message->[1],'[]'); + + mojo_login($t, $user->name,"$$"); + + my $message = $t->websocket_ok("/ws/subscribe")->send_ok("list_domain_requests/".$clone->{id}) + ->message_ok; + + for ( 1 .. 5 ) { + sleep 1; + $message = $message->message_ok; + last if $t->message->[1] eq '[]'; + } + + is($t->message->[1],'[]'); + $message->finish_ok(); + + $base->is_public($is_public); + user_admin->make_admin($user->id); + + Ravada::Request->remove(uid => user_admin->id + ,name => $clone->{name}); + wait_request(); + + mojo_request($t, "remove_base", { id_domain => $base->id }) + if !$is_base; + +} ######################################################################################## init('/etc/ravada.conf',0); @@ -500,6 +570,8 @@ for my $vm_name ( @{rvd_front->list_vm_types} ) { test_list_machines_non_admin($t,\@bases); test_bases_access($t,\@bases); + test_domain_requests($t, $bases[0]); + remove_old_domains_req(); while( list_machines_user($t) ) { remove_old_domains_req(); diff --git a/t/mojo/30_settings.t b/t/mojo/30_settings.t index 1801bde6f..8e391397e 100644 --- a/t/mojo/30_settings.t +++ b/t/mojo/30_settings.t @@ -463,7 +463,7 @@ sub _create_storage_pool($id_vm , $vm_name) { ,name => $name ,directory => $dir ); - wait_request( ); + wait_request( $req ); is($req->error,''); return $name; diff --git a/t/mojo/50_utf8.t b/t/mojo/50_utf8.t index ba943abd0..96016e201 100644 --- a/t/mojo/50_utf8.t +++ b/t/mojo/50_utf8.t @@ -9,7 +9,6 @@ use HTML::Lint; use Test::More; use Test::Mojo; use Mojo::File 'path'; -use Mojo::JSON qw(decode_json); use lib 't/lib'; use Test::Ravada; @@ -54,7 +53,7 @@ sub _test_discover($vm_name) { wait_request(); return if !$req->output; - my $json = decode_json($req->output); + my $json = $req->output; my $base_name = base_domain_name(); my @domains = grep { /^$base_name/ } @$json; ok(!scalar(@domains)) or confess Dumper(\@domains); @@ -266,7 +265,7 @@ $t->ua->inactivity_timeout(900); $t->ua->connect_timeout(60); remove_old_domains_req(0); # 0=do not wait for them -for my $vm_name (sort @{rvd_front->list_vm_types} ) { +for my $vm_name (reverse sort @{rvd_front->list_vm_types} ) { test_utf8($t, $vm_name); } diff --git a/t/mojo/70_volatile.t b/t/mojo/70_volatile.t index fe66c46c2..97e75b733 100644 --- a/t/mojo/70_volatile.t +++ b/t/mojo/70_volatile.t @@ -6,7 +6,6 @@ use Data::Dumper; use Test::More; use Test::Mojo; use Mojo::File 'path'; -use Mojo::JSON qw(decode_json); use lib 't/lib'; use Test::Ravada; @@ -212,7 +211,7 @@ sub _new_network($vm_name,$id_vm) { wait_request(debug => 0); like($req_new->output , qr/\d+/) or exit; - $net = decode_json($req_new->output); + $net = $req_new->output; $net->{ip_address} =~ s/(\d+\.\d+\.)\d+(.*)/$1$cont$2/; my $name = $net->{name}; @@ -411,7 +410,7 @@ sub _remove_unused_volumes() { ); wait_request(); next if !$req->output; - my $list = decode_json($req->output); + my $list = $req->output; my @remove; for my $entry ( @{$list->{list}} ) { my $file = $entry->{file}; diff --git a/t/nodes/00_req.t b/t/nodes/00_req.t new file mode 100644 index 000000000..21ea4d505 --- /dev/null +++ b/t/nodes/00_req.t @@ -0,0 +1,490 @@ +use warnings; +use strict; + +use utf8; +use Carp qw(confess); +use Data::Dumper; +use Digest::MD5; +use Mojo::JSON qw(decode_json); +use Storable qw(dclone); +use Test::More; + +use lib 't/lib'; +use Test::Ravada; + +no warnings "experimental::signatures"; +use feature qw(signatures); + +my $N_IP = 2; +############################################################################### + +sub _create_remote_node($vm_name) { + my %config = ( + name => new_domain_name() + ,host => '192.168.18.'.$N_IP++ + ); + + my $vm = rvd_back->search_vm($vm_name); + + my $node = $vm->new(%config); + return $node; +} + +sub test_req_migrate($vm, $node1, $node2) { + my $domain = create_domain($vm); + $domain->_data('id_vm' => $node1->id); + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node2->id + ); + ok($req->after_request_ok()); + my $id_req_prev = $req->after_request_ok(); + ok($id_req_prev); + _mock_fail($id_req_prev); + + wait_request(debug => 0, check_error => 0); + is($req->status(),'done'); + is($req->error,'failure'); + + remove_domain_db($domain); +} + +sub test_req_migrate_active($vm, $node1, $node2) { + my $domain = create_domain($vm); + $domain->_data('id_vm' => $node1->id); + $domain->_data('status' => 'active'); + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node2->id + ,shutdown => 1 + ); + ok($req->after_request_ok()); + my $id_req_prev = $req->after_request_ok(); + $id_req_prev = [$id_req_prev] if !ref($id_req_prev); + ok($id_req_prev) or return; + + my ($req_prev_migrate,$req_prev_shutdown); + for my $id ( @$id_req_prev ) { + my $req_prev = Ravada::Request->open($id); + $req_prev_migrate = $req_prev if $req_prev->command eq 'migrate'; + $req_prev_shutdown = $req_prev if $req_prev->command eq 'shutdown'; + } + ok($req_prev_migrate) or exit; + ok($req_prev_shutdown) or exit; + + my $new_ids = dclone($id_req_prev); + $req->_data('after_request_ok' => 99); + delete $req->{_data}; + + push @$new_ids,(99); + is_deeply($req->after_request_ok(), $new_ids) + or die Dumper([$req->after_request_ok(), $new_ids]); + + $req->_data('after_request' => ''); + for ( 100 .. 103 ) { + $req->_data('after_request' => $_ ); + } + is_deeply($req->after_request(), ["100","101","102","103"]); + $req->_data('after_request' => ''); + $req->_data('after_request_ok' => ''); + + remove_domain_db($domain); +} + + +sub test_req_prepare_base($vm, $node1, $node2) { + my $domain = create_domain($vm); + $domain->_data('id_vm' => $node1->id); + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node2->id + ); + my $id_req_prev = $req->after_request_ok(); + ok($id_req_prev) or die Dumper([$domain->id, $req->id]); + + _mock_fail($id_req_prev); + + wait_request(debug => 0, check_error => 0); + is($req->status(),'done'); + is($req->error,'failure'); + remove_domain_db($domain); +} + +sub _mock_fail($id_req) { + my $sth = connector->dbh->prepare( + "UPDATE requests set status='done',error='failure' " + ." WHERE id = ?" + ); + $sth->execute($id_req); +} + +sub test_req_migrate_nested($vm, $node1) { + my $base1 = create_base($vm); + $base1->_data('is_base' => 1); + + my $base2 = create_base($vm); + $base2->_data('is_base' => 1); + $base2->_data('id_base' => $base1->id); + + my $base3 = create_base($vm); + $base2->_data('is_base' => 1); + $base3->_data('id_base' => $base2->id); + + my $clone = create_domain($vm); + $clone->_data('id_base' => $base3->id); + + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node1->id + ); + my $id_req_prev = $req->after_request_ok(); + ok($id_req_prev) or return; + my $req_prev = Ravada::Request->open($id_req_prev); + is($req_prev->id_domain, $clone->id_base); + is($req_prev->id_domain, $base3->id); + is($req_prev->command(), 'set_base_vm'); + + $id_req_prev = $req_prev->after_request_ok(); + ok($id_req_prev) or return; + isnt($id_req_prev, $req_prev->id) or exit; + $req_prev = Ravada::Request->open($id_req_prev); + is($req_prev->id_domain, $base2->id); + is($req_prev->id_domain, $base3->id_base); + is($req_prev->command(), 'set_base_vm'); + + $id_req_prev = $req_prev->after_request_ok(); + ok($id_req_prev) or return; + isnt($id_req_prev, $req_prev->id) or exit; + $req_prev = Ravada::Request->open($id_req_prev); + is($req_prev->id_domain, $base1->id); + is($req_prev->id_domain, $base2->id_base); + is($req_prev->command(), 'set_base_vm'); + + $id_req_prev = $req_prev->after_request_ok(); + ok(!$id_req_prev); + remove_domain_db($clone); +} + +sub test_req_gone($vm) { + + my $base = create_domain($vm); + + my $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $vm->id + ); + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + is($bases_vm->{$vm->id}->{id_request},$req->id); + $req->status('done'); + + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $base->id + ); + wait_request(); + + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + is($bases_vm->{$vm->id}->{id_request},undef); + + remove_domain($base); +} + +sub test_req_failed($vm) { + + my $base = create_domain($vm); + + my $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $vm->id + ); + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + is($bases_vm->{$vm->id}->{id_request},$req->id); + wait_request(); + + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},1) or exit; + is($bases_vm->{$vm->id}->{id_request},undef) or exit; + + my $req_rm = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $vm->id + ); + + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},1) or exit; + is($bases_vm->{$vm->id}->{id_request},$req_rm->id) or exit; + wait_request(debug => 0); + + $bases_vm = $base->_bases_vm_info(); + is($bases_vm->{$vm->id}->{enabled},0) or exit; + + remove_domain($base); + +} + +sub test_req_prepare_nested($vm, $node1) { + my $base1 = create_base($vm); + $base1->_data('is_base' => 1); + + my $base2 = create_base($vm); + $base2->_data('is_base' => 1); + $base2->_data('id_base' => $base1->id); + + my $clone2 = create_base($vm); + $clone2->_data('id_base' => $base1->id); + + my $base3 = create_base($vm); + $base3->_data('is_base' => 1); + $base3->_data('id_base' => $base2->id); + + my $clone3 = create_base($vm); + $clone3->_data('is_base' => 1); + + my $clone = create_domain($vm); + $clone->_data('id_base' => $base3->id); + + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $clone->id + ,id_vm => $node1->id + ); + my $id_req_prev = $req->after_request_ok(); + ok($id_req_prev) or return; + + #First prepare clone on node vm local + my $req_prev = Ravada::Request->open($id_req_prev->[0]); + is($req_prev->id_domain, $clone->id) or exit; + is($req_prev->args('id_vm'), $vm->id); + is($req_prev->command(), 'set_base_vm'); + + #Then prepare base on node + $req_prev = Ravada::Request->open($id_req_prev->[1]); + is($req_prev->id_domain, $base3->id) or exit; + is($req_prev->args('id_vm'), $node1->id); + is($req_prev->command(), 'set_base_vm'); + + # Chain prepare base requirements + $id_req_prev = $req_prev->after_request_ok(); + ok($id_req_prev) or die; + isnt($id_req_prev, $req_prev->id) or exit; + $req_prev = Ravada::Request->open($id_req_prev); + is($req_prev->id_domain, $base2->id); + is($req_prev->id_domain, $base3->id_base); + is($req_prev->command(), 'set_base_vm'); + + $id_req_prev = $req_prev->after_request_ok(); + ok($id_req_prev) or return; + isnt($id_req_prev, $req_prev->id) or exit; + $req_prev = Ravada::Request->open($id_req_prev); + is($req_prev->id_domain, $base1->id); + is($req_prev->id_domain, $base2->id_base); + is($req_prev->command(), 'set_base_vm'); + + $id_req_prev = $req_prev->after_request_ok(); + ok(!$id_req_prev); + + for my $base ( $base1, $base2, $base3, $clone) { + $base->_set_base_vm_db( $node1->id,1); + for ( 1 .. 2 ) { + my $clone2 = create_domain($vm); + $clone2->_data('id_base' => $base->id); + $clone2->_data('id_vm' => $node1->id); + } + } + test_req_remove_base_nested($vm, $node1, $clone, $base3, $base2, $base1); + remove_domain_db($base1); +} + +sub test_req_remove_base_nested($vm, $node1, $clone, $base3, $base2, $base1) { + for ( 1 .. 3 ) { + my $clone = create_domain($vm); + $clone->_data('id_base' => $base1->id); + $clone->_data('id_vm' => $node1->id); + } + + my $req = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base1->id + ,id_vm => $node1->id + ); + test_remove_requirements($base1, $node1->id, $req); +} + +sub test_remove_requirements($base, $id_node, $req) { + my @clones = $base->clones; + return if !@clones; + + my $id_req_prev = $req->after_request_ok(); + ok($id_req_prev) or die "Expecting requirements for " + .$req->id." ".$req->command." ".Dumper($req->args); + $id_req_prev=[$id_req_prev] if !ref($id_req_prev); + + for my $clone ( @clones ) { + next if $clone->{id_vm} != $id_node; + my $req_prev = _search_request_previous($clone->{id}, $id_req_prev); + ok($req_prev, "Expecting a request to migrate clone ".$clone->{id}." ".$clone->{name}) or exit; + ok($req_prev, "Expecting req for clone $clone->{id}") or die ; + if ($clone->{is_base}) { + my $base2 = Ravada::Front::Domain->open($clone->{id}); + test_remove_requirements($base2, $req_prev); + } + } +} + +sub _search_request_previous($id_domain, $id_req_prev) { + return if !$id_req_prev; + $id_req_prev = [$id_req_prev] if !ref($id_req_prev); + for my $id (@$id_req_prev) { + my $req_prev = Ravada::Request->open($id); + return $req_prev if $req_prev->id_domain == $id_domain; + + $req_prev = _search_request_previous($id_domain, $req_prev->after_request_ok()); + return $req_prev if $req_prev; + } +} + +sub test_chain_children($vm, $node1, $node2) { + + my $base1 = create_domain($vm); + $base1->_data('id_vm' => $node1->id); + + my $base2 = create_base($vm); + $base2->_data('is_base' => 1); + $base2->_data('id_base' => $base1->id); + $base2->_data('id_vm' => $node1->id); + + my $clone = create_domain_v2(vm => $vm); + $clone->_data('id_base' => $base2->id); + $clone->_data('id_vm' => $node1->id); + + my $req_migrate = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node2->id + ); + + my $req_rm = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base1->id + ,id_vm => $node1->id + ); + my $requirements = $req_rm->_data('after_request_ok'); + $requirements = [$requirements] unless ref($requirements); + + my ($found) = grep { $_ == $req_migrate->id } @$requirements; + ok($found,"Expecting ".$req_migrate->id." in @$requirements") + or die Dumper($requirements); + remove_domain_db($base1); +} + +sub test_chain_remove_vm($vm, $node1, $node2) { + + my $base = create_domain($vm); + + $base->_data('id_vm' => $node1->id); + + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node2->id + ); + + my $expected = [ $req->id, $req->after_request_ok]; + my $req_rm = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node2->id + ); + is_deeply($req_rm->_data('after_request_ok'), $expected); + $req_rm->_delete(); + + $req_rm = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node2->id + ); + is_deeply($req_rm->_data('after_request_ok'), $expected); + + $req_rm->_delete(); + + $req_rm = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node2->id + ,value => 0 + ); + is_deeply($req_rm->_data('after_request_ok'), $expected) + or die Dumper($req_rm->_data('after_request_ok')); + + $req_rm->_delete(); + + my $req_set = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node2->id + ,value => 1 + ); + is($req_set->id(),$req->id); + + remove_domain_db($base); +} + +############################################################################### + +init(); +clean(); +for my $vm_name (vm_names() ) { + my $vm; + eval { $vm = rvd_back->search_vm($vm_name) }; + + SKIP: { + + my $msg = "SKIPPED: $vm_name virtual manager not found ".($@ or ''); + + diag($msg) if !$vm; + skip($msg,10) if !$vm; + + diag("Testing remote node in $vm_name"); + + isnt($vm->name,'Void_localhost'); + my $node1 = _create_remote_node($vm_name); + my $node2 = _create_remote_node($vm_name); + + test_chain_remove_vm($vm, $node1, $node2); + test_chain_children($vm, $node1, $node2); + + test_req_gone($vm); + + test_req_failed($vm); + test_req_prepare_nested($vm, $node1); + test_req_migrate_nested($vm, $node1); + test_req_prepare_base($vm, $node1, $node2); + test_req_migrate_active($vm, $node1, $node2); + test_req_migrate($vm, $node1, $node2); + $node1->remove(); + $node2->remove(); + } +} + +END: { + end(); + done_testing(); +} + + diff --git a/t/nodes/10_basic.t b/t/nodes/10_basic.t index dd5007d70..1cc6f791c 100644 --- a/t/nodes/10_basic.t +++ b/t/nodes/10_basic.t @@ -30,33 +30,33 @@ sub test_reuse_vm($node) { $domain->set_base_vm(vm => $node, user => user_admin); my $clone1 = $domain->clone(name => new_domain_name, user => user_admin); - my $clone2 = $domain->clone(name => new_domain_name, user => user_admin); - is($clone1->_vm, $clone2->_vm, $clone1->_vm->name); - is($clone1->_vm->id, $clone2->_vm->id); + + $domain->set_base_vm(vm => $node, user => user_admin); is($clone1->list_instances,1); + my $vm_local = rvd_back->search_vm($node->type,'localhost'); + + $clone1->migrate($vm_local); $clone1->migrate($node); is($clone1->_data('id_vm'), $node->id); $clone2->migrate($node); is($clone2->_data('id_vm'), $node->id); - is($clone1->list_instances,2); + is($clone1->list_instances,2) or die $node->type." ".$clone1->name; - is($clone1->_vm, $clone2->_vm); - is($clone1->_vm, $clone2->_vm); is($clone1->_vm->{_ssh}, $clone2->_vm->{_ssh}); is($clone1->is_local, 0 ); test_remove($clone1, $node); - my $vm_local = rvd_back->search_vm($node->type,'localhost'); is($vm_local->is_local, 1); $clone2->migrate($vm_local); is($clone2->is_local, 1 ); test_remove($clone2, $node); + remove_domain($domain); } sub test_remove_req($vm, $node) { @@ -78,6 +78,8 @@ sub test_remove_req($vm, $node) { is($req->error, ''); $domain->remove(user_admin); + + check_leftovers(); } sub test_remove($clone, $node) { @@ -89,7 +91,7 @@ sub test_remove($clone, $node) { for my $file ( @volumes ) { ok( -e $file, "Expecting file '$file' in localhost"); - my ($out, $err) = $node->run_command("ls $file"); + my ($out, $err) = $node->run_command("ls", $file); ok($out, "Expecting file '$file' in ".$node->name) or exit; } @@ -97,9 +99,11 @@ sub test_remove($clone, $node) { $clone->remove(user_admin); for my $file ( @volumes ) { ok(! -e $file, "Expecting no file '$file' in localhost") or exit; - my ($out, $err) = $node->run_command("ls $file"); + my ($out, $err) = $node->run_command("ls", $file); ok(!$out, "Expecting no file '$file' in ".$node->name) or exit; } + + check_leftovers(); } sub test_iptables($node, $node2) { @@ -148,7 +152,6 @@ sub test_iptables($node, $node2) { ,jump => 'DROP' ); is(scalar @found,0,Dumper(\@found)); - # warn Dumper($list->{filter}); $clone1->remove(user_admin); @@ -226,6 +229,7 @@ sub test_iptables_close($vm, $node) { sub _remove_clones($domain) { _remove_domain($domain,0); + check_leftovers(); } sub _remove_domain($domain, $remove_base=0) { @@ -242,6 +246,7 @@ sub _remove_domain($domain, $remove_base=0) { if $remove_base; wait_request(); + check_leftovers(); } sub _create_2_clones_same_port($vm, $node, $base, $ip_local, $ip_remote) { @@ -281,13 +286,12 @@ sub _create_2_clones_same_port($vm, $node, $base, $ip_local, $ip_remote) { } sub _start_clone_in_node($vm, $node, $base) { + ok(scalar($base->list_vms) >1) or confess Dumper([map { $_->name } $base->list_vms]); my $found_clone; for my $try ( 1 .. 20 ) { my $clone1 = $base->clone(name => new_domain_name, user => user_admin); - _remove_tmp($clone1,$vm); - ok(scalar($base->list_vms) >1) or confess Dumper([map { $_->name } $base->list_vms]); eval { $clone1->start(user_admin) }; - is($@,'') or die "Error $@ starting ".$clone1->name; + is($@,'') or confess "Error $@ starting ".$clone1->name; $found_clone = $clone1; last if $clone1->_vm->id == $node->id; ok(scalar($base->list_vms) >1) or confess Dumper([map { $_->name } $base->list_vms]); @@ -317,6 +321,8 @@ sub test_removed_local_swap($vm, $node) { } sub test_removed_remote_swap($vm, $node) { + return; + # TODO diag("Testing removed remote swap in ".$vm->type); my $base = create_domain($vm); $base->add_volume(size => 128*1024 , type => 'tmp'); @@ -349,34 +355,60 @@ sub test_removed_remote_swap($vm, $node) { $base->remove(user_admin); } +sub _req_clone($base) { + my $name = new_domain_name(); + my $req = Ravada::Request->clone( + uid => user_admin->id + ,name => $name + ,id_domain => $base->id + ); + wait_request(); + is($req->error,'') or exit; + my ($clone0) = grep { $_->{name} eq $name } $base->clones; + return Ravada::Domain->open($clone0->{id}); +} + sub test_removed_base_file($vm, $node) { + # TODO + return; + # TODO. When files are manually removed, clone again from main node + # diag("Testing removed base in ".$vm->type); my $base = create_domain($vm); $base->prepare_base(user_admin); - $base->set_base_vm(node => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); is($base->base_in_vm($node->id),1); for my $file ( $base->list_files_base ) { $node->remove_file($file); } + Ravada::Request->refresh_storage( + uid => user_admin->id + ,id_vm => $node->id + ); + wait_request(); - my $found_req; my $found_clone; for my $try ( 1 .. 20 ) { - my $clone1 = $base->clone(name => new_domain_name, user => user_admin); - $clone1->start(user_admin); + my $clone1 = _req_clone($base); + Ravada::Request->start_domain(uid => user_admin->id, id_domain => $clone1->id); + wait_request(check_error => 0, debug => 0); $found_clone = $clone1; my @req = $base->list_requests(); - next if !scalar @req; + my $found_req; for my $req (@req) { if($req->command eq 'set_base_vm') { $found_req = $req; last; } } - last if $found_req; + last if $found_req || $clone1->is_active; } - ok($found_req,"Expecting request to set base vm"); wait_request(); is($base->base_in_vm($node->id),1); is(scalar($base->list_vms),2) or exit; @@ -390,6 +422,7 @@ sub test_removed_base_file($vm, $node) { $req->stop; } $base->remove(user_admin); + check_leftovers(); } sub _remove_base_files($base, $node) { @@ -400,16 +433,17 @@ sub _remove_base_files($base, $node) { } sub _remove_tmp($domain, $vm = $domain->_vm) { + $vm->refresh_storage_pools(); my ($found_swap, $found_tmp); for my $vol ( $domain->list_volumes ) { if ( $vol =~ /TMP/ ) { - $vm->remove_file($vol); $found_tmp= 1; } if ( $vol =~ /SWAP/ ) { - $vm->remove_file($vol); $found_swap = 1; } + $vm->remove_file($vol) + if $vol =~ /TMP|SWAP/ && $vm->file_exists($vol); } die "Error: no swap found in ".$domain->name if !$found_swap; die "Error: no tmp found in ".$domain->name if !$found_tmp; @@ -418,6 +452,8 @@ sub _remove_tmp($domain, $vm = $domain->_vm) { } sub test_removed_base_file_and_swap_remote($vm, $node) { + # TODO + return; diag("Testing removed remote base and swap in ".$vm->type); my $base = create_domain($vm); $base->add_volume(size => 128*1024 , type => 'tmp'); @@ -465,7 +501,7 @@ sub _check_base_in_vm_db($base, $id_node, $id_req, $value) { $sth->execute($base->id, $id_node); my $found = $sth->fetchrow_hashref; ok($found) or exit; - is($found->{enabled}, $value); + is($found->{enabled}, $value) or confess; is($found->{id_request}, $id_req) or confess; my @vms = $base->list_vms(); @@ -489,7 +525,8 @@ sub test_set_vm_fail($vm, $node) { my $pool2 = create_storage_pool($vm); $vm->default_storage_pool_name($pool2); $base->add_volume( size => 11000 ); - $base->prepare_base(user_admin); + + $base->prepare_base(user => user_admin, overwrite => 1); $base->_set_base_vm_db($node->id, 1); @@ -530,7 +567,7 @@ sub test_set_vm_fail($vm, $node) { sub test_set_vm($vm, $node) { my $base = create_domain($vm); my $info = $base->info(user_admin); - is($info->{bases}->{$vm->id},0); + is($info->{bases}->{$vm->id}->{enabled},0); my $req = Ravada::Request->set_base_vm( id_domain => $base->id @@ -539,25 +576,23 @@ sub test_set_vm($vm, $node) { , uid => user_admin->id ); rvd_back->_process_requests_dont_fork(); + wait_request(); is($req->status, 'done'); like($req->error, qr{^($|rsync done)}); - is($base->_vm->id, $vm->id); - my $base2 = Ravada::Domain->open($base->id); - is($base2->_vm->id, $vm->id); $info = $base2->info(user_admin); - is($info->{bases}->{$vm->id},1,Dumper($info->{bases})) or exit; - is($info->{bases}->{$node->id},1,$node->id." " + is($info->{bases}->{$vm->id}->{enabled},1,Dumper($info->{bases})) or exit; + is($info->{bases}->{$node->id}->{enabled},1,$node->id." " .Dumper($info->{bases})) or exit; is($base->list_instances,2) or exit; my $base_f = Ravada::Front::Domain->open($base->id); $info = $base_f->info(user_admin); - is($info->{bases}->{$vm->id},1) or exit; - is($info->{bases}->{$node->id},1) or exit; + is($info->{bases}->{$vm->id}->{enabled},1) or exit; + is($info->{bases}->{$node->id}->{enabled},1) or exit; is($base_f->list_instances,2) or exit; @@ -644,7 +679,12 @@ sub test_volatile_req($vm, $node) { my $base = create_domain($vm); $base->volatile_clones(1); $base->prepare_base(user_admin); - $base->set_base_vm(user => user_admin, node => $node); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(debug => 0); ok($base->base_in_vm($node->id)); my @clones; my $clone; @@ -670,6 +710,7 @@ sub test_volatile_req($vm, $node) { shutdown_domain_internal($clone); _wait_machine_removed($clone); + diag("Checking ". $clone->name." removed"); for my $vol ( $clone->list_volumes ) { ok(!$vm->file_exists($vol),$vol) or exit; ok(!$node->file_exists($vol),$vol." in ".$node->name) or exit; @@ -685,10 +726,11 @@ sub _wait_machine_removed($clone) { last if !$clone2; rvd_back->_cmd_refresh_vms(); - wait_request(); + wait_request(debug => 0); } - wait_request(); + wait_request(debug => 0); + check_leftovers(); } sub test_domain_gone($vm, $node) { @@ -719,17 +761,16 @@ sub test_volatile_req_clone($vm, $node, $machine='pc-i440fx') { my $base = create_domain_v2(vm => $vm, options => { machine => $machine }); $base->prepare_base(user_admin); + $base->volatile_clones(1); my $req = Ravada::Request->set_base_vm( uid => user_admin->id ,id_domain => $base->id ,id_vm => $node->id ,value => 1 ); - _check_base_in_vm_db($base, $node->id,$req->id, 1); - $base->volatile_clones(1); - ok($base->base_in_vm($node->id)); - _check_base_in_vm_db($base, $node->id,$req->id, 1); - wait_request(debug => 1); + _check_base_in_vm_db($base, $node->id,$req->id, 0); + ok(!$base->base_in_vm($node->id)); + wait_request(debug => 0); _check_base_in_vm_db($base, $node->id,undef, 1); my $clone; @@ -840,29 +881,13 @@ sub test_clone_remote($vm, $node) { is($clone->list_instances,1); - _test_old_base($base, $vm); - _test_clones($base, $vm); + _test_clones($base, $clone->_vm); $clone->remove(user_admin); is($clone->list_instances,undef); $base->remove(user_admin); is($base->list_instances,undef); } -sub _test_old_base($base, $vm) { - my $sth = connector->dbh->prepare( - "DELETE FROM bases_vm " - ." WHERE id_domain=? AND id_vm=?" - ); - $sth->execute($base->id, $vm->id); - - my $base_f = Ravada::Front::Domain->open($base->id); - - my $info = $base_f->info(user_admin); - is($info->{bases}->{$vm->id},1) ; - - is(scalar keys %{$info->{bases}}, 2); -} - sub _test_clones($base, $vm) { my $info = $base->info(user_admin); ok($info->{clones}) or return; @@ -871,45 +896,144 @@ sub _test_clones($base, $vm) { } sub test_remove_base($vm, $node, $volatile) { - my $base = create_domain($vm); + diag("tst remove base, volatile_clones=$volatile ".$vm->name." ".$node->name); + my $base = create_domain_v2(vm => $vm, disk => 0.5, data => 0, swap => 0); + my $uuid; + $uuid = $base->domain->get_uuid_string() if $vm->type eq 'KVM'; $base->volatile_clones($volatile); my @volumes0 = $base->list_volumes( device => 'disk'); ok(!grep(/iso$/,@volumes0),"Expecting no iso files on device list ".Dumper(\@volumes0)) or exit; $base->prepare_base(user_admin); + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; - my @volumes = $base->list_files_base(); - $base->set_base_vm(node => $node, user => user_admin); - for my $file ( @volumes ) { - my ($out, $err) = $node->run_command("ls $file"); - ok($out, "Expecting file '$file' in ".$node->name) or exit; + my @volumes_base = $base->list_files_base(); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); + check_leftovers(); + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; + for my $file ( @volumes_base ) { + ok($node->file_exists($file)) + or die "Expecting file '$file' in ".$node->name; + ok($vm->file_exists($file)) + or die "Expecting file '$file' in ".$vm->name; + } + test_domain_internal($base->name,$vm, $node); + + Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); + test_domain_internal($base->name,$vm); + test_domain_internal_not($base->name, $node); + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; + + my $base_gone = $node->search_domain($base->name); + ok(!$base_gone,"Expecting ".$base->name." removed in ".$node->name) or exit; + for my $file ( @volumes_base ) { + ok(!$node->file_exists($file)) or exit; + ok($vm->file_exists($file), "Expecting file '$file' in local") or exit; + } + for my $file ( @volumes0 ) { + ok(!$node->file_exists($file),$file); + ok($vm->file_exists($file), "Expecting file '$file' in local") or exit; } - $base->remove_base_vm(node => $node, user => user_admin); - for my $file ( @volumes , @volumes0 ) { - ok(!$node->file_exists($file)); - ok(-e $file, "Expecting file '$file' in local") or exit; + my $bases_vm = $base->_bases_vm(); + for my $id_vm ( keys %$bases_vm) { + delete $bases_vm->{$id_vm} if !$bases_vm->{$id_vm}; } - isnt($base->_data('id_vm'), $node->id); + is(scalar(keys %$bases_vm),1); - $base->set_base_vm(node => $node, user => user_admin); + $base = Ravada::Domain->open($base->id); + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; + delete $base->{_data}->{id_vm}; + is($base->_data('id_vm'), $vm->id); + + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); is(scalar($base->list_vms), 2) or exit; - $base->remove_base(user_admin); + $bases_vm = $base->_bases_vm(); + for my $id_vm ( keys %$bases_vm) { + delete $bases_vm->{$id_vm} if !$bases_vm->{$id_vm}; + } + is(scalar(keys %$bases_vm),2); - my @req = $base->list_requests(); - is(scalar @req,2); - ok(grep {$_->command eq 'remove_base_vm' } @req) or die Dumper(\@req); + + test_domain_internal($base->name,$vm, $node); wait_request( debug => 0 ); - for my $file ( @volumes ) { - ok(!-e $file, "Expecting no file '$file' in local") or exit; - my ($out, $err) = $node->run_command("ls $file"); - ok(!$out, "Expecting no file '$file' in ".$node->name) or exit; + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; + Ravada::Request->remove_base( + uid => user_admin->id + ,id_domain => $base->id + ); + wait_request(debug => 0); + $base = Ravada::Domain->open($base->id); + is($base->domain->get_uuid_string(), $uuid) if $vm->type eq 'KVM'; + + # my @req = $base->list_requests(); + # is(scalar @req,2); + # ok(grep {$_->command eq 'remove_base_vm' } @req) or die Dumper(\@req); + wait_request( debug => 0 ); + + for my $file ( @volumes_base ) { + is($vm->file_exists($file),0 + , "Expecting no file '$file' in local") or exit; + is($node->file_exists($file),0 + , "Expecting no file '$file' in node") or exit; } $base->remove(user_admin); + check_leftovers(); +} + +sub test_domain_internal($name, @vms) { + + for my $vm (@vms) { + if (ref($vm) =~ /KVM$/) { + my $domain; + eval { $domain = $vm->vm->get_domain_by_name($name) }; + my $error = ($@ or ''); + ok($domain,"Expecting $name in ".$vm->name." $error") or confess; + } else { + my $domain = $vm->search_domain($name); + my $config_file = $domain->_config_file; + ok($vm->file_exists($config_file)); + } + } } +sub test_domain_internal_not($name, @vms) { + + for my $vm (@vms) { + if (ref($vm) =~ /KVM$/) { + $vm->_reconnect(); + my $domain; + eval { $domain = $vm->vm->get_domain_by_name($name) }; + my $error = ($@ or ''); + warn $error if $error; + ok(!$domain,"Expecting not $name in ".$vm->name) or confess; + } else { + my $domain = $vm->search_domain($name); + ok(!$domain,"Expecting $name not in node ".$vm->name) or confess; + if ($domain) { + my $config_file = $domain->_config_file; + ok(!$vm->file_exists($config_file)); + } + } + } +} sub _check_internal_autostart($domain, $expected) { if ($domain->type eq 'KVM') { ok($domain->domain->get_autostart) if $expected; @@ -960,7 +1084,7 @@ sub test_duplicated_set_base_vm($vm, $node) { , at => time + 3 ); my $req4 = Ravada::Request->remove_base_vm(id_vm => $node->id - , uid => 2 + , uid => 1 , id_domain => $domain->id , at => time + 4 ); @@ -998,7 +1122,6 @@ sub test_create_active($vm, $node) { ); wait_request(debug => 0); $clone = rvd_front->search_domain($name); - ok($vm->search_domain($name),"Expecting clone $name in master node") or exit; last if $clone->display(user_admin) =~ /$remote_ip/; } like($clone->display(user_admin), qr($remote_ip)); @@ -1045,17 +1168,40 @@ sub test_keep_node($node, $clone) { sub test_base_unset($vm, $node) { my $base = create_domain($vm); $base->prepare_base(user_admin); - $base->set_base_vm(vm => $node, user => user_admin); + is(Ravada::Domain::base_in_vm($base->id,$vm->id),1) or exit; + + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); my $clone = $base->clone(name => new_domain_name, user => user_admin); - $clone->migrate($node); - $base->set_base_vm(id_vm => $node->id,value => 0, user => user_admin); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); + + delete_request('migrate','set_base_vm','remove_base_vm'); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ,value => 0 + ); + wait_request(debug => 0); + is($base->base_in_vm($node->id),0) or exit; is(Ravada::Domain::base_in_vm($base->id,$node->id),0) or exit; + wait_request(debug => 0); my $clone2 = Ravada::Domain->open($clone->id); + is($clone2->_data('id_vm'), $vm->id) or exit; $clone2->start(user_admin); - is($clone2->_vm->name, $vm->name) or exit; + is($clone2->_vm->name, $vm->name) or confess; _remove_domain($base); } @@ -1108,9 +1254,10 @@ sub test_change_clone($vm, $node) { ok(-e $vol); ok($node->file_exists($vol), $vol) if $vol !~ /iso$/; } + my $node_clone = $clone->_vm; for my $vol (@volumes_clone) { - ok(-e $vol, $vol); - ok(!$node->file_exists($vol), $vol) if $vol !~ /iso$/; + ok($node_clone->file_exists($vol), $vol) or exit + if $vol !~ /iso$/; } $clone->remove(user_admin); $base->remove(user_admin); @@ -1133,7 +1280,6 @@ sub _machine_types($vm) { $types{$1} = [ $version,$machine ] if !exists $types{$1} || $version > $types{$1}->[0]; } - warn Dumper(\%types); for (keys %types) { push @types,($types{$_}->[1]); } @@ -1174,16 +1320,67 @@ sub test_pc_other($vm, $node) { } -sub test_fill_memory($vm, $node, $migrate) { - #TODO: Void VMs - return if $vm->type eq 'Void'; - diag("Testing fill memory ".$vm->type.", migrate=$migrate"); +sub _check_files_exist($domain) { + for my $file ($domain->list_volumes()) { + ok($domain->_vm->file_exists($file),"Expecting in ".$domain->_vm->name + ." file exists $file") or exit; + } +} + +sub _import_clone($vm) { + if ($vm->type eq 'Void') { + return create_domain_v2(vm => $vm, swap => 1 , data => 1); + } + my $base0 = rvd_front->search_domain($BASE_NAME); + $base0 = import_domain($vm->type, $BASE_NAME, 1) if !$base0; + return if !$base0; + my $name = new_domain_name(); + Ravada::Request->clone( + name => $name + ,uid => user_admin->id + ,id_domain => $base0->id + ); + wait_request(); + my $clone = rvd_back->search_domain($name); + my $req = Ravada::Request->spinoff( + uid => user_admin->id + ,id_domain => $clone->id + ); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $clone->id + ,after_request => $req->id + ); + wait_request(); + return $clone; +} + +sub _shutdown_domains(@nodes) { + for my $node (@nodes) { + for my $domain ($node->list_domains(active => 1)) { + my $base_name=base_domain_name(); + if ( $domain->name =~ /$base_name/ ) { + warn $domain->name; + Ravada::Request->force_shutdown( + uid => user_admin->id + ,id_domain => $domain->id + ); + } + } + } + wait_request(); +} + +sub test_fill_memory($vm, $node, $migrate, $start=0) { + diag("Testing fill memory ".$vm->type.", migrate=$migrate, start=$start"); + + _shutdown_domains($vm,$node); + start_node($node); - my $base = rvd_back->search_domain($BASE_NAME); - $base = import_domain('KVM', $BASE_NAME, 1) if !$base; + my $base = _import_clone($vm); if (!$base) { - diag("SKIPPING: base $BASE_NAME must be installed to test"); - return; + diag("SKIPPING: base $BASE_NAME must be installed to test"); + return; } $base->prepare_base(user_admin) if !$base->is_base; Ravada::Request->set_base_vm(id_vm => $node->id @@ -1191,6 +1388,7 @@ sub test_fill_memory($vm, $node, $migrate) { ,id_domain => $base->id ); wait_request(); + ok($base->_id_base_in_vm($node->id)); my $master_free_memory = $vm->free_memory; my $node_free_memory = $node->free_memory; @@ -1203,43 +1401,115 @@ sub test_fill_memory($vm, $node, $migrate) { my $error; my %nodes; my @clones; + my $created_in_node=0; for ( 1 .. 100 ) { my $clone_name = new_domain_name(); - diag("Try $_ , $clone_name may go to ".$node->name); my $req = Ravada::Request->create_domain( name => $clone_name ,id_owner => user_admin->id ,id_base => $base->id ,memory => int($memory) + ,start => $start ); - wait_request(debug => 0); - is($req->error, ''); + wait_request(debug => 0, check_error => 0); + like($req->error, qr/^(No free memory|$)/); is($req->status,'done'); push @clones,($clone_name); my $clone = rvd_back->search_domain($clone_name) or last; ok($clone,"Expecting clone $clone_name") or exit; - $clone->migrate($node) if $migrate; + $created_in_node++ if $clone->_data('id_vm') == $node->id; + _check_files_exist($clone); + + Ravada::Request->migrate( uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ,shutdown => 1 + ,shutdown_timeout => 1 + ) if $migrate; wait_request(debug => 0); - eval { $clone->start(user_admin) }; - $error = $@; - diag($error) if $error; + $clone = Ravada::Domain->open($clone->id); + my $req_start = Ravada::Request->start_domain( + uid => user_admin->id + ,id_domain => $clone->id + ); + wait_request(debug => 0, check_error => 0); + $error = $req_start->error; like($error, qr/(^$|No free memory)/); exit if $error && $error !~ /No free memory/; + $created_in_node++ if $clone->_data('id_vm') == $node->id; last if $error; $clone = Ravada::Domain->open($clone->id); - $nodes{$clone->_vm->name}++; + my $node_name = $clone->_vm->name; + $nodes{$node_name}++; last if $migrate && exists $nodes{$vm->name} && $nodes{$vm->name} > 2; - if ($migrate || keys(%nodes) > 0) { - $memory = int($memory*1.5); + if (!$error && !$clone->is_active) { + die $clone->_vm->name." ".$clone->name if !$error && !$clone->is_active; } + $memory *= 1.5; } - ok(exists $nodes{$vm->name},"Expecting some clones to node ".$vm->name." ".$vm->id); + ok($created_in_node,"Expecting some clones created in node ".$node->name) + or confess; + ok(exists $nodes{$vm->name},"Expecting some clones to node ".$vm->name." ".$vm->id) + or die Dumper(\%nodes); ok(exists $nodes{$node->name},"Expecting some clones to node ".$node->name." ".$node->id) or exit; + + my ($clone) = grep { $_->{id_vm} == $vm->id } $base->clones; + for my $clone0 ( $base-> clones ) { + next if $clone0->{id_vm} eq $vm->id; + my $clone0b = Ravada::Front::Domain->open($clone0->{id}); + next if $clone0b->list_instances<2; + test_rsync_back($vm, $clone); + } + _remove_clones($base); } +sub test_rsync_back($vm, $clone) { + confess if !$clone || !exists $clone->{id_vm} || !defined $clone->{id_vm}; + if ($clone->{id_vm} == $vm->id) { + diag("Warning: ".$clone->{name}." already in node ".$vm->name); + return; + } + Ravada::Request->force_shutdown(uid => user_admin->id + ,id_domain => $clone->{id} + ); + wait_request(); + my $req_back; + my $clone2 = Ravada::Domain->open($clone->{id}); + my $node = $clone2->_vm; + for my $req ( $clone2->list_requests) { + if ($req->command eq 'rsync_back') { + $req_back = $req; + $req->run_at(0); + } + } + $req_back = Ravada::Request->rsync_back( + uid =>user_admin->id + ,id_domain => $clone->{id} + ,id_node => $vm->id + ) if !$req_back; + wait_request( debug => 0); + is($req_back->error,''); + + $clone2 = Ravada::Domain->open($clone->{id}); + is($clone2->_data('id_vm'), $node->id); + my @instances = $clone2->list_instances(); + is(scalar(@instances),2,"Expecting 2 instances of ".$clone->{name}. "[ ".$clone->{id}." ]") + or exit; + + $req_back->status('requested'); + wait_request( debug => 0); + is($req_back->error,''); + + $clone2 = Ravada::Domain->open($clone->{id}); + is($clone2->_data('id_vm'), $node->id); + + @instances = $clone2->list_instances(); + is(scalar(@instances),2,"Expecting 2 instances"); +} + sub test_migrate($vm, $node) { diag("Test migrate"); @@ -1362,7 +1632,7 @@ sub _migrate($domain, $node,$active) { .". It is in ".$domain2->_vm->name if $node->id != $domain2->_vm->id; - die "Error: domain ".$domain2->name." should be active=$active, got ".$domain2->is_active + confess "Error: domain ".$domain2->name." should be active=$active, got ".$domain2->is_active if $domain2->is_active != $active; } @@ -1407,13 +1677,14 @@ sub test_volumes_levels($domain, $level) { for my $vol ($domain->list_volumes_info) { next if !$vol->file; + next if $vol->file !~ /.qcow/; my @backings = _get_backing_files($vol->file); for my $file (@backings) { like($file ,qr{-vd[a-z][\.-]},$domain->name) or exit; unlike($file,qr{--+},$domain->name) or exit; } is(scalar(@backings), $level, "Expecting ".$domain->name - ." : ".$vol->file." level $level\n".Dumper(\@backings)) or exit; + ." : ".$vol->file." level $level\n".Dumper(\@backings)) or confess; } } @@ -1430,6 +1701,7 @@ sub _get_backing_xml($disk) { } sub test_domain_volumes_levels($domain, $level) { + return if $domain->type eq 'Void'; my $doc =XML::LibXML->load_xml(string => $domain->xml_description()); my $found = 0; @@ -1450,20 +1722,31 @@ sub test_domain_volumes_levels($domain, $level) { sub test_nested_base($vm, $node, $levels=1) { my $base0 = create_domain($vm); - $base0->add_volume(swap => 1, size => 10 * 1024); - $base0->add_volume(type => 'tmp', size => 10 * 1024); - $base0->add_volume(type => 'data', size => 10 * 1024); + + $base0->add_volume(swap => 1, size => 10 * 1024, format => 'qcow2'); + $base0->add_volume(type => 'tmp', size => 10 * 1024, format => 'qcow2'); + $base0->add_volume(type => 'data', size => 10 * 1024, format => 'qcow2'); my $base1 = $base0; my $clone; my @bases = ( ); for my $n ( 1 .. $levels ) { diag("Cloning from ".$base1->name." level $n / $levels"); - $base1->prepare_base(user_admin) if !$base1->is_base; - $clone = $base1->clone( - name => new_domain_name - ,user => user_admin + if (!$base1->is_base) { + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $base1->id + ); + wait_request(); + } + Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $base1->id + ,number => 3 ); + wait_request(); + my @clones = $base1->clones(); + $clone = $vm->search_domain($clones[0]->{name}); is($clone->id_base,$base1->id); push @bases,($base1); wait_request(); @@ -1473,17 +1756,68 @@ sub test_nested_base($vm, $node, $levels=1) { } _test_migrate_nested($vm, $node, \@bases, $clone, $levels); - $base0->remove_base_vm(vm => $node, user => user_admin); + _migrate_fast($clone, $vm); + my @volumes_base = $base0->list_files_base; + _remove_base_vm($base0, $node); + for my $file ( $clone->list_volumes() ) { + ok($vm->file_exists($file)) or die $file; + } _test_migrate_nested($vm, $node, \@bases, $clone, $levels); - my ($file) = $base0->list_files_base; - $node->remove_file($file); - for my $domain ($clone, reverse @bases ) { - $domain->remove(user_admin); + _test_all_children_ok($base0); + + remove_domain($base0); +} + +sub _test_all_children_ok($base) { + for my $clone( $base->clones ) { + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $clone->{id} + ); + if ($clone->{is_base}) { + _test_all_children_ok(Ravada::Front::Domain->open($clone->{id})); + } else { + Ravada::Request->start_domain( + uid => user_admin->id + ,id_domain => $clone->{id} + ); + } + wait_request(debug => 0); } } +sub _migrate_fast($domain, $node) { + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node->id + ,shutdown => 1 + ); + wait_request(debug => 0); + my $domain2 = Ravada::Front::Domain->open($domain->id); + is($domain2->_data('id_vm'),$node->id) or confess; +} + +sub _remove_base_vm($base,$node) { + diag("Remove base from ".$node->id." ".$node->name." for ".$base->id." " + .$base->name); + delete_request('migrate','set_base_vm','remove_base_vm'); + my $req = Ravada::Request->remove_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + + wait_request(debug => 0); + my $base2=Ravada::Domain->open($base->id); + isnt($base2->_data('id_vm'), $node->id) or confess $base->id." ".$base->name; + + _check_clones_in_node($base2, $base2->_data('id_vm')); +} + sub _test_migrate_nested($vm, $node, $bases, $clone, $levels) { + delete_request('migrate','set_base_vm','remove_base_vm'); my $req = Ravada::Request->migrate( id_node => $node->id ,id_domain => $clone->id @@ -1498,14 +1832,31 @@ sub _test_migrate_nested($vm, $node, $bases, $clone, $levels) { is($req->status,'done'); for my $base ( @$bases ) { is($base->is_base,1,"Expecting ".$base->name." is base") or exit; - is($base->base_in_vm($node->id),1); + is($base->base_in_vm($node->id),1) or confess Dumper([$clone->id,$base->id]); } my $clone2 = Ravada::Domain->open($clone->id); - is($clone2->_vm->id,$node->id) or exit; + is($clone2->_vm->id,$node->id) or confess; eval { $clone2->start(user_admin) }; is(''.$@, '', $clone2->name) or exit; } +sub _check_clones_in_node($base0, $id_node) { + my $base = $base0; + $base = Ravada::Front::Domain->open($base0->{id}) if ref($base) !~/Ravada/; + my $vm = Ravada::VM->open($id_node); + for my $clone ( $base->clones ) { + is($clone->{id_vm}, $id_node) or confess $clone->{name}; + my $clone2 = Ravada::Front::Domain->open($clone->{id}); + for my $volume ( $clone2->list_volumes) { + ok($vm->file_exists($volume->{file})) + or confess "File from ".$clone->{name}." not in node ".$vm->name." ".$volume->{file}; + } + if ( $clone->{is_base}) { + _check_clones_in_node($clone, $id_node); + } + } +} + sub test_display_ip($vm, $node, $set_localhost_dp=0) { my $vm_ip = $vm->ip; if ($set_localhost_dp == 1) { @@ -1601,11 +1952,12 @@ sub test_nat($vm, $node, $set_localhost_natip=0) { $node->_data(nat_ip => ''); } -sub _download_alpine64 { +sub _download_alpine64($vm) { my $id_iso = search_id_iso('Alpine%64'); my $req = Ravada::Request->download( id_iso => $id_iso + ,id_vm => $vm->id ); wait_request(); is($req->error, ''); @@ -1615,13 +1967,12 @@ sub _download_alpine64 { sub test_displays($vm, $node, $no_builtin=0) { my $base; if ( $vm->type eq 'KVM') { - $base = rvd_back->search_domain($BASE_NAME); - $base = import_domain('KVM', $BASE_NAME, 1) if !$base; + $base = _import_clone($vm); } else { return; # $base = create_domain($vm); } - _download_alpine64(); + _download_alpine64($vm); my $domain = $base->clone(name => new_domain_name, user => user_admin); my $n_displays = 1; @@ -1685,6 +2036,302 @@ sub test_network($vm, $node) { my $node_nets = $node->list_virtual_networks(); } +sub test_volumes_exist($domain, $node, $expected=1) { + + my @volumes = $domain->list_volumes(); + my @files_base = $domain->list_files_base(); + for my $file ( @volumes, @files_base) { + my $curr_expected = $expected; + $curr_expected = 1 if $file =~ /\.iso$/; + is(( $node->file_exists($file) or 0), $curr_expected,"Expected in ".$node->name." =$curr_expected " + .$file) or confess; + } +} + +sub _req_create($vm, $start=0) { + my $name = new_domain_name(); + my $req = Ravada::Request->create_domain( + name => $name + ,id_vm => $vm->id + ,id_owner => user_admin->id + ,id_iso => search_id_iso('Alpine%64') + ,disk => 10240 + ,swap => 10240 + ,data => 10240 + ,start => $start + ); + wait_request(); + is($req->error,''); + my $base = rvd_back->search_domain($name); + ok($base) or return; + is($base->_vm->id, $vm->id); + + return $base; +} + +sub test_start_remote($domain) { + my $node = $domain->_vm; + die "Not remote ".$node->name if $node->is_local(); + + my $req = Ravada::Request->start_domain( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(debug => 0); + is($req->error,''); + + my $domain2 = Ravada::Domain->open($domain->id); + is($domain2->_vm->id, $node->id); +} + +sub test_shutdown_remote($domain) { + my $node = $domain->_vm; + die "Not remote ".$node->name if $node->is_local(); + + my $req = Ravada::Request->force_shutdown( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + is($req->error,''); + test_no_rsync_back($domain->id); + + my $domain2 = Ravada::Domain->open($domain->id); + is($domain2->_vm->id, $node->id); + + test_no_rsync_back($domain->id); + + for ( 1 .. 10 ) { + is($domain2->is_active,0 ); + last if !$domain2->is_active; + diag("Waiting for ".$domain2->name." is down"); + sleep 1; + } + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + + test_no_rsync_back($domain->id); +} + +sub test_no_rsync_back($id_domain) { + my $sth = connector->dbh->prepare( + "SELECT * FROM requests WHERE id_domain=?" + ." AND command='rsync_back'" + ); + $sth->execute($id_domain); + + my $row = $sth->fetchrow_hashref; + ok(!$row) or exit; +} +sub test_prepare_base_remote($base) { + my $node = $base->_vm; + die "Not remote ".$node->name if $node->is_local(); + + Ravada::Request->force_shutdown( + uid => user_admin->id + ,id_domain => $base->id + ); + my $req = Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $base->id + ); + wait_request($req); + is($req->status,'done'); + is($req->error,''); + + my $vm_local = $base->_vm->new(host => 'localhost'); + my $not_found = $vm_local->search_domain($base->name); + ok(!$not_found,"Expecting ".$base->name." not found in ".$vm_local->name); + + test_volumes_exist($base,$node,1); + test_volumes_exist($base,$vm_local,0); +} + +sub test_clone_only_remote($base,$start, $volatile=0) { + my $node = $base->_vm; + die "Not remote ".$node->name if $node->is_local(); + + my $name = new_domain_name(); + + my $req = Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $base->id + ,name => $name + ,start => $start + ,volatile => $volatile + ); + wait_request($req); + is($req->status,'done'); + is($req->error,'') or confess; + + my $vm_local = rvd_back->search_vm($node->type,'localhost'); + + my $clone_local = $vm_local->search_domain($name); + ok(!$clone_local); + + my $clone = rvd_back->search_domain($name); + ok($clone) or return; + is($clone->_vm->id , $node->id); + + return $clone; +} + +sub test_migrate_clone($node1, $node2) { + my $base = _req_create($node1); + Ravada::Request->prepare_base(uid => user_admin->id + ,id_domain => $base->id + ); + wait_request(); + + is($base->base_in_vm($node1->id),1); + is($base->base_in_vm($node2->id),0); + + my $clone = _req_clone($base); + + my $req=Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node2->id + ); + wait_request(debug => 0); + is($req->error,''); + + is($base->base_in_vm($node1->id),1); + is($base->base_in_vm($node2->id),1); + + my $clone2 = Ravada::Domain->open(id => $clone->id); + is($clone2->_data('id_vm'),$node2->id, "Expecting ".$clone2->name." in ".$node2->name) or die; + my @instances = $clone2->list_instances(); + is(@instances,2); + + test_remove_instances($clone, $node1, $node2); + test_remove_instances($base, $node1, $node2); +} + +sub test_migrate_standalone($node1, $node2) { + + my $domain = _req_create($node1, 0); # create and not start + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node2->id + ); + wait_request(); + + test_volumes_exist($domain, $node1,1); + test_volumes_exist($domain, $node2,0); + + test_remove_instances($domain, $node1, $node2); +} +sub test_spinoff_remote($vm, $node) { + + my $base = _req_create($node); + Ravada::Request->prepare_base(uid => user_admin->id + ,id_domain => $base->id + ); + wait_request(); + my $clone = test_clone_only_remote($base, 1); + + my $req_spinoff = Ravada::Request->spinoff( + uid => user_admin->id + ,id_domain => $clone->id + ); + wait_request(); + is($req_spinoff->error,''); + + my $clone2 = Ravada::Domain->open($clone->id); + is($clone2->id_base, undef); + + test_remove_instances($clone, $vm, $node); + test_remove_instances($base, $vm, $node); +} + +sub test_base_only_in_node_add_hw($vm, $node) { + my $iso = $node->_search_iso( search_id_iso('Alpine%64') ); + my $device_cdrom = $node->search_volume_path_re(qr($iso->{file_re})); + $node->remove_file($device_cdrom); + + my $base = _req_create($node); + Ravada::Request->add_hardware( + name => 'disk' + ,uid => user_admin->id + ,id_domain => $base->id + ,data => { size => '0.5G' } + ); + wait_request(debug => 0); + + test_volumes_exist($base,$node,1); + test_volumes_exist($base,$vm,0); +} + +sub test_base_only_in_node($vm, $node, $start=0) { + + diag("Test base only in node , start=$start"); + + my $base = _req_create($node,$start); + + my $not_found = $vm->search_domain($base->name); + ok(!$not_found); + + test_volumes_exist($base,$node,1); + test_volumes_exist($base,$vm,0); + + test_start_remote($base); + test_shutdown_remote($base); + + test_remove_instances($base, $vm, $node); + + $base = _req_create($node, $start); + test_prepare_base_remote($base); + + my $clone = test_clone_only_remote($base, $start); + + if ( $clone ) { + test_start_remote($clone); + + my $clone2 = test_clone_only_remote($clone, $start); + test_remove_instances($clone2) if $clone2; + + test_remove_instances($clone); + } + + my $clone_volatile = test_clone_only_remote($base, $start, 1); + test_remove_instances($clone_volatile) if $clone_volatile; + + test_remove_instances($base, $vm, $node); + +} + +sub test_remove_instances($base, @nodes) { + my @volumes = $base->list_volumes(); + my @files_base = $base->list_files_base(); + Ravada::Request->remove_domain( + uid => user_admin->id + ,name => $base->name + ); + wait_request(debug => 0); + my $vm = $base->_vm; + my %done; + for my $vm ( $base->_vm, @nodes ) { + next if $done{$vm->id()}; + my $domain = $vm->search_domain($base->name); + ok(!$domain); + for my $file ( @volumes, @files_base ) { + if ($file =~ /\.iso$/) { + ok($vm->file_exists($file)); + } else { + ok(!$vm->file_exists($file), "Expecting no file '$file' in ".$vm->name) or confess; + } + } + } + check_leftovers(); + +} + + ################################################################################## if ($>) { @@ -1735,6 +2382,19 @@ for my $vm_name (reverse vm_names() ) { start_node($node); + test_base_only_in_node_add_hw($vm, $node); #start after create = 1 + + test_migrate_clone($node, $vm); + test_migrate_clone($vm, $node); + + test_spinoff_remote($vm, $node); + + test_migrate_standalone($vm, $node); + test_migrate_standalone($node, $vm); + + test_base_only_in_node($vm, $node, 1); #start after create = 1 + test_base_only_in_node($vm, $node); + test_volatile_req($vm, $node); test_domain_gone($vm, $node); @@ -1747,8 +2407,6 @@ for my $vm_name (reverse vm_names() ) { test_pc_other($vm,$node); - test_fill_memory($vm, $node, 1); # migrate - # test displays with no builtin added test_displays($vm, $node,1) if $tls; # test displays with only builtin @@ -1756,13 +2414,9 @@ for my $vm_name (reverse vm_names() ) { test_iptables_close($vm, $node); - test_nat($vm, $node, 1); # also set deprecated localhost ip - test_duplicated_set_base_vm($vm, $node); - if ($vm_name eq 'KVM') { - test_nested_base($vm, $node, 3); - test_nested_base($vm, $node); - } + test_nested_base($vm, $node, 3); + test_nested_base($vm, $node); test_removed_base_file($vm, $node); diff --git a/t/nodes/20_dead_node.t b/t/nodes/20_dead_node.t index aa2b07dd1..7a9851acd 100644 --- a/t/nodes/20_dead_node.t +++ b/t/nodes/20_dead_node.t @@ -40,23 +40,21 @@ sub test_down_node($vm, $node) { is($req->status, 'done'); like($req->error, qr{^($|checked)},"Expecting no error after refresh vms"); - warn 1; - is($clone[0]->is_active, 0, "Expecting clone not active after node shutdown"); - warn 2; + my $clone_f = Ravada::Front::Domain->open($clone[0]->id); + is($clone_f->is_active, 0, "Expecting clone not active after node shutdown"); + start_node($node); my@req; - for (@clone) { + for (@clone, $domain) { push @req,(Ravada::Request->remove_domain(uid => user_admin->id , name=> $_->name )); } for my $req (@req) { - warn $req->command; rvd_back->_process_requests_dont_fork(); next if $req->status ne 'done'; is($req->error ,''); } - $domain->remove(user_admin); } sub test_disabled_node($vm, $node) { diff --git a/t/nodes/50_three_nodes.t b/t/nodes/50_three_nodes.t index 86159dfcb..e5f432d05 100644 --- a/t/nodes/50_three_nodes.t +++ b/t/nodes/50_three_nodes.t @@ -13,6 +13,26 @@ no warnings "experimental::signatures"; use feature qw(signatures); ################################################################################## +sub test_remote_standalone( @nodes ) { + for my $node0 (@nodes) { + my $domain = create_domain($node0); + for my $node1 (@nodes) { + diag("Migrate from ".$domain->_vm->name." to ".$node1->name); + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $domain->id + ,id_node => $node1->id + ,shutdown => 1 + ,start => 1 + ); + wait_request( debug => 1); + my $domain_f = Ravada::Front::Domain->open($domain->id); + is($domain_f->_data('id_vm'),$node1->id); + } + remove_domain($domain); + } +} + sub test_remove_n($vm, @nodes ) { my $domain = create_domain($vm); @@ -20,15 +40,30 @@ sub test_remove_n($vm, @nodes ) { $domain->prepare_base(user_admin); my $n=1; + $n++ if !$domain->_vm->is_local; for my $node ( @nodes ) { - $domain->set_base_vm(vm => $node, user => user_admin); - is($domain->list_instances, ++$n); + Ravada::Request->set_base_vm( + id_vm=> $node->id + ,uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + is($domain->list_instances, ++$n) + or die Dumper([$domain->list_instances]); } for my $node1 ( @nodes ) { my $clone = $domain->clone(user => user_admin, name => new_domain_name); - $clone->migrate($node1); - $clone->start(user_admin); + diag("Migrate clone ".$clone->name." from ".$clone->_vm->name + ." to ".$node1->name); + my $req = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node1->id + ,shutdown => 1 + ,start => 1 + ); + wait_request(); for my $node2 ( @nodes ) { next if $node2->id == $node1->id; diag("Migrating ".$clone->name." from ".$node1->name." to ".$node2->name); @@ -69,14 +104,40 @@ sub test_remove($vm, $node1, $node2) { , name => new_domain_name ); is($clone1->list_instances,1); - $clone1->migrate($node1); - is($clone1->list_instances,2); + + my $n_exp_instances=2; + if ($clone1->_vm->id == $node1->id ) { + # does nothing + $n_exp_instances=1; + } elsif ( !$clone1->_vm->is_local && !$node1->is_local ) { + # does a pass via local + $n_exp_instances=3; + } + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone1->id + ,id_node => $node1->id + ); + wait_request(); + + is($clone1->list_instances,$n_exp_instances); my $clone2 = $domain->clone( user => user_admin , name => new_domain_name ); - $clone2->migrate($node1); - $clone2->migrate($node2); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone2->id + ,id_node => $node1->id + ); + wait_request(); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone2->id + ,id_node => $node2->id + ); + wait_request(); + is($clone2->list_instances,3); my @name = ( $clone1->name, $clone2->name, $domain->name); @@ -156,6 +217,10 @@ for my $vm_name ( 'Void', 'KVM') { my $node_shared = remote_node_shared($vm_name) or next; + test_remote_standalone($node1, $node2, $node_shared); + + test_remove_n($node1, $node2, $node_shared); + # create on local first test_remove_n($vm, $node1, $node2, $node_shared); test_remove($vm, $node1, $node2); diff --git a/t/nodes/60_hardware.t b/t/nodes/60_hardware.t index f5cf246ad..d705b66f7 100644 --- a/t/nodes/60_hardware.t +++ b/t/nodes/60_hardware.t @@ -4,6 +4,7 @@ use strict; use Carp qw(confess); use Data::Dumper; use Digest::MD5; +use Storable qw(dclone); use Test::More; use lib 't/lib'; @@ -40,8 +41,17 @@ sub test_graphics($vm, $node) { } sub test_driver_clone($vm, $node, $domain, $driver_name, $option) { - $domain->remove_base(user_admin) if $domain->is_base; - wait_request(); + if ( $domain->is_base ) { + Ravada::Request->remove_clones( + uid => user_admin->id + ,id_domain => $domain->id + ); + Ravada::Request->remove_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + } my $req = Ravada::Request->set_driver(uid => user_admin->id , id_domain => $domain->id , id_option => $option->{id} @@ -51,19 +61,40 @@ sub test_driver_clone($vm, $node, $domain, $driver_name, $option) { is($req->error,''); is($domain->get_driver($driver_name), $option->{value} , $driver_name); - $domain->prepare_base(user_admin); - $domain->set_base_vm(node => $node, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); - my $clone = $domain->clone(name => new_domain_name, user => user_admin); - $clone->migrate($node); + my $name = new_domain_name(); + Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $domain->id + ,name => $name + ); + wait_request(); + my $clone = rvd_back->search_domain($name); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); my $clone2 = Ravada::Domain->open($clone->id); is($clone2->_vm->id,$node->id); is($clone2->get_driver($driver_name), $option->{value} , $driver_name); - $clone->remove(user_admin); - - $domain->remove_base(user_admin); + Ravada::Request->remove_clones( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + Ravada::Request->remove_base( + uid => user_admin->id + ,id_domain => $domain->id + ); wait_request(); } @@ -73,14 +104,37 @@ sub test_driver_migrate($vm, $node, $domain, $driver_name) { diag("No driver for $driver_name in ".$domain->type); next; }; - $domain->prepare_base(user_admin); - $domain->set_base_vm(node => $node, user => user_admin); + + # make sure prepare_base and the set_base_vm are chained + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ) if !$domain->is_base(); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); + + wait_request(debug => 0); for my $option ($driver->get_options) { next if defined $domain->get_driver($driver_name) && $domain->get_driver($driver_name) eq $option->{value}; # diag("Testing $driver_name $option->{value} then migrate"); - my $clone = $domain->clone(name => new_domain_name, user => user_admin); + my $name = new_domain_name(); + my $req_clone = Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $domain->id + ,name => $name + ); + wait_request(); + my $clone; + for ( 1 .. 3 ) { + $clone = rvd_back->search_domain($name); + last if $clone; + sleep 1; + } my $req = Ravada::Request->set_driver(uid => user_admin->id , id_domain => $clone->id , id_option => $option->{id} @@ -89,22 +143,28 @@ sub test_driver_migrate($vm, $node, $domain, $driver_name) { is($req->status,'done'); is($req->error,''); - $clone->migrate($node); + Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request(); my $clone2 = Ravada::Domain->open($clone->id); is($clone2->_vm->id,$node->id); is($clone2->get_driver($driver_name), $option->{value} , $driver_name) or exit; - $clone->remove(user_admin); + Ravada::Request->remove( + uid => user_admin->id + ,name => $clone->name + ); last unless $ENV{TEST_LONG}; } - $domain->remove_base(user_admin); - wait_request(); } sub test_drivers_type($type, $vm, $node) { - my $domain = create_domain($vm->type); + my $domain = create_domain($vm); my $req = Ravada::Request->add_hardware(uid => user_admin->id , id_domain => $domain->id @@ -133,8 +193,22 @@ sub test_drivers_type($type, $vm, $node) { ok(!$@,"Expecting no error, got : ".($@ or '')); is($domain->get_driver($type), $option->{value}, $type); - $domain->prepare_base(user_admin); - $domain->set_base_vm(node => $node, user => user_admin); + my $req_prepare = Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + is($req_prepare->status(),'done'); + is($req_prepare->error(),''); + + my $req = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $domain->id + ,id_vm => $node->id + ); + wait_request(); + is($req->status(),'done'); + is($req->error(),''); my $clone = $domain->clone(name => new_domain_name, user => user_admin); is($clone->get_driver($type), $option->{value}, $type); @@ -156,6 +230,7 @@ sub test_drivers_type($type, $vm, $node) { for my $vol (@vols) { ok (! -e $vol ) or die "$vol"; } + $domain = Ravada::Domain->open($domain->id); } $domain->remove(user_admin); @@ -192,15 +267,95 @@ sub _add_hardware($domain) { wait_request(debug => 0); } -sub test_change_hardware($vm, @nodes) { - diag("[".$vm->type."] testing remove with ".scalar(@nodes)." node ".join(",",map { $_->name } @nodes)); - my $domain = create_domain($vm); +sub _change_disk_size($domain) { + $domain->shutdown_now(user_admin) if $domain->is_active; - _add_hardware($domain); + my $info = $domain->info(user_admin); + my $disk = $info->{hardware}->{disk}; + confess Dumper([$domain->_vm->name." ".$domain->name, $disk]) if !defined $disk->[0]; - my $clone = $domain->clone(name => new_domain_name, user => user_admin); - $clone->add_volume(size => 128*1024 , type => 'data'); - my @volumes = $clone->list_volumes(); + my $data = dclone($disk->[0]); + my $new_capacity = int($data->{capacity}*3.5); + $data->{capacity}=$new_capacity; + + my $req = Ravada::Request->change_hardware( + uid => user_admin->id + ,id_domain => $domain->id + ,index => 0 + ,data => $data + ,hardware => 'disk' + ); + wait_request(); + + my $data2; + for ( 1 .. 3 ) { + my $domain2 = Ravada::Domain->open($domain->id); + my $disk2 = $domain2->info(user_admin)->{hardware}->{disk}; + $data2 = dclone($disk2->[0]); + last if int($data2->{capacity}*0.9) == int($new_capacity*0.9); + + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $domain->id + ,_force => 1 + ); + wait_request(); + } + + is(int($data2->{capacity}*0.9), int($new_capacity*0.9)) or die $domain->name; + + +} + +sub _do_test_change_hardware($domain, $hardware) { + + $domain = Ravada::Domain->open($domain->id); + my %sub = ( + 'disk' => \&_change_disk_size + ); + my $sub = $sub{$hardware}; + if (!$sub) { + return; + } + $sub->($domain); +} + +sub _clone_and_add_volume($domain) { + my $name = new_domain_name(); + Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $domain->id + ,name => $name + ); + my $clone; + for ( 1 .. 3 ) { + $clone = rvd_back->search_domain($name); + wait_request(); + } + my $data = { + 'file' => '', + 'driver' => { + 'cache' => 'writeback', + }, + 'device' => 'disk', + 'allocation' => '200M', + 'bus' => 'virtio', + 'capacity' => '1G', + 'type' => 'data' + }; + delete $data->{driver} if $domain->type eq 'Void'; + + my $req = Ravada::Request->add_hardware( + uid => user_admin->id + ,id_domain => $clone->id + ,name => 'disk' + ,'data' => $data + ); + wait_request(); + return $clone; +} + +sub _migrate_clone($clone, @nodes) { for my $node (@nodes) { for ( 1 .. 10 ) { @@ -209,21 +364,50 @@ sub test_change_hardware($vm, @nodes) { sleep 1; } is($node->ping(),1) or die "Error: I can't ping ".$node->ip; - $domain->set_base_vm( vm => $node, user => user_admin); + + my $req_set_base = Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $clone->id_base() + ,id_vm => $node->id + ); + wait_request($req_set_base); + my $clone2 = $node->search_domain($clone->name); ok(!$clone2); - $clone->migrate($node); + + my $req_migrate = Ravada::Request->migrate( + uid => user_admin->id + ,id_domain => $clone->id + ,id_node => $node->id + ); + wait_request($req_migrate); $clone2 = $node->search_domain($clone->name); ok($clone2); } +} + +sub test_change_hardware($vm, @nodes) { + diag("Change hardware nodes=".scalar(@nodes)); + my $domain = create_domain($vm); + + _add_hardware($domain); + + my $clone = _clone_and_add_volume($domain); + my @volumes = $clone->list_volumes(); + + _migrate_clone($clone,@nodes); + $clone = Ravada::Domain->open($clone->id); + my $n_instances = $domain->list_instances(); my $info = $clone->info(user_admin); my %devices; for my $hardware ( sort keys %{$info->{hardware}} ) { $devices{$hardware} = scalar(@{$info->{hardware}->{$hardware}}); } - my @hardware = grep (!/^disk$/, sort keys %{$info->{hardware}}); + my @hardware = grep (!/^(disk|display|usb)$/, sort keys %{$info->{hardware}}); + push @hardware,("display"); + push @hardware,("usb") if $vm->type ne 'Void'; push @hardware,("disk"); for my $hardware (reverse @hardware) { next if $hardware =~ /cpu|features|memory/; @@ -231,6 +415,8 @@ sub test_change_hardware($vm, @nodes) { $tls = grep {$_->{driver} =~ /-tls/} @{$info->{hardware}->{$hardware}} if $hardware eq 'display'; + _do_test_change_hardware($clone, $hardware); + #TODO disk volumes in Void #next if $vm->type eq 'Void' && $hardware =~ /disk|volume/; @@ -241,7 +427,13 @@ sub test_change_hardware($vm, @nodes) { $n = scalar(@{$info->{hardware}->{$hardware}})-1 if $hardware eq 'usb controller'; - $clone->remove_controller($hardware,$n); + Ravada::Request->remove_hardware( + uid => user_admin->id + ,id_domain => $clone->id + ,name => $hardware + ,index => $n + ); + wait_request(debug => 0); is (scalar($clone->list_instances()), $n_instances); my $n_expected = scalar(@{$info->{hardware}->{$hardware}})-1; @@ -256,10 +448,16 @@ sub test_change_hardware($vm, @nodes) { for my $node ($vm, @nodes) { my $clone2 = $node->search_domain($clone->name); ok($clone2,"Expecting clone ".$clone->name." in remote node ".$node->name - ." when removing $hardware") or next; + ." when removing $hardware") or next; + + my $devices2; + if ($hardware eq 'disk') { + $devices2 = [ $clone2->list_volumes ]; + } else { + my $info2 = $clone2->info(user_admin); + $devices2 = $info2->{hardware}->{$hardware}; + } - my $info2 = $clone2->info(user_admin); - my $devices2 = $info2->{hardware}->{$hardware}; if ($hardware eq 'video' && $vm->type eq 'KVM') { is( scalar(@$devices2),1); is($devices2->[0]->{type},'none'); @@ -277,8 +475,13 @@ sub test_change_hardware($vm, @nodes) { } } - $clone->remove(user_admin); - $domain->remove(user_admin); + for my $name ( $clone->name, $domain->name ) { + Ravada::Request->remove_domain( + uid => user_admin->id + ,name => $name + ); + wait_request(); + } } ################################################################################## @@ -298,7 +501,7 @@ $Ravada::Domain::MIN_FREE_MEMORY = 256 * 1024; my @nodes; -for my $vm_name ( vm_names() ) { +for my $vm_name (reverse vm_names() ) { my $vm; eval { $vm = rvd_back->search_vm($vm_name) }; diff --git a/t/nodes/70_shared.t b/t/nodes/70_shared.t index 1e0ee0174..c5b44519c 100644 --- a/t/nodes/70_shared.t +++ b/t/nodes/70_shared.t @@ -35,7 +35,7 @@ sub test_shared($vm, $node) { ,id_domain => $domain->id ,id_vm => $node->id ); - rvd_back->_process_requests_dont_fork(1); + wait_request(); ok($req->status, 'done'); is($req->error, '') or exit; @@ -61,7 +61,7 @@ sub test_shared($vm, $node) { ,id_vm => $node->id ,value => 0 ); - rvd_back->_process_requests_dont_fork(1); + wait_request(); ok($req->status, 'done'); is($req->error, '') or exit; @@ -70,12 +70,7 @@ sub test_shared($vm, $node) { is($domain->base_in_vm($vm->id),1); for my $vol (@files_base) { - my $ok; - for ( 1 .. 5 ) { - $ok = -e $vol; - last if $ok; - sleep 1; - } + my $ok = $vm->file_exists($vol); ok($ok,"Volume $vol should exist") or exit; ok($node->file_exists($vol), "Volume $vol should exist in ".$node->name); } @@ -125,51 +120,100 @@ sub _change_ram($domain) { } sub test_change_ram($vm, $node, $start=0, $prepare_base=0, $migrate=0) { - diag("start=$start , prepare_base=$prepare_base , migrate=$migrate"); + diag("test change ram start=$start , prepare_base=$prepare_base , migrate=$migrate"); my $base = $BASE->clone(name => new_domain_name, user => user_admin); $base->spinoff(); my $domain = $base; if ($prepare_base) { $base->prepare_base(user_admin); - $base->set_base_vm(vm => $node, user => user_admin); - $domain = $base->clone(name => new_domain_name, user => user_admin); + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node->id + ); + wait_request(); + + ok($vm->search_domain($base->name),"Expecting base in ".$vm->name) + or exit; + ok($node->search_domain($base->name),"Expecting base ".$base->name + ." in ".$node->name." ".$node->type) + or exit; + my $name = new_domain_name(); + Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $base->id + ,name => $name + ); + wait_request(); + $domain = rvd_back->search_domain($name); } req_migrate($node, $domain, $start) if $migrate; - my $new_mem = _change_ram($domain); if ( $migrate ) { my $domain2 = Ravada::Domain->open($domain->id); is($domain2->_vm->id, $node->id); + $domain=$domain2; } + my $new_mem = _change_ram($domain); _test_volumes_exist($domain); my $domain_local = $vm->search_domain($domain->name); - is($domain_local->_vm->id,$vm->id); - my $mem2 = $domain_local->info(user_admin)->{memory}; - is($mem2, $new_mem); + if ( $domain_local ) { + is($domain_local->_vm->id,$vm->id); + my $mem2 = $domain_local->info(user_admin)->{memory}; + is($mem2, $new_mem); + } req_start($domain); req_migrate($node, $domain, 1); $domain = Ravada::Domain->open($domain->id); - $mem2 = $domain->info(user_admin)->{memory}; + my $mem2 = $domain->info(user_admin)->{memory}; is($mem2, $new_mem); _test_volumes_exist($domain); - $domain->remove(user_admin); - $base->remove(user_admin) if $base->id != $domain->id; + my @volumes = ($base->list_volumes, $domain->list_volumes, $base->list_files_base); + remove_domain_and_clones_req($base,1,1); + test_files_removed([$vm, $node], \@volumes); +} + +sub test_files_removed($nodes, $volumes) { + my %done; + for my $vm ( @$nodes ) { + for my $file (@$volumes) { + + my $key = $vm->name.".".$file; + return if $done{$key}++; + + ok(!$vm->file_exists($file)) or die $file; + ok(!-e $file) or die $file; + } + } + +} + +sub test_domains_removed(@domain) { + my %done; + for my $domain (@domain) { + next if $done{$domain->name}++; + for my $vm (rvd_back->list_vms) { + + } + } } sub _test_volumes_exist($domain) { my $domain_local = Ravada::Domain->open($domain->id); + my $vm = $domain_local->_vm; + $vm->refresh_storage(); for my $disk ( $domain_local->list_volumes ) { - ok(-e $disk,"Expecting ".$domain_local->name." $disk exist in " + ok($vm->file_exists($disk),"Expecting ".$domain_local->name." $disk exist in " .$domain_local->_vm->name) or confess; } if ($domain->id_base) { my $base = Ravada::Domain->open($domain->id_base); for my $disk ($base->list_files_base) { - ok(-e $disk,"Expecting $disk exist"); + ok($vm->file_exists($disk),"Expecting $disk exist"); } } } @@ -180,9 +224,21 @@ sub test_add_disk($vm, $node, $start=0, $prepare_base=0, $migrate=0) { my $domain = $base; if ($prepare_base) { - $base->prepare_base(user_admin); - $base->set_base_vm(vm => $node, user => user_admin); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); $domain = $base->clone(name => new_domain_name, user => user_admin); + for my $node0 ( $vm, $node ) { + Ravada::Request->set_base_vm( + uid => user_admin->id + ,id_domain => $base->id + ,id_vm => $node0->id + ); + } + wait_request(); + } my $n = scalar($domain->list_volumes); my @volumes0 = map { $_->{file} } $domain->list_volumes_info; @@ -195,9 +251,9 @@ sub test_add_disk($vm, $node, $start=0, $prepare_base=0, $migrate=0) { } _test_volumes_exist($domain); + my @volumes1 = $domain->list_volumes(); my $domain_local = $vm->search_domain($domain->name); is($domain_local->_vm->id,$vm->id); - my @volumes1 = map { $_->{file} } $domain->list_volumes_info; is(scalar($domain_local->list_volumes),$n+1,Dumper(\@volumes0,\@volumes1)) or exit; req_start($domain); @@ -206,8 +262,9 @@ sub test_add_disk($vm, $node, $start=0, $prepare_base=0, $migrate=0) { is(scalar($domain->list_volumes),$n+1); _test_volumes_exist($domain); - $domain->remove(user_admin); - # $base->remove(user_admin) if $base->id != $domain->id; + my @volumes = ($base->list_volumes, $domain->list_volumes); + remove_domain_and_clones_req($base); + test_files_removed([$vm, $node], \@volumes); } sub req_start($domain) { @@ -221,6 +278,9 @@ sub req_start($domain) { } sub req_migrate($node, $domain, $start=0) { + confess if !defined $domain; + my $domain2 = Ravada::Front::Domain->open($domain->id); + return if $domain2->_data('id_vm') == $node->id; my $req = Ravada::Request->migrate( id_domain => $domain->id ,uid => user_admin->id @@ -229,12 +289,12 @@ sub req_migrate($node, $domain, $start=0) { ,start => 1 ,id_node => $node->id ); - wait_request(); + wait_request(debug => 0); is($req->status,'done'); is($req->error,''); - my $domain2 = Ravada::Domain->open($domain->id); - is($domain2->_vm->id,$node->id); + my $domain_f = Ravada::Front::Domain->open($domain->id); + is($domain_f->_data('id_vm'),$node->id) or confess; } sub import_base($vm) { @@ -246,6 +306,32 @@ sub import_base($vm) { } } +sub _check_sp($sp, @nodes) { + for my $node (@nodes) { + my ($sp) = grep {$_->{name} eq $sp} $node->list_storage_pools(1); + confess "SP ".$sp." not active in ".$node->name if !$sp->{is_active}; + } + +} + +sub test_remove_base($vm, $node) { + my $base = $BASE->clone(name => new_domain_name, user => user_admin); + $base->spinoff(); + + $base->prepare_base(user_admin); + $base->set_base_vm(vm => $node, user => user_admin); + my @vols_base = $base->list_files_base; + Ravada::Request->remove_base( + uid => user_admin->id + ,id_domain => $base->id + ); + wait_request(debug => 0); + for my $vol ( @vols_base ) { + ok(!-e $vol) or die $vol; + } + remove_domain_and_clones_req($base); +} + ################################################################################# if ($>) { my $msg = "SKIPPED: Test must run as root"; @@ -261,7 +347,7 @@ clean(); $Ravada::Domain::MIN_FREE_MEMORY = 256 * 1024; -for my $vm_name ( vm_names() ) { +for my $vm_name (reverse vm_names() ) { my $vm; eval { $vm = rvd_back->search_vm($vm_name) }; @@ -283,8 +369,11 @@ the file " } if ($vm && !grep /^$SHARED_SP$/,$vm->list_storage_pools) { - $msg = "SKIPPED: Missing storage pool '$SHARED_SP' in node ".$vm->name; - $vm = undef; + my $sp = start_storage_pool($vm,$SHARED_SP); + if (!$sp) { + $msg = "SKIPPED: Missing storage pool '$SHARED_SP' in node ".$vm->name." ".$vm->type; + $vm = undef; + } } diag($msg) if !$vm; @@ -312,24 +401,31 @@ the file " is($vm->shared_storage($node, $storage_path),1,"Expecting $SHARED_SP shared") or exit; import_base($vm); - - test_is_shared($vm, $node); - test_shared($vm, $node); + $node->default_storage_pool_name($SHARED_SP); + test_change_ram($vm,$node, 0, 1, 1); for my $default_sp ( 0,1 ) { $node->default_storage_pool_name('default') if !$default_sp; $node->default_storage_pool_name($SHARED_SP) if $default_sp; for my $start ( 0,1 ) { - for my $prepare_base ( 0,1 ) { + for my $prepare_base ( 1,0 ) { for my $migrate( 1, 0 ) { test_change_ram($vm,$node, $start, $prepare_base, $migrate); test_add_disk($vm,$node, $start, $prepare_base, $migrate); + _check_sp($SHARED_SP, $vm, $node); } } } } + test_remove_base($vm, $node); + test_remove_base($node, $vm); + + test_is_shared($vm, $node); + test_shared($vm, $node); + NEXT: + remove_old_domains_req(); clean_remote_node($node); remove_node($node); } diff --git a/t/nodes/80_policy.t b/t/nodes/80_policy.t index f0be35f95..16ea32579 100644 --- a/t/nodes/80_policy.t +++ b/t/nodes/80_policy.t @@ -35,19 +35,27 @@ sub test_same_node_hibernate($vm, $node1, $node2) { } sub _set_base($node1, $node2) { - for my $node ( $node1, $node2 ) { - $BASE->set_base_vm( + + for my $node ($BASE->_vm, $node1, $node2 ) { + Ravada::Request->set_base_vm( id_vm => $node->id - ,user => user_admin + ,uid => user_admin->id + ,id_domain => $BASE->id ); } + wait_request(); my $domain = $BASE->clone( name => new_domain_name() ,user => user_admin ); - $domain->prepare_base(user_admin); + Ravada::Request->prepare_base( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); $domain->_data('balance_policy'=>1); + $domain->is_public(1); return $domain; } @@ -58,22 +66,32 @@ sub test_same_node($vm, $node1, $node2, $hibernate=undef) { my $domain = _set_base($node1, $node2); for my $node ( $node1, $node2 ) { - $domain->set_base_vm( + Ravada::Request->set_base_vm( id_vm => $node->id - ,user => user_admin + ,uid => user_admin->id + ,id_domain => $domain->id ); + wait_request(debug => 1); } my ($clone1,@clone) = _create_clones($domain, $user, 4); for my $node0 ( $node1, $node2, $vm ) { + diag("First migrate ".$clone1->name." from ".$domain->_vm->name." to node ".$node0->name); _migrate($node0, $clone1); Ravada::Request->hybernate( uid => $user->id ,id_domain => $clone1->id ) if $hibernate; + $clone1 = Ravada::Front::Domain->open($clone1->id); + if ($clone1->_data('id_vm') != $node0->id) { + diag("Error: could not start clone ".$clone1->name." in node ".$node0->name." ".$node0->id); + next; + } + diag("Expecting other clones go to ".$node0->name); for my $clone ( @clone ) { + diag("Expecting clone ".$clone->name." go to ".$node0->name); my $req_s = Ravada::Request->start_domain( id_domain => $clone->id ,uid => $user->id @@ -85,10 +103,6 @@ sub test_same_node($vm, $node1, $node2, $hibernate=undef) { ,"Expecting ".$clone->name." same node in ".$vm->type) or exit; } - if ( $hibernate ) { - $clone1->remove(user_admin); - ($clone1) = _create_clones($domain, $user,1); - } _shutdown($clone1, @clone); } @@ -126,11 +140,23 @@ sub _shutdown(@clones) { sub _create_clones($base, $user, $n) { my @clone; for (1 .. $n ) { - my $clone = $base->clone( - name => new_domain_name() - ,user => $user - ,memory => 128*1024 + my $name = new_domain_name(); + my $req = Ravada::Request->clone( + uid => $user->id + ,id_domain => $base->id + ,name => $name ); + ok($req->id); + wait_request(debug => 0); + is($req->status(),'done'); + is($req->error,''); + my $clone; + for ( 1 .. 10 ) { + $clone = rvd_back->search_domain($name); + last if $clone; + wait_request( debug => 1); + } + die "$name not found " if !$clone; push @clone,($clone); } return @clone; @@ -145,8 +171,7 @@ sub _migrate($node, $clone) { my $clone_f = Ravada::Front::Domain->open($clone->id); - return if $clone_f->_data('id_vm') == $node->id; - + delete_request('migrate'); my $req = Ravada::Request->migrate( id_node => $node->id ,id_domain => $clone->id @@ -155,7 +180,6 @@ sub _migrate($node, $clone) { ,start => 1 ); wait_request(debug => 0); - sleep 1; } ########################################################################## diff --git a/t/repository/10_iso.t b/t/repository/10_iso.t index e9b63e075..ad2c95b80 100644 --- a/t/repository/10_iso.t +++ b/t/repository/10_iso.t @@ -67,6 +67,7 @@ sub test_download($iso_name) { , id_vm => $vm->id # , delay => 4 , test => 1 + , _force => 1 ); is($req1->status, 'requested'); @@ -117,7 +118,7 @@ sub test_download_iso($vm, $id_iso, $name) { rvd_back->_process_all_requests_dont_fork(); is($req1->status, 'done'); is($req1->error,'',$iso->{name}); - like($req1->output,qr/^http.*/); + like($req1->output,qr/^http.*/) or exit; } sub test_post_login() { @@ -139,10 +140,33 @@ sub test_post_login() { } } +sub test_unique_entries() { + my $sth = connector->dbh->prepare("SELECT * FROM iso_images"); + $sth->execute(); + my %uniq; + while ( my $row = $sth->fetchrow_hashref) { + if (defined $row->{url}) { + if ( defined $row->{file_re} ) { + $row->{url_file_re}=$row->{url}." : ".$row->{file_re}; + } else { + $row->{url_file_re}=$row->{url}; + } + } + for my $field ( qw(name description url_file_re file_re)) { + my $value = $row->{$field}; + next if !defined $value; + $uniq{$field}->{$value} //= 0; + ok(!$uniq{$field}->{$value}++,"Expecting unique $field '$value'"); + } + } +} + #################################################################### +test_unique_entries(); test_insert_locale(); test_insert_request(); +test_unique_entries(); SKIP: { skip("SKIPPED: Test must run as root",8) if $<; diff --git a/t/request/15_download.t b/t/request/15_download.t index a234d124b..3da7ebf4d 100644 --- a/t/request/15_download.t +++ b/t/request/15_download.t @@ -27,6 +27,7 @@ sub test_download($vm, $iso0, $test=0) { , id_vm => $vm->id # , delay => 4 , test => $test + , uid => user_admin->id ); is($req1->status, 'requested'); @@ -67,6 +68,34 @@ sub test_debians() { ok($found,"Expecting some debian entries found"); } +sub test_fail_download($vm) { + my $id_iso = search_id_iso('Alpine'); + my $sth = connector->dbh->prepare( + "SELECT url,file_re FROM iso_images WHERE id=?" + ); + $sth->execute($id_iso); + my ($url, $file_re) = $sth->fetchrow; + + $sth = connector->dbh->prepare( + "UPDATE iso_images SET url=?,file_re=? WHERE id=?" + ); + $sth->execute('http://localhost/fail/','alpine.iso', $id_iso); + + my $req = Ravada::Request->create_domain( + id_owner => user_admin->id() + ,id_vm => $vm->id + ,id_iso => $id_iso + ,name => new_domain_name() + ,disk => 1024 * 1024 + ); + wait_request( debug => 1, check_error => 0); + diag($req->error); + + $sth->execute($url,$file_re, $id_iso); + + like($req->error,qr/No.* found on http.*/); +} + ################################################################## SKIP: { @@ -83,6 +112,9 @@ for my $vm_name ('KVM') { } skip($msg,10) if !$vm; + diag($vm_name); + + test_fail_download($vm); $vm->_check_default_storage(); test_debians(); @@ -94,7 +126,7 @@ for my $vm_name ('KVM') { # || $iso->{name} =~ /Mint.*22/i # || $iso->{name} =~ /Mate.* 2/i # || $iso->{name} =~ /De.*an.*12/i; - #next unless $iso->{name} =~ /Dev.*an.*12/i; + diag($iso->{name}); test_download($vm, $iso,1); } } diff --git a/t/request/30_hardware.t b/t/request/30_hardware.t index 41c46e16c..d3e7cfce7 100644 --- a/t/request/30_hardware.t +++ b/t/request/30_hardware.t @@ -32,11 +32,12 @@ my $TLS; ######################################################################## # -sub _download_alpine64 { +sub _download_alpine64($id_vm) { my $id_iso = search_id_iso('Alpine%64'); my $req = Ravada::Request->download( id_iso => $id_iso + ,id_vm => $id_vm ); wait_request(); is($req->error, ''); @@ -545,19 +546,16 @@ sub test_add_cdrom($domain) { $n++; } - my $data = { device => 'cdrom' , boot => 2 }; my $file_iso = "/var/tmp/test_30_hardware.iso"; + my $data = { device => 'cdrom' , boot => 2, file => $file_iso }; if ($domain->type eq 'KVM') { eval { $domain->_set_boot_hd(1) }; is(''.$@,'') or exit; eval { $domain->_set_boot_hd(0) }; is(''.$@,'') or exit; - my $iso = $domain->_vm->_search_iso(search_id_iso('Alpine')); - $data->{file} = $iso->{device}; } else { $data->{boot} = 2; } - $data->{file} = $file_iso if !$data->{file}; my $found = 0; test_add_hardware_request($domain->_vm, $domain,'disk', $data); @@ -571,7 +569,6 @@ sub test_add_cdrom($domain) { is($device->info->{boot}, 2, $domain->name) or die Dumper($device->info); } } - unlink $file_iso; } @@ -696,7 +693,27 @@ sub test_add_network_nat($domain) { is($req->error,''); } +sub test_add_network_isolated($domain, $isolated) { + my $req = Ravada::Request->add_hardware( + uid => user_admin->id + ,name => 'network' + ,id_domain => $domain->id + ,data => { + driver => 'virtio' + ,type => 'NAT' + ,network => 'default' + ,port => { isolated => $isolated } + } + ); + wait_request(); + is($req->error,''); +} + + sub test_add_network($domain) { + + test_add_network_isolated($domain,'yes'); + test_add_network_isolated($domain,'no'); test_add_network_bridge($domain); test_add_network_nat($domain); } @@ -1822,7 +1839,7 @@ for my $vm_name (vm_names()) { diag("Skipping VM $vm_name in this system"); next; } - _download_alpine64() if !$<; + _download_alpine64($vm->id) if !$<; $TLS = 0; $TLS = 1 if check_libvirt_tls() && $vm_name eq 'KVM'; for my $base ( _create_base($vm) ) { diff --git a/t/request/30_hardware_clones.t b/t/request/30_hardware_clones.t index f6ee00e93..acb393a40 100644 --- a/t/request/30_hardware_clones.t +++ b/t/request/30_hardware_clones.t @@ -173,7 +173,7 @@ sub _test_change_disk($base, $clone) { my $data_base2 = dclone($disks_base2->[0]); my $data_clone2 = dclone($disks_clone2->[0]); - is_deeply($data_base2, $data_base); + is_deeply($data_base2, $data_base) or exit; is($data_clone2->{file}, $data_clone->{file}) or exit; } diff --git a/t/request/31_hw_boot_order.t b/t/request/31_hw_boot_order.t index a7ed5067b..189ba944a 100644 --- a/t/request/31_hw_boot_order.t +++ b/t/request/31_hw_boot_order.t @@ -31,7 +31,7 @@ my $xml =<2 - hvm + hvm @@ -194,6 +194,12 @@ sub _fix_domain_config($domain) { my ($uuid) = $doc->findnodes('/domain/uuid/text()'); $uuid->setData($old_uuid); + my ($node_type) = $doc->findnodes('/domain/os/type'); + my $type_re = $node_type->getAttribute('machine'); + $type_re =~ s/-[\d\.]$//; + my $machine = $domain->_vm->_find_machine_type($node_type->getAttribute('arch'), $type_re); + $node_type->setAttribute('machine' => $machine); + for my $volume ( $doc->findnodes("/domain/devices/disk/source") ) { my $old_file = $volume->getAttribute('file'); my ($path,$ext) = $old_file =~ m{(.*)/.*(-sd.*)}; diff --git a/t/request/70_network.t b/t/request/70_network.t index 2335bdc72..818f1ea9a 100644 --- a/t/request/70_network.t +++ b/t/request/70_network.t @@ -31,7 +31,12 @@ sub test_list_nats($vm) { wait_request(); is($req->status,'done'); is($req->error,''); - like($req->output,qr{\"$exp_nat[0]\"}); + my $found; + for ( @{ $req->output }) { + $found = $_ if $_ eq $exp_nat[0]; + last if $found; + } + ok($found, "Expecting $exp_nat[0] in ".Dumper($req->output)); my $nats = rvd_front->list_network_interfaces( user => user_admin @@ -72,7 +77,7 @@ sub test_list_bridges($vm) { is($req->error,''); my @exp_bridges = sort(_expected_bridges($vm)); - is($req->output,encode_json(\@exp_bridges)); + is_deeply($req->output,\@exp_bridges) or confess; my $bridges = rvd_front->list_network_interfaces( user => user_admin @@ -84,7 +89,7 @@ sub test_list_bridges($vm) { SKIP: { skip("No system bridges found",1) if !scalar @exp_bridges; - like($req->output, qr/\["[\w\d]+".*\]/); + isa_ok($req->output,'ARRAY'); } } sub _expected_bridges($vm) { diff --git a/t/storage_list_unused.t b/t/storage_list_unused.t index a50b6a344..0a0c71037 100644 --- a/t/storage_list_unused.t +++ b/t/storage_list_unused.t @@ -52,8 +52,7 @@ sub test_links($vm) { ); wait_request(); my $out_json = $req2->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); my $found = _search_file($output, $vol); ok(!$found,"Expecting $vol not found") or die Dumper([$machine->list_volumes]); @@ -107,8 +106,7 @@ sub test_links_dir($vm, $machine) { ); wait_request(); my $out_json = $req2->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $exp ($file_link, "$dir_dst/$file" ) { my $found = _search_file($output, $exp); @@ -143,8 +141,7 @@ sub test_list_unused_discover($vm, $machine) { ); wait_request(); my $out_json = $req->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $vol (@volumes) { my $found = _search_file($output, $vol); @@ -186,8 +183,7 @@ sub test_list_unused_discover2($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); for my $vol (@volumes) { my $found = _search_file($output, $vol); @@ -217,8 +213,7 @@ sub test_list_unused($vm, $machine, $hidden_vols) { ); wait_request(); my $out_json = $req->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); my $found = _search_file($output, $file); ok($found,"Expecting $file found ") or die Dumper($output); @@ -246,8 +241,7 @@ sub test_page($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '[]' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or []); my $req2 = Ravada::Request->list_unused_volumes( uid => user_admin->id @@ -257,8 +251,7 @@ sub test_page($vm) { ); wait_request(); my $out_json2 = $req2->output; - $out_json2 = '[]' if !defined $out_json2; - my $output2 = decode_json($out_json2); + my $output2 = ($out_json2 or []); isnt($output2, $output); @@ -402,8 +395,7 @@ sub test_more($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '{}' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or {}); my $list = $output->{list}; $more = $output->{more}; @@ -443,7 +435,7 @@ sub test_linked_sp_here($vm) { wait_request(); my $out_json = $req->output; $out_json = '{}' if !defined $out_json; - my $output = decode_json($out_json); + my $output = $out_json; my $list = $output->{list}; my @found = grep ($_->{file} =~ /^$new_dir/, @$list); @@ -488,8 +480,7 @@ sub test_linked_sp($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '{}' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or {}); my $list = $output->{list}; my @found = grep ($_->{file} =~ /$new_filename/, @$list); @@ -565,8 +556,7 @@ sub test_linked_sp_level2($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '{}' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or {}); my $list = $output->{list}; my @found = grep ($_->{file} =~ /$new_filename$/, @$list); @@ -611,8 +601,7 @@ sub test_linked_sp_level0($vm) { ); wait_request(); my $out_json = $req->output; - $out_json = '{}' if !defined $out_json; - my $output = decode_json($out_json); + my $output = ($out_json or {}); my $list = $output->{list}; my @found = grep ($_->{file} =~ /$new_filename$/, @$list); @@ -648,14 +637,23 @@ sub _check_leftovers($vm, $delete=0) { sub _clean_old_sps($vm) { remove_qemu_pools($vm) if $vm->type eq 'KVM'; + my $base = base_domain_name(); if ($vm->type eq 'KVM') { - my $base = base_domain_name(); for my $pool ( $vm->vm->list_all_storage_pools()) { next if $pool->get_name !~ /^$base/; $pool->destroy if $pool->is_active; $pool->undefine; } } + for my $sp ( $vm->list_storage_pools ) { + next if $sp !~/^$base/; + Ravada::Request->remove_storage_pool( + uid => user_admin->id + ,id_vm => $vm->id + ,name => $sp + ); + wait_request(); + } } ######################################################################## diff --git a/t/storage_move.t b/t/storage_move.t index d30efd5b6..2a0f5cb3e 100644 --- a/t/storage_move.t +++ b/t/storage_move.t @@ -90,7 +90,6 @@ sub test_do_not_overwrite($vm) { } sub _search_free_space($dir) { - diag($dir); open my $mounts,"<","/proc/mounts" or die $!; my $found; while (my $line = <$mounts>) { @@ -193,7 +192,6 @@ sub test_queue_move($vm) { remove_domain($domain); $vm->remove_storage_pool($sp); - } sub test_queue_change_hw($vm) { @@ -245,6 +243,11 @@ sub test_move_volume($vm, $domain=undef) { ,format => "raw" ,size => 1024*10 ); + $domain->add_volume( name => new_domain_name().".qcow2" + ,format => "qcow2" + ,size => 1024*10 + ); + my ($sp, $dir) = _create_storage_pool($vm); test_fail_nonvol($domain, $sp); @@ -257,7 +260,6 @@ sub test_move_volume($vm, $domain=undef) { my ($filename)= $vol =~ m{.*/(.*)}; if ( -e "$dir/$filename" ) { - diag("removing previously copied $dir/$filename"); unlink("$dir/$filename") or die "$! $dir/$filename"; $vm->refresh_storage(); } @@ -273,6 +275,7 @@ sub test_move_volume($vm, $domain=undef) { wait_request( debug => 0); is($req->status,'done'); is($req->error, ''); + ok(-e "$dir/$filename", "Expecting $dir/$filename") or exit; if ($vol =~ /iso$/) { ok( -e $vol) or die "Expecting $vol not removed"; } else { @@ -299,6 +302,7 @@ sub test_move_volume($vm, $domain=undef) { for my $vol (@volumes) { ok(!-e $vol); } + $vm->remove_storage_pool($sp); $vm->remove_storage_pool($sp); rmdir($dir) or die "$! $dir"; diff --git a/t/user/networks.t b/t/user/networks.t index df610c8a8..f4b6923ac 100644 --- a/t/user/networks.t +++ b/t/user/networks.t @@ -10,7 +10,6 @@ use Test::Ravada; use Ravada; use Data::Dumper; -use Mojo::JSON qw(decode_json); no warnings "experimental::signatures"; use feature qw(signatures); @@ -27,7 +26,7 @@ sub test_create_network($vm) { is($req_new->status, 'done'); is($req_new->error, ''); ok($req_new->output,"Expecting output") or die; - my $data = decode_json($req_new->output); + my $data = $req_new->output; my $req = Ravada::Request->create_network( uid => user_admin->id @@ -60,7 +59,7 @@ sub test_grant_access($vm) { ); wait_request(); is($req_new->error,''); - my $data = decode_json($req_new->output); + my $data = $req_new->output; my $req_create = Ravada::Request->create_network( uid => $user->id @@ -152,7 +151,7 @@ sub test_deny_access($vm) { like($req_delete->error,qr/not authorized/); $req_create->status('requested'); - my $new_data = decode_json($req_new->output); + my $new_data = $req_new->output; $req_create->arg('data' => $new_data); $req_create->status('requested'); wait_request(); @@ -164,7 +163,7 @@ sub test_deny_access($vm) { is($req_list->status,'done'); is($req_list->error,''); - my $new_list = decode_json($req_list->output); + my $new_list = $req_list->output; my ($found) = grep { $_->{name} eq $new_data->{name} } @$new_list; ok($found,"Expecting new network $new_data->{name}"); diff --git a/t/user/upgrade_grants.t b/t/user/upgrade_grants.t index 72ae92513..76b84dab5 100644 --- a/t/user/upgrade_grants.t +++ b/t/user/upgrade_grants.t @@ -124,7 +124,7 @@ sub test_upgrade_default_user() { } ###################################################################### -init(); +clean(); my $vm_name = 'Void'; my $vm; diff --git a/t/vm/10_domain.t b/t/vm/10_domain.t index 5e2bd88f0..8a23a9f0b 100644 --- a/t/vm/10_domain.t +++ b/t/vm/10_domain.t @@ -648,12 +648,6 @@ sub test_create_domain_nocd { my $id_iso = search_id_iso('Alpine'); - my $sth = connector->dbh->prepare( - "UPDATE iso_images set device=NULL WHERE id=?" - ); - $sth->execute($id_iso); - $sth->finish; - my $iso; eval { $iso = $vm->_search_iso($id_iso,'')}; return if $@ && $@ =~ /Can't locate object method/; diff --git a/t/vm/11_base.t b/t/vm/11_base.t new file mode 100644 index 000000000..2c9ba1f8c --- /dev/null +++ b/t/vm/11_base.t @@ -0,0 +1,75 @@ +use warnings; +use strict; + +use Carp qw(confess); +use Data::Dumper; +use Hash::Util qw(lock_hash); +use IPC::Run3 qw(run3); +use JSON::XS; +use Test::More; + +no warnings "experimental::signatures"; +use feature qw(signatures); + +use lib 't/lib'; +use Test::Ravada; + +sub test_remove_base($vm) { + + my $base = import_clone($vm); + + my @volumes_base = $base->list_files_base(); + + my @volumes= $base->list_volumes(); + for my $vol ($base->list_volumes_info()) { + my $backing = $vol->backing_file; + ok($vm->file_exists($backing),$backing); + } + + $base->remove_base(user_admin); + + for my $vol ($base->list_volumes_info()) { + my $backing = $vol->backing_file; + ok(!$backing,"Expecting no backing from file ".$vol->file); + } + + for my $vol (@volumes_base) { + ok(!$vm->file_exists($vol),"Expecting base file '$vol' removed"); + } + + $base->start(user_admin); + my $ip = wait_ip($base); + + ok($ip); + + remove_domain($base); + +} + +######################################################################## + +init(); +clean(); + +for my $vm_name ( vm_names() ) { + my $vm; + + eval { $vm = rvd_back->search_vm($vm_name) }; + + SKIP: { + my $msg = "SKIPPED test: No $vm_name VM found "; + if ($vm && $vm_name =~ /kvm/i && $>) { + $msg = "SKIPPED: Test must run as root"; + $vm = undef; + } + + diag($msg) if !$vm; + skip $msg,10 if !$vm; + + test_remove_base($vm); + } +} + +######################################################################## +end(); +done_testing(); diff --git a/t/vm/20_base.t b/t/vm/20_base.t index 4429e85ac..224360ffe 100644 --- a/t/vm/20_base.t +++ b/t/vm/20_base.t @@ -49,6 +49,8 @@ sub test_create_domain { .($domain->name or '') ." for VM $vm_name" ); + $domain->add_volume(type => 'swap', size => 1024*1024, format => 'qcow2'); + $domain->add_volume(type => 'data', size => 1024*1024, format => 'qcow2'); return $domain; } @@ -68,7 +70,7 @@ sub test_files_base { my @files = $domain->list_files_base(); ok(scalar @files == $n_expected,"Expecting $n_expected files base , got " - .scalar @files); + .scalar @files) or confess; return; } @@ -776,7 +778,7 @@ sub _test_compare_list($display1, $display2, $domain=undef) { sub test_prepare_base { my $vm_name = shift; my $domain = shift; - my $n_volumes = (shift or 1); + my $n_volumes = (shift or 3); test_files_base($domain,0); $domain->shutdown_now($USER) if $domain->is_active(); @@ -910,14 +912,16 @@ sub test_prepare_base_with_cd { ,id_owner => user_admin->id ); my @volumes_clone = $clone->list_volumes_info; + my %dupe; for my $vol (@volumes_clone) { like(ref $vol->domain, qr/^Ravada::Domain/); like(ref $vol->vm, qr/^Ravada::VM/); + die "Duplicated vol ".$vol->file if $dupe{$vol->file}++; } my ($cd_clone ) = grep { defined $_->file && $_->file =~ /\.iso$/ } @volumes_clone; ok($cd_clone,"Expecting a CD in clone ".Dumper([ map { delete $_->{domain}; delete $_->{vm}; $_ } @volumes_clone])) or exit; - is($cd_clone->info->{target}, $cd_base->[1]) or exit; + is($cd_clone->info->{target}, $cd_base->[1]) or die Dumper($clone->name, $cd_clone->info()); $clone->remove(user_admin); $domain->remove(user_admin); @@ -1108,6 +1112,7 @@ sub test_remove_base_level($vm_name) { my @clones; for ( 1 .. 3 ) { my $clone = $base->clone(name => new_domain_name, user => user_admin); + _check_volume_mode_domain($clone); push @clones,($clone); } @@ -1121,6 +1126,7 @@ sub test_remove_base_level($vm_name) { for ( 1 .. 3 ) { for my $base2 ($base, @clones ) { my $clone = $base2->clone(name => new_domain_name, user => user_admin); + _check_volume_mode_domain($clone); push @clones2,($clone); } } @@ -1181,7 +1187,7 @@ sub _do_test_remove_base($domain, $base=undef) { ok(!$domain->is_base,"Domain ".$domain->name." should be base") or return; for my $file (@files) { - die $file if $file !~ m{^[0-9a-z_/\-\.]+$}; + die $file if $file !~ m{^[0-9a-zA-Z_/\-\.]+$}; if ($file =~ /\.iso$/) { ok(-e $file,"Expecting file base '$file' removed" ); } else { @@ -1199,8 +1205,15 @@ sub _do_test_remove_base($domain, $base=undef) { } } +sub _check_volume_mode_domain($domain) { + for my $file ( $domain->list_volumes) { + _check_volume_mode($file); + } +} + sub _check_volume_mode($file) { my $mode = stat($file)->mode; + my $fail = 0; if ($file =~ /\.iso$/) { ok($mode & S_IRUSR); # user can read @@ -1210,11 +1223,12 @@ sub _check_volume_mode($file) { ok($mode & S_IRUSR); # User can read ok($mode & S_IWUSR); # User can write - ok(!($mode & S_IRGRP)); # Group can not read - ok(!($mode & S_IROTH)); # Others can not read - ok(!($mode & S_IWGRP)); # Group can not write - ok(!($mode & S_IWOTH)); # Others can not write + ok(!($mode & S_IRGRP)) || $fail++; # Group can not read + ok(!($mode & S_IROTH)) || $fail++; # Others can not read + ok(!($mode & S_IWGRP)) || $fail++; # Group can not write + ok(!($mode & S_IWOTH)) || $fail++; # Others can not write } + confess $file if $fail; } @@ -1800,7 +1814,7 @@ sub test_prepare_base_disk_missing($vm) { my ($two) = grep(!/iso$/i, reverse @volumes); unlink $two or die "$! $two"; - is($vm->file_exists($two),undef); + is($vm->file_exists($two),0); eval { $domain->prepare_base(user_admin); @@ -1948,6 +1962,9 @@ for my $vm_name ( vm_names() ) { } flush_rules() if !$<; + my $domaina = test_create_domain($vm_name); + test_prepare_base($vm_name, $domaina); + test_remove_base($vm_name); test_remove_base_level($vm_name);# if $ENV{TEST_LONG}; @@ -1961,8 +1978,6 @@ for my $vm_name ( vm_names() ) { test_prepare_base_volatile($vm); test_change_display_settings($vm); - test_display_drivers($vm,0); - test_display_drivers($vm,1); #remove after testing display type test_display_iptables($vm); @@ -2007,13 +2022,13 @@ for my $vm_name ( vm_names() ) { $domain = undef; my $domain2 = test_create_domain_swap($vm_name); - test_prepare_base($vm_name, $domain2 , 2); + test_prepare_base($vm_name, $domain2 , 4); $domain2->remove( user_admin ); $domain2 = test_create_domain_swap($vm_name); $domain2->start( user_admin ); $domain2->shutdown_now( user_admin ); - test_prepare_base($vm_name, $domain2 , 2); + test_prepare_base($vm_name, $domain2 , 4); $domain2->remove( user_admin ); NEXT: diff --git a/t/vm/23_display.t b/t/vm/23_display.t index bd9406745..b2038afe6 100644 --- a/t/vm/23_display.t +++ b/t/vm/23_display.t @@ -67,7 +67,9 @@ sub test_display_conflict($vm) { my $display = $domain->info(user_admin)->{hardware}->{display}; last if defined $display->[0]->{port} && defined $display->[1]->{port} - && $display->[0]->{port} ne $display->[1]->{port}; + && $display->[0]->{port} ne $display->[1]->{port} + && $display->[0]->{is_active} + && $display->[1]->{is_active}; Ravada::Request->refresh_machine(uid => user_admin->id ,id_domain=> $domain->id ,_force => 1 @@ -78,7 +80,7 @@ sub test_display_conflict($vm) { my $display = $domain->info(user_admin)->{hardware}->{display}; isnt($display->[0]->{port}, $display->[1]->{port}) or die Dumper($display); is($display->[0]->{is_active},1); - is($display->[1]->{is_active},1); + is($display->[1]->{is_active},1) or die $domain->name; my $port3; for ( 1 .. 10 ) { diff --git a/t/vm/35_remove2.t b/t/vm/35_remove2.t index 3eae36aa1..10e3ccab9 100644 --- a/t/vm/35_remove2.t +++ b/t/vm/35_remove2.t @@ -70,9 +70,31 @@ sub _clone($base, $name=new_domain_name) { ); } +sub _check_volumes_different($d1, $d2) { + + my %vols_d1 = sort $d1->list_volumes; + my %vols_d2 = sort $d2->list_volumes; + for my $vol (keys %vols_d1) { + ok(!exists $vols_d2{$vol}) or die $vol; + } + for my $vol (keys %vols_d2) { + ok(!exists $vols_d1{$vol}) or die $vol; + } + +} + +sub _check_backing_file($d) { + for my $vol0 ($d->list_volumes_info) { + ok($vol0->backing_file) or die $vol0->{file}; + like($vol0->backing_file(),qr/\.ro\./); + } + +} + sub test_remove_rename($vm) { Test::Ravada::_check_leftovers_domains(); my $base= create_domain($vm->type); + $base->add_volume(format => 'qcow2', size => 1*1024*1024); my $name = new_domain_name(); my $base2 = _clone($base, $name); $base2->prepare_base(user_admin); @@ -87,9 +109,15 @@ sub test_remove_rename($vm) { is($@,'') or exit; $clone2 = rvd_back->search_domain($name); ok($clone2); - $clone2->remove(user_admin); - for my $vol (@volumes_base, $base2->list_volumes) { + _check_volumes_different($clone2, $base2); + _check_backing_file($clone2); + + $clone2->remove(user_admin); + for my $vol (reverse $base2->list_volumes) { + ok( -e $vol,$vol) or die $base2->name; + } + for my $vol (@volumes_base) { ok( -e $vol,$vol); } diff --git a/t/vm/40_volumes.t b/t/vm/40_volumes.t index e10390b0f..cfc61819c 100644 --- a/t/vm/40_volumes.t +++ b/t/vm/40_volumes.t @@ -55,6 +55,15 @@ sub test_create_domain { return $domain; } +sub _remove_base($domain) { + return if !$domain->is_base; + for my $clone0 ( $domain->clones ) { + my $clone = Ravada::Domain->open($clone0->{id}); + $clone->remove(user_admin); + } + $domain->remove_base($USER); +} + sub test_add_volume { my $vm = shift; my $domain = shift; @@ -62,6 +71,7 @@ sub test_add_volume { my $swap = shift; $domain->shutdown_now($USER) if $domain->is_active; + _remove_base($domain) if $domain->is_base; my @volumes = $domain->list_volumes(); @@ -79,7 +89,7 @@ sub test_add_volume { ,size => 512*1024 ,swap => $swap); - my ($vm_name) = $vm->name =~ /^(.*)_/; + my ($vm_name) = $vm->type; my $vmb = rvd_back->search_vm($vm_name); ok($vmb,"I can't find a VM ".$vm_name) or return; my $domainb = $vmb->search_domain($domain->name); @@ -114,7 +124,7 @@ sub test_backing_store($domain) { for my $backing_store ($disk->findnodes('backingStore')) { $found_bs++; my ($format) = $backing_store->findnodes('format'); - ok($format) or die "Expecting format in backing store ".$backing_store->toString(); + ok($format) or die "Expecting format in backing store ".$disk->toString(); my ($source) = $backing_store->findnodes('source'); ok($source) or die "Expecting source in backing store ".$backing_store->toString(); @@ -635,17 +645,6 @@ sub _check_backing_store($xml, $name=undef) { return 1; } -sub _convert_file_to_raw($vm, @files) { - for my $file ( @files ) { - my $file_dst = "$file.raw"; - my @cmd = ('qemu-img','convert',"-O","raw",$file,$file_dst); - my ($out, $err) = $vm->run_command(@cmd); - die $err if $err; - copy($file_dst,$file) or die "$! $file_dst -> $file"; - unlink $file_dst or die "$! $file_dst"; - } -} - sub _create_domain_no_backing_store($vm) { #standalone has no backingStore entries my $standalone = create_domain($vm); @@ -659,9 +658,6 @@ sub _create_domain_no_backing_store($vm) { $base->add_volume(type => 'TMP' , format => 'raw', size => 1024 * 10); $base->prepare_base(user_admin); - my ($file) = grep { /TMP/ } $base->list_files_base; - _convert_file_to_raw($vm, $file); - my $base_doc = _remove_backing_store($base->get_xml_base); my $sth = connector->_dbh->prepare( "UPDATE base_xml set xml=? WHERE id_domain = ? " diff --git a/t/vm/45_vol_swap.t b/t/vm/45_vol_swap.t index 43e752c21..247f3f97f 100644 --- a/t/vm/45_vol_swap.t +++ b/t/vm/45_vol_swap.t @@ -88,7 +88,7 @@ sub test_clone_raw($domain ) { my $doc = XML::LibXML->load_xml( string => $backing ); my ($format) = $doc->findnodes('/backingStore/format'); ok($format,"Expecing in backing: ".$doc->toString) or next; - is($format->getAttribute('type'),'qcow2',"Expecting format ".$format->toString) + like($format->getAttribute('type'),qr/qcow2|raw/,"Expecting format ".$format->toString) or exit; } is($found,2); diff --git a/t/vm/55_rename.t b/t/vm/55_rename.t index 0993e8248..c87198bba 100644 --- a/t/vm/55_rename.t +++ b/t/vm/55_rename.t @@ -101,7 +101,6 @@ sub _change_hardware_ram($domain) { } sub _add_hardware_disk($domain) { - diag("add disk"); Ravada::Request->shutdown_domain( uid => user_admin->id ,id_domain => $domain->id @@ -117,7 +116,9 @@ sub _add_hardware_disk($domain) { ); wait_request(); my $domain2 = Ravada::Front::Domain->open($domain->id); - diag($domain2->_data('config_no_hd')); + like($domain2->_data('config_no_hd'),qr/./) or die $domain->name; + my $name = $domain2->name; + ok(grep /$name/, $domain->list_volumes); } sub test_req_rename_domain { diff --git a/t/vm/60_new_args.t b/t/vm/60_new_args.t index 04418e815..a6ff00749 100644 --- a/t/vm/60_new_args.t +++ b/t/vm/60_new_args.t @@ -293,6 +293,7 @@ for my $vm_name ( vm_names() ) { skip $msg,10 if !$vm_ok; use_ok("Ravada::VM::$vm_name"); + test_args($vm_name); test_small($vm_name, $vm); }; diff --git a/t/vm/82_route.t b/t/vm/82_route.t index 52b47e000..203737de9 100644 --- a/t/vm/82_route.t +++ b/t/vm/82_route.t @@ -62,7 +62,7 @@ sub test_slim_route($vm) { eval { $domain->start(user => user_admin, remote_ip => $remote_ip); }; - like($@, qr/binding socket to/) if$vm->type ne 'Void'; + like($@, qr/binding socket to/) or die $domain->name if $vm->type ne 'Void'; my $display = $domain->info(user_admin)->{hardware}->{display}; for my $dp (@$display) { unlike($dp->{listen_ip}, qr/^192.168.12/); diff --git a/t/vm/89_ports_unique.t b/t/vm/89_ports_unique.t index a1dfc02c3..03a964fb3 100644 --- a/t/vm/89_ports_unique.t +++ b/t/vm/89_ports_unique.t @@ -69,7 +69,8 @@ for my $vm_name ( reverse vm_names() ) { my $string = join(" ", map { $_ or '' } @$rule); next if $string eq 'A POSTROUTING j LIBVIRT_PRT'; - die Dumper($rule) if $dupe{$string}++; + next if $string =~ /A LIBVIRT_/; + die Dumper([$string,$rule]) if $dupe{$string}++; } } diff --git a/t/vm/93_ports_bridge.t b/t/vm/93_ports_bridge.t index 85f83ebbc..f23730fae 100644 --- a/t/vm/93_ports_bridge.t +++ b/t/vm/93_ports_bridge.t @@ -84,6 +84,8 @@ sub test_bridge($vm) { wait_request(debug => 0); my $internal_ip = _wait_ip($domain); + $domain->ip; + wait_request(debug => 0); my $ip_info = $domain->ip_info(); ok($ip_info->{type} eq 'bridge'); diff --git a/t/vm/94_ports_exposed.t b/t/vm/94_ports_exposed.t index d10434c02..65547e3ee 100644 --- a/t/vm/94_ports_exposed.t +++ b/t/vm/94_ports_exposed.t @@ -58,30 +58,73 @@ sub test_expose_port($vm) { my $remote_ip2 = '10.0.0.2'; my $local_ip = $vm->ip; + is($domain->_data('ports_exposed'),0); my $req = Ravada::Request->start_domain( uid => user_admin->id ,id_domain => $domain->id ,remote_ip => $remote_ip1 ); + wait_request( request => $req); + delete $domain->{_data}; + my $internal_ip = _wait_ip2($vm->type, $domain) or die "Error: no ip for ".$domain->name; + Ravada::Request->refresh_machine( + uid => user_admin->id + ,id_domain => $domain->id + ,_force => 1 + ); wait_request( request => $req); + my $domain_f = Ravada::Front::Domain->open($domain->id); + is($domain_f->ip(), $internal_ip); + + delete $domain->{_data}; + is($domain->_data('ports_exposed'),2); + my ($port) = $domain->list_ports(); + is($req->error,''); + is($domain->_data('ports_exposed'),2); + + my @out_nat = split /\n/, `iptables-save -t nat`; + my @prerouting= (grep /--to-destination $internal_ip:22/, @out_nat); + is(scalar(@prerouting),1); + my @out= split /\n/, `iptables-save`; + my @forward = (grep /-s $remote_ip1\/32 -d $internal_ip.* --dport 22.*-j ACCEPT/, @out); + is(scalar(@forward),1,"-s $remote_ip1\/32 -d $internal_ip.* --dport 22.*-j ACCEPT") or die $domain->name." ". Dumper([grep /FORWARD/,@out]); + + # test open from another ip Ravada::Request->open_exposed_ports( uid => user_admin->id ,id_domain => $domain->id ,remote_ip => $remote_ip2 ); wait_request(debug=>0); - is($req->error,''); - my @out_nat = split /\n/, `iptables-save -t nat`; - my @prerouting= (grep /--to-destination $internal_ip:22/, @out_nat); + @out_nat = split /\n/, `iptables-save -t nat`; + @prerouting= (grep /--to-destination $internal_ip:22/, @out_nat); is(scalar(@prerouting),1); - my @out= split /\n/, `iptables-save`; - my @forward = (grep /-s $remote_ip2\/32 -d $internal_ip.* --dport 22.*-j ACCEPT/, @out); + @out= split /\n/, `iptables-save`; + @forward = (grep /-s $remote_ip2\/32 -d $internal_ip.* --dport 22.*-j ACCEPT/, @out); is(scalar(@forward),1,"-s $remote_ip2\/32 -d $internal_ip.* --dport 22.*-j ACCEPT") or die $domain->name." ". Dumper([grep /FORWARD/,@out]); + + # test shutdown ports closed + Ravada::Request->shutdown_domain( + uid => user_admin->id + ,id_domain => $domain->id + ); + wait_request(); + delete $domain->{_data}; + is($domain->_data('ports_exposed'),0) or die $domain->name; + + @out_nat = split /\n/, `iptables-save -t nat`; + @prerouting= (grep /--to-destination $internal_ip:22/, @out_nat); + is(scalar(@prerouting),0); + @out= split /\n/, `iptables-save`; + @forward = (grep /-s $remote_ip2\/32 -d $internal_ip.* --dport 22.*-j ACCEPT/, @out); + is(scalar(@forward),0,"-s $remote_ip2\/32 -d $internal_ip.* --dport 22.*-j ACCEPT") or die $domain->name." ". Dumper([grep /FORWARD/,@out]); + is($domain->_data('ports_exposed'),0); + remove_domain($domain0); } @@ -115,6 +158,7 @@ SKIP: { diag($msg) if !$vm; skip $msg,10 if !$vm; + diag("testing $vm_name"); _import_base($vm); test_expose_port($vm); } diff --git a/t/vm/compact.t b/t/vm/compact.t index 47c088f97..cd651a0d3 100644 --- a/t/vm/compact.t +++ b/t/vm/compact.t @@ -148,6 +148,7 @@ sub test_compact_clone($vm) { ####################################################### init(); +clean(); test_settings(); if ($>) { diff --git a/t/vm/d10_not_download.t b/t/vm/d10_not_download.t index 9b011b501..7d5dbe8e3 100644 --- a/t/vm/d10_not_download.t +++ b/t/vm/d10_not_download.t @@ -29,6 +29,7 @@ sub test_windows($vm) { next unless $iso->{name} =~ /windows/i || !$iso->{url}; is($iso->{has_cd},1) unless $iso->{name} =~ /^Empty/; is($iso->{url}, undef); + next if $iso->{arch} eq 'i686'; my $name = new_domain_name(); my @args =( id_owner => user_admin->id diff --git a/t/vm/d20_disks.t b/t/vm/d20_disks.t index 60ac649b3..8d00d184c 100644 --- a/t/vm/d20_disks.t +++ b/t/vm/d20_disks.t @@ -4,6 +4,7 @@ use warnings; use strict; +use Carp qw(confess); use Data::Dumper; use Mojo::JSON qw(decode_json); use Storable qw(dclone); @@ -472,7 +473,7 @@ sub _req_create($vm, $iso, $options) { my $req = Ravada::Request->create_domain(@args); wait_request( debug => 0); my $domain = $vm->search_domain($name); - ok($domain) or die "No machine $name ".Dumper($iso); + ok($domain) or confess "No machine $name ".Dumper($iso); $domain->shutdown_now(user_admin); return $domain; } @@ -533,6 +534,9 @@ sub _req_add_cd($domain) { sub _search_iso_alpine($vm) { my $id_alpine = search_id_iso('Alpine%32'); my $iso = $vm->_search_iso($id_alpine); + my $file_re = $iso->{file_re}; + $iso->{device} = $vm->search_volume_path_re(qr($file_re)); + die "Missing iso file from ".Dumper($iso) if !$iso->{device}; return $iso->{device}; } sub _machine_types($vm) { @@ -545,7 +549,7 @@ sub _machine_types($vm) { like($req->output,qr/./); my $machine_types = {}; - $machine_types = decode_json($req->output()); + $machine_types = $req->output(); return $machine_types; } @@ -574,7 +578,6 @@ sub test_cdrom($vm) { eval { $iso = $vm->_search_iso($iso_frontend->{id}, $device_iso) }; next if $@ && $@ =~ /No.*iso.*found/; die $@ if $@; - $iso->{device} = $device_iso; my %done; for my $bios (undef, 'legacy','uefi') { @@ -588,6 +591,7 @@ sub test_cdrom($vm) { $options{bios}=$bios if defined $bios; $options{machine}=$machine if defined $machine; + $iso->{device} = $device_iso; my $domain = _req_create($vm, $iso, \%options); _req_add_cd($domain); diff --git a/t/vm/d30_discover.t b/t/vm/d30_discover.t index 964c622a6..fec864f3b 100644 --- a/t/vm/d30_discover.t +++ b/t/vm/d30_discover.t @@ -42,7 +42,7 @@ sub test_discover($vm) { my $out = $req->output; like($out,qr/./); - my $decoded = decode_json($out); + my $decoded = $out; my ($found3) = grep { $_ eq $name } @$decoded; ok($found3, "Expecting $name in requested discover for ".$vm->type) diff --git a/t/vm/h10_hybernate.t b/t/vm/h10_hybernate.t index e58f6a160..73e0c387c 100644 --- a/t/vm/h10_hybernate.t +++ b/t/vm/h10_hybernate.t @@ -40,6 +40,8 @@ sub test_hybernate_clone { my ($vm_name, $domain) = @_; $domain->is_public(1); + $domain->shutdown_now(user_admin) if $domain->is_active; + my $clone = $domain->clone(name => new_domain_name(), user => $USER); eval {$clone->start($USER) if !$clone->is_active }; @@ -61,7 +63,10 @@ sub test_hybernate_clone { sub test_hybernate_clone_swap { my ($vm_name, $domain) = @_; + $domain->remove_base(user_admin); + $domain->add_volume_swap( size => 1024*512); + $domain->add_volume_swap( size => 1024*512, format => 'qcow2'); test_hybernate_clone($vm_name,$domain); } @@ -79,7 +84,6 @@ sub test_remove_hybernated { eval{ $clone->remove($USER) }; ok(!$@,"Expecting no error removing , got : ".($@ or '')); - } ################################################################ diff --git a/t/vm/n20_name.t b/t/vm/n20_name.t index d588f8028..c33f1f4c1 100644 --- a/t/vm/n20_name.t +++ b/t/vm/n20_name.t @@ -87,7 +87,8 @@ sub test_nat($vm_name) { ok($domain,"[$vm_name] Expecting the domain $domain_name") or exit; my $file_config = "/tmp/config_display.yml"; - DumpFile($file_config,{ display_ip => $display_ip, vm => \@VMS }); + DumpFile($file_config,{ display_ip => $display_ip, vm => \@VMS + ,dir_rrd => '/var/tmp/ravada/rrd/$$'}); my $rvd_back = Ravada->new( connector => connector() , config => $file_config @@ -123,7 +124,8 @@ sub test_nat($vm_name) { #-------------------------------------------------------------------------------- # Now with Nat # - DumpFile($file_config,{ display_ip => $display_ip, nat_ip => $NAT_IP, vm => \@VMS }); + DumpFile($file_config,{ display_ip => $display_ip, nat_ip => $NAT_IP, vm => \@VMS + , dir_rrd => '/var/tmp/ravada/rrd/$$'}); $rvd_back = Ravada->new( connector => connector() , config => $file_config @@ -154,7 +156,7 @@ sub test_nat($vm_name) { $domain->remove(user_admin); - DumpFile($file_config,{ vm => \@VMS }); + DumpFile($file_config,{ vm => \@VMS, dir_rrd => '/var/tmp/ravada/rrd/$$'}); $rvd_back = Ravada->new( connector => connector() , config => $file_config diff --git a/t/vm/networking.t b/t/vm/networking.t index d604ee0c6..4efbd8135 100644 --- a/t/vm/networking.t +++ b/t/vm/networking.t @@ -3,7 +3,6 @@ use strict; use Carp qw(confess); use Data::Dumper; -use Mojo::JSON qw(decode_json); use Storable qw(dclone); use Test::More; @@ -84,7 +83,7 @@ sub test_create_fail ($vm) { ); wait_request(check_error => 0, debug => 0); like($req->error,qr/Network is already in use/) or die $name; - my $out = decode_json($req->output); + my $out = $req->output; like($out->{id_network},qr/^\d+$/) or exit; my ($old) = grep { $_->{id} eq $out->{id_network} } @networks; @@ -121,7 +120,7 @@ sub test_duplicate_bridge_add($vm, $net) { ,id_vm => $vm->id ); wait_request( check_error => 0, debug => 0); - is($req->output,'{}'); + is_deeply($req->output,{}); like($req->error,qr/already exists/) or exit; my ($net_created) = grep {$net2->{name} eq $_->{name} } @@ -204,7 +203,7 @@ sub test_add_network($vm) { wait_request(debug => 0); like($req_new->output , qr/\d+/) or exit; - my $net = decode_json($req_new->output); + my $net = $req_new->output; my $name = $net->{name}; my $user = create_user(); @@ -225,7 +224,7 @@ sub test_add_network($vm) { ); wait_request( debug => 0); - my $out = decode_json($req->output); + my $out = $req->output; my($new) = grep { $_->{name} eq $name } $vm->list_virtual_networks(); ok($new,"Expecting new network $name created") or die Dumper([$vm->list_virtual_networks]); isa_ok($out,'HASH') @@ -262,7 +261,7 @@ sub test_remove_user($vm) { ); wait_request(debug => 0); - my $data = decode_json($req->output); + my $data = $req->output; is($data->{id_vm},$vm->id); my $req_create = Ravada::Request->create_network( @@ -833,7 +832,7 @@ sub test_new_network($vm) { ,name => base_domain_name()."_" ); wait_request(); - my $data = decode_json($req->output); + my $data = $req->output; is($data->{id_vm},$vm->id); my $req_create = Ravada::Request->create_network( @@ -849,9 +848,9 @@ sub test_new_network($vm) { ,name => base_domain_name()."_" ); wait_request(); - my $new_net = decode_json($req_create->output); + my $new_net = $req_create->output; - my $data2 = decode_json($req2->output); + my $data2 = $req2->output; for my $field( keys %$data) { next if $field =~ /^(id_vm|ip_netmask|is_active|autostart|forward_mode)/; diff --git a/t/vm/p10_pools.t b/t/vm/p10_pools.t index 7d3d0448a..3410627e9 100644 --- a/t/vm/p10_pools.t +++ b/t/vm/p10_pools.t @@ -342,15 +342,32 @@ sub test_exposed_port($vm) { is($req->error,''); is($base->is_base,1) or exit; - my $req_refresh = Ravada::Request->refresh_vms( _no_duplicate => 1); - wait_request( debug => 0 ,skip => 'set_time' ); - is($req_refresh->status, 'done'); - is(scalar($base->clones), $n); - - my $clone = $base->clone(name => new_domain_name(), user => user_admin); + my $clone; + for ( 1 .. 10 ) { + my $req_refresh = Ravada::Request->refresh_vms( _force => 1); + wait_request( debug => 0 ,skip => 'set_time' ); + is($req_refresh->status, 'done'); + is(scalar($base->clones), $n); - for my $clone ( $base->clones ) { - Ravada::Domain->open($clone->{id})->remove(user_admin); + my $name = new_domain_name(); + my $req_clone = Ravada::Request->clone( + uid => user_admin->id + ,id_domain => $base->id + ,name => $name + ); + wait_request(debug => 0, check_error => 0); + ($clone) = grep { $_->{id_owner} == user_admin->id } $base->clones(); + last if $clone; + } + ok($clone) or exit; + is($clone->{id_owner}, user_admin->id); + + for my $clone0 ( $base->clones ) { + my $clone2 = Ravada::Domain->open($clone0->{id}); + ok($clone2->list_ports); + my ($port22) = grep { $_->{internal_port} == 22 } $clone2->list_ports(); + ok($port22); + $clone2->remove(user_admin); } $base->remove(user_admin); diff --git a/t/vm/r20_rebase.t b/t/vm/r20_rebase.t index 58e361da6..94bd01efb 100644 --- a/t/vm/r20_rebase.t +++ b/t/vm/r20_rebase.t @@ -250,7 +250,7 @@ sub test_prepare_remove($vm) { sub test_rebase_clone($vm) { my $base0 = create_domain($vm); - $base0->add_volume( format => 'qcow2' ); + $base0->add_volume( format => 'qcow2', size => $VOL_SIZE ); Ravada::Request->prepare_base( id_domain => $base0->id @@ -307,6 +307,8 @@ sub test_rebase_clone($vm) { clean(); $ENV{LANG}='C'; +unlink '/var/tmp/rvd_void/frankie/alpine-standard-3.23-x86_64.iso'; + for my $vm_name (vm_names() ) { ok($vm_name); SKIP: { diff --git a/templates/main/admin_hostdev.html.ep b/templates/main/admin_hostdev.html.ep index e93771e8a..4b03768c6 100644 --- a/templates/main/admin_hostdev.html.ep +++ b/templates/main/admin_hostdev.html.ep @@ -79,8 +79,8 @@
- list command: - filter: + <%=l 'list command' %>: + <%=l 'filter' %>:
- Machines + <%=l 'Machines' %>
- +
<%=l 'Machine' %> <%=l 'locked' %>
<%=l 'This Machine is a base' %>
diff --git a/templates/main/admin_settings.html.ep b/templates/main/admin_settings.html.ep index 046e6442f..49eb82976 100644 --- a/templates/main/admin_settings.html.ep +++ b/templates/main/admin_settings.html.ep @@ -134,7 +134,7 @@ > <%=l 'Only previously authorized users can log in.' %> <%=l 'You can grant access to users from the users administration form:'%> - upload + <%=l 'upload' %> diff --git a/templates/main/list_bases_ng.html.ep b/templates/main/list_bases_ng.html.ep index 2571c49e2..93fd92382 100644 --- a/templates/main/list_bases_ng.html.ep +++ b/templates/main/list_bases_ng.html.ep @@ -93,7 +93,7 @@ Prepare base + ><%=l 'Prepare base' %>
<%=l 'Preparing a base will create a template for all the users to clone.' %> diff --git a/templates/main/needs_restart.html.ep b/templates/main/needs_restart.html.ep index a21714e39..f4fa45c51 100644 --- a/templates/main/needs_restart.html.ep +++ b/templates/main/needs_restart.html.ep @@ -1,4 +1,4 @@ -
+
<%=l 'The changes will apply on next restart' %>
{{error}}
+ %= include '/main/settings_machine_locked' %= include 'main/needs_restart' %= include 'main/settings_machine_tabs_body'
diff --git a/templates/main/settings_machine_locked.html.ep b/templates/main/settings_machine_locked.html.ep new file mode 100644 index 000000000..416ce0848 --- /dev/null +++ b/templates/main/settings_machine_locked.html.ep @@ -0,0 +1,23 @@ +
+
+ + <%=l 'Virtual Machine locked' %> + + + + +
+ + +
    +
  • [{{request.id}}] {{request.command}} {{request.status}}
    • +
+
+ +
+ +
diff --git a/templates/main/storage_list.html.ep b/templates/main/storage_list.html.ep index a26afd7d3..b2fe5c719 100644 --- a/templates/main/storage_list.html.ep +++ b/templates/main/storage_list.html.ep @@ -9,12 +9,12 @@ - Enabled - Size - Used - Available - Used % - Path + <%=l 'Enabled' %> + <%=l 'Size' %> + <%=l 'Used' %> + <%=l 'Available' %> + <%=l 'Used %' %> + <%=l 'Path' %> diff --git a/templates/main/upload_users.html.ep b/templates/main/upload_users.html.ep index fbb81a09f..9a5ac4196 100644 --- a/templates/main/upload_users.html.ep +++ b/templates/main/upload_users.html.ep @@ -28,7 +28,7 @@ novalidate >
- + + "> + +
{{node.name}} @@ -54,8 +57,7 @@
<%=l 'Node down' %>
<%=l 'Node disabled' %>
-
<%=l 'This base has clones' %>
-
<%=l 'This node has' %> {{ showmachine.clones[node.id].length }} <%=l 'clones' %>
+
<%=l 'This node has' %> {{ showmachine.clones[node.id].length }} <%=l 'clones' %>
diff --git a/templates/main/vm_hostdev.html.ep b/templates/main/vm_hostdev.html.ep index f5622ce0d..566f9e347 100644 --- a/templates/main/vm_hostdev.html.ep +++ b/templates/main/vm_hostdev.html.ep @@ -39,6 +39,6 @@
Manage Host Devices + href="/admin/hostdev/{{showmachine.type}}"><%=l 'Manage Host Devices' %> %= include "/main/pending_request" diff --git a/templates/ng-templates/list_next_bookings_today.html.ep b/templates/ng-templates/list_next_bookings_today.html.ep index 04fb9805c..dfadd5f92 100644 --- a/templates/ng-templates/list_next_bookings_today.html.ep +++ b/templates/ng-templates/list_next_bookings_today.html.ep @@ -4,8 +4,8 @@

<%=l 'Today Schedule' %>

- <%=l 'This server has reservations for today. Machines from users out of - the booking list will be shutdown.' %> + <%=l 'This server has reservations for today.' %> + <%=l 'Machines from users out of the booking list will be shutdown.' %>