Francois Gouget : testbot/VMs: Fix the VM deletion.
Alexandre Julliard
julliard at winehq.org
Tue Oct 23 13:42:46 CDT 2012
Module: tools
Branch: master
Commit: 3da43ab5d8e49989bd60b178199337a59b8f22af
URL: http://source.winehq.org/git/tools.git/?a=commit;h=3da43ab5d8e49989bd60b178199337a59b8f22af
Author: Francois Gouget <fgouget at codeweavers.com>
Date: Tue Oct 23 18:58:40 2012 +0200
testbot/VMs: Fix the VM deletion.
VMs cannot be deleted directly because the Tasks hold references to
them. So mark VMs as deleted and let the Janitor.pl script delete them
when no Task references them anymore.
---
testbot/bin/Janitor.pl | 45 ++++++++++++++++++++++++++++++++++++++++
testbot/ddl/update18.sql | 4 +++
testbot/ddl/winetestbot.sql | 2 +-
testbot/lib/WineTestBot/VMs.pm | 14 +++++++++--
testbot/web/Submit.pl | 2 +-
testbot/web/admin/VMsList.pl | 15 +++++++++++++
6 files changed, 77 insertions(+), 5 deletions(-)
diff --git a/testbot/bin/Janitor.pl b/testbot/bin/Janitor.pl
index 033bd5d..5f3a992 100755
--- a/testbot/bin/Janitor.pl
+++ b/testbot/bin/Janitor.pl
@@ -34,10 +34,13 @@ use WineTestBot::Jobs;
use WineTestBot::Log;
use WineTestBot::Patches;
use WineTestBot::PendingPatchSets;
+use WineTestBot::VMs;
+
$ENV{PATH} = "/usr/bin:/bin";
delete $ENV{ENV};
+# Delete obsolete Jobs
if ($WineTestBot::Config::JobPurgeDays != 0)
{
my $DeleteBefore = time() - $WineTestBot::Config::JobPurgeDays * 86400;
@@ -59,6 +62,7 @@ if ($WineTestBot::Config::JobPurgeDays != 0)
$Jobs = undef;
}
+# Delete PatchSets that are more than a day old
my $DeleteBefore = time() - 1 * 86400;
my $Sets = WineTestBot::PendingPatchSets::CreatePendingPatchSets();
foreach my $SetKey (@{$Sets->GetKeys()})
@@ -85,6 +89,7 @@ foreach my $SetKey (@{$Sets->GetKeys()})
}
}
+# Delete obsolete Patches now that no Job references them
if ($WineTestBot::Config::JobPurgeDays != 0)
{
$DeleteBefore = time() - $WineTestBot::Config::JobPurgeDays * 86400;
@@ -111,6 +116,7 @@ if ($WineTestBot::Config::JobPurgeDays != 0)
$Patches = undef;
}
+# Archive old Jobs, that is remove all their associated files
if ($WineTestBot::Config::JobArchiveDays != 0)
{
my $ArchiveBefore = time() - $WineTestBot::Config::JobArchiveDays * 86400;
@@ -137,3 +143,42 @@ if ($WineTestBot::Config::JobArchiveDays != 0)
}
$Jobs = undef;
}
+
+# Purge deleted VMs if they are not referenced anymore
+my $VMs = CreateVMs();
+$VMs->AddFilter("Role", ["deleted"]);
+my %DeleteList;
+map { $DeleteList{$_} = 1 } @{$VMs->GetKeys()};
+
+if (%DeleteList)
+{
+ my $Jobs = CreateJobs();
+ foreach my $JobKey (@{$Jobs->GetKeys()})
+ {
+ my $Job = $Jobs->GetItem($JobKey);
+ my $Steps = $Job->Steps;
+ foreach my $StepKey (@{$Steps->GetKeys()})
+ {
+ my $Step = $Steps->GetItem($StepKey);
+ my $Tasks = $Step->Tasks;
+ foreach my $TaskKey (@{$Tasks->GetKeys()})
+ {
+ my $Task = $Tasks->GetItem($TaskKey);
+ if (exists $DeleteList{$Task->VM->Name})
+ {
+ LogMsg "Janitor: keeping the ", $Task->VM->Name, " VM for task (", join(":", $JobKey, $StepKey, $TaskKey), ")\n";
+ delete $DeleteList{$Task->VM->Name};
+ }
+ }
+ }
+ }
+ foreach my $VMKey (keys %DeleteList)
+ {
+ my $VM = $VMs->GetItem($VMKey);
+ my $ErrMessage = $VMs->DeleteItem($VM);
+ if (!defined $ErrMessage)
+ {
+ LogMsg "Janitor: deleted the ", $VM->Name, " VM\n";
+ }
+ }
+}
diff --git a/testbot/ddl/update18.sql b/testbot/ddl/update18.sql
new file mode 100644
index 0000000..9299d61
--- /dev/null
+++ b/testbot/ddl/update18.sql
@@ -0,0 +1,4 @@
+USE winetestbot;
+
+ALTER TABLE VMs
+ MODIFY Role ENUM('extra', 'base', 'winetest', 'retired', 'deleted') NOT NULL;
diff --git a/testbot/ddl/winetestbot.sql b/testbot/ddl/winetestbot.sql
index b0a4f02..75e3318 100644
--- a/testbot/ddl/winetestbot.sql
+++ b/testbot/ddl/winetestbot.sql
@@ -47,7 +47,7 @@ CREATE TABLE VMs
Name VARCHAR(20) NOT NULL,
SortOrder INT(3) NOT NULL,
Type ENUM('win32', 'win64', 'build') NOT NULL,
- Role ENUM('extra', 'base', 'winetest', 'retired') NOT NULL,
+ Role ENUM('extra', 'base', 'winetest', 'retired', 'deleted') NOT NULL,
Status ENUM('dirty', 'reverting', 'sleeping', 'idle', 'running', 'offline') NOT NULL,
VirtURI VARCHAR(64) NOT NULL,
VirtDomain VARCHAR(32) NOT NULL,
diff --git a/testbot/lib/WineTestBot/VMs.pm b/testbot/lib/WineTestBot/VMs.pm
index 45ff555..2b4786e 100644
--- a/testbot/lib/WineTestBot/VMs.pm
+++ b/testbot/lib/WineTestBot/VMs.pm
@@ -532,7 +532,7 @@ BEGIN
CreateBasicPropertyDescriptor("Name", "VM name", 1, 1, "A", 20),
CreateBasicPropertyDescriptor("SortOrder", "Display order", !1, 1, "N", 3),
CreateEnumPropertyDescriptor("Type", "Type of VM", !1, 1, ['win32', 'win64', 'build']),
- CreateEnumPropertyDescriptor("Role", "VM Role", !1, 1, ['extra', 'base', 'winetest', 'retired']),
+ CreateEnumPropertyDescriptor("Role", "VM Role", !1, 1, ['extra', 'base', 'winetest', 'retired', 'deleted']),
CreateEnumPropertyDescriptor("Status", "Current status", !1, 1, ['dirty', 'reverting', 'sleeping', 'idle', 'running', 'offline']),
CreateBasicPropertyDescriptor("VirtURI", "LibVirt URI of the VM", !1, 1, "A", 64),
CreateBasicPropertyDescriptor("VirtDomain", "LibVirt Domain for the VM", !1, 1, "A", 32),
@@ -609,10 +609,18 @@ sub SortKeysBySortOrder
my %SortOrder;
foreach my $Key (@$Keys)
{
- $SortOrder{$Key} = $self->GetItem($Key)->SortOrder;
+ my $Item = $self->GetItem($Key);
+ $SortOrder{$Key} = [$Item->Role, $Item->SortOrder];
}
- my @SortedKeys = sort { $SortOrder{$a} <=> $SortOrder{$b} } @$Keys;
+ my @SortedKeys = sort {
+ my ($soa, $sob) = ($SortOrder{$a}, $SortOrder{$b});
+ # Sort deleted VMs last
+ return 1 if (@$soa[0] eq "deleted");
+ return -1 if (@$sob[0] eq "deleted");
+ # Otherwise follow the SortOrder key
+ return @$soa[1] <=> @$sob[1];
+ } @$Keys;
return \@SortedKeys;
}
diff --git a/testbot/web/Submit.pl b/testbot/web/Submit.pl
index 7d44903..d8b222d 100644
--- a/testbot/web/Submit.pl
+++ b/testbot/web/Submit.pl
@@ -242,7 +242,7 @@ sub GenerateFields
$VMs->AddFilter("Status", ["reverting", "sleeping", "idle", "running", "dirty"]);
if ($self->{ShowAll})
{
- # All but the retired ones
+ # All but the retired and deleted ones
$VMs->AddFilter("Role", ["base", "winetest", "extra"]);
}
else
diff --git a/testbot/web/admin/VMsList.pl b/testbot/web/admin/VMsList.pl
index c148582..0e6d133 100644
--- a/testbot/web/admin/VMsList.pl
+++ b/testbot/web/admin/VMsList.pl
@@ -54,6 +54,21 @@ sub SortKeys
return $self->{Collection}->SortKeysBySortOrder($Keys);
}
+sub OnItemAction
+{
+ my $self = shift;
+ my ($CollectionBlock, $Item, $Action) = @_;
+
+ if ($Action eq "Delete")
+ {
+ $Item->Role("deleted");
+ my ($ErrKey, $ErrProperty, $ErrMessage) = $self->{Collection}->Save();
+ return ! defined($ErrMessage);
+ }
+
+ return $self->SUPER::OnItemAction(@_);
+}
+
package main;
my $Request = shift;
More information about the wine-cvs
mailing list