github.com/containers/libpod@v1.9.4-0.20220419124438-4284fd425507/contrib/cirrus/logformatter (about)

     1  #!/usr/bin/perl
     2  #
     3  # logformatter - highlight a Cirrus test log (ginkgo or bats)
     4  #
     5  # Adapted from https://raw.githubusercontent.com/edsantiago/greasemonkey/podman-ginkgo-highlight
     6  #
     7  package LibPod::CI::LogFormatter;
     8  
     9  use v5.14;
    10  use utf8;
    11  
    12  # Grumble. CI system doesn't have 'open'
    13  binmode STDIN,  ':utf8';
    14  binmode STDOUT, ':utf8';
    15  
    16  use strict;
    17  use warnings;
    18  
    19  (our $ME = $0) =~ s|.*/||;
    20  
    21  our $VERSION = '0.1';
    22  
    23  # For debugging, show data structures using DumpTree($var)
    24  #use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
    25  
    26  ###############################################################################
    27  # BEGIN user-customizable section
    28  
    29  # Stylesheet for highlighting or de-highlighting parts of lines
    30  our $CSS = <<'END_CSS';
    31  /* wrap long lines - don't require user to scroll right */
    32  pre        { line-break: normal; overflow-wrap: normal; white-space: pre-wrap; }
    33  
    34  .boring    { color: #999; }
    35  .timestamp { color: #999; }
    36  .log-debug { color: #999; }
    37  .log-info  { color: #333; }
    38  .log-warn  { color: #f60; }
    39  .log-error { color: #900; font-weight: bold; }
    40  .subtest   { background: #eee; }
    41  .subsubtest { color: #F39; font-weight: bold; }
    42  .string    { color: #00c; }
    43  .command   { font-weight: bold; color: #000; }
    44  .changed   { color: #000; font-weight: bold; }
    45  
    46  /* links to source files: not as prominent as links to errors */
    47  a.codelink:link    { color: #000; }
    48  a.codelink:visited { color: #666; }
    49  a.codelink:hover   { background: #000; color: #999; }
    50  
    51  /* The timing tests at bottom: remove underline, it's too cluttery. */
    52  a.timing           { text-decoration: none; }
    53  
    54  /* BATS styles */
    55  .bats-ok        { color: #393; }
    56  .bats-notok     { color: #F00; font-weight: bold; }
    57  .bats-skip      { color: #F90; }
    58  .bats-log       { color: #900; }
    59  .bats-log-esm   { color: #b00; font-weight: bold; }
    60  
    61  /* error titles: display next to timestamp, not on separate line */
    62  h2 { display: inline; }
    63  END_CSS
    64  
    65  # END   user-customizable section
    66  ###############################################################################
    67  
    68  ###############################################################################
    69  # BEGIN boilerplate args checking, usage messages
    70  
    71  sub usage {
    72      print  <<"END_USAGE";
    73  Usage: $ME [OPTIONS] TEST_NAME
    74  
    75  $ME is a filter; it HTMLifies an input stream (presumably
    76  Ginkgo or BATS log results), writing HTML results to an output file
    77  but passing stdin unmodified to stdout. It is intended to run in
    78  the Cirrus CI environment.
    79  
    80  Parameters:
    81  
    82      TEST_NAME   descriptive name; output file will be TEST_NAME.log.html
    83  
    84  OPTIONS:
    85  
    86    --help         display this message
    87    --man          display program man page
    88    --version      display program name and version
    89  END_USAGE
    90  
    91      exit;
    92  }
    93  
    94  # Command-line options.  Note that this operates directly on @ARGV !
    95  our $debug   = 0;
    96  our $force   = 0;
    97  our $verbose = 0;
    98  our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
    99  sub handle_opts {
   100      use Getopt::Long;
   101      GetOptions(
   102          'debug!'     => \$debug,
   103          'dry-run|n!' => sub { $NOT = ' [NOT]' },
   104          'force'      => \$force,
   105          'verbose|v'  => \$verbose,
   106  
   107          help         => \&usage,
   108          version      => sub { print "$ME version $VERSION\n"; exit 0 },
   109      ) or die "Try `$ME --help' for help\n";
   110  }
   111  
   112  # END   boilerplate args checking, usage messages
   113  ###############################################################################
   114  
   115  ############################## CODE BEGINS HERE ###############################
   116  
   117  # The term is "modulino".
   118  __PACKAGE__->main()                                     unless caller();
   119  
   120  # Main code.
   121  sub main {
   122      # Note that we operate directly on @ARGV, not on function parameters.
   123      # This is deliberate: it's because Getopt::Long only operates on @ARGV
   124      # and there's no clean way to make it use @_.
   125      handle_opts();                      # will set package globals
   126  
   127      # In case someone is tempted to run us on the command line
   128      die "$ME: this is a filter, not an interactive script\n" if -t *STDIN;
   129  
   130      # Fetch command-line arguments.  Barf if too many.
   131      my $test_name = shift(@ARGV)
   132          or die "$ME: missing TEST_NAME argument; try $ME --help\n";
   133      warn "$ME: Too many arguments; ignoring extras. try $ME --help\n" if @ARGV;
   134  
   135      format_log($test_name);
   136  }
   137  
   138  
   139  sub format_log {
   140      my $test_name = shift;              # in: e.g. 'integration_test'
   141  
   142      my $outfile = "$test_name.log.html";
   143      my $out_tmp = "$outfile.tmp.$$";
   144      open my $out_fh, '>:utf8', $out_tmp
   145          or warn "$ME: Cannot create $out_tmp: $!\n";
   146  
   147      # Boilerplate: HTML headers for output file
   148      print { $out_fh } <<"END_HTML"      if $out_fh;
   149  <?xml version="1.0" encoding="utf-8"?>
   150  <!DOCTYPE html
   151          PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
   152           "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
   153  <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
   154  <head>
   155  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
   156  <title>$test_name</title>
   157  <style type="text/css">
   158  $CSS
   159  </style>
   160  
   161  <!-- on page load, go to bottom: that's where the error summary is -->
   162  <script language="javascript">
   163  function scrollToBottom() {
   164      if (window.scrollY < 10) {
   165          window.scrollTo(0, document.body.scrollHeight);
   166      }
   167  }
   168  window.addEventListener("load", scrollToBottom, false);
   169  </script>
   170  </head>
   171  <body>
   172  <pre>
   173  END_HTML
   174  
   175      # State variables
   176      my $previous_timestamp = '';  # timestamp of previous line
   177      my $cirrus_task;              # Cirrus task number, used for linking
   178      my $git_commit;               # git SHA, used for linking to source files
   179      my $in_failure;               # binary flag: are we in an error dump?
   180      my $in_timing;                # binary flag: are we in the timing section?
   181      my $after_divider = 0;        # Count of lines after seeing '-----'
   182      my $current_output;           # for removing duplication
   183      my $looks_like_bats;          # binary flag: for detecting BATS results
   184  
   185      # Main loop: read input, one line at a time, and write out reformatted
   186    LINE:
   187      while (my $line = <STDIN>) {
   188          print $line;                    # Immediately dump back to stdout
   189  
   190          # Remain robust in face of errors: always write stdout even if no HTML
   191          next LINE if ! $out_fh;
   192  
   193          chomp $line;
   194          $line =~ s/\0//g;               # Some log files have NULs????
   195          $line = escapeHTML($line);
   196  
   197          # Temporarily strip off leading timestamp
   198          $line =~ s/^(\[\+\d+s\]\s)//;
   199          my $timestamp = $1 || '';
   200          if ($previous_timestamp && $timestamp eq $previous_timestamp) {
   201              $timestamp = ' ' x length($timestamp);
   202          }
   203          elsif ($timestamp) {
   204              $previous_timestamp = $timestamp;
   205          }
   206  
   207          # Try to identify the git commit we're working with...
   208          if ($line =~ m!libpod/define.gitCommit=([0-9a-f]+)!) {
   209              $git_commit = $1;
   210          }
   211          # ...so we can link to specific lines in source files
   212          if ($git_commit) {
   213              #           1  12  3                  34     4 5   526  6
   214              $line =~ s{^(.*)(\/(containers\/libpod)(\/\S+):(\d+))(.*)$}
   215                        {$1<a class="codelink" href='https://github.com/$3/blob/$git_commit$4#L$5'>$2</a>$6};
   216          }
   217  
   218          # Try to identify the cirrus task
   219          if ($line =~ /cirrus-task-(\d+)/) {
   220              $cirrus_task = $1;
   221          }
   222  
   223          # BATS handling (used also for apiv2 tests, which emit TAP output)
   224          if ($line =~ /^1\.\.\d+$/ || $line =~ m!/test-apiv2!) {
   225              $looks_like_bats = 1;
   226          }
   227          if ($looks_like_bats) {
   228              my $css;
   229  
   230              if    ($line =~ /^ok\s.*\s# skip/) { $css = 'skip'    }
   231              elsif ($line =~ /^ok\s/)           { $css = 'ok'      }
   232              elsif ($line =~ /^not\s+ok\s/)     { $css = 'notok'   }
   233              elsif ($line =~ /^#\s#\|\s/)       { $css = 'log-esm' }
   234              elsif ($line =~ /^#\s/)            { $css = 'log'     }
   235  
   236              if ($css) {
   237                  # Make it linkable, e.g. foo.html#t--00001
   238                  if ($line =~ /^(not\s+)?ok\s+(\d+)/) {
   239                      $line = sprintf("<a name='t--%05d'>%s</a>", $2, $line);
   240                  }
   241                  $line = "<span class='bats-$css'>$line</span>";
   242              }
   243  
   244              print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   245                  if $timestamp;
   246              print { $out_fh } $line, "\n";
   247              next LINE;
   248          }
   249  
   250          # Timing section at the bottom of the page
   251          if ($line =~ / timing results\s*$/) {
   252              $in_timing = 1;
   253          }
   254          elsif ($in_timing) {
   255              if ($line =~ /^(\S.*\S)\s+(\d+\.\d+)\s*$/) {
   256                  my ($name, $time) = ($1, $2);
   257                  my $id = make_id($1, 'timing');
   258  
   259                  # Try to column-align the timing numbers. Some test names
   260                  # will be longer than our max - oh well.
   261                  my $spaces = 80 - length(unescapeHTML($name));
   262                  $spaces = 1 if $spaces < 1;
   263                  $spaces++ if $time < 10;
   264                  my $spacing = ' ' x $spaces;
   265                  $line = qq{<a class="timing" href="#t--$id">$name</a>$spacing$time};
   266              }
   267              else {
   268                  $in_timing = 0;
   269              }
   270          }
   271  
   272          #
   273          # Ginkgo error reformatting
   274          #
   275          if ($line =~ /^.{1,4} (Failure|Panic)( in .*)? \[/) {
   276              # Begins a block of multiple lines including a stack trace
   277              print { $out_fh } "<div class='log-error'>\n";
   278              $in_failure = 1;
   279          }
   280          elsif ($line =~ /^-----------/) {
   281              if ($in_failure) {
   282                  # Ends a stack trace block
   283                  $in_failure = 0;
   284                  print { $out_fh } "</div>\n";
   285              }
   286              $after_divider = 1;
   287  
   288              print { $out_fh } "</pre>\n<hr />\n<pre>\n";
   289              # Always show timestamp at start of each new test
   290              $previous_timestamp = '';
   291              next LINE;
   292          }
   293          # (bindings test sometimes emits 'Running' with leading bullet char)
   294          elsif ($line =~ /^•?Running:/) {
   295              # Highlight the important (non-boilerplate) podman command.
   296              # Strip out the global podman options, but show them on hover
   297              $line =~ s{(\S+\/podman)((\s+--(root|runroot|runtime|tmpdir|storage-opt|conmon|cgroup-manager|cni-config-dir|storage-driver|events-backend) \S+)*)(.*)}{
   298                  my ($full_path, $options, $args) = ($1, $2, $5);
   299  
   300                  $options =~ s/^\s+//;
   301                  # Separate each '--foo bar' with newlines for readability
   302                  $options =~ s/ --/\n--/g;
   303                  qq{<span title="$full_path"><b>podman</b></span> <span class=\"boring\" title=\"$options\">[options]</span><b>$args</b>};
   304              }e;
   305              $current_output = '';
   306          }
   307          # Grrr. 'output:' usually just tells us what we already know.
   308          elsif ($line =~ /^output:/) {
   309              $current_output =~ s!^\s+|\s+$!!g;  # Trim leading/trailing blanks
   310              $current_output =~ s/\s+/ /g;       # Collapse multiple spaces
   311              if ($line eq "output: $current_output" || $line eq 'output: ') {
   312                  next LINE;
   313              }
   314          }
   315          elsif ($line =~ /^Error:/ || $line =~ / level=(warning|error) /) {
   316              $line = "<span class='log-warn'>" . $line . "</span>";
   317          }
   318          elsif ($line =~ /^panic:/) {
   319              $line = "<span class='log-error'>" . $line . "</span>";
   320          }
   321          else {
   322              $current_output .= ' ' . $line;
   323          }
   324  
   325  
   326          # Two lines after each divider, there's a test name. Make it
   327          # an anchor so we can link to it later.
   328          if ($after_divider++ == 2) {
   329              # Sigh. There is no actual marker. Assume that anything with
   330              ## two leading spaces then alpha (not slashes) is a test name.
   331              if ($line =~ /^  [a-zA-Z]/) {
   332                  my $id = make_id($line, 'anchor');
   333  
   334                  $line = "<a name='t--$id'><h2>$line</h2></a>";
   335              }
   336          }
   337  
   338          # Failure name corresponds to a previously-seen block.
   339          ## FIXME: sometimes there are three failures with the same name.
   340          ##        ...I have no idea why or how to link to the right ones.
   341          #              1  2           2        3             3   14          4
   342          if ($line =~ /^(\[(Fail|Panic!)\] .* \[(It|BeforeEach)\] )([A-Za-z].*)/) {
   343              my ($lhs, $type, $ginkgo_fluff, $testname) = ($1, $2, $3, $4);
   344              my $id = make_id($testname, 'link');
   345  
   346              $line = "<b>$lhs<a href='#t--$id'>$testname</a></b>";
   347          }
   348  
   349          print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   350              if $timestamp;
   351          print { $out_fh } $line, "\n";
   352      }
   353  
   354      my $have_formatted_log;     # Set on success
   355  
   356      if ($out_fh) {
   357          print { $out_fh } "</pre>\n";
   358  
   359          # Did we find a cirrus task? Link back.
   360          if ($cirrus_task) {
   361              print { $out_fh } <<"END_HTML";
   362  <hr />
   363  <h3>Cirrus <a href="https://cirrus-ci.com/task/$cirrus_task">task $cirrus_task</a></h3>
   364  END_HTML
   365          }
   366  
   367          # FIXME: need a safe way to get TZ
   368          printf { $out_fh } <<"END_HTML", scalar(CORE::localtime);
   369  <hr />
   370  <small>Processed %s by $ME v$VERSION</small>
   371  </body>
   372  </html>
   373  END_HTML
   374  
   375          if (close $out_fh) {
   376              if (rename $out_tmp => $outfile) {
   377                  $have_formatted_log = 1;
   378              }
   379              else {
   380                  warn "$ME: Could not rename $out_tmp: $!\n";
   381              }
   382          }
   383          else {
   384              warn "$ME: Error writing $out_tmp: $!\n";
   385          }
   386      }
   387  
   388      # FIXME: if Cirrus magic envariables are available, write a link to results
   389      if ($have_formatted_log && $ENV{CIRRUS_TASK_ID}) {
   390          my $URL_BASE          = "https://storage.googleapis.com";
   391          my $STATIC_MAGIC_BLOB = "cirrus-ci-5385732420009984-fcae48";
   392          my $ARTIFACT_NAME     = "html";
   393  
   394          my $URL = "${URL_BASE}/${STATIC_MAGIC_BLOB}/artifacts/$ENV{CIRRUS_REPO_FULL_NAME}/$ENV{CIRRUS_TASK_ID}/${ARTIFACT_NAME}/${outfile}";
   395  
   396          print "\n\nAnnotated results:\n  $URL\n";
   397      }
   398  }
   399  
   400  
   401  #############
   402  #  make_id  #  Given a test name, generate an anchor link name
   403  #############
   404  sub make_id {
   405      my $name = shift;                   # in: test title
   406      my $type = shift;                   # in: differentiator (anchor, link)
   407  
   408      state %counter;
   409  
   410      $name =~ s/^\s+|\s+$//g;            # strip leading/trailing whitespace
   411      $name =~ s/[^a-zA-Z0-9_-]/-/g;      # Convert non-alphanumeric to dash
   412  
   413      # Keep a running tally of how many times we've seen this identifier
   414      # for this given type! This lets us cross-match, in the bottom of
   415      # the page, the first/second/third failure of a given test.
   416      $name .= "--" . ++$counter{$type}{$name};
   417  
   418      $name;
   419  }
   420  
   421  
   422  
   423  sub escapeHTML {
   424      my $s = shift;
   425  
   426      state %chars;
   427      %chars = ('&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&#39;')
   428          if keys(%chars) == 0;
   429      my $class = join('', sort keys %chars);
   430      $s =~ s/([$class])/$chars{$1}/ge;
   431  
   432      return $s;
   433  }
   434  
   435  sub unescapeHTML {
   436      my $s = shift;
   437  
   438      # We don't actually care about the character, only its length
   439      $s =~ s/\&\#?[a-z0-9]+;/./g;
   440  
   441      return $s;
   442  }
   443  
   444  
   445  1;