Francois Gouget : testbot/web: Allow administrators to retrieve the Engine log.
Alexandre Julliard
julliard at winehq.org
Wed Nov 22 14:08:25 CST 2017
Module: tools
Branch: master
Commit: c5db3541484dfc7716c6c9614605fdb69e804a50
URL: http://source.winehq.org/git/tools.git/?a=commit;h=c5db3541484dfc7716c6c9614605fdb69e804a50
Author: Francois Gouget <fgouget at 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 at codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard at 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);
- at EXPORT = qw(&LogMsg &Time &Elapsed);
+ at 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;
+
+ at 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;
More information about the wine-cvs
mailing list