Module: tools
Branch: master
Commit: b5cfda0874e819f1565da2daaac621f21f16767b
URL: https://source.winehq.org/git/tools.git/?a=commit;h=b5cfda0874e819f1565da2d…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Tue Apr 5 14:21:03 2022 +0200
testbot: Use MakeOfficialURL() in non-CGI scripts.
Non-CGI scripts should not have $HTTP_HOST anyway so this is the same as
MakeSecureURL().
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/bin/WineRunBuild.pl | 2 +-
testbot/bin/WineRunReconfig.pl | 8 ++++----
testbot/bin/WineRunTask.pl | 4 ++--
testbot/bin/WineRunWineTest.pl | 4 ++--
testbot/bin/WineSendLog.pl | 4 ++--
testbot/lib/WineTestBot/Users.pm | 8 ++++----
6 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/testbot/bin/WineRunBuild.pl b/testbot/bin/WineRunBuild.pl
index 1bddc04..7e8fced 100755
--- a/testbot/bin/WineRunBuild.pl
+++ b/testbot/bin/WineRunBuild.pl
@@ -334,7 +334,7 @@ if (!$Domain->IsPoweredOn())
NotifyAdministrator("Putting the ". $VM->Name ." VM offline",
"The ". $VM->Name ." VM should have been powered on to run the task\n".
"below but its state was ". $Domain->GetStateDescription() ." instead.\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
"So the VM has been put offline and the TestBot will try to regain\n".
"access to it.");
WrapUpAndExit('queued', undef, undef, 'boterror vm off');
diff --git a/testbot/bin/WineRunReconfig.pl b/testbot/bin/WineRunReconfig.pl
index 9f71ff4..5b6d7df 100755
--- a/testbot/bin/WineRunReconfig.pl
+++ b/testbot/bin/WineRunReconfig.pl
@@ -336,7 +336,7 @@ if (!$Domain->IsPoweredOn())
NotifyAdministrator("Putting the ". $VM->Name ." VM offline",
"The ". $VM->Name ." VM should have been powered on to run the task\n".
"below but its state was ". $Domain->GetStateDescription() ." instead.\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
"So the VM has been put offline and the TestBot will try to regain\n".
"access to it.");
WrapUpAndExit('queued', undef, undef, 'boterror vm off');
@@ -432,7 +432,7 @@ if ($TA->GetFile("Reconfig.log", "$TaskDir/task.log"))
NotifyAdministrator("The ". $VM->Name ." build failed",
"The ". $VM->Name ." build failed and $Status\n\n".
"See the link below for more details:\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
$NewStatus = "badbuild";
}
my $LogErrMsg = CreateLogErrorsCache($LogInfo);
@@ -546,7 +546,7 @@ if ($NewStatus eq 'completed')
"Could not recreate the $IdleSnapshot snapshot:\n\n".
"$ErrMessage\n\n".
"See the link below for more details:\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
FatalError("Could not recreate the $IdleSnapshot snapshot: $ErrMessage\n");
}
@@ -562,7 +562,7 @@ if ($NewStatus eq 'completed')
." after its update:\n\n".
"$ErrMessage\n\n".
"See the link below for more details:\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n");
}
else
{
diff --git a/testbot/bin/WineRunTask.pl b/testbot/bin/WineRunTask.pl
index 017e8c4..0641bb5 100755
--- a/testbot/bin/WineRunTask.pl
+++ b/testbot/bin/WineRunTask.pl
@@ -386,7 +386,7 @@ if (!$Domain->IsPoweredOn())
NotifyAdministrator("Putting the ". $VM->Name ." VM offline",
"The ". $VM->Name ." VM should have been powered on to run the task\n".
"below but its state was ". $Domain->GetStateDescription() ." instead.\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
"So the VM has been put offline and the TestBot will try to regain\n".
"access to it.");
WrapUpAndExit('queued', undef, undef, undef, 'boterror vm off');
@@ -466,7 +466,7 @@ elsif ($Step->Type eq "suite")
if (defined($WebHostName))
{
my $URL = GetTaskURL($JobId, $StepNo, $TaskNo, 1);
- $Script .= "-u ". BatchQuote(MakeSecureURL($URL)) ." ";
+ $Script .= "-u ". BatchQuote(MakeOfficialURL($URL)) ." ";
}
my $Tag = $VM->Type ne "win64" ? "" : $Step->FileType eq "exe64" ? "64" : "32";
$Tag = BuildTag($VM->Name, $Tag);
diff --git a/testbot/bin/WineRunWineTest.pl b/testbot/bin/WineRunWineTest.pl
index 3526719..62a7fc5 100755
--- a/testbot/bin/WineRunWineTest.pl
+++ b/testbot/bin/WineRunWineTest.pl
@@ -383,7 +383,7 @@ if (!$Domain->IsPoweredOn())
NotifyAdministrator("Putting the ". $VM->Name ." VM offline",
"The ". $VM->Name ." VM should have been powered on to run the task\n".
"below but its state was ". $Domain->GetStateDescription() ." instead.\n".
- MakeSecureURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
+ MakeOfficialURL(GetTaskURL($JobId, $StepNo, $TaskNo)) ."\n\n".
"So the VM has been put offline and the TestBot will try to regain\n".
"access to it.");
WrapUpAndExit('queued', undef, undef, 'boterror vm off');
@@ -437,7 +437,7 @@ if ($Step->Type eq "suite")
if (defined $WebHostName)
{
my $URL = GetTaskURL($JobId, $StepNo, $TaskNo, 1);
- $Script .= "-u ". ShQuote(MakeSecureURL($URL)) ." ";
+ $Script .= "-u ". ShQuote(MakeOfficialURL($URL)) ." ";
}
my $Info = $VM->Description ? $VM->Description : "";
if ($VM->Details)
diff --git a/testbot/bin/WineSendLog.pl b/testbot/bin/WineSendLog.pl
index 65c95de..954edae 100755
--- a/testbot/bin/WineSendLog.pl
+++ b/testbot/bin/WineSendLog.pl
@@ -48,6 +48,7 @@ use WineTestBot::Jobs;
use WineTestBot::Log;
use WineTestBot::LogUtils;
use WineTestBot::StepsTasks;
+use WineTestBot::Utils;
my $PART_BOUNDARY = "==13F70BD1-BA1B-449A-9CCB-B6A8E90CED47==";
@@ -184,8 +185,7 @@ sub SendLog($)
my $StepsTasks = CreateStepsTasks(undef, $Job);
my @SortedKeys = sort { $a <=> $b } @{$StepsTasks->GetKeys()};
- my $JobURL = ($UseSSL ? "https://" : "http://") .
- "$WebHostName/JobDetails.pl?Key=". $Job->GetKey();
+ my $JobURL = MakeOfficialURL("/JobDetails.pl?Key=". $Job->GetKey());
#
diff --git a/testbot/lib/WineTestBot/Users.pm b/testbot/lib/WineTestBot/Users.pm
index 772a2b7..bd9cf35 100644
--- a/testbot/lib/WineTestBot/Users.pm
+++ b/testbot/lib/WineTestBot/Users.pm
@@ -138,8 +138,8 @@ sub Approve($)
return $ErrMessage;
}
- my $URL = MakeSecureURL("/ResetPassword.pl?Name=" . uri_escape($self->Name) .
- "&ResetCode=" . uri_escape($self->ResetCode));
+ my $URL = MakeOfficialURL("/ResetPassword.pl?Name=". uri_escape($self->Name)
+ ."&ResetCode=". uri_escape($self->ResetCode));
my $Recipient = $self->GetEMailRecipient();
open (SENDMAIL, "|/usr/sbin/sendmail -oi -t -odq");
print SENDMAIL <<"EOF";
@@ -177,8 +177,8 @@ sub SendResetCode($)
return $ErrMessage;
}
- my $URL = MakeSecureURL("/ResetPassword.pl?Name=" . uri_escape($self->Name) .
- "&ResetCode=" . uri_escape($self->ResetCode));
+ my $URL = MakeOfficialURL("/ResetPassword.pl?Name=". uri_escape($self->Name)
+ ."&ResetCode=". uri_escape($self->ResetCode));
my $UserName = $self->Name;
my $Recipient = $self->GetEMailRecipient();
open (SENDMAIL, "|/usr/sbin/sendmail -oi -t -odq");
Module: tools
Branch: master
Commit: 5d1dd2ee9e47c211eec016d0154ee4eb4a627030
URL: https://source.winehq.org/git/tools.git/?a=commit;h=5d1dd2ee9e47c211eec016d…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Tue Apr 5 14:20:59 2022 +0200
testbot/web: Add MakeOfficialURL() for sending URLs to third-parties.
It should be used whenever sending a URL to a third-party.
Also document SecureConnection() and MakeSecureURL().
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/lib/WineTestBot/Utils.pm | 38 +++++++++++++++++++++++++++++++++++---
testbot/web/Register.pl | 5 ++---
2 files changed, 37 insertions(+), 6 deletions(-)
diff --git a/testbot/lib/WineTestBot/Utils.pm b/testbot/lib/WineTestBot/Utils.pm
index 13529c3..bc501ff 100644
--- a/testbot/lib/WineTestBot/Utils.pm
+++ b/testbot/lib/WineTestBot/Utils.pm
@@ -27,7 +27,8 @@ WineTestBot::Utils - Utility functions
=cut
use Exporter 'import';
-our @EXPORT = qw(SecureConnection MakeSecureURL GetTaskURL GenerateRandomString
+our @EXPORT = qw(SecureConnection MakeSecureURL MakeOfficialURL GetTaskURL
+ GenerateRandomString
OpenNewFile CreateNewFile CreateNewLink CreateNewDir GetMTime
DurationToString BuildEMailRecipient IsValidFileName
BuildTag SanitizeTag LocaleName NotifyAdministrator
@@ -50,7 +51,8 @@ use WineTestBot::Config;
Returns true if the user accessed the website over a secure connection.
-This relies on the web server setting the $HTTPS environment variable.
+This relies on the web server setting the $HTTPS environment variable for CGI
+scripts.
=back
=cut
@@ -69,12 +71,16 @@ Builds a URL that accesses this website using https if possible.
The parameter should be an absolute path that includes neither the protocol
nor the hostname.
-Note that this method uses $HTTP_HOST which may not match the official website
+This relies on the web server setting the $HTTP_HOST environment variable for
+CGI scripts. However $HTTP_HOST which may not match the official website
hostname. As such this should only be used for providing URLs back to the user
accessing the website, not for URLs sent to third-parties.
+See also MakeOfficialURL().
+
=back
=cut
+
sub MakeSecureURL($)
{
my ($URL) = @_;
@@ -83,6 +89,32 @@ sub MakeSecureURL($)
return $Protocol . ($ENV{"HTTP_HOST"} || $WebHostName) . $URL;
}
+=pod
+=over 12
+
+=item C<MakeOfficialURL()>
+
+Creates a URL pointing to the official website.
+The parameter should be an absolute path that includes neither the protocol
+nor the hostname.
+
+This is the method to use in non-CGI scripts and to build URLs sent to any
+third-party (e.g. via email); where a third party is any user other than the
+one currently browsing the website.
+
+See also MakeSecureURL().
+
+=back
+=cut
+
+sub MakeOfficialURL($)
+{
+ my ($URL) = @_;
+
+ my $Protocol = $UseSSL ? "https://" : "http://";
+ return "$Protocol$WebHostName$URL";
+}
+
sub GetTaskURL($$$;$$)
{
my ($JobId, $StepNo, $TaskNo, $ShowScreenshot, $LogName) = @_;
diff --git a/testbot/web/Register.pl b/testbot/web/Register.pl
index bbea0eb..b10be75 100644
--- a/testbot/web/Register.pl
+++ b/testbot/web/Register.pl
@@ -139,9 +139,8 @@ sub OnSendRequest($)
{
$Msg .= "Remarks:\n" . $self->GetParam("Remarks") . "\n";
}
- my $URL = ($UseSSL ? "https://" : "http://") . $WebHostName .
- "/admin/UserDetails.pl?Key=" . uri_escape($self->GetParam("Name"));
- $Msg .= "\nTo approve or deny the request, please go to " . $URL;
+ my $URL = MakeOfficialURL("/admin/UserDetails.pl?Key=". uri_escape($self->GetParam("Name")));
+ $Msg .= "\nTo approve or deny the request, please go to $URL";
NotifyAdministrator("winetestbot account request", $Msg);
return 1;
Module: tools
Branch: master
Commit: 69fe9a569f7eb9c313e82bc61ce5370a8b4d85f3
URL: https://source.winehq.org/git/tools.git/?a=commit;h=69fe9a569f7eb9c313e82bc…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Tue Apr 5 14:20:41 2022 +0200
testbot/cgi: Let FormPage operate in read-only mode.
The FormPage is in read-write mode by default as this is the most common
case, but calling SetReadWrite(0) puts it in read-only mode where it
shows the field values but does not allow modifying them.
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/lib/ObjectModel/CGI/FormPage.pm | 27 +++++++++++++++++++++++++--
1 file changed, 25 insertions(+), 2 deletions(-)
diff --git a/testbot/lib/ObjectModel/CGI/FormPage.pm b/testbot/lib/ObjectModel/CGI/FormPage.pm
index dfcd55e..c6a8c6b 100644
--- a/testbot/lib/ObjectModel/CGI/FormPage.pm
+++ b/testbot/lib/ObjectModel/CGI/FormPage.pm
@@ -70,6 +70,8 @@ properties that the form should show or allow editing, as specified by
DisplayProperty(). It may be undefined if determining the property list is
delegated to GetPropertyDescriptors().
+By default the form allows modifying the field values.
+
See also Page::new().
=back
@@ -82,11 +84,30 @@ sub _initialize($$$$)
$self->SUPER::_initialize($Request, $RequiredRole);
$self->{PropertyDescriptors} = $PropertyDescriptors;
+ $self->{RW} = 1;
$self->{HasRequired} = !1;
$self->{ActionPerformed} = !1;
$self->{Method} = "post";
}
+=pod
+=over 12
+
+=item C<SetReadWrite()>
+
+If set to true, the form allows editing the fields.
+Otherwise it only shows their values.
+
+=back
+=cut
+
+sub SetReadWrite($$)
+{
+ my ($self, $RW) = @_;
+
+ $self->{RW} = $RW;
+}
+
#
# Property handling
@@ -167,10 +188,12 @@ sub DisplayProperty($$)
# type the appropriate key value would also be cumbersome so this is
# currently not supported. But they can be displayed.
$PropertyDescriptor->GetClass() eq "Itemref" ? "ro" :
- # All other properties can be edited...
+ # All other properties can displayed,
+ !$self->{RW} ? "ro" :
+ # and even edited if in read-write mode...
$PropertyDescriptor->GetClass() ne "Basic" ? "rw" :
$PropertyDescriptor->GetType() ne "S" ? "rw" :
- # ...except autoincrement ones (shown as <unset> if undefined)
+ # ...except autoincrement ones
"ro";
}
Module: tools
Branch: master
Commit: 29cc30ec1abcfd5df03351f2a7cd06800018c578
URL: https://source.winehq.org/git/tools.git/?a=commit;h=29cc30ec1abcfd5df03351f…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Tue Apr 5 14:20:33 2022 +0200
testbot: Add Collection::GetSortedItems().
This provides a default comparison function for items, letting them
override it as appropriate for subclasses.
Collection::GetSortedItems() then returns the collection's items sorted
according to that order.
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/lib/ObjectModel/Collection.pm | 22 ++++++++++++++
testbot/lib/ObjectModel/Item.pm | 53 ++++++++++++++++++++++++++++++++++
testbot/lib/WineTestBot/Patches.pm | 10 +++----
testbot/lib/WineTestBot/SpecialJobs.pm | 15 ++--------
testbot/lib/WineTestBot/VMs.pm | 12 ++++++++
5 files changed, 94 insertions(+), 18 deletions(-)
diff --git a/testbot/lib/ObjectModel/Collection.pm b/testbot/lib/ObjectModel/Collection.pm
index dd0be12..93a4502 100644
--- a/testbot/lib/ObjectModel/Collection.pm
+++ b/testbot/lib/ObjectModel/Collection.pm
@@ -395,6 +395,28 @@ sub GetItems($)
=pod
=over 12
+=item C<GetSortedItems()>
+
+Returns all the Item objects present in the Collection in the order defined
+by the Item's Compare() method.
+
+See also GetItems() for the exact set of items being returned.
+
+=back
+=cut
+
+sub GetSortedItems($$)
+{
+ my ($self, $Items) = @_;
+
+ $self->Load() if (!$self->{Loaded});
+ my @SortedItems = sort { $a->Compare($b) } values %{$self->{Items}};
+ return \@SortedItems;
+}
+
+=pod
+=over 12
+
=item C<GetItemsCount()>
Returns how many Items are present in the Collection.
diff --git a/testbot/lib/ObjectModel/Item.pm b/testbot/lib/ObjectModel/Item.pm
index fb125f0..9cec7b4 100644
--- a/testbot/lib/ObjectModel/Item.pm
+++ b/testbot/lib/ObjectModel/Item.pm
@@ -363,6 +363,59 @@ sub GetKey($)
return $Key;
}
+=pod
+=over 12
+
+=item C<Compare()>
+
+$A->Compare($B) return a negative, zero or positive value depending on whether
+$A is less than, equal to, or greater than $B respectively.
+
+Neither object can be undefined, and both must be of the same type.
+
+The comparison is based on the Item's key fields which are compared in their
+order in the property descriptors list, and based on their types (so numeric
+comparison for numeric values, and alphabetical otherwise).
+
+Note that the comparison is not particularly optimised so if it is called
+many times it would probably be more efficient to redefine it.
+
+=back
+=cut
+
+sub Compare($$)
+{
+ my ($self, $B) = @_;
+
+ foreach my $PropertyDescriptor (@{$self->{PropertyDescriptors}})
+ {
+ next if (!$PropertyDescriptor->GetIsKey());
+
+ my $ColNames = $PropertyDescriptor->GetColNames();
+ if ($PropertyDescriptor->GetClass() eq "Basic")
+ {
+ my $ColName = $ColNames->[0];
+ my $ColType = $PropertyDescriptor->GetType();
+ return ($ColType eq "N" or $ColType eq "S" or $ColType eq "DT") ?
+ $self->{ColValues}{$ColName} <=> $B->{ColValues}{$ColName} :
+ $self->{ColValues}{$ColName} cmp $B->{ColValues}{$ColName};
+ }
+ if ($PropertyDescriptor->GetClass() eq "Enum")
+ {
+ my $ColName = $ColNames->[0];
+ return $self->{ColValues}{$ColName} cmp $B->{ColValues}{$ColName};
+ }
+
+ # A Detailref cannot be a key so this is an Itemref
+ foreach my $ColName (@$ColNames)
+ {
+ my $Cmp = $self->{ColValues}{$ColName} cmp $B->{ColValues}{$ColName};
+ return $Cmp if ($Cmp);
+ }
+ }
+ return 0;
+}
+
sub GetFullKey($)
{
my ($self) = @_;
diff --git a/testbot/lib/WineTestBot/Patches.pm b/testbot/lib/WineTestBot/Patches.pm
index cc0fbe9..6891fa5 100644
--- a/testbot/lib/WineTestBot/Patches.pm
+++ b/testbot/lib/WineTestBot/Patches.pm
@@ -268,12 +268,11 @@ sub Submit($$;$)
my $WinVMs = CreateVMs();
$WinVMs->AddFilter("Type", $Bits eq "32" ? ["win32", "win64"] : ["win64"]);
$WinVMs->AddFilter("Role", ["base"]);
- my $SortedKeys = $WinVMs->SortKeysBySortOrder($WinVMs->GetKeys());
+ my $SortedVMs = $WinVMs->GetSortedItems();
my $Tasks;
- foreach my $VMKey (@$SortedKeys)
+ foreach my $VM (@$SortedVMs)
{
- my $VM = $WinVMs->GetItem($VMKey);
my ($ErrMessage, $Missions) = ParseMissionStatement($VM->Missions);
next if (defined $ErrMessage);
@@ -338,12 +337,11 @@ sub Submit($$;$)
my $WineVMs = CreateVMs();
$WineVMs->AddFilter("Type", ["wine"]);
$WineVMs->AddFilter("Role", ["base"]);
- my $SortedKeys = $WineVMs->SortKeysBySortOrder($WineVMs->GetKeys());
+ my $SortedVMs = $WineVMs->GetSortedItems();
my $Tasks;
- foreach my $VMKey (@$SortedKeys)
+ foreach my $VM (@$SortedVMs)
{
- my $VM = $WineVMs->GetItem($VMKey);
my ($ErrMessage, $Missions) = ParseMissionStatement($VM->Missions);
next if (defined $ErrMessage);
diff --git a/testbot/lib/WineTestBot/SpecialJobs.pm b/testbot/lib/WineTestBot/SpecialJobs.pm
index 360e1ff..e8677ec 100644
--- a/testbot/lib/WineTestBot/SpecialJobs.pm
+++ b/testbot/lib/WineTestBot/SpecialJobs.pm
@@ -54,10 +54,7 @@ sub GetReconfigVMs($$)
$VMs->AddFilter("Name", [$VMKey]) if (defined $VMKey);
$VMs->AddFilter("Type", [$VMType]);
$VMs->FilterEnabledRole();
-
- my $SortedKeys = $VMs->SortKeysBySortOrder($VMs->GetKeys());
- my @SortedVMs = map { $VMs->GetItem($_) } @$SortedKeys;
- return \@SortedVMs;
+ return $VMs->GetSortedItems();
}
sub AddReconfigJob($$$)
@@ -132,10 +129,7 @@ sub GetWindowsTestVMs($$$)
{
$VMs->FilterEnabledRole();
}
-
- my $SortedKeys = $VMs->SortKeysBySortOrder($VMs->GetKeys());
- my @SortedVMs = map { $VMs->GetItem($_) } @$SortedKeys;
- return \@SortedVMs;
+ return $VMs->GetSortedItems();
}
sub AddWindowsTestJob($$$$$)
@@ -219,10 +213,7 @@ sub GetWineTestVMs($)
$VMs->AddFilter("Name", [$VMKey]) if (defined $VMKey);
$VMs->AddFilter("Type", ["wine"]);
$VMs->FilterEnabledRole();
-
- my $SortedKeys = $VMs->SortKeysBySortOrder($VMs->GetKeys());
- my @SortedVMs = map { $VMs->GetItem($_) } @$SortedKeys;
- return \@SortedVMs;
+ return $VMs->GetSortedItems();
}
sub AddWineTestJob($$)
diff --git a/testbot/lib/WineTestBot/VMs.pm b/testbot/lib/WineTestBot/VMs.pm
index 65f6333..ee0c1be 100644
--- a/testbot/lib/WineTestBot/VMs.pm
+++ b/testbot/lib/WineTestBot/VMs.pm
@@ -177,6 +177,18 @@ sub InitializeNew($$)
$self->SUPER::InitializeNew($Collection);
}
+sub Compare($$)
+{
+ my ($self, $B) = @_;
+
+ # Sort retired and deleted VMs last
+ my %RoleOrders = ("retired" => 1, "deleted" => 2);
+
+ return ($RoleOrders{$self->Role} || 0) <=> ($RoleOrders{$B->Role} || 0) ||
+ $self->SortOrder <=> $B->SortOrder ||
+ $self->Name <=> $B->Name;
+}
+
sub HasEnabledRole($)
{
my ($self) = @_;