Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Ravada-Mirror
Commits
5cb32ec2
Commit
5cb32ec2
authored
Nov 28, 2016
by
Francesc Guasch
Browse files
[#67] first step to remove id_base after prepare base
parent
143d07a4
Changes
2
Hide whitespace changes
Inline
Side-by-side
lib/Ravada/Domain.pm
View file @
5cb32ec2
...
...
@@ -92,18 +92,8 @@ before 'remove' => \&_allow_remove;
after
'
remove
'
=>
\
&_after_remove_domain
;
before
'
prepare_base
'
=>
\
&_allow_prepare_base
;
after
'
prepare_base
'
=>
sub
{
my
$self
=
shift
;
my
(
$user
)
=
@_
;
$self
->
is_base
(
1
);
if
(
$self
->
{
_was_active
}
)
{
$self
->
resume
(
$user
);
}
delete
$self
->
{
_was_active
};
};
after
'
prepare_base
'
=>
\
&_post_prepare_base
;
before
'
start
'
=>
\
&_start_preconditions
;
after
'
start
'
=>
\
&_post_start
;
...
...
@@ -189,6 +179,21 @@ sub _allow_prepare_base {
}
};
sub
_post_prepare_base
{
my
$self
=
shift
;
my
(
$user
)
=
@_
;
$self
->
is_base
(
1
);
if
(
$self
->
{
_was_active
}
)
{
$self
->
resume
(
$user
);
}
delete
$self
->
{
_was_active
};
$self
->
_remove_id_base
();
};
sub
_check_has_clones
{
my
$self
=
shift
;
return
if
!
$self
->
is_known
();
...
...
@@ -440,6 +445,18 @@ sub _remove_files_base {
}
sub
_remove_id_base
{
my
$self
=
shift
;
my
$sth
=
$$CONNECTOR
->
dbh
->
prepare
(
"
UPDATE domains set id_base=NULL
"
.
"
WHERE id=?
"
);
$sth
->
execute
(
$self
->
id
);
$sth
->
finish
;
}
=head2 is_base
Returns true or false if the domain is a prepared base
=cut
...
...
t/vm/95_spinoff.t
View file @
5cb32ec2
use
warnings
;
use
strict
;
use
Carp
qw(confess)
;
use
Data::
Dumper
;
use
Test::
More
;
use
Test::SQL::
Data
;
...
...
@@ -62,10 +63,20 @@ sub test_create_domain {
return
$domain
;
}
sub
test_clone
{
my
(
$vm_name
,
$domain
)
=
@_
;
my
$clone
=
$domain
->
clone
(
name
=>
new_domain_name
(),
user
=>
$USER
);
ok
(
$clone
);
return
$clone
;
}
sub
test_files_base
{
my
$domain
=
shift
;
my
$n_expected
=
shift
;
my
(
$domain
,
$n_expected
)
=
@_
;
confess
("
Expecting a domain , got
"
.
Dumper
(
\
@
_
))
if
!
ref
$domain
;
my
@files
=
$domain
->
list_files_base
();
ok
(
scalar
@files
==
$n_expected
,"
Expecting
$n_expected
files base , got
"
...
...
@@ -91,72 +102,7 @@ sub test_prepare_base {
test_files_base
(
$domain
,
1
);
my
@disk
=
$domain
->
disk_device
();
$domain
->
shutdown
(
user
=>
$USER
);
touch_mtime
(
@disk
);
eval
{
$domain
->
prepare_base
(
$USER
)
};
ok
(
!
$@
,"
Trying to prepare base again failed, it should have worked.
");
ok
(
$domain
->
is_base
);
my
$name_clone
=
new_domain_name
();
my
$domain_clone
;
eval
{
$domain_clone
=
$RVD_BACK
->
create_domain
(
name
=>
$name_clone
,
id_owner
=>
$USER
->
id
,
id_base
=>
$domain
->
id
,
vm
=>
$vm_name
);
};
ok
(
!
$@
,"
Clone domain, expecting error='' , got='
"
.
(
$@
or
'')
.
"
'
")
or
exit
;
ok
(
$domain_clone
,"
Trying to clone from
"
.
$domain
->
name
.
"
to
$name_clone
");
test_devices_clone
(
$vm_name
,
$domain_clone
);
test_display
(
$vm_name
,
$domain_clone
);
ok
(
$domain_clone
->
id_base
&&
$domain_clone
->
id_base
==
$domain
->
id
,"
[
$vm_name
] Expecting id_base=
"
.
$domain
->
id
.
"
got
"
.
(
$domain_clone
->
id_base
or
'
<UNDEF>
'))
or
exit
;
my
$domain_clone2
=
$RVD_FRONT
->
search_clone
(
id_base
=>
$domain
->
id
,
id_owner
=>
$USER
->
id
);
ok
(
$domain_clone2
,"
Searching for clone id_base=
"
.
$domain
->
id
.
"
user=
"
.
$USER
->
id
.
"
expecting domain , got nothing
"
.
"
"
.
Dumper
(
$domain
))
or
exit
;
if
(
$domain_clone2
)
{
ok
(
$domain_clone2
->
name
eq
$domain_clone
->
name
,"
Expecting clone name
"
.
$domain_clone
->
name
.
"
, got:
"
.
$domain_clone2
->
name
);
ok
(
$domain_clone2
->
id
eq
$domain_clone
->
id
,"
Expecting clone id
"
.
$domain_clone
->
id
.
"
, got:
"
.
$domain_clone2
->
id
);
}
touch_mtime
(
@disk
);
eval
{
$domain
->
prepare_base
(
$USER
)
};
ok
(
$@
&&
$@
=~
/has \d+ clones/i
,"
[
$vm_name
] Don't prepare if there are clones
"
.
(
$@
or
'
<UNDEF>
'));
ok
(
$domain
->
is_base
);
$domain_clone
->
remove
(
$USER
);
touch_mtime
(
@disk
);
eval
{
$domain
->
prepare_base
(
$USER
)
};
ok
(
!
$@
,"
[
$vm_name
] Error preparing base after clone removed :'
"
.
(
$@
or
'')
.
"
'
");
ok
(
$domain
->
is_base
,"
[
$vm_name
] Expecting domain is_base=1 , got :
"
.
$domain
->
is_base
);
$domain
->
is_base
(
0
);
ok
(
!
$domain
->
is_base
,"
[
$vm_name
] Expecting domain is_base=0 , got :
"
.
$domain
->
is_base
);
$domain
->
is_base
(
1
);
ok
(
$domain
->
is_base
,"
[
$vm_name
] Expecting domain is_base=1 , got :
"
.
$domain
->
is_base
);
is
(
$domain
->
id_base
,
undef
);
}
sub
test_remove_base
{
...
...
@@ -176,6 +122,23 @@ sub test_remove_base {
for
my
$file
(
@files
)
{
ok
(
!-
e
$file
,"
Expecting file base '
$file
' removed
"
);
}
my
$vm
=
rvd_back
->
search_vm
(
$vm_name
);
my
$domain_clone2
=
$vm
->
search_domain
(
$domain_clone
->
name
);
ok
(
$domain_clone2
,"
Expecting clone still there
");
}
sub
test_remove_domain
{
my
$vm_name
=
shift
;
my
$domain
=
shift
;
my
$domain_clone
=
shift
;
$domain
->
remove
(
$USER
);
my
$vm
=
rvd_back
->
search_vm
(
$vm_name
);
my
$domain2
=
$vm
->
search_domain
(
$domain
->
name
);
ok
(
!
$domain2
,"
Expecting no domain after remove
");
}
#######################################################################33
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment