Francois Gouget : testbot/web: Allow administrators to retrieve the Engine log.

[Alexandre Julliard]

Module: tools
Branch: master
Commit: c5db3541484dfc7716c6c9614605fdb69e804a50
URL:    http://source.winehq.org/git/tools.git/?a=commit;h=c5db3541484dfc7716c6c9614...

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);
-(a)EXPORT = qw(&LogMsg &Time &Elapsed);
+(a)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;
+
+(a)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;