podman

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
            # And, sigh, Macintosh always has to be different
327
            #           1              123    3 4   425  5
328
            $line =~ s{^(.*/ci/task-\d+)((/\S+):(\d+))(.*)$}
329
                      {$1<a class="codelink" href="https://github.com/containers/podman/blob/$git_commit$3#L$4">$2</a>$5};
330

331
            # ...as does Windows
332
            #           1                             123    3 4   435  5
333
            $line =~ s{^(.*/Local/cirrus-ci-build/repo)((/\S+):(\d+))(.*)$}
334
                      {$1<a class="codelink" href="https://github.com/containers/podman/blob/$git_commit$3#L$4">$2</a>$5}
335
        }
336

337
        # Try to identify the cirrus task
338
        if ($line =~ /cirrus-task-(\d+)/) {
339
            $cirrus_task = $1;
340
        }
341

342
        # logrus messages, always highlighted
343
        #              1   2   2 13     34  4 5      56   6 7    78  8
344
        if ($line =~ /^(\s*(#\s)?)(time=)(.*) (level=)(\S+) (msg=)(.*)/) {
345
            my $span = "<span class='log-$6'>";
346
            $line = "$1$3$span$4</span> $5$span$6</span> $7$span$8</span>";
347
        }
348

349
        # BATS handling. This will recognize num_tests both at start and end
350
        if ($line =~ /^1\.\.(\d+)$/) {
351
            $looks_like_bats = 1;
352
            $bats_count{expected_total} = $1;
353
            undef $looks_like_python;
354
        }
355
        # Since the number of tests can't always be predicted, recognize
356
        # some leading text strings that indicate BATS output to come.
357
        elsif ($line =~ /^TAP\s+version\s/ || $line =~ m!/test-apiv2!) {
358
            $looks_like_bats = 1;
359
            $bats_count{expected_total} = -1; # Expect to be overridden at end!
360
            undef $looks_like_python;
361
        }
362

363
        # 'python -m unittest' means we're starting some pythony stuff
364
        elsif ($line =~ m!/python.*\sunittest\s!) {
365
            $looks_like_python = 1;
366
            undef $looks_like_bats;
367
        }
368
        elsif ($looks_like_python && $line =~ m!Ran\s+(\d+)\s+tests\s+in\s!) {
369
            # End of python tests. However, we're still likely to see a
370
            # summary line saying 'OK' or 'FAILED'. Deal with that by
371
            # resetting $looks_like_python to 0, which the next elsif catches
372
            $bats_count{expected_total} += $1;
373
            $looks_like_python = 0;
374
            print { $out_fh } "</div>\n"            if $in_failure;
375
            undef $in_failure;
376
        }
377
        elsif (defined($looks_like_python) && !$looks_like_python) {
378
            # The final python summary line. Show it in its appropriate color.
379
            if ($line =~ /^\s*(OK|FAILED)\s+\(/) {
380
                undef $looks_like_python;
381
                my $css = ($1 eq 'OK' ? 'passed' : 'failed');
382
                $print_line->("bats-$css");
383
                next LINE;
384
            }
385
        }
386

387
        if ($looks_like_bats) {
388
            my $css;
389

390
            # 2023-05-16 run_podman() now displays NS-precision timestamps
391
            # on commands and their output. This is cluttery, so if we
392
            # see these, strip them and display in the left-hand (coarse)
393
            # timestamp column instead. Hovering will display the full time.
394
            #
395
            #               1   1  23   3 4   4 5        52
396
            if ($line =~ s{^(#\s)\[((\d+):(\d+):(\d+\.\d+))\]\s}{$1}) {
397
                my ($full, $h, $m, $s) = ($2, $3, $4, $5);
398
                my $timestamp_fine = $h * 3600.0 + $m * 60.0 + $s;
399
                my $short;
400
                if ($previous_timestamp_fine) {
401
                    # This will fail if we do a midnight wraparound. NBD.
402
                    my $delta = $timestamp_fine - $previous_timestamp_fine;
403

404
                    # Human-readable format
405
                    if ($delta > 10) {
406
                        $short = sprintf("%04ds", $delta);
407
                    }
408
                    elsif ($delta > 1) {
409
                        $short = sprintf("%03.2fs", $delta);
410
                    }
411
                    elsif ($delta > 0.001) {
412
                        $short = sprintf("%03dms", $delta * 1000.0);
413
                    }
414
                    else {
415
                        # Ultra-improbable
416
                        $short = sprintf("%03dns", $delta * 1_000_000.0);
417
                    }
418
                }
419
                else {
420
                    $short = "     ";
421
                }
422

423
                # left-hand timestamp [+0001s] becomes <+013ms>
424
                $timestamp = "<span title=\"$full\">&lt;+$short&gt;</span> ";
425
                $previous_timestamp_fine = $timestamp_fine;
426
            }
427

428
            # Readability: /long/path/to/podman -> podman (hover for full path)
429
            # Also make it boldface, to make commands stand out
430
            $line =~ s{^(#\s+(#|\$)\s+)(\S+/)(podman\S*)(\s.*)}
431
                      {$1<b><span title="$3$4">$4</span>$5</b>};
432

433
            if    ($line =~ /^ok\s.*\s# skip/)    { $css = 'skipped'       }
434
            elsif ($line =~ /^ok\s/)              { $css = 'passed'        }
435
            elsif ($line =~ /^not\s+ok\s/)        { $css = 'failed'        }
436
            elsif ($line =~ /^# #(\/v|\| |\\\^)/) { $css = 'log-failblock' }
437
            elsif ($line =~ /^#\s/)               { $css = 'log'           }
438

439
            # Link to source file. This is ugly: we have to hardcode 'podman'
440
            # and 'test/system' because there's no way to get them from log.
441
            #
442
            #          1  2      2               13     4         43           5
443
            $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>};
444

445
            if ($css) {
446
                # Make it linkable, e.g. foo.html#t--00001
447
                if ($line =~ /^(not\s+)?ok\s+(\d+)\s+(.*)/) {
448
                    $line = sprintf("<a name='t--%05d'>%s</a>", $2, $line);
449

450
                    push @{$bats_count{__fail_list}}, [ $2, $3 ] if $1;
451
                }
452
                $bats_count{$css}++;
453
                $css = "bats-$css";
454
            }
455

456
            $print_line->($css);
457
            next LINE;
458
        }
459
        elsif ($looks_like_python) {
460
            my $css;
461

462
            if    ($line =~ /\s\.\.\.\sskipped/) { $css = 'skipped' }
463
            elsif ($line =~ /\s\.\.\.\sok\s*$/)  { $css = 'passed'  }
464
            elsif ($line =~ /\s\.\.\.\sFAIL/)    { $css = 'failed'  }
465
            elsif ($line =~ /^\s*={40}/)         {
466
                # Begins a block of multiple lines including a stack trace
467
                print { $out_fh } "<div class='log-error'>\n" unless $in_failure;
468
                $in_failure = 1;
469
            }
470

471
            if ($css) {
472
                $bats_count{$css}++;
473
                $css = "bats-$css";
474
            }
475
            $print_line->($css);
476
            next LINE;
477
        }
478

479
        #
480
        # Must be ginkgo
481
        #
482
        if ($line =~ s!^(\s*)(&[gl]t;)\s+(Enter|Exit)\s+\[(\w+)\]!!) {
483
            my ($indent, $arrow, $action, $block) = ($1, $2, $3, $4);
484
            if ($action eq 'Enter') {
485
                printf { $out_fh } "<div class=\"ginkgo-timeline ginkgo-%s\">",
486
                    lc($block);
487
                $line = "$indent&rarr; Enter [<b>$block</b>]$line";
488
                $print_line->();
489

490
                # machine tests, run without -p, don't have a blank line
491
                # separating headers from logs; but this works just fine.
492
                $after_divider = 999;
493
            }
494
            else {
495
                # Can be a div within a div
496
                if ($in_failure) {
497
                    $in_failure = 0;
498
                    print { $out_fh } "</div>";
499
                }
500

501
                $line = "$indent&larr; Exit  [$block]$line";
502
                $print_line->();
503

504
                print { $out_fh } "</div>";
505
            }
506

507
            next LINE;
508
        }
509

510
        # Ginkgo v2 nicely lumps all retries for the same given test
511
        if ($line =~ /^\s*Attempt\s+\#\d+\s+Failed\.\s+Retr/) {
512
            $print_line->("error-retry");
513
            next LINE;
514
        }
515

516
        # Timing section at the bottom of the page
517
        if ($line =~ / timing results\s*$/) {
518
            $in_timing = 1;
519
        }
520
        elsif ($in_timing) {
521
            if ($line =~ /^\s*(\S.*\S)\s+(\d+\.\d+)\s*$/) {
522
                my ($name, $time) = ($1, $2);
523
                my $id = make_id($1, 'timing');
524

525
                # Try to column-align the timing numbers. Some test names
526
                # will be longer than our max - oh well.
527
                my $spaces = 90 - length(unescapeHTML($name));
528
                $spaces = 1 if $spaces < 1;
529
                $spaces++ if $time < 10;
530
                my $spacing = ' ' x $spaces;
531
                $line = qq{<span class="timing"><a href="#t--$id">$name</a>$spacing$time</span>};
532
            }
533
            else {
534
                $in_timing = 0;
535
            }
536
        }
537

538
        # Ginkgo summary line. Colorize Passed, Failed, Flaked, Skipped
539
        if ($line =~ /^(\s*)(FAIL|SUCCESS)!(\s+--\s+)(.*\d+\sPassed.*)/) {
540
            my ($indent, $status, $dashes, $rhs) = ($1, $2, $3, $4);
541
            my @counts = split('\|', $rhs);
542
            my @formatted;
543
            for my $c (@counts) {
544
                $c =~ /^(\s*)(\d+)\s+(\w+)(\s*)$/
545
                    or warn "$ME: line $.: WEIRD: '$c' in '$rhs' from '$line'";
546
                my ($lhs, $n, $category, $rhs) = ($1||'', $2, $3, $4||'');
547
                # Only highlight if count > 0, so "0 Failed" doesn't yell
548
                if ($n > 0) {
549
                    # Yes, we use 'bats-xxxx' classes even though we're ginkgo.
550
                    push @formatted, sprintf("%s<span class=\"bats-%s\"><b>%d</b> %s</span>%s",
551
                                             $lhs, lc($category), $n, $category, $rhs);
552
                }
553
                else {
554
                    # Zero. Leave unhighlighted.
555
                    push @formatted, $c;
556
                }
557
            }
558
            $line = sprintf("%s<span class=\"ginkgo-final-%s\">%s!</span>%s%s",
559
                            $indent,
560
                            lc($status), $status,
561
                            $dashes, join('|', @formatted));
562
            $print_line->();
563
            next LINE;
564
        }
565

566
        #
567
        # Ginkgo error reformatting
568
        #
569
        if ($line =~ /^\s*\[(FAILED|PANICKED)\]/) {
570
            # Begins a block of multiple lines including a stack trace
571
            print { $out_fh } "<div class='log-error'>\n";
572
            $in_failure = 1;
573
        }
574
        elsif ($line =~ /^-----------/) {
575
            if ($in_failure) {
576
                # Ends a stack trace block
577
                $in_failure = 0;
578
                print { $out_fh } "</div>\n";
579
            }
580
            $after_divider = 1;
581
            $subtest_status = 'passed';         # until proven otherwise
582
            $subtest_name = '';
583

584
            print { $out_fh } "</pre>\n<hr />\n<pre>\n";
585
            # Always show timestamp at start of each new test
586
            $previous_timestamp = '';
587
            next LINE;
588
        }
589
        # (bindings test sometimes emits 'Running' with leading bullet char)
590
        elsif ($line =~ s!^•?(\s*)Running:!<span class="boring">$1$Prompt</span>!) {
591
            # Highlight the important (non-boilerplate) podman command.
592
            $line =~ s/\s+--remote\s+/ /g;      # --remote takes no args
593
            # Strip out the global podman options, but show them on hover
594
            $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.*)}{
595
                my ($full_path, $remote, $options, $args) = ($1, $2||'', $3, $6);
596

597
                $options =~ s/^\s+//;
598
                # Separate each '--foo bar' with newlines for readability
599
                $options =~ s/ --/\n--/g;
600
                qq{<span title="$full_path"><b>podman$remote</b></span> <span class=\"boring\" title=\"$options\">[options]</span><b>$args</b>};
601
            }e;
602

603
            # Quadlet output messages have a weird "... with FOO=path"
604
            # addition that's hard to read. Make it friendlier.
605
            #          1        2       213    34                45   5
606
            $line =~ s{(\S+/bin/(quadlet))(\s.*)(\s+with\s+Q\S+?=)(\S+)}
607
                      {<span title="$1"><b>$2$3</b></span><span class="boring">$4</span><b>$5</b>};
608

609
            $current_output = '';
610
        }
611
        # Windows
612
        #                 1   12                        2  3  3
613
        elsif ($line =~ /^(\s*)(C:\\Users.*\\podman\.exe)\s(.*)$/) {
614
            $line = qq{$1C&gt; <span title="$2"><b>podman.exe</b></span> <b>$3</b>};
615
        }
616
        elsif ($line =~ /^\s*Error:/ || $line =~ / level=(warning|error) /) {
617
            $line = "<span class='log-warning'>" . $line . "</span>";
618
        }
619
        elsif ($line =~ /^panic:/) {
620
            $line = "<span class='log-error'>" . $line . "</span>";
621
        }
622
        else {
623
            $current_output .= ' ' . $line;
624
        }
625

626
        # One line after each divider, there's a status/timing line.
627
        if ($after_divider == 1) {
628
            # When run with -p, ginkgo emits timing information on the
629
            # first line after the divider. (Without -p, it's at the end).
630
            # Recognize this, because it affects our recognition (below)
631
            # of the test name.
632
            $line =~ s{(\[(\d+)\.\d+\s+seconds\])}{
633
                if ($2 > 5) { "<b><span class='log-slow'>$1</span></b>" }
634
                else        { "<b>$1</b>" }
635
            }e && --$after_divider;
636

637
            # Make FAILED and SKIPPING visible. (Only works with ginkgo -p;
638
            # without -p, status is at the bottom of the test block)
639
            if ($line =~ s!^(.*\[(SKIPPED|FAILED|FLAKEY).*\].*)!<span class="log-\L$2\E">$1</span>!) {
640
                $subtest_status = lc($2);
641
            }
642

643
            # FIXME: gray out entire block if it's skipped?
644
        }
645

646
        # Test name recognition, linking, and highlighting.
647
        # The lines after each divider, until the first empty line, are
648
        # one or more test name specifiers, a nested level of Description()
649
        # and It() names:
650
        #    -----------
651
        #    * blah [N seconds]     <<<---- only when run with -p
652
        #    Podman foo
653
        #    /var/tmp/go/src/path/to/this/file.go:lineno
654
        #       podman bar
655
        #       /var/tmp/go/src/path/to/this/file.go:lineno
656
        #
657
        # There may even be three nested levels (e.g., quadlet). We
658
        # look for non-path lines and assemble them -- "Podman foo",
659
        # " Podman foo podman bar" -- giving each an HTML anchor
660
        # to which we can link from the summary section at bottom.
661
        if ($after_divider <= 10) {      # Assume no more than ~5 levels
662
            if ($line =~ /^\s*$/) {
663
                # Stop looking when we get to the blank line
664
                $after_divider = 999;
665
            }
666
            elsif ($line =~ /span.*class=.boring./) {
667
                # Sigh. Bindings tests run without -p, and have no blank line
668
                # separator. Use the first command to signal real logs.
669
                # FIXME: can we solve this with ReportBeforeEach()?
670
                #   https://onsi.github.io/ginkgo/#generating-reports-programmatically
671
                $after_divider = 999;
672
            }
673
            elsif ($line =~ m!^\s*(/\S+|C:/)!) {
674
                # Source code path: skip
675
            }
676
            elsif ($line =~ /<b/) {
677
                # Already-formatted line (like the "N seconds" one): skip
678
            }
679
            elsif ($line =~ /^\s*(\[It\]\s*)?(.*)/) {
680
                # Test description or name! Remove the "It", and make an anchor
681
                $subtest_name .= " " if $subtest_name;
682
                $subtest_name .= $2;
683
                my $id = make_id($subtest_name, 'anchor');
684
                $line = "<a name='t--$id'><h2 class=\"log-$subtest_status\">$line</h2></a>";
685

686
                # Special case for tests that fail outside of a Describe()
687
                # block, e.g., global After/BeforeEach. We still want to
688
                # highlight those in the <h2>, but do not include "TOP-LEVEL"
689
                # in the anchor name for the actual test name (which will
690
                # come later, a few lines down).
691
                $subtest_name = '' if $subtest_name =~ /^\s*TOP-LEVEL/;
692
            }
693
        }
694
        ++$after_divider;
695

696
        # Highlight test name when it appears in the middle of commands.
697
        # But make it boring, because we already have the test name in large
698
        # bold just above. (Except in skipped tests).
699
        $line =~ s!^(\s*)(\[It\]\s+.*)!$1<span class="testname">$2</span>!;
700

701
        # Failure name corresponds to a previously-seen block.
702
        #              1     2           2   3  3   4                       4   15           5
703
        if ($line =~ /^(\s*\[(FAIL|PANIC!)\] (.*) \[(It|BeforeEach|AfterEach)\] )([A-Za-z-].*)/) {
704
            my ($lhs, $type, $desc, $ginkgo_fluff, $testname) = ($1, $2, $3, $4, $5);
705
            $desc =~ s/^TOP-LEVEL\s*//;
706
            my $id = make_id("$desc $testname", 'link');
707

708
            $line = "<span class=\"log-error\">$lhs<a href='#t--$id'>$testname</a></span>";
709
        }
710

711
        print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
712
            if $timestamp;
713
        print { $out_fh } $line, "\n";
714
    }
715

716
    my $have_formatted_log;     # Set on success
717

718
    if ($out_fh) {
719
        # Summary line for BATS tests
720
        if (keys %bats_count) {
721
            print { $out_fh } "<hr/><span class='bats-summary'>Summary:";
722
            my $total = 0;
723
            my $comma = '';
724
            for my $class (qw(passed failed skipped)) {
725
                if (my $n = $bats_count{$class}) {
726
                    printf { $out_fh } "%s <span class='bats-%s'>%d %s</span>",
727
                        $comma, $class, $n, ucfirst($class);
728
                    $total += $n;
729
                    $comma = ',';
730
                }
731
            }
732

733
            printf { $out_fh } ". Total tests: $total";
734
            if (my $expected_total = $bats_count{expected_total}) {
735
                if ($total != $expected_total) {
736
                    print { $out_fh } " <span class='bats-failed'>(WARNING: expected $expected_total)</span>";
737
                }
738
            }
739
            print { $out_fh } "</span>\n";
740
        }
741

742
        print { $out_fh } "</pre>  <!-- end processed output -->\n";
743

744
        # Did we find a cirrus task? Link back.
745
        if ($cirrus_task) {
746
            print { $out_fh } <<"END_HTML";
747
<hr />
748
<h3>Cirrus <a href="https://cirrus-ci.com/task/$cirrus_task">task $cirrus_task</a></h3>
749
END_HTML
750
        }
751

752
        # FIXME: need a safe way to get TZ
753
        printf { $out_fh } <<"END_HTML", scalar(CORE::localtime);
754
<hr />
755
<small>Processed %s by $ME v$VERSION</small>
756
</body>
757
</html>
758
END_HTML
759

760
        if (close $out_fh) {
761
            if (rename $out_tmp => $outfile) {
762
                $have_formatted_log = 1;
763
            }
764
            else {
765
                warn "$ME: Could not rename $out_tmp: $!\n";
766
            }
767
        }
768
        else {
769
            warn "$ME: Error writing $out_tmp: $!\n";
770
        }
771
    }
772

773
    # Grumble. Github only shows the last N lines of the log... which is
774
    # anti-helpful when you want a quick synopsis of what failed. Write a
775
    # summary at the tail, to make it easier for humans to see what went wrong.
776
    if (my $fails = $bats_count{__fail_list}) {
777
        print  "\n";
778
        printf "Failed tests (%d):\n", scalar(@$fails);
779
        printf " - %d %s\n", @$_ for @$fails;
780
    }
781

782
    # If Cirrus magic envariables are available, write a link to results.
783
    # FIXME: it'd be so nice to make this a clickable live link.
784
    #
785
    # As of June 2022 we use the Cirrus API[1] as the source of our logs,
786
    # instead of linking directly to googleapis.com. This will allow us
787
    # to abstract cloud-specific details, so we can one day use Amazon cloud.
788
    # See #14569 for more info.
789
    #
790
    #   [1] https://cirrus-ci.org/guide/writing-tasks/#latest-build-artifacts
791
    if ($have_formatted_log && $ENV{CIRRUS_TASK_ID}) {
792
        my $URL_BASE = "https://api.cirrus-ci.com";
793
        my $task_id  = $ENV{CIRRUS_TASK_ID};
794

795
        # Link by *taskID*, not buildID + taskname. First, this is shorter
796
        # and less duplicaty. Second, and more important, buildID + taskname
797
        # is non-unique, and a link to a flake log will be clobbered.
798
        my $URL = "${URL_BASE}/v1/artifact/task/$task_id/html/${outfile}";
799

800
        print "\n\nAnnotated results:\n  $URL\n";
801
    }
802
}
803

804

805
#############
806
#  make_id  #  Given a test name, generate an anchor link name
807
#############
808
sub make_id {
809
    my $name = shift;                   # in: test title
810
    my $type = shift;                   # in: differentiator (anchor, link)
811

812
    state %counter;
813

814
    $name =~ s/\r//g;                   # strip windows ^Ms
815
    $name =~ s/^\s+|\s+$//g;            # strip leading/trailing whitespace
816
    $name =~ s/^\[It\]\s*//;            # strip leading "[It] "
817
    $name =~ s/\&#\d+;//g;              # 'doesn&#39;t' -> 'doesnt'
818
    $name =~ s/\&quot;/-/g;             # '&quot;path&quot;' -> '-path-'
819
    $name =~ s/[^a-zA-Z0-9_-]/-/g;      # Convert non-alphanumeric to dash
820
    $name =~ s/-{3,}/-/g;               # '------' to just '-'
821

822
    # Keep a running tally of how many times we've seen this identifier
823
    # for this given type! This lets us cross-match, in the bottom of
824
    # the page, the first/second/third failure of a given test.
825
    $name .= "--" . ++$counter{$type}{$name};
826

827
    $name;
828
}
829

830

831
###############################################################################
832
# BEGIN job_synopsis and related helpers
833

834
##################
835
#  job_synopsis  #  Job details, links to github/cirrus
836
##################
837
sub job_synopsis {
838
    my $subtest_name = shift;           # e.g. integration_test
839

840
    my $s = <<"END_SYNOPSIS";
841
<table class="synopsis">
842
END_SYNOPSIS
843

844
    # PR 1234 - title of the pr
845
    my $pr_title = escapeHTML(_env_replace("{CIRRUS_CHANGE_TITLE}"));
846
    $s .= _tr("GitHub PR", sprintf("%s - %s",
847
                                   _a("{CIRRUS_PR}", "https://{CIRRUS_REPO_CLONE_HOST}/{CIRRUS_REPO_FULL_NAME}/pull/{CIRRUS_PR}"),
848
                                   $pr_title));
849

850
    # PR author, if signed-off-by
851
    if (my $msg = _env_replace("{CIRRUS_COMMIT_MESSAGE}")) {
852
        while ($msg =~ /^Signed-off-by:\s+(\S.*\S)$/gmi) {
853
            $s .= _tr("Author", escapeHTML($1));
854
        }
855
    }
856

857
    # eg "test fedora", "special_testing_rootless"
858
    # WARNING: As of 2020-10-05, $CIRRUS_TASK_NAME reflects the same
859
    # descriptive content as our $subtest_name argument (confirm via
860
    # cross-checking runner.sh:logformatter() vs cirrus.yml:&std_name_fmt).
861
    # If this ever becomes untrue, just add _tr("Subtest", $subtest_name).
862
    my $test_name = _env_replace("{CIRRUS_TASK_NAME}");
863
    # (Special-case cleanup: Cirrus\ quotes\ spaces; remove for readability).
864
    $test_name =~ s/\\\s+/ /g;
865
    $s .= _tr("Test name", $test_name);
866

867
    # Macs always have to be different
868
    my $is_mac = ($test_name =~ /darwin/);
869

870
    # Link to further Cirrus results, e.g. other runs.
871
    # Build is mostly boring, it's usually TASK that we want to see.
872
    $s .= _tr("Cirrus", sprintf("<small>Build %s</small> / <b>Task %s</b>",
873
                                _a("{CIRRUS_BUILD_ID}", "https://cirrus-ci.com/build/{CIRRUS_BUILD_ID}"),
874
                                _a("{CIRRUS_TASK_ID}", "https://cirrus-ci.com/task/{CIRRUS_TASK_ID}")));
875

876
    # Logs: link to original (unformatted) log; journal; and, if remote, server
877
    my @logs;
878
    push @logs, _a("main", sprintf("https://api.cirrus-ci.com/v1/task/{CIRRUS_TASK_ID}/logs/%s.log",
879
                                   ($is_mac ? 'test' : 'main')));
880
    push @logs, _a("journal", "https://api.cirrus-ci.com/v1/task/{CIRRUS_TASK_ID}/logs/journal.log")
881
        unless $is_mac;
882

883
    # System tests are single-threaded, and have a server log available
884
    if ($test_name =~ /sys\s+remote\s/) {
885
        push @logs, _a("remote server", "https://api.cirrus-ci.com/v1/artifact/task/{CIRRUS_TASK_ID}/server_log/podman-server.log");
886
    }
887
    $s .= _tr("Logs", join(" / ", @logs));
888

889
    # BASE_SHA can tell us if our parent includes--or doesn't--a purported
890
    # fix for a flake. Note that "commits", plural, links to a git history
891
    # listing; if we used "commit", singular, that would be less useful.
892
    $s .= _tr("Base commit", _a("{CIRRUS_BASE_SHA}", "https://{CIRRUS_REPO_CLONE_HOST}/{CIRRUS_REPO_FULL_NAME}/commits/{CIRRUS_BASE_SHA}"));
893

894
    $s .= "</table>\n";
895
    return $s;
896
}
897

898

899
sub _tr {
900
    my ($th, $td) = @_;
901
    return "<tr><th>$th:</th><td>$td</td></tr>\n";
902
}
903

904
sub _a {
905
    my ($name, $href) = map { _env_replace($_) } @_;
906

907
    if ($href =~ /UNDEFINED/) {
908
        return "$name ($href)";
909
    }
910
    return "<a href='$href'>$name</a>";
911
}
912

913
sub _env_replace {
914
    my $s_in = shift;
915

916
    $s_in =~ s[\{(.*?)\}][$ENV{$1} || "[$1 UNDEFINED]"]ge;
917

918
    return $s_in;
919
}
920

921
# END   job_synopsis and related helpers
922
###############################################################################
923
# BEGIN html-formatting helpers
924

925
sub escapeHTML {
926
    my $s = shift;
927

928
    state %chars;
929
    %chars = ('&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&#39;')
930
        if keys(%chars) == 0;
931
    my $class = join('', sort keys %chars);
932
    $s =~ s/([$class])/$chars{$1}/ge;
933

934
    return $s;
935
}
936

937
sub unescapeHTML {
938
    my $s = shift;
939

940
    # We don't actually care about the character, only its length
941
    $s =~ s/\&\#?[a-z0-9]+;/./g;
942

943
    return $s;
944
}
945

946
# END   html-formatting helpers
947
###############################################################################
948

949
1;
950