Module: tools
Branch: master
Commit: c5db3541484dfc7716c6c9614605fdb69e804a50
URL: http://source.winehq.org/git/tools.git/?a=commit;h=c5db3541484dfc7716c6c961…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Wed Nov 22 16:36:43 2017 +0100
testbot/web: Allow administrators to retrieve the Engine log.
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/lib/WineTestBot/CGI/PageBase.pm | 3 +
testbot/lib/WineTestBot/Log.pm | 8 +-
testbot/web/admin/Log.pl | 103 +++++++++++++++++++
testbot/web/admin/SendLog.pl | 173 ++++++++++++++++++++++++++++++++
4 files changed, 286 insertions(+), 1 deletion(-)
diff --git a/testbot/lib/WineTestBot/CGI/PageBase.pm b/testbot/lib/WineTestBot/CGI/PageBase.pm
index 04759ca..4ae190e 100644
--- a/testbot/lib/WineTestBot/CGI/PageBase.pm
+++ b/testbot/lib/WineTestBot/CGI/PageBase.pm
@@ -298,6 +298,9 @@ EOF
print " <li class='divider'> </li>\n";
print " <li><p><a href='", MakeSecureURL("/admin/BranchesList.pl"),
"'>Branches</a></p></li>\n";
+ print " <li class='divider'> </li>\n";
+ print " <li><p><a href='", MakeSecureURL("/admin/Log.pl"),
+ "'>Engine Log</a></p></li>\n";
print " <li class='bot'> </li>\n";
}
diff --git a/testbot/lib/WineTestBot/Log.pm b/testbot/lib/WineTestBot/Log.pm
index 7abf2cb..f1499dd 100644
--- a/testbot/lib/WineTestBot/Log.pm
+++ b/testbot/lib/WineTestBot/Log.pm
@@ -31,7 +31,7 @@ use vars qw (@ISA @EXPORT);
require Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(&LogMsg &Time &Elapsed);
+@EXPORT = qw(&LogMsg &OpenLog &Time &Elapsed);
my $logfile;
my $logprefix;
@@ -58,6 +58,12 @@ sub LogMsg(@)
print $logfile scalar localtime, " ", $logprefix, "[$$]: ", @_ if ($logfile);
}
+sub OpenLog()
+{
+ my $Handle;
+ return open($Handle, "<", "$LogDir/log") ? $Handle : undef;
+}
+
=pod
=over 12
diff --git a/testbot/web/admin/Log.pl b/testbot/web/admin/Log.pl
new file mode 100644
index 0000000..b9754bd
--- /dev/null
+++ b/testbot/web/admin/Log.pl
@@ -0,0 +1,103 @@
+# -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# Let the administrator download an excerpt of the Engine log
+#
+# Copyright 2017 Francois Gouget
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+
+use strict;
+
+package LogPage;
+
+use ObjectModel::BasicPropertyDescriptor;
+use ObjectModel::CGI::FreeFormPage;
+use WineTestBot::Config;
+use WineTestBot::Log;
+
+@LogPage::ISA = qw(ObjectModel::CGI::FreeFormPage);
+
+sub _initialize($$$)
+{
+ my ($self, $Request, $RequiredRole) = @_;
+
+ my @PropertyDescriptors = (
+ CreateBasicPropertyDescriptor("Hours", "Hours", !1, !1, "N", 2),
+ );
+ $self->SUPER::_initialize($Request, $RequiredRole, \@PropertyDescriptors);
+}
+
+sub GetPropertyValue($$)
+{
+ my ($self, $PropertyDescriptor) = @_;
+
+ my $PropertyName = $PropertyDescriptor->GetName();
+ return 1 if ($PropertyName eq "Hours"); # Provides a default value
+
+ return $self->SUPER::GetPropertyValue($PropertyDescriptor);
+}
+
+sub GetHeaderText($)
+{
+ #my ($self) = @_;
+ return "Specify how many hours of log messages to get.";
+}
+
+sub GetActions($)
+{
+ my ($self) = @_;
+
+ my $Actions = $self->SUPER::GetActions();
+ push(@$Actions, "Download");
+
+ return $Actions;
+}
+
+sub OnDownload($)
+{
+ my ($self) = @_;
+ $self->Redirect("/admin/SendLog.pl?Hours=". $self->GetParam("Hours")); # does not return
+ exit;
+}
+
+sub OnAction($$)
+{
+ my ($self, $Action) = @_;
+
+ return $self->OnDownload() if ($Action eq "Download");
+ return $self->SUPER::OnAction($Action);
+}
+
+sub GenerateBody($)
+{
+ my ($self) = @_;
+
+ my $Log = OpenLog();
+ if (defined $Log)
+ {
+ my $Size = (stat($Log))[7];
+ $Size = int($Size / 1024 / 1024);
+ print "<div class='Content'><p>Log size: $Size MB</p></div>\n\n";
+ close($Log);
+ }
+ $self->SUPER::GenerateBody();
+}
+
+
+package main;
+
+my $Request = shift;
+
+my $LogPage = LogPage->new($Request, "admin");
+$LogPage->GeneratePage();
diff --git a/testbot/web/admin/SendLog.pl b/testbot/web/admin/SendLog.pl
new file mode 100644
index 0000000..7044c33
--- /dev/null
+++ b/testbot/web/admin/SendLog.pl
@@ -0,0 +1,173 @@
+# -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# Sends an excerpt of the TestBot Engine log
+#
+# Copyright 2017 Francois Gouget
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+
+use strict;
+
+use HTTP::Date;
+
+use Apache2::Const -compile => qw(REDIRECT);
+use CGI;
+use CGI::Cookie;
+use URI::Escape;
+use WineTestBot::Config;
+use WineTestBot::CGI::Sessions;
+use WineTestBot::Log;
+
+
+sub GetStartPosition($$)
+{
+ my ($Log, $Hours) = @_;
+
+ # The log file can be pretty long so do a binary search to figure out where
+ # the oldest log line less than $Hours old is.
+ my $Cutoff = time() - 3600 * $Hours;
+ my $Size = (stat($Log))[7];
+ my ($Min, $Max) = (0, $Size);
+ while ($Min < $Max)
+ {
+ my $Middle = int(($Min + $Max) / 2);
+ seek($Log, $Middle, 0);
+
+ # Ignore the first line which we assume is going to be incomplete (even
+ # if by chance it start with a timestamp there is no way to know if that
+ # timestamp is at the beginning of the line). Also adjust $Middle so it
+ # always points to the start of a line.
+ my $Line = <$Log>;
+ $Middle += length($Line);
+ if ($Middle >= $Size)
+ {
+ # There is no line less than $Hours old so it would make sense to
+ # return $Size. But instead return $Min so the administrator at
+ # least sees the last line.
+ return ($Min, 0);
+ }
+ if ($Middle >= $Max)
+ {
+ # There is only one line between $Min and $Max. Determine whether to
+ # include it or not.
+ $Middle = $Min;
+ seek($Log, $Middle, 0);
+ }
+ my $Current = $Middle;
+ while ($Line = <$Log>)
+ {
+ # Note that the log file may have lines with no timestamp
+ if ($Line =~ /^(\w{3} \w{3} [0-9 ]\d \d{2}:\d{2}:\d{2} \d{4}) /)
+ {
+ my $Time = str2time($1);
+ if ($Time < $Cutoff)
+ {
+ # This line is too old
+ $Current += length($Line);
+ if ($Current >= $Size)
+ {
+ # See the $Middle == $Size comment. Note that this may return more
+ # than one line.
+ return ($Min, 0);
+ }
+ $Min = $Current;
+ }
+ else
+ {
+ # Consider that lines with no timestamp are less than $Hours old too
+ $Max = $Middle;
+ }
+ last;
+ }
+ $Current += length($Line);
+ if ($Current >= $Max)
+ {
+ # Consider that lines with no timestamp are less than $Hours old too
+ $Max = $Middle;
+ last;
+ }
+ }
+ return $Min if (!defined $Line);
+ }
+ return ($Min, 1);
+}
+
+sub PrintLog($)
+{
+ my ($Request) = @_;
+
+ my $CGIObj = CGI->new($Request);
+ my $Hours = $CGIObj->param("Hours");
+ if (!defined $Hours or $Hours !~ /^(\d\d?)$/)
+ {
+ $Request->headers_out->set("Location", "/");
+ $Request->status(Apache2::Const::REDIRECT);
+ exit;
+ }
+ $Hours = $1;
+
+ # Text file
+ $Request->content_type("text/plain");
+
+ my $Log = OpenLog();
+ if (defined $Log)
+ {
+ binmode($Log);
+ if ($Hours > 0)
+ {
+ my ($Position, $Found) = GetStartPosition($Log, $Hours);
+ if (!$Found)
+ {
+ print "There is no log entry less than $Hours hour(s) old.\n";
+ print "Here are the last few lines:\n";
+ }
+ seek($Log, $Position, 0);
+ }
+
+ binmode(STDOUT);
+ while (1)
+ {
+ my $Block;
+ my $Len = sysread($Log, $Block, 16384);
+ last if (!$Len);
+ print $Block;
+ }
+ close($Log);
+ }
+ else
+ {
+ print "Could not open the log file!\n";
+ }
+}
+
+my $Request = shift;
+
+my %Cookies = CGI::Cookie->fetch($Request);
+my $IsAdmin;
+if (defined $Cookies{"SessionId"})
+{
+ my $Session = CreateSessions()->GetItem($Cookies{"SessionId"}->value);
+ $IsAdmin = $Session->User->HasRole("admin") if ($Session);
+
+}
+if (!$IsAdmin)
+{
+ $Request->headers_out->set("Location", "/Login.pl?Target=" . uri_escape($ENV{"REQUEST_URI"}));
+ $Request->status(Apache2::Const::REDIRECT);
+ exit;
+}
+
+PrintLog($Request);
+
+exit;
Module: tools
Branch: master
Commit: 14de13e34f5b8f4fe7201e2501372bed0be9c7ba
URL: http://source.winehq.org/git/tools.git/?a=commit;h=14de13e34f5b8f4fe7201e25…
Author: Francois Gouget <fgouget(a)codeweavers.com>
Date: Wed Nov 22 11:24:33 2017 +0100
testbot: Always create the Task directory even if there is nothing to stage.
Otherwise the Engine will have nowhere to put the error log when forking
the Task's child process. This particularly impacts the Reconfig Tasks
since they neither have a patch nor executable to stage.
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard(a)winehq.org>
---
testbot/lib/WineTestBot/Steps.pm | 11 ++++-------
1 file changed, 4 insertions(+), 7 deletions(-)
diff --git a/testbot/lib/WineTestBot/Steps.pm b/testbot/lib/WineTestBot/Steps.pm
index 8c5d4ec..95c0a45 100644
--- a/testbot/lib/WineTestBot/Steps.pm
+++ b/testbot/lib/WineTestBot/Steps.pm
@@ -87,10 +87,9 @@ sub HandleStaging($$)
{
my ($self) = @_;
- if (! $self->InStaging)
- {
- return undef;
- }
+ # Always at least create the step's directory
+ my $StepDir = $self->CreateDir();
+ return undef if (! $self->InStaging);
my $FileName = $self->FileName;
if ($FileName !~ m/^[0-9a-z-]+_(.*)$/)
@@ -99,9 +98,7 @@ sub HandleStaging($$)
}
my $BaseName = $1;
my $StagingFileName = "$DataDir/staging/$FileName";
- my $StepDir = $self->CreateDir();
- my $FinalFileName = "$StepDir/$BaseName";
- if (!move($StagingFileName, $FinalFileName))
+ if (!move($StagingFileName, "$StepDir/$BaseName"))
{
return "Could not move the staging file: $!";
}