github.com/containers/podman/v4@v4.9.4/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  binmode STDERR, ':utf8';
    16  
    17  use strict;
    18  use warnings;
    19  
    20  (our $ME = $0) =~ s|.*/||;
    21  
    22  our $VERSION = '0.3';
    23  
    24  # Autoflush stdout
    25  $| = 1;
    26  
    27  # For debugging, show data structures using DumpTree($var)
    28  #use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
    29  
    30  ###############################################################################
    31  # BEGIN user-customizable section
    32  
    33  # Stylesheet for highlighting or de-highlighting parts of lines
    34  our $CSS = <<'END_CSS';
    35  /* wrap long lines - don't require user to scroll right */
    36  pre        { line-break: normal; overflow-wrap: normal; white-space: pre-wrap; }
    37  
    38  /* synopsis table at top */
    39  table.synopsis { border: none; border-collapse: collapse; margin-left: 2em; margin-top: 2ex; }
    40  .synopsis th   { font-weight: normal; font-size: 110%; text-align: right; }
    41  .synopsis td   { font-weight: bold;   font-size: 120%; font-family: monospace; }
    42  
    43  /* test results */
    44  .testname     { font-size: 125%; color: #444; }
    45  .boring       { color: #999; }
    46  .timestamp    { color: #999; }
    47  .log-debug    { color: #999; }
    48  .log-info     { color: #333; }
    49  .log-warning  { color: #f60; }
    50  .log-error    { background: #fee; color: #900; font-weight: bold; }
    51  .error-retry  { color: #c33; font-size: 125%; font-weight: bold; border-top: 1px solid #f00; }
    52  .log-passed   { color: #393; }
    53  .log-failed   { color: #F00; font-weight: bold; font-size: 150%; }
    54  .log-skipped  { color: #F90; }
    55  .log-flakey   { background: #f93; font-weight: bold; font-size: 150%; }
    56  .log-slow     { background: #FF0; color: #000; font-weight: bold; }
    57  .subtest      { background: #eee; }
    58  .subsubtest   { color: #F39; font-weight: bold; }
    59  .string       { color: #00c; }
    60  .command      { font-weight: bold; color: #000; }
    61  .changed      { color: #000; font-weight: bold; }
    62  
    63  /* Ginkgo "Enter/Exit [foo]": visually separate from each other */
    64  .ginkgo-timeline   { margin-top: 1ex; margin-bottom: 1ex; }
    65  
    66  /* BeforeEach and AfterEach tend to be boring. Gray them out. */
    67  .ginkgo-beforeeach { background: #f0f0f0; color: #999; }
    68  .ginkgo-aftereach  { background: #f0f0f0; color: #999; }
    69  .ginkgo-beforeeach b { color: #000; }
    70  .ginkgo-aftereach  b { color: #000; }
    71  
    72  /* [It] is where the test happens but we don't need any special highlights */
    73  .ginkgo-it           { }
    74  
    75  /* Final summary line at bottom */
    76  .ginkgo-final-success { background: #393; font-weight: bold; font-size: 150%; }
    77  .ginkgo-final-fail    { background: #f00; font-weight: bold; font-size: 150%; }
    78  
    79  /* links to source files: not as prominent as links to errors */
    80  a.codelink:link    { color: #000; }
    81  a.codelink:visited { color: #666; }
    82  a.codelink:hover   { background: #000; color: #999; }
    83  
    84  /* The timing tests at bottom: remove underline, it's too cluttery. */
    85  a.timing           { text-decoration: none; }
    86  .timing:hover      { background: #FF9; }  /* highlight row for easy reading */
    87  
    88  /* BATS styles */
    89  .bats-passed    { color: #393; }
    90  .bats-failed    { color: #F00; font-weight: bold; }
    91  .bats-flaked    { color: #F93; font-weight: bold; }
    92  .bats-skipped   { color: #F90; }
    93  .bats-log       { color: #933; }
    94  .bats-log-failblock { color: #b00; background-color: #fee; display: inline-flex; margin: 0 -500%; padding: 0 500% !important; }
    95  
    96  .bats-summary   { font-size: 150%; }
    97  
    98  /* error titles: display next to timestamp, not on separate line */
    99  h2,h3 { display: inline; }
   100  END_CSS
   101  
   102  # END   user-customizable section
   103  ###############################################################################
   104  
   105  ###############################################################################
   106  # BEGIN boilerplate args checking, usage messages
   107  
   108  sub usage {
   109      print  <<"END_USAGE";
   110  Usage: $ME [OPTIONS] TEST_NAME
   111  
   112  $ME is a filter; it HTMLifies an input stream (presumably
   113  Ginkgo or BATS log results), writing HTML results to an output file
   114  but passing stdin unmodified to stdout. It is intended to run in
   115  the Cirrus CI environment.
   116  
   117  Parameters:
   118  
   119      TEST_NAME   descriptive name; output file will be TEST_NAME.log.html
   120  
   121  OPTIONS:
   122  
   123    --help         display this message
   124    --man          display program man page
   125    --version      display program name and version
   126  END_USAGE
   127  
   128      exit;
   129  }
   130  
   131  # Command-line options.  Note that this operates directly on @ARGV !
   132  our $debug   = 0;
   133  our $force   = 0;
   134  our $verbose = 0;
   135  our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
   136  sub handle_opts {
   137      use Getopt::Long;
   138      GetOptions(
   139          'debug!'     => \$debug,
   140          'dry-run|n!' => sub { $NOT = ' [NOT]' },
   141          'force'      => \$force,
   142          'verbose|v'  => \$verbose,
   143  
   144          help         => \&usage,
   145          version      => sub { print "$ME version $VERSION\n"; exit 0 },
   146      ) or die "Try `$ME --help' for help\n";
   147  }
   148  
   149  # END   boilerplate args checking, usage messages
   150  ###############################################################################
   151  
   152  ############################## CODE BEGINS HERE ###############################
   153  
   154  # The term is "modulino".
   155  __PACKAGE__->main()                                     unless caller();
   156  
   157  # Main code.
   158  sub main {
   159      # Note that we operate directly on @ARGV, not on function parameters.
   160      # This is deliberate: it's because Getopt::Long only operates on @ARGV
   161      # and there's no clean way to make it use @_.
   162      handle_opts();                      # will set package globals
   163  
   164      # In case someone is tempted to run us on the command line
   165      die "$ME: this is a filter, not an interactive script\n" if -t *STDIN;
   166  
   167      # Fetch command-line arguments.  Barf if too many.
   168      my $test_name = shift(@ARGV)
   169          or die "$ME: missing TEST_NAME argument; try $ME --help\n";
   170      warn "$ME: Too many arguments; ignoring extras. try $ME --help\n" if @ARGV;
   171  
   172      format_log($test_name);
   173  }
   174  
   175  
   176  sub format_log {
   177      my $test_name = shift;              # in: e.g. 'integration_test'
   178  
   179      my $outfile = "$test_name.log.html";
   180      my $out_tmp = "$outfile.tmp.$$";
   181      open my $out_fh, '>:utf8', $out_tmp
   182          or warn "$ME: Cannot create $out_tmp: $!\n";
   183  
   184      # Boilerplate: HTML headers for output file
   185      print { $out_fh } <<"END_HTML"      if $out_fh;
   186  <?xml version="1.0" encoding="utf-8"?>
   187  <!DOCTYPE html
   188          PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
   189           "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
   190  <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
   191  <head>
   192  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
   193  <title>$test_name</title>
   194  <style type="text/css">
   195  $CSS
   196  </style>
   197  
   198  <!-- on page load, go to bottom: that's where the error summary is -->
   199  <script language="javascript">
   200  function scrollToBottom() {
   201      if (window.scrollY < 10) {
   202          window.scrollTo(0, document.body.scrollHeight);
   203      }
   204  }
   205  window.addEventListener("load", scrollToBottom, false);
   206  </script>
   207  </head>
   208  <body>
   209  END_HTML
   210  
   211      # Synopsis of this job: show job environment, links to PR and Cirrus
   212      print { $out_fh } "<h2>Synopsis</h2>\n<hr/>\n",
   213          job_synopsis($test_name), "<hr/>\n";
   214  
   215      # FOR DEBUGGING: dump environment, but in HTML comments to not clutter
   216      # This is safe. There is a TOKEN envariable, but it's not sensitive.
   217      # There are no sensitive/secret values in our execution environment,
   218      # but we're careful anyway. $SECRET_ENV_RE is set in lib.sh
   219      my $filter_re = $ENV{SECRET_ENV_RE} || 'ACCOUNT|GC[EP]|PASSW|SECRET|TOKEN';
   220      $filter_re .= '|BASH_FUNC';   # These are long and un-useful
   221  
   222      print { $out_fh } "<!-- Environment: -->\n";
   223      for my $e (sort keys %ENV) {
   224          next if $e =~ /$filter_re/;
   225  
   226          my $val = escapeHTML($ENV{$e});
   227          $val =~ s/--/-&#x002D;/g;       # double dash not valid in comments
   228          printf { $out_fh } "<!--  %-20s %s -->\n", $e, $val;
   229      }
   230  
   231      # State variables
   232      my $previous_timestamp = '';  # timestamp of previous line
   233      my $previous_timestamp_fine;  # fine-grain timestamp (BATS only)
   234      my $cirrus_task;              # Cirrus task number, used for linking
   235      my $git_commit;               # git SHA, used for linking to source files
   236      my $subtest_status;           # pass, fail, skip, flake - for each subtest
   237      my $subtest_name;             # assembled from two or more Describe()/It()s
   238      my $in_failure;               # binary flag: are we in an error dump?
   239      my $in_timing;                # binary flag: are we in the timing section?
   240      my $after_divider = 999;      # Count of lines after seeing '-----'
   241      my $current_output;           # for removing duplication
   242      my $looks_like_bats;          # binary flag: for detecting BATS results
   243      my $looks_like_python;        #   " "   "  : for colorizing python tests
   244      my %bats_count;               # For summary line: count of pass/fail/skip
   245  
   246      # When running in cirrus, we have the commit SHA
   247      $git_commit = $ENV{CIRRUS_CHANGE_IN_REPO};
   248  
   249      print { $out_fh } "<pre> <!-- begin processed output -->\n";
   250  
   251      # Assume rootful prompt, check for rootless (here and in log itself, below)
   252      my $Prompt = '#';
   253      $Prompt = '$' if $test_name =~ /rootless/;
   254  
   255      # Main loop: read input, one line at a time, and write out reformatted
   256    LINE:
   257      while (my $line = <STDIN>) {
   258          # ARGH. Some log files have NUL characters , apparently because
   259          # certain tests write tar to stdout. Bleagh. Although it seems
   260          # rude to strip those from our (purportedly untouched) log,
   261          # it's worse to read log files with random NULs.
   262          $line =~ s/\0//g;
   263  
   264          print $line;                    # Immediately dump back to stdout
   265  
   266          $Prompt = '$' if $line =~ /Runner executing .* as rootless /;
   267  
   268          # Remain robust in face of errors: always write stdout even if no HTML
   269          next LINE if ! $out_fh;
   270  
   271          chomp $line;
   272          $line = escapeHTML($line);
   273  
   274          # Temporarily strip off leading timestamp
   275          $line =~ s/^(\[\+\d+s\]\s)//;
   276          my $timestamp = $1 || '';
   277          if ($previous_timestamp && $timestamp eq $previous_timestamp) {
   278              $timestamp = ' ' x length($timestamp);
   279          }
   280          elsif ($timestamp) {
   281              $previous_timestamp = $timestamp;
   282          }
   283  
   284          # Helper function for printing a formatted line. This should almost
   285          # always be followed by 'next LINE'.
   286          my $print_line = sub {
   287              my $css = shift;
   288  
   289              print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   290                  if $timestamp;
   291              print { $out_fh } "<span class='$css'>"     if $css;
   292              print { $out_fh } $line;
   293              print { $out_fh } "</span>"                 if $css;
   294              print { $out_fh } "\n";
   295          };
   296  
   297          # ARGH! Special case for tests that run 'cat /proc/self/attr/current:
   298          # that file terminates with NUL, so ginkgo logs concatenate the next
   299          # output line, which is usually "Running: next-podman-command".
   300          # This makes the log readable by splitting into two lines.
   301          if ($line =~ /^(\s*)(\S+_u:\S+_t:\S+:c\S+)(Running:.*)/) {
   302              my ($indent, $selinux, $nextline) = ($1||'', $2, $3);
   303              # Print the SELinux line, unmodified...
   304              $line = $indent . $selinux;
   305              $print_line->();
   306              # ...then forget that, and continue processing (fall through)
   307              # with the 'Running' line.
   308              $line = $indent . $nextline;
   309          }
   310  
   311          # Try to identify the git commit we're working with...
   312          if ($line =~ m!/define.gitCommit=([0-9a-f]+)!) {
   313              $git_commit = $1;
   314          }
   315          # ...so we can link to specific lines in source files
   316          if ($git_commit) {
   317              #           1  12  3                 34     4 5   526  6
   318              $line =~ s{^(.*)(\/(containers\/[^/]+)(\/\S+):(\d+))(.*)$}
   319                        {$1<a class="codelink" href='https://github.com/$3/blob/$git_commit$4#L$5'>$2</a>$6};
   320  
   321              # Same, for python errors
   322              #           1  12  3                 34         4             5   526
   323              $line =~ s{^(.*)(\/(containers\/[^/]+)(\/\S+\.py).*,\s+line\s+(\d+))(,\s+in.*)$}
   324                        {$1<a class="codelink" href='https://github.com/$3/blob/$git_commit$4#L$5'>$2</a>$6};
   325          }
   326  
   327          # Try to identify the cirrus task
   328          if ($line =~ /cirrus-task-(\d+)/) {
   329              $cirrus_task = $1;
   330          }
   331  
   332          # logrus messages, always highlighted
   333          #              1   2   2 13     34  4 5      56   6 7    78  8
   334          if ($line =~ /^(\s*(#\s)?)(time=)(.*) (level=)(\S+) (msg=)(.*)/) {
   335              my $span = "<span class='log-$6'>";
   336              $line = "$1$3$span$4</span> $5$span$6</span> $7$span$8</span>";
   337          }
   338  
   339          # BATS handling. This will recognize num_tests both at start and end
   340          if ($line =~ /^1\.\.(\d+)$/) {
   341              $looks_like_bats = 1;
   342              $bats_count{expected_total} = $1;
   343              undef $looks_like_python;
   344          }
   345          # Since the number of tests can't always be predicted, recognize
   346          # some leading text strings that indicate BATS output to come.
   347          elsif ($line =~ /^TAP\s+version\s/ || $line =~ m!/test-apiv2!) {
   348              $looks_like_bats = 1;
   349              $bats_count{expected_total} = -1; # Expect to be overridden at end!
   350              undef $looks_like_python;
   351          }
   352  
   353          # 'python -m unittest' means we're starting some pythony stuff
   354          elsif ($line =~ m!/python.*\sunittest\s!) {
   355              $looks_like_python = 1;
   356              undef $looks_like_bats;
   357          }
   358          elsif ($looks_like_python && $line =~ m!Ran\s+(\d+)\s+tests\s+in\s!) {
   359              # End of python tests. However, we're still likely to see a
   360              # summary line saying 'OK' or 'FAILED'. Deal with that by
   361              # resetting $looks_like_python to 0, which the next elsif catches
   362              $bats_count{expected_total} += $1;
   363              $looks_like_python = 0;
   364              print { $out_fh } "</div>\n"            if $in_failure;
   365              undef $in_failure;
   366          }
   367          elsif (defined($looks_like_python) && !$looks_like_python) {
   368              # The final python summary line. Show it in its appropriate color.
   369              if ($line =~ /^\s*(OK|FAILED)\s+\(/) {
   370                  undef $looks_like_python;
   371                  my $css = ($1 eq 'OK' ? 'passed' : 'failed');
   372                  $print_line->("bats-$css");
   373                  next LINE;
   374              }
   375          }
   376  
   377          if ($looks_like_bats) {
   378              my $css;
   379  
   380              # 2023-05-16 run_podman() now displays NS-precision timestamps
   381              # on commands and their output. This is cluttery, so if we
   382              # see these, strip them and display in the left-hand (coarse)
   383              # timestamp column instead. Hovering will display the full time.
   384              #
   385              #               1   1  23   3 4   4 5        52
   386              if ($line =~ s{^(#\s)\[((\d+):(\d+):(\d+\.\d+))\]\s}{$1}) {
   387                  my ($full, $h, $m, $s) = ($2, $3, $4, $5);
   388                  my $timestamp_fine = $h * 3600.0 + $m * 60.0 + $s;
   389                  my $short;
   390                  if ($previous_timestamp_fine) {
   391                      # This will fail if we do a midnight wraparound. NBD.
   392                      my $delta = $timestamp_fine - $previous_timestamp_fine;
   393  
   394                      # Human-readable format
   395                      if ($delta > 10) {
   396                          $short = sprintf("%04ds", $delta);
   397                      }
   398                      elsif ($delta > 1) {
   399                          $short = sprintf("%03.2fs", $delta);
   400                      }
   401                      elsif ($delta > 0.001) {
   402                          $short = sprintf("%03dms", $delta * 1000.0);
   403                      }
   404                      else {
   405                          # Ultra-improbable
   406                          $short = sprintf("%03dns", $delta * 1_000_000.0);
   407                      }
   408                  }
   409                  else {
   410                      $short = "     ";
   411                  }
   412  
   413                  # left-hand timestamp [+0001s] becomes <+013ms>
   414                  $timestamp = "<span title=\"$full\">&lt;+$short&gt;</span> ";
   415                  $previous_timestamp_fine = $timestamp_fine;
   416              }
   417  
   418              # Readability: /long/path/to/podman -> podman (hover for full path)
   419              # Also make it boldface, to make commands stand out
   420              $line =~ s{^(#\s+(#|\$)\s+)(\S+/)(podman\S*)(\s.*)}
   421                        {$1<b><span title="$3$4">$4</span>$5</b>};
   422  
   423              if    ($line =~ /^ok\s.*\s# skip/)    { $css = 'skipped'       }
   424              elsif ($line =~ /^ok\s/)              { $css = 'passed'        }
   425              elsif ($line =~ /^not\s+ok\s/)        { $css = 'failed'        }
   426              elsif ($line =~ /^# #(\/v|\| |\\\^)/) { $css = 'log-failblock' }
   427              elsif ($line =~ /^#\s/)               { $css = 'log'           }
   428  
   429              # Link to source file. This is ugly: we have to hardcode 'podman'
   430              # and 'test/system' because there's no way to get them from log.
   431              #
   432              #          1  2      2               13     4         43           5
   433              $line =~ s{(in(\stest)?\s+file\s+\S+/)(\S+\.(bats|bash)),\s+line\s+(\d+)}{$1<a class="codelink" href="https://github.com/containers/podman/blob/$git_commit/test/system/$3#L$5">$3, line $5</a>};
   434  
   435              if ($css) {
   436                  # Make it linkable, e.g. foo.html#t--00001
   437                  if ($line =~ /^(not\s+)?ok\s+(\d+)\s+(.*)/) {
   438                      $line = sprintf("<a name='t--%05d'>%s</a>", $2, $line);
   439  
   440                      push @{$bats_count{__fail_list}}, [ $2, $3 ] if $1;
   441                  }
   442                  $bats_count{$css}++;
   443                  $css = "bats-$css";
   444              }
   445  
   446              $print_line->($css);
   447              next LINE;
   448          }
   449          elsif ($looks_like_python) {
   450              my $css;
   451  
   452              if    ($line =~ /\s\.\.\.\sskipped/) { $css = 'skipped' }
   453              elsif ($line =~ /\s\.\.\.\sok\s*$/)  { $css = 'passed'  }
   454              elsif ($line =~ /\s\.\.\.\sFAIL/)    { $css = 'failed'  }
   455              elsif ($line =~ /^\s*={40}/)         {
   456                  # Begins a block of multiple lines including a stack trace
   457                  print { $out_fh } "<div class='log-error'>\n" unless $in_failure;
   458                  $in_failure = 1;
   459              }
   460  
   461              if ($css) {
   462                  $bats_count{$css}++;
   463                  $css = "bats-$css";
   464              }
   465              $print_line->($css);
   466              next LINE;
   467          }
   468  
   469          #
   470          # Must be ginkgo
   471          #
   472          if ($line =~ s!^(\s*)(&[gl]t;)\s+(Enter|Exit)\s+\[(\w+)\]!!) {
   473              my ($indent, $arrow, $action, $block) = ($1, $2, $3, $4);
   474              if ($action eq 'Enter') {
   475                  printf { $out_fh } "<div class=\"ginkgo-timeline ginkgo-%s\">",
   476                      lc($block);
   477                  $line = "$indent&rarr; Enter [<b>$block</b>]$line";
   478                  $print_line->();
   479  
   480                  # machine tests, run without -p, don't have a blank line
   481                  # separating headers from logs; but this works just fine.
   482                  $after_divider = 999;
   483              }
   484              else {
   485                  # Can be a div within a div
   486                  if ($in_failure) {
   487                      $in_failure = 0;
   488                      print { $out_fh } "</div>";
   489                  }
   490  
   491                  $line = "$indent&larr; Exit  [$block]$line";
   492                  $print_line->();
   493  
   494                  print { $out_fh } "</div>";
   495              }
   496  
   497              next LINE;
   498          }
   499  
   500          # Ginkgo v2 nicely lumps all retries for the same given test
   501          if ($line =~ /^\s*Attempt\s+\#\d+\s+Failed\.\s+Retr/) {
   502              $print_line->("error-retry");
   503              next LINE;
   504          }
   505  
   506          # Timing section at the bottom of the page
   507          if ($line =~ / timing results\s*$/) {
   508              $in_timing = 1;
   509          }
   510          elsif ($in_timing) {
   511              if ($line =~ /^\s*(\S.*\S)\s+(\d+\.\d+)\s*$/) {
   512                  my ($name, $time) = ($1, $2);
   513                  my $id = make_id($1, 'timing');
   514  
   515                  # Try to column-align the timing numbers. Some test names
   516                  # will be longer than our max - oh well.
   517                  my $spaces = 90 - length(unescapeHTML($name));
   518                  $spaces = 1 if $spaces < 1;
   519                  $spaces++ if $time < 10;
   520                  my $spacing = ' ' x $spaces;
   521                  $line = qq{<span class="timing"><a href="#t--$id">$name</a>$spacing$time</span>};
   522              }
   523              else {
   524                  $in_timing = 0;
   525              }
   526          }
   527  
   528          # Ginkgo summary line. Colorize Passed, Failed, Flaked, Skipped
   529          if ($line =~ /^(\s*)(FAIL|SUCCESS)!(\s+--\s+)(.*\d+\sPassed.*)/) {
   530              my ($indent, $status, $dashes, $rhs) = ($1, $2, $3, $4);
   531              my @counts = split('\|', $rhs);
   532              my @formatted;
   533              for my $c (@counts) {
   534                  $c =~ /^(\s*)(\d+)\s+(\w+)(\s*)$/
   535                      or warn "$ME: line $.: WEIRD: '$c' in '$rhs' from '$line'";
   536                  my ($lhs, $n, $category, $rhs) = ($1||'', $2, $3, $4||'');
   537                  # Only highlight if count > 0, so "0 Failed" doesn't yell
   538                  if ($n > 0) {
   539                      # Yes, we use 'bats-xxxx' classes even though we're ginkgo.
   540                      push @formatted, sprintf("%s<span class=\"bats-%s\"><b>%d</b> %s</span>%s",
   541                                               $lhs, lc($category), $n, $category, $rhs);
   542                  }
   543                  else {
   544                      # Zero. Leave unhighlighted.
   545                      push @formatted, $c;
   546                  }
   547              }
   548              $line = sprintf("%s<span class=\"ginkgo-final-%s\">%s!</span>%s%s",
   549                              $indent,
   550                              lc($status), $status,
   551                              $dashes, join('|', @formatted));
   552              $print_line->();
   553              next LINE;
   554          }
   555  
   556          #
   557          # Ginkgo error reformatting
   558          #
   559          if ($line =~ /^\s*\[(FAILED|PANICKED)\]/) {
   560              # Begins a block of multiple lines including a stack trace
   561              print { $out_fh } "<div class='log-error'>\n";
   562              $in_failure = 1;
   563          }
   564          elsif ($line =~ /^-----------/) {
   565              if ($in_failure) {
   566                  # Ends a stack trace block
   567                  $in_failure = 0;
   568                  print { $out_fh } "</div>\n";
   569              }
   570              $after_divider = 1;
   571              $subtest_status = 'passed';         # until proven otherwise
   572              $subtest_name = '';
   573  
   574              print { $out_fh } "</pre>\n<hr />\n<pre>\n";
   575              # Always show timestamp at start of each new test
   576              $previous_timestamp = '';
   577              next LINE;
   578          }
   579          # (bindings test sometimes emits 'Running' with leading bullet char)
   580          elsif ($line =~ s!^•?(\s*)Running:!<span class="boring">$1$Prompt</span>!) {
   581              # Highlight the important (non-boilerplate) podman command.
   582              $line =~ s/\s+--remote\s+/ /g;      # --remote takes no args
   583              # Strip out the global podman options, but show them on hover
   584              $line =~ s{(\S+\/podman(-remote)?)((\s+--(root|runroot|runtime|tmpdir|storage-opt|conmon|cgroup-manager|\S+-backend|network-config-dir|storage-driver|url) \S+)*)(\s.*)}{
   585                  my ($full_path, $remote, $options, $args) = ($1, $2||'', $3, $6);
   586  
   587                  $options =~ s/^\s+//;
   588                  # Separate each '--foo bar' with newlines for readability
   589                  $options =~ s/ --/\n--/g;
   590                  qq{<span title="$full_path"><b>podman$remote</b></span> <span class=\"boring\" title=\"$options\">[options]</span><b>$args</b>};
   591              }e;
   592  
   593              # Quadlet output messages have a weird "... with FOO=path"
   594              # addition that's hard to read. Make it friendlier.
   595              #          1        2       213    34                45   5
   596              $line =~ s{(\S+/bin/(quadlet))(\s.*)(\s+with\s+Q\S+?=)(\S+)}
   597                        {<span title="$1"><b>$2$3</b></span><span class="boring">$4</span><b>$5</b>};
   598  
   599              $current_output = '';
   600          }
   601          elsif ($line =~ /^\s*Error:/ || $line =~ / level=(warning|error) /) {
   602              $line = "<span class='log-warning'>" . $line . "</span>";
   603          }
   604          elsif ($line =~ /^panic:/) {
   605              $line = "<span class='log-error'>" . $line . "</span>";
   606          }
   607          else {
   608              $current_output .= ' ' . $line;
   609          }
   610  
   611          # One line after each divider, there's a status/timing line.
   612          if ($after_divider == 1) {
   613              # When run with -p, ginkgo emits timing information on the
   614              # first line after the divider. (Without -p, it's at the end).
   615              # Recognize this, because it affects our recognition (below)
   616              # of the test name.
   617              $line =~ s{(\[(\d+)\.\d+\s+seconds\])}{
   618                  if ($2 > 5) { "<b><span class='log-slow'>$1</span></b>" }
   619                  else        { "<b>$1</b>" }
   620              }e && --$after_divider;
   621  
   622              # Make FAILED and SKIPPING visible. (Only works with ginkgo -p;
   623              # without -p, status is at the bottom of the test block)
   624              if ($line =~ s!^(.*\[(SKIPPED|FAILED|FLAKEY).*\].*)!<span class="log-\L$2\E">$1</span>!) {
   625                  $subtest_status = lc($2);
   626              }
   627  
   628              # FIXME: gray out entire block if it's skipped?
   629          }
   630  
   631          # Test name recognition, linking, and highlighting.
   632          # The lines after each divider, until the first empty line, are
   633          # one or more test name specifiers, a nested level of Description()
   634          # and It() names:
   635          #    -----------
   636          #    * blah [N seconds]     <<<---- only when run with -p
   637          #    Podman foo
   638          #    /var/tmp/go/src/path/to/this/file.go:lineno
   639          #       podman bar
   640          #       /var/tmp/go/src/path/to/this/file.go:lineno
   641          #
   642          # There may even be three nested levels (e.g., quadlet). We
   643          # look for non-path lines and assemble them -- "Podman foo",
   644          # " Podman foo podman bar" -- giving each an HTML anchor
   645          # to which we can link from the summary section at bottom.
   646          if ($after_divider <= 10) {      # Assume no more than ~5 levels
   647              if ($line =~ /^\s*$/) {
   648                  # Stop looking when we get to the blank line
   649                  $after_divider = 999;
   650              }
   651              elsif ($line =~ /span.*class=.boring./) {
   652                  # Sigh. Bindings tests run without -p, and have no blank line
   653                  # separator. Use the first command to signal real logs.
   654                  # FIXME: can we solve this with ReportBeforeEach()?
   655                  #   https://onsi.github.io/ginkgo/#generating-reports-programmatically
   656                  $after_divider = 999;
   657              }
   658              elsif ($line =~ m!^\s*/\S+!) {
   659                  # Source code path: skip
   660              }
   661              elsif ($line =~ /<b/) {
   662                  # Already-formatted line (like the "N seconds" one): skip
   663              }
   664              elsif ($line =~ /^\s*(\[It\]\s*)?(.*)/) {
   665                  # Test description or name! Remove the "It", and make an anchor
   666                  $subtest_name .= " " if $subtest_name;
   667                  $subtest_name .= $2;
   668                  my $id = make_id($subtest_name, 'anchor');
   669                  $line = "<a name='t--$id'><h2 class=\"log-$subtest_status\">$line</h2></a>";
   670  
   671                  # Special case for tests that fail outside of a Describe()
   672                  # block, e.g., global After/BeforeEach. We still want to
   673                  # highlight those in the <h2>, but do not include "TOP-LEVEL"
   674                  # in the anchor name for the actual test name (which will
   675                  # come later, a few lines down).
   676                  $subtest_name = '' if $subtest_name =~ /^\s*TOP-LEVEL/;
   677              }
   678          }
   679          ++$after_divider;
   680  
   681          # Highlight test name when it appears in the middle of commands.
   682          # But make it boring, because we already have the test name in large
   683          # bold just above. (Except in skipped tests).
   684          $line =~ s!^(\s*)(\[It\]\s+.*)!$1<span class="testname">$2</span>!;
   685  
   686          # Failure name corresponds to a previously-seen block.
   687          #              1     2           2   3  3   4                       4   15           5
   688          if ($line =~ /^(\s*\[(FAIL|PANIC!)\] (.*) \[(It|BeforeEach|AfterEach)\] )([A-Za-z-].*)/) {
   689              my ($lhs, $type, $desc, $ginkgo_fluff, $testname) = ($1, $2, $3, $4, $5);
   690              $desc =~ s/^TOP-LEVEL\s*//;
   691              my $id = make_id("$desc $testname", 'link');
   692  
   693              $line = "<span class=\"log-error\">$lhs<a href='#t--$id'>$testname</a></span>";
   694          }
   695  
   696          print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   697              if $timestamp;
   698          print { $out_fh } $line, "\n";
   699      }
   700  
   701      my $have_formatted_log;     # Set on success
   702  
   703      if ($out_fh) {
   704          # Summary line for BATS tests
   705          if (keys %bats_count) {
   706              print { $out_fh } "<hr/><span class='bats-summary'>Summary:";
   707              my $total = 0;
   708              my $comma = '';
   709              for my $class (qw(passed failed skipped)) {
   710                  if (my $n = $bats_count{$class}) {
   711                      printf { $out_fh } "%s <span class='bats-%s'>%d %s</span>",
   712                          $comma, $class, $n, ucfirst($class);
   713                      $total += $n;
   714                      $comma = ',';
   715                  }
   716              }
   717  
   718              printf { $out_fh } ". Total tests: $total";
   719              if (my $expected_total = $bats_count{expected_total}) {
   720                  if ($total != $expected_total) {
   721                      print { $out_fh } " <span class='bats-failed'>(WARNING: expected $expected_total)</span>";
   722                  }
   723              }
   724              print { $out_fh } "</span>\n";
   725          }
   726  
   727          print { $out_fh } "</pre>  <!-- end processed output -->\n";
   728  
   729          # Did we find a cirrus task? Link back.
   730          if ($cirrus_task) {
   731              print { $out_fh } <<"END_HTML";
   732  <hr />
   733  <h3>Cirrus <a href="https://cirrus-ci.com/task/$cirrus_task">task $cirrus_task</a></h3>
   734  END_HTML
   735          }
   736  
   737          # FIXME: need a safe way to get TZ
   738          printf { $out_fh } <<"END_HTML", scalar(CORE::localtime);
   739  <hr />
   740  <small>Processed %s by $ME v$VERSION</small>
   741  </body>
   742  </html>
   743  END_HTML
   744  
   745          if (close $out_fh) {
   746              if (rename $out_tmp => $outfile) {
   747                  $have_formatted_log = 1;
   748              }
   749              else {
   750                  warn "$ME: Could not rename $out_tmp: $!\n";
   751              }
   752          }
   753          else {
   754              warn "$ME: Error writing $out_tmp: $!\n";
   755          }
   756      }
   757  
   758      # Grumble. Github only shows the last N lines of the log... which is
   759      # anti-helpful when you want a quick synopsis of what failed. Write a
   760      # summary at the tail, to make it easier for humans to see what went wrong.
   761      if (my $fails = $bats_count{__fail_list}) {
   762          print  "\n";
   763          printf "Failed tests (%d):\n", scalar(@$fails);
   764          printf " - %d %s\n", @$_ for @$fails;
   765      }
   766  
   767      # If Cirrus magic envariables are available, write a link to results.
   768      # FIXME: it'd be so nice to make this a clickable live link.
   769      #
   770      # As of June 2022 we use the Cirrus API[1] as the source of our logs,
   771      # instead of linking directly to googleapis.com. This will allow us
   772      # to abstract cloud-specific details, so we can one day use Amazon cloud.
   773      # See #14569 for more info.
   774      #
   775      #   [1] https://cirrus-ci.org/guide/writing-tasks/#latest-build-artifacts
   776      if ($have_formatted_log && $ENV{CIRRUS_TASK_ID}) {
   777          my $URL_BASE = "https://api.cirrus-ci.com";
   778          my $task_id  = $ENV{CIRRUS_TASK_ID};
   779  
   780          # Link by *taskID*, not buildID + taskname. First, this is shorter
   781          # and less duplicaty. Second, and more important, buildID + taskname
   782          # is non-unique, and a link to a flake log will be clobbered.
   783          my $URL = "${URL_BASE}/v1/artifact/task/$task_id/html/${outfile}";
   784  
   785          print "\n\nAnnotated results:\n  $URL\n";
   786      }
   787  }
   788  
   789  
   790  #############
   791  #  make_id  #  Given a test name, generate an anchor link name
   792  #############
   793  sub make_id {
   794      my $name = shift;                   # in: test title
   795      my $type = shift;                   # in: differentiator (anchor, link)
   796  
   797      state %counter;
   798  
   799      $name =~ s/^\s+|\s+$//g;            # strip leading/trailing whitespace
   800      $name =~ s/^\[It\]\s*//;            # strip leading "[It] "
   801      $name =~ s/\&#\d+;//g;              # 'doesn&#39;t' -> 'doesnt'
   802      $name =~ s/\&quot;/-/g;             # '&quot;path&quot;' -> '-path-'
   803      $name =~ s/[^a-zA-Z0-9_-]/-/g;      # Convert non-alphanumeric to dash
   804      $name =~ s/-{3,}/-/g;               # '------' to just '-'
   805  
   806      # Keep a running tally of how many times we've seen this identifier
   807      # for this given type! This lets us cross-match, in the bottom of
   808      # the page, the first/second/third failure of a given test.
   809      $name .= "--" . ++$counter{$type}{$name};
   810  
   811      $name;
   812  }
   813  
   814  
   815  ###############################################################################
   816  # BEGIN job_synopsis and related helpers
   817  
   818  ##################
   819  #  job_synopsis  #  Job details, links to github/cirrus
   820  ##################
   821  sub job_synopsis {
   822      my $subtest_name = shift;           # e.g. integration_test
   823  
   824      my $s = <<"END_SYNOPSIS";
   825  <table class="synopsis">
   826  END_SYNOPSIS
   827  
   828      # PR 1234 - title of the pr
   829      my $pr_title = escapeHTML(_env_replace("{CIRRUS_CHANGE_TITLE}"));
   830      $s .= _tr("GitHub PR", sprintf("%s - %s",
   831                                     _a("{CIRRUS_PR}", "https://{CIRRUS_REPO_CLONE_HOST}/{CIRRUS_REPO_FULL_NAME}/pull/{CIRRUS_PR}"),
   832                                     $pr_title));
   833  
   834      # PR author, if signed-off-by
   835      if (my $msg = _env_replace("{CIRRUS_COMMIT_MESSAGE}")) {
   836          while ($msg =~ /^Signed-off-by:\s+(\S.*\S)$/gmi) {
   837              $s .= _tr("Author", escapeHTML($1));
   838          }
   839      }
   840  
   841      # eg "test fedora", "special_testing_rootless"
   842      # WARNING: As of 2020-10-05, $CIRRUS_TASK_NAME reflects the same
   843      # descriptive content as our $subtest_name argument (confirm via
   844      # cross-checking runner.sh:logformatter() vs cirrus.yml:&std_name_fmt).
   845      # If this ever becomes untrue, just add _tr("Subtest", $subtest_name).
   846      my $test_name = _env_replace("{CIRRUS_TASK_NAME}");
   847      # (Special-case cleanup: Cirrus\ quotes\ spaces; remove for readability).
   848      $test_name =~ s/\\\s+/ /g;
   849      $s .= _tr("Test name", $test_name);
   850  
   851      # Link to further Cirrus results, e.g. other runs.
   852      # Build is mostly boring, it's usually TASK that we want to see.
   853      $s .= _tr("Cirrus", sprintf("<small>Build %s</small> / <b>Task %s</b>",
   854                                  _a("{CIRRUS_BUILD_ID}", "https://cirrus-ci.com/build/{CIRRUS_BUILD_ID}"),
   855                                  _a("{CIRRUS_TASK_ID}", "https://cirrus-ci.com/task/{CIRRUS_TASK_ID}")));
   856  
   857      # Logs: link to original (unformatted) log; journal; and, if remote, server
   858      my @logs = (
   859          _a("main", "https://api.cirrus-ci.com/v1/task/{CIRRUS_TASK_ID}/logs/main.log"),
   860          _a("journal", "https://api.cirrus-ci.com/v1/task/{CIRRUS_TASK_ID}/logs/journal.log"),
   861      );
   862  
   863      # System tests are single-threaded, and have a server log available
   864      if ($test_name =~ /sys\s+remote\s/) {
   865          push @logs, _a("remote server", "https://api.cirrus-ci.com/v1/artifact/task/{CIRRUS_TASK_ID}/server_log/podman-server.log");
   866      }
   867      $s .= _tr("Logs", join(" / ", @logs));
   868  
   869      # BASE_SHA can tell us if our parent includes--or doesn't--a purported
   870      # fix for a flake. Note that "commits", plural, links to a git history
   871      # listing; if we used "commit", singular, that would be less useful.
   872      $s .= _tr("Base commit", _a("{CIRRUS_BASE_SHA}", "https://{CIRRUS_REPO_CLONE_HOST}/{CIRRUS_REPO_FULL_NAME}/commits/{CIRRUS_BASE_SHA}"));
   873  
   874      $s .= "</table>\n";
   875      return $s;
   876  }
   877  
   878  
   879  sub _tr {
   880      my ($th, $td) = @_;
   881      return "<tr><th>$th:</th><td>$td</td></tr>\n";
   882  }
   883  
   884  sub _a {
   885      my ($name, $href) = map { _env_replace($_) } @_;
   886  
   887      if ($href =~ /UNDEFINED/) {
   888          return "$name ($href)";
   889      }
   890      return "<a href='$href'>$name</a>";
   891  }
   892  
   893  sub _env_replace {
   894      my $s_in = shift;
   895  
   896      $s_in =~ s[\{(.*?)\}][$ENV{$1} || "[$1 UNDEFINED]"]ge;
   897  
   898      return $s_in;
   899  }
   900  
   901  # END   job_synopsis and related helpers
   902  ###############################################################################
   903  # BEGIN html-formatting helpers
   904  
   905  sub escapeHTML {
   906      my $s = shift;
   907  
   908      state %chars;
   909      %chars = ('&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&#39;')
   910          if keys(%chars) == 0;
   911      my $class = join('', sort keys %chars);
   912      $s =~ s/([$class])/$chars{$1}/ge;
   913  
   914      return $s;
   915  }
   916  
   917  sub unescapeHTML {
   918      my $s = shift;
   919  
   920      # We don't actually care about the character, only its length
   921      $s =~ s/\&\#?[a-z0-9]+;/./g;
   922  
   923      return $s;
   924  }
   925  
   926  # END   html-formatting helpers
   927  ###############################################################################
   928  
   929  1;