Module: tools Branch: master Commit: c5db3541484dfc7716c6c9614605fdb69e804a50 URL: http://source.winehq.org/git/tools.git/?a=commit;h=c5db3541484dfc7716c6c9614...
Author: Francois Gouget fgouget@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@codeweavers.com Signed-off-by: Alexandre Julliard julliard@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;