podman

1
#!/usr/bin/perl
2
#
3
# xref-helpmsgs-manpages - cross-reference --help options against man pages
4
#
5
package LibPod::CI::XrefHelpmsgsManpages;
6

7
use v5.14;
8
use utf8;
9

10
use strict;
11
use warnings;
12
use Clone                       qw(clone);
13
use FindBin;
14

15
(our $ME = $0) =~ s|.*/||;
16
our $VERSION = '0.1';
17

18
# For debugging, show data structures using DumpTree($var)
19
#use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
20

21
# unbuffer output
22
$| = 1;
23

24
###############################################################################
25
# BEGIN user-customizable section
26

27
# Path to podman executable
28
my $Default_Podman = "$FindBin::Bin/../bin/podman";
29
my $PODMAN = $ENV{PODMAN} || $Default_Podman;
30

31
# Path to all doc files, including .rst and (down one level) markdown
32
our $Docs_Path = 'docs/source';
33

34
# Path to podman markdown source files (of the form podman-*.1.md)
35
our $Markdown_Path = "$Docs_Path/markdown";
36

37
# Global error count
38
our $Errs = 0;
39

40
# Table of exceptions for documenting fields in '--format {{.Foo}}'
41
#
42
# Autocomplete is wonderful, and it's even better when we document the
43
# existing options. Unfortunately, sometimes internal structures get
44
# exposed that are of no use to anyone and cannot be guaranteed. Avoid
45
# documenting those. This table lists those exceptions. Format is:
46
#
47
#      foo       .Bar
48
#
49
# ...such that "podman foo --format '{{.Bar}}'" will not be documented.
50
#
51
my $Format_Exceptions = <<'END_EXCEPTIONS';
52
# Deep internal structs; pretty sure these are permanent exceptions
53
events       .Details
54
history      .ImageHistoryLayer
55
images       .Arch .ImageSummary .Os .IsManifestList
56
network-ls   .Network
57

58
# FIXME: this one, maybe? But someone needs to write the text
59
machine-list    .Starting
60

61
# No clue what these are. Some are just different-case dups of others.
62
pod-ps  .Containers .Id .InfraId .ListPodsReport .Namespace
63
ps      .Cgroup .CGROUPNS .IPC .ListContainer .MNT .Namespaces .NET .PIDNS .User .USERNS .UTS
64

65
# I think .Destination is an internal struct, but .IsMachine maybe needs doc?
66
system-connection-list .Destination .IsMachine
67
END_EXCEPTIONS
68

69
my %Format_Exceptions;
70
for my $line (split "\n", $Format_Exceptions) {
71
    $line =~ s/#.*$//;                  # strip comments
72
    next unless $line;                  # skip empty lines
73
    my ($subcommand, @fields) = split(' ', $line);
74
    $Format_Exceptions{"podman-$subcommand"} = \@fields;
75
}
76

77
# Hardcoded list of podman commands for which '--format' does NOT mean
78
# a Go format.
79
#
80
# I realize that it looks stupid to hardcode these: I could instead
81
# check "--format ''" and look for completion strings, 'oci', 'json',
82
# doesn't matter: if anything shows up, we excuse the missing '{{.'.
83
# (We'd still have to make a special exception for 'podman inspect').
84
#
85
# My reason for hardcoding is that these should be rare exceptions
86
# and we want to account for every single one. If a new command gets
87
# added, with a --format option that does not autocomplete '{{.',
88
# let's make sure it gets extra eyeballs.
89
my %Format_Option_Is_Special = map { $_ => 1 } (
90
    'build',  'farm build', 'image build',      # oci | docker
91
    'commit', 'container commit',               #  "  "  " "
92
    'diff',   'container diff', 'image diff',   # only supports "json"
93
    'generate systemd',                         #  "    "  "      "
94
    'mount',  'container mount', 'image mount', #  "    "  "      "
95
    'push',   'image push', 'manifest push',    # oci | v2s*
96
    'save',   'image save',                     # image formats (oci-*, ...)
97
    'inspect',                                  # ambiguous (container/image)
98
 );
99

100
# Hardcoded list of existing duplicate-except-for-case format codes,
101
# with their associated subcommands. Let's not add any more.
102
my %Format_Option_Dup_Allowed = (
103
    'podman-images' => { '.id'     => 1 },
104
    'podman-stats'  => { '.avgcpu' => 1, '.pids' => 1 },
105
);
106

107
# Do not cross-reference these.
108
my %Skip_Subcommand = map { $_ => 1 } (
109
    "help",                     # has no man page
110
    "completion",               # internal (hidden) subcommand
111
    "compose",                  # external tool, outside of our control
112
);
113

114
# END   user-customizable section
115
###############################################################################
116
# BEGIN boilerplate args checking, usage messages
117

118
sub usage {
119
    print  <<"END_USAGE";
120
Usage: $ME [OPTIONS]
121

122
$ME recursively runs 'podman --help' against
123
all subcommands; and recursively reads podman-*.1.md files
124
in $Markdown_Path, then cross-references that each --help
125
option is listed in the appropriate man page and vice-versa.
126

127
$ME invokes '\$PODMAN' (default: $Default_Podman).
128

129
In the spirit of shoehorning functionality where it wasn't intended,
130
$ME also checks the SEE ALSO section of each man page
131
to ensure that references and links are properly formatted
132
and valid.
133

134
Exit status is zero if no inconsistencies found, one otherwise
135

136
OPTIONS:
137

138
  -v, --verbose  show verbose progress indicators
139
  -n, --dry-run  make no actual changes
140

141
  --help         display this message
142
  --version      display program name and version
143
END_USAGE
144

145
    exit;
146
}
147

148
# Command-line options.  Note that this operates directly on @ARGV !
149
our $debug   = 0;
150
our $verbose = 0;
151
sub handle_opts {
152
    use Getopt::Long;
153
    GetOptions(
154
        'debug!'     => \$debug,
155
        'verbose|v'  => \$verbose,
156

157
        help         => \&usage,
158
        version      => sub { print "$ME version $VERSION\n"; exit 0 },
159
    ) or die "Try `$ME --help' for help\n";
160
}
161

162
# END   boilerplate args checking, usage messages
163
###############################################################################
164

165
############################## CODE BEGINS HERE ###############################
166

167
# The term is "modulino".
168
__PACKAGE__->main()                                     unless caller();
169

170
# Main code.
171
sub main {
172
    # Note that we operate directly on @ARGV, not on function parameters.
173
    # This is deliberate: it's because Getopt::Long only operates on @ARGV
174
    # and there's no clean way to make it use @_.
175
    handle_opts();                      # will set package globals
176

177
    # Fetch command-line arguments.  Barf if too many.
178
    die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;
179

180
    chdir "$FindBin::Bin/.."
181
        or die "$ME: FATAL: Cannot cd $FindBin::Bin/..: $!";
182

183
    my $help = podman_help();
184
    my $man  = podman_man('podman');
185
    my $rst  = podman_rst();
186

187
    xref_by_help($help, $man);
188
    xref_by_man($help, $man);
189

190
    xref_rst($help, $rst);
191

192
    exit !!$Errs;
193
}
194

195
###############################################################################
196
# BEGIN cross-referencing
197

198
##################
199
#  xref_by_help  #  Find keys in '--help' but not in man
200
##################
201
sub xref_by_help {
202
    my ($help, $man, @subcommand) = @_;
203

204
  OPTION:
205
    for my $k (sort keys %$help) {
206
        next if $k =~ /^_/;             # metadata ("_desc"). Ignore.
207

208
        if (! ref($man)) {
209
            # Super-unlikely but I've seen it
210
            warn "$ME: 'podman @subcommand' is not documented in man pages!\n";
211
            ++$Errs;
212
            next OPTION;
213
        }
214

215
        if (exists $man->{$k}) {
216
            if (ref $help->{$k}) {
217
                # This happens when 'podman foo --format' offers
218
                # autocompletion that looks like a Go template, but those
219
                # template options aren't documented in the man pages.
220
                if ($k eq '--format' && ! ref($man->{$k})) {
221
                    # "podman inspect" tries to autodetect if it's being run
222
                    # on an image or container. It cannot sanely be documented.
223
                    unless ("@subcommand" eq "inspect") {
224
                        warn "$ME: 'podman @subcommand': --format options are available through autocomplete, but are not documented in $man->{_path}\n";
225
                        ++$Errs;
226
                    }
227
                    next OPTION;
228
                }
229

230
                xref_by_help($help->{$k}, $man->{$k}, @subcommand, $k);
231
            }
232

233
            # Documenting --format fields is tricky! They can be scalars, structs,
234
            # or functions. This is a complicated block because if help & man don't
235
            # match, we want to give the most user-friendly message possible.
236
            elsif (@subcommand && $subcommand[-1] eq '--format') {
237
                # '!' is one of the Format_Exceptions defined at top
238
                if (($man->{$k} ne '!') && ($man->{$k} ne $help->{$k})) {
239
                    # Fallback message
240
                    my $msg = "TELL ED TO HANDLE THIS: man='$man->{$k}' help='$help->{$k}'";
241

242
                    # Many different permutations of mismatches.
243
                    my $combo = "$man->{$k}-$help->{$k}";
244
                    if ($combo eq '0-...') {
245
                        $msg = "is a nested structure. Please add '...' to man page.";
246
                    }
247
                    elsif ($combo =~ /^\d+-\.\.\.$/) {
248
                        $msg = "is a nested structure, but the man page documents it as a function?!?";
249
                    }
250
                    elsif ($combo eq '...-0') {
251
                        $msg = "is a simple value, not a nested structure. Please remove '...' from man page.";
252
                    }
253
                    elsif ($combo =~ /^0-[1-9]\d*$/) {
254
                        $msg = "is a function that calls for $help->{$k} args. Please investigate what those are, then add them to the man page. E.g., '$k *bool*' or '$k *path* *bool*'";
255
                    }
256
                    elsif ($combo =~ /^\d+-[1-9]\d*$/) {
257
                        $msg = "is a function that calls for $help->{$k} args; the man page lists $man->{$k}. Please fix the man page.";
258
                    }
259

260
                    warn "$ME: 'podman @subcommand {{$k' $msg\n";
261
                    ++$Errs;
262
                }
263
            }
264
        }
265
        else {
266
            # Not documented in man. However, handle '...' as a special case
267
            # in formatting strings. E.g., 'podman info .Host' is documented
268
            # in the man page as '.Host ...' to indicate that the subfields
269
            # are way too many to list individually.
270
            my $k_copy = $k;
271
            while ($k_copy =~ s/\.[^.]+$//) {
272
                my $parent_man = $man->{$k_copy} // '';
273
                if (($parent_man eq '...') || ($parent_man eq '!')) {
274
                    next OPTION;
275
                }
276
            }
277

278
            # Nope, it's not that case.
279
            my $man = $man->{_path} || 'man';
280
            # The usual case is "podman ... --help"...
281
            my $what = '--help';
282
            # ...but for *options* (e.g. --filter), we're checking command completion
283
            $what = '<TAB>' if @subcommand && $subcommand[-1] =~ /^--/;
284
            warn "$ME: 'podman @subcommand $what' lists '$k', which is not in $man\n";
285
            ++$Errs;
286
        }
287
    }
288
}
289

290
#################
291
#  xref_by_man  #  Find keys in man pages but not in --help
292
#################
293
#
294
# In an ideal world we could share the functionality in one function; but
295
# there are just too many special cases in man pages.
296
#
297
sub xref_by_man {
298
    my ($help, $man, @subcommand) = @_;
299

300
    # FIXME: this generates way too much output
301
  KEYWORD:
302
    for my $k (grep { $_ ne '_path' } sort keys %$man) {
303
        if ($k eq '--format' && ref($man->{$k}) && ! ref($help->{$k})) {
304
            warn "$ME: 'podman @subcommand': --format options documented in man page, but not available via autocomplete\n";
305
            next KEYWORD;
306
        }
307

308
        if (exists $help->{$k}) {
309
            if (ref $man->{$k}) {
310
                xref_by_man($help->{$k}, $man->{$k}, @subcommand, $k);
311
            }
312
            elsif ($k =~ /^-/) {
313
                # This is OK: we don't recurse into options
314
            }
315
            else {
316
                # FIXME: should never get here, but we do. Figure it out later.
317
            }
318
        }
319
        elsif ($k ne '--help' && $k ne '-h') {
320
            my $man = $man->{_path} || 'man';
321

322
            # Special case: podman-inspect serves dual purpose (image, ctr)
323
            my %ignore = map { $_ => 1 } qw(-l -s -t --latest --size --type);
324
            next if $man =~ /-inspect/ && $ignore{$k};
325

326
            # Special case: podman-diff serves dual purpose (image, ctr)
327
            my %diffignore = map { $_ => 1 } qw(-l --latest );
328
            next if $man =~ /-diff/ && $diffignore{$k};
329

330
            # Special case: the 'trust' man page is a mess
331
            next if $man =~ /-trust/;
332

333
            # Special case: '--net' is an undocumented shortcut
334
            next if $k eq '--net' && $help->{'--network'};
335

336
            # Special case: these are actually global options
337
            next if $k =~ /^--(cni-config-dir|runtime)$/ && $man =~ /-build/;
338

339
            # Special case: weirdness with Cobra and global/local options
340
            next if $k eq '--namespace' && $man =~ /-ps/;
341

342
            next if "@subcommand" eq 'system' && $k eq 'service';
343

344
            # Special case for hidden or external commands
345
            next if $Skip_Subcommand{$k};
346

347
            # It's not always --help, sometimes we check <TAB> completion
348
            my $what = '--help';
349
            $what = 'command completion' if @subcommand && $subcommand[-1] =~ /^--/;
350
            warn "$ME: 'podman @subcommand': '$k' in $man, but not in $what\n";
351
            ++$Errs;
352
        }
353
    }
354
}
355

356
##############
357
#  xref_rst  #  Cross-check *.rst files against help
358
##############
359
#
360
# This makes a pass over top-level commands only. There is no rst
361
# documentation for any podman subcommands.
362
#
363
sub xref_rst {
364
    my ($help, $rst) = @_;
365

366

367
    # We key on $help because that is Absolute Truth: anything in podman --help
368
    # must be referenced in an rst (the converse is not necessarily true)
369
    for my $k (sort grep { $_ !~ /^[_-]/ } keys %$help) {
370
        if (exists $rst->{$k}) {
371
            # Descriptions must match
372
            if ($rst->{$k}{_desc} ne $help->{$k}{_desc}) {
373
                warn "$ME: podman $k: inconsistent description in $rst->{$k}{_source}:\n";
374
                warn "   help: '$help->{$k}{_desc}'\n";
375
                warn "   rst:  '$rst->{$k}{_desc}'\n";
376
                ++$Errs;
377
            }
378
        }
379
        else {
380
            warn "$ME: Not found in rst: $k\n";
381
            ++$Errs;
382
         }
383
    }
384

385
    # Now the other way around: look for anything in Commands.rst that is
386
    # not in podman --help
387
    for my $k (sort grep { $rst->{$_}{_source} =~ /Commands.rst/ } keys %$rst) {
388
        if ($k ne 'Podman' && ! exists $help->{$k}) {
389
            warn "$ME: 'podman $k' found in $rst->{$k}{_source} but not 'podman help'\n";
390
            ++$Errs;
391
        }
392
    }
393
}
394

395
# END   cross-referencing
396
###############################################################################
397
# BEGIN data gathering
398

399
#################
400
#  podman_help  #  Parse output of 'podman [subcommand] --help'
401
#################
402
sub podman_help {
403
    my %help;
404
    open my $fh, '-|', $PODMAN, @_, '--help'
405
        or die "$ME: Cannot fork: $!\n";
406
    my $section = '';
407
    while (my $line = <$fh>) {
408
        chomp $line;
409

410
        # First line of --help is a short command description. We compare it
411
        # (in a later step) against the blurb in Commands.rst.
412
        # FIXME: we should crossref against man pages, but as of 2024-03-18
413
        # it would be way too much work to get those aligned.
414
        $help{_desc} //= $line;
415

416
        # Cobra is blessedly consistent in its output:
417
        #    [command blurb]
418
        #    Description: ...
419
        #    Usage: ...
420
        #    Available Commands:
421
        #       ....
422
        #    Options:
423
        #       ....
424
        #
425
        # Start by identifying the section we're in...
426
        if ($line =~ /^Available\s+(Commands):/) {
427
            $section = lc $1;
428
        }
429
        elsif ($line =~ /^(Options):/) {
430
            $section = lc $1;
431
        }
432

433
        # ...then track commands and options. For subcommands, recurse.
434
        elsif ($section eq 'commands') {
435
            if ($line =~ /^\s{1,4}(\S+)\s/) {
436
                my $subcommand = $1;
437
                print "> podman @_ $subcommand\n"               if $debug;
438

439
                # check that the same subcommand is not listed twice (#12356)
440
                if (exists $help{$subcommand}) {
441
                    warn "$ME: 'podman @_ help' lists '$subcommand' twice\n";
442
                    ++$Errs;
443
                }
444

445
                $help{$subcommand} = podman_help(@_, $subcommand)
446
                    unless $Skip_Subcommand{$subcommand};
447
            }
448
        }
449
        elsif ($section eq 'options') {
450
            my $opt = '';
451

452
            # Handle '--foo' or '-f, --foo'
453
            if ($line =~ /^\s{1,10}(--\S+)\s/) {
454
                print "> podman @_ $1\n"                        if $debug;
455
                $opt = $1;
456
                $help{$opt} = 1;
457
            }
458
            elsif ($line =~ /^\s{1,10}(-\S),\s+(--\S+)\s/) {
459
                print "> podman @_ $1, $2\n"                    if $debug;
460
                $opt = $2;
461
                $help{$1} = $help{$opt} = 1;
462
            }
463

464
            # Special case for --format: run podman with autocomplete.
465
            # If that lists one or more '{{.Foo<something>' entries,
466
            # convert our option data structure from scalar (indicating
467
            # that we just cross-check for existence in the man page)
468
            # to hashref (indicating that we recurse down and cross-check
469
            # each individual param).
470
            #
471
            # There are three possibilities for <something>:
472
            #    {{.Foo}}  (end braces)       | terminal node. Usual case.
473
            #    {{.Foo.   (dot)              | deeper struct. Hard to handle.
474
            #    {{.Foo This is a function... | function. Rare, and " " " "
475
            #
476
            if ($opt eq '--format') {
477
                my @completions = _completions(@_, '--format', '{{.');
478
                for my $c (@completions) {
479
                    if ($c =~ /^\{\{(\.\S+)(\s+This.*\s(\d+)\s+arg.*)?$/) {
480
                        my ($fmt, $n_args) = ($1, $3 || 0);
481
                        # Strip off braces/dot, leaving just the name
482
                        $fmt =~ s/(\.|\}\})$//;
483
                        my $stripped = $1;
484

485
                        # First time through: convert to a hashref
486
                        $help{$opt} = {}   if ! ref($help{$opt});
487

488
                        # Remember this param
489
                        if ($stripped eq '}}') {
490
                            $n_args = 0;
491
                        }
492
                        elsif ($stripped eq '.') {
493
                            $n_args = '...';
494
                        }
495
                        $help{$opt}{$fmt} = $n_args;
496
                    }
497
                }
498

499
                # If subcommand supports '--format {{.x', it should also
500
                # support '--format json'
501
                if (ref $help{$opt}) {
502
                    my @json = _completions(@_, '--format', 'json');
503
                    if (! grep { $_ eq 'json' } @json) {
504
                        warn "$ME: podman @_ --format json is unimplemented\n";
505
                        ++$Errs;
506
                    }
507
                }
508

509
                else {
510
                    # --format option for this subcommand does not support
511
                    # completion for Go templates. This is OK for an
512
                    # existing set of commands (see table at top of script)
513
                    # but is a fatal error for any others, presumably a
514
                    # new subcommand. Either the subcommand must be fixed
515
                    # to support autocompletion, or the subcommand must be
516
                    # added to our exclusion list at top.
517
                    unless ($Format_Option_Is_Special{"@_"}) {
518
                        warn "$ME: podman @_ --format '{{.' does not offer autocompletion\n";
519
                        ++$Errs;
520
                    }
521
                }
522
            }
523
            # Same thing, for --filter
524
            elsif ($opt eq '--filter') {
525
                my @completions = _completions(@_, '--filter=');
526
                for my $c (@completions) {
527
                    if ($c =~ /^(\S+)=/) {
528
                        $help{$opt} = {} if ! ref($help{$opt});
529
                        $help{$opt}{$1} = 1;
530
                    }
531
                }
532
            }
533
        }
534
    }
535
    close $fh
536
        or die "$ME: Error running 'podman @_ --help'\n";
537

538
    return \%help;
539
}
540

541

542
################
543
#  podman_man  #  Parse contents of podman-*.1.md
544
################
545
our %Man_Seen;
546
sub podman_man {
547
    my $command = shift;
548
    my $subpath = "$Markdown_Path/$command.1.md";
549
    print "** $subpath \n"                              if $debug;
550

551
    my %man = (_path => $subpath);
552

553
    # We often get called multiple times on the same man page,
554
    # because (e.g.) podman-container-list == podman-ps. It's the
555
    # same man page text, though, and we don't know which subcommand
556
    # we're being called for, so there's nothing to be gained by
557
    # rereading the man page or by dumping yet more warnings
558
    # at the user. So, keep a cache of what we've done.
559
    if (my $seen = $Man_Seen{$subpath}) {
560
        return clone($seen);
561
    }
562
    $Man_Seen{$subpath} = \%man;
563

564
    open my $fh, '<', $subpath
565
        or die "$ME: Cannot read $subpath: $!\n";
566
    my $section = '';
567
    my @most_recent_flags;
568
    my $previous_subcmd = '';
569
    my $previous_flag = '';
570
    my $previous_format = '';
571
    my $previous_filter = '';
572
  LINE:
573
    while (my $line = <$fh>) {
574
        chomp $line;
575
        next LINE unless $line;		# skip empty lines
576

577
        # First line (page title) must match the command name.
578
        if ($line =~ /^%\s+/) {
579
            my $expect = "% $command 1";
580
            if ($line ne $expect) {
581
                warn "$ME: $subpath:$.: wrong title line '$line'; should be '$expect'\n";
582
                ++$Errs;
583
            }
584
        }
585

586
        # .md files designate sections with leading double hash
587
        if ($line =~ /^##\s*(GLOBAL\s+)?OPTIONS/) {
588
            $section = 'flags';
589
            $previous_flag = '';
590
        }
591
        elsif ($line =~ /^###\s+\w+\s+OPTIONS/) {
592
            # podman image trust has sections for set & show
593
            $section = 'flags';
594
            $previous_flag = '';
595
        }
596
        elsif ($line =~ /^\#\#\s+(SUB)?COMMANDS/) {
597
            $section = 'commands';
598
        }
599
        elsif ($line =~ /^\#\#\s+SEE\s+ALSO/) {
600
            $section = 'see-also';
601
        }
602
        elsif ($line =~ /^\#\#[^#]/) {
603
            $section = '';
604
        }
605

606
        # This will be a table containing subcommand names, links to man pages.
607
        # The format is slightly different between podman.1.md and subcommands.
608
        elsif ($section eq 'commands') {
609
            # In podman.1.md
610
            if ($line =~ /^\|\s*\[podman-(\S+?)\(\d\)\]/) {
611
                # $1 will be changed by recursion _*BEFORE*_ left-hand assignment
612
                my $subcmd = $1;
613
                $man{$subcmd} = podman_man("podman-$subcmd");
614
            }
615

616
            # In podman-<subcommand>.1.md
617
            #                      1   1        2  3   3    4   4         2
618
            elsif ($line =~ /^\|\s+(\S+)\s+\|\s+(\[(\S+)\]\((\S+)\.1\.md\))/) {
619
                my ($subcmd, $blob, $shown_name, $link_name) = ($1, $2, $3, $4);
620
                if ($previous_subcmd gt $subcmd) {
621
                    warn "$ME: $subpath:$.: '$previous_subcmd' and '$subcmd' are out of order\n";
622
                    ++$Errs;
623
                }
624
                if ($previous_subcmd eq $subcmd) {
625
                    warn "$ME: $subpath:$.: duplicate subcommand '$subcmd'\n";
626
                    ++$Errs;
627
                }
628
                $previous_subcmd = $subcmd;
629
                $man{$subcmd} = podman_man($link_name);
630

631
                # Check for inconsistencies between the displayed man page name
632
                # and the actual man page name, e.g.
633
                #  '[podman-bar(1)](podman-baz.1.md)
634
                $shown_name =~ s/\(\d\)$//;
635
                $shown_name =~ s/\\//g;         # backslashed hyphens
636
                (my $should_be = $link_name) =~ s/\.1\.md$//;
637
                if ($shown_name ne $should_be) {
638
                    warn "$ME: $subpath:$.: '$shown_name' should be '$should_be' in '$blob'\n";
639
                    ++$Errs;
640
                }
641
            }
642
        }
643

644
        # Options should always be of the form '**-f**' or '**\-\-flag**',
645
        # possibly separated by comma-space.
646
        elsif ($section eq 'flags') {
647
            # e.g. 'podman run --ip6', documented in man page, but nonexistent
648
            if ($line =~ /^not\s+implemented/i) {
649
                delete $man{$_} for @most_recent_flags;
650
            }
651

652
            @most_recent_flags = ();
653
            # As of PR #8292, all options are <h4> and anchored
654
            if ($line =~ s/^\#{4}\s+//) {
655
                # If option has long and short form, long must come first.
656
                # This is a while-loop because there may be multiple long
657
                # option names, e.g. --net/--network
658
                my $is_first = 1;
659
                while ($line =~ s/^\*\*(--[a-z0-9-]+)\*\*(,\s+)?//g) {
660
                    my $flag = $1;
661
                    $man{$flag} = 1;
662
                    if ($flag lt $previous_flag && $is_first) {
663
                        warn "$ME: $subpath:$.: $flag should precede $previous_flag\n";
664
                        ++$Errs;
665
                    }
666
                    if ($flag eq $previous_flag) {
667
                        warn "$ME: $subpath:$.: flag '$flag' is a dup\n";
668
                        ++$Errs;
669
                    }
670
                    $previous_flag = $flag if $is_first;
671
                    push @most_recent_flags, $flag;
672

673
                    # Further iterations of /g are allowed to be out of order,
674
                    # e.g., it's OK for "--namespace, -ns" to precede --nohead
675
                    $is_first = 0;
676
                }
677
                # Short form
678
                if ($line =~ s/^\*\*(-[a-zA-Z0-9])\*\*//) {
679
                    my $flag = $1;
680
                    $man{$flag} = 1;
681

682
                    # Keep track of them, in case we see 'Not implemented' below
683
                    push @most_recent_flags, $flag;
684
                }
685

686
                # Options with no '=whatever'
687
                next LINE if !$line;
688

689
                # Anything remaining *must* be of the form '=<possibilities>'
690
                if ($line !~ /^=/) {
691
                    warn "$ME: $subpath:$.: could not parse '$line' in option description\n";
692
                    ++$Errs;
693
                }
694

695
                # For some years it was traditional, albeit wrong, to write
696
                #     **--foo**=*bar*, **-f**
697
                # The correct way is to add =*bar* at the end.
698
                if ($line =~ s/,\s\*\*(-[a-zA-Z])\*\*//) {
699
                    $man{$1} = 1;
700
                    warn "$ME: $subpath:$.: please rewrite as ', **$1**$line'\n";
701
                    ++$Errs;
702
                }
703

704
                # List of possibilities ('=*a* | *b*') must be space-separated
705
                if ($line =~ /\|/) {
706
                    if ($line =~ /[^\s]\|[^\s]/) {
707
                        # Sigh, except for this one special case
708
                        if ($line !~ /SOURCE-VOLUME.*HOST-DIR.*CONTAINER-DIR/) {
709
                            warn "$ME: $subpath:$.: values must be space-separated: '$line'\n";
710
                            ++$Errs;
711
                        }
712
                    }
713
                    my $copy = $line;
714
                    if ($copy =~ s/\**true\**//) {
715
                        if ($copy =~ s/\**false\**//) {
716
                            if ($copy !~ /[a-z]/) {
717
                                warn "$ME: $subpath:$.: Do not enumerate true/false for boolean-only options\n";
718
                                ++$Errs;
719
                            }
720
                        }
721
                    }
722
                }
723
            }
724

725
            # --format does not always mean a Go format! E.g., push --format=oci
726
            if ($previous_flag eq '--format') {
727
                # ...but if there's a table like '| .Foo | blah blah |'
728
                # then it's definitely a Go template. There are three cases:
729
                #     .Foo        - Scalar field. The usual case.
730
                #     .Foo ...    - Structure with subfields, e.g. .Foo.Xyz
731
                #     .Foo ARG(s) - Function requiring one or more arguments
732
                #
733
                #                   1     12   3        32
734
                if ($line =~ /^\|\s+(\.\S+)(\s+([^\|]+\S))?\s+\|/) {
735
                    my ($format, $etc) = ($1, $3);
736

737
                    # Confirmed: we have a table with '.Foo' strings, so
738
                    # this is a Go template. Override previous (scalar)
739
                    # setting of the --format flag with a hash, indicating
740
                    # that we will recursively cross-check each param.
741
                    if (! ref($man{$previous_flag})) {
742
                        $man{$previous_flag} = { _path => $subpath };
743
                    }
744

745
                    # ...and document this format option. $etc, if set,
746
                    # will indicate if this is a struct ("...") or a
747
                    # function.
748
                    if ($etc) {
749
                        if ($etc eq '...') {    # ok
750
                            ;
751
                        }
752
                        elsif ($etc =~ /^\*[a-z]+\*(\s+\*[a-z]+\*)*$/) {
753
                            # a function. Preserve only the arg COUNT, not
754
                            # their names. (command completion has no way
755
                            # to give us arg names or types).
756
                            $etc = scalar(split(' ', $etc));
757
                        }
758
                        else {
759
                            warn "$ME: $subpath:$.: unknown args '$etc' for '$format'. Valid args are '...' for nested structs or, for functions, one or more asterisk-wrapped argument names.\n";
760
                            ++$Errs;
761
                        }
762
                    }
763

764
                    $man{$previous_flag}{$format} = $etc || 0;
765

766
                    # Sort order check, case-insensitive
767
                    if (lc($format) lt lc($previous_format)) {
768
                        warn "$ME: $subpath:$.: format specifier '$format' should precede '$previous_format'\n";
769
                        ++$Errs;
770
                    }
771

772
                    # Dup check, would've caught #19462.
773
                    if (lc($format) eq lc($previous_format)) {
774
                        # Sigh. Allow preexisting exceptions, but no new ones.
775
                        unless ($Format_Option_Dup_Allowed{$command}{lc $format}) {
776
                            warn "$ME: $subpath:$.: format specifier '$format' is a dup\n";
777
                            ++$Errs;
778
                        }
779
                    }
780
                    $previous_format = $format;
781
                }
782
            }
783
            # Same as above, but with --filter
784
            elsif ($previous_flag eq '--filter') {
785
                if ($line =~ /^\|\s+(\S+)\s+\|/) {
786
                    my $filter = $1;
787

788
                    # (Garbage: these are just table column titles & dividers)
789
                    next LINE if $filter =~ /^\**Filter\**$/;
790
                    next LINE if $filter =~ /---+/;
791

792
                    # Special case: treat slash-separated options
793
                    # ("after/since") as identical, and require that
794
                    # each be documented.
795
                    for my $f (split '/', $filter) {
796
                        # Special case for negated options ("label!="): allow,
797
                        # but only immediately after the positive case.
798
                        if ($f =~ s/!$//) {
799
                            if ($f ne $previous_filter) {
800
                                warn "$ME: $subpath:$.: filter '$f!' only allowed immediately after its positive\n";
801
                                ++$Errs;
802
                            }
803
                            next LINE;
804
                        }
805

806
                        if (! ref($man{$previous_flag})) {
807
                            $man{$previous_flag} = { _path => $subpath };
808
                        }
809
                        $man{$previous_flag}{$f} = 1;
810
                    }
811

812
                    # Sort order check, case-insensitive
813
                    # FIXME FIXME! Disabled for now because it would make
814
                    # this PR completely impossible to review (as opposed to
815
                    # only mostly-impossible)
816
                    #if (lc($filter) lt lc($previous_filter)) {
817
                    #  warn "$ME: $subpath:$.: filter specifier '$filter' should precede '$previous_filter'\n";
818
                    #  ++$Errs;
819
                    #}
820

821
                    # Dup check. Yes, it happens.
822
                    if (lc($filter) eq lc($previous_filter)) {
823
                        warn "$ME: $subpath:$.: filter specifier '$filter' is a dup\n";
824
                        ++$Errs;
825
                    }
826
                    $previous_filter = $filter;
827
                }
828
            }
829
        }
830

831
        # It's easy to make mistakes in the SEE ALSO elements.
832
        elsif ($section eq 'see-also') {
833
            _check_seealso_links( "$subpath:$.", $line );
834
        }
835
    }
836
    close $fh;
837

838
    # Done reading man page. If there are any '--format' exceptions defined
839
    # for this command, flag them as seen, and as '...' so we don't
840
    # complain about any sub-fields.
841
    if (my $fields = $Format_Exceptions{$command}) {
842
        $man{"--format"}{$_} = '!' for @$fields;
843
    }
844

845
    # Special case: the 'image trust' man page tries hard to cover both set
846
    # and show, which means it ends up not being machine-readable.
847
    if ($command eq 'podman-image-trust') {
848
        my %set  = %man;
849
        my %show = %man;
850
        $show{$_} = 1 for qw(--raw -j --json);
851
        return +{ set => \%set, show => \%show }
852
    }
853

854
    return \%man;
855
}
856

857

858
################
859
#  podman_rst  #  Parse contents of docs/source/*.rst
860
################
861
sub podman_rst {
862
    my %rst;
863

864
    # Read all .rst files, looking for ":doc:`subcmd <target>` description"
865
    for my $rst (glob "$Docs_Path/*.rst") {
866
        open my $fh, '<', $rst
867
            or die "$ME: Cannot read $rst: $!\n";
868

869
        # The basename of foo.rst is usually, but not always, the name of
870
        # a podman subcommand. There are a few special cases:
871
        (my $command = $rst) =~ s!^.*/(.*)\.rst!$1!;
872

873
        my $subcommand_href = \%rst;
874
        if ($command eq 'Commands') {
875
            ;
876
        }
877
        else {
878
            $subcommand_href = $rst{$command} //= { _source => $rst };
879
        }
880

881
        my $previous_subcommand = '';
882
        while (my $line = <$fh>) {
883
            if ($line =~ /^:doc:`(\S+)\s+<(.*?)>`\s+(.*)/) {
884
                my ($subcommand, $target, $desc) = ($1, $2, $3);
885

886
                # Check that entries are in alphabetical order, and not dups
887
                if ($subcommand lt $previous_subcommand) {
888
                    warn "$ME: $rst:$.: '$previous_subcommand' and '$subcommand' are out of order\n";
889
                    ++$Errs;
890
                }
891
                if ($subcommand eq $previous_subcommand) {
892
                    warn "$ME: $rst:$.: duplicate '$subcommand'\n";
893
                    ++$Errs;
894
                }
895
                $previous_subcommand = $subcommand;
896

897
                # Mark this subcommand as documented.
898
                $subcommand_href->{$subcommand}{_desc} = $desc;
899
                $subcommand_href->{$subcommand}{_source} = $rst;
900

901
                # Check for invalid links. These will be one of two forms:
902
                #    <markdown/foo.1>     -> markdown/foo.1.md
903
                #    <foo>                -> foo.rst
904
                if ($target =~ m!^markdown/!) {
905
                    if (! -e "$Docs_Path/$target.md") {
906
                        warn "$ME: $rst:$.: '$subcommand' links to nonexistent $target\n";
907
                        ++$Errs;
908
                    }
909

910
                    my $expect = "markdown/podman-$subcommand.1";
911
                    if ($subcommand eq 'Podman') {
912
                        $expect = "markdown/podman.1";
913
                    }
914
                    if ($target ne $expect) {
915
                        warn "$ME: $rst:$.: '$subcommand' links to $target (expected '$expect')\n";
916
                        ++$Errs;
917
                    }
918
                }
919
                else {
920
                    if (! -e "$Docs_Path/$target.rst") {
921
                        warn "$ME: $rst:$.: '$subcommand' links to nonexistent $target.rst\n";
922
                        ++$Errs;
923
                    }
924
                }
925
            }
926
        }
927
        close $fh;
928
    }
929

930
    # Special case: 'image trust set/show' are documented in image-trust.1
931
    $rst{image}{trust}{$_} = { _desc => 'ok' } for (qw(set show));
932

933
    return \%rst;
934
}
935

936
##################
937
#  _completions  #  run podman __complete, return list of completions
938
##################
939
sub _completions {
940
    my $kidpid = open my $podman_fh, '-|';
941
    if (! defined $kidpid) {
942
        die "$ME: Could not fork: $!\n";
943
    }
944

945
    if ($kidpid == 0) {
946
        # We are the child
947
        close STDERR;
948
        exec $PODMAN, '__complete', @_;
949
        die "$ME: Could not exec: $!\n";
950
    }
951

952
    # We are the parent
953
    my @completions;
954
    while (my $line = <$podman_fh>) {
955
        chomp $line;
956
        push @completions, $line;
957

958
        # Recursively expand Go templates, like '{{.Server.Os}}'
959
        if ($line =~ /^\{\{\..*\.$/) {
960
            my @cmd_copy = @_;          # clone of podman subcommands...
961
            pop @cmd_copy;              # ...so we can recurse with new format
962
            my @subcompletions = _completions(@cmd_copy, $line);
963

964
            # A huge number of deep fields are time-related. Don't document them.
965
            my @is_time = grep { /Nanosecond|UnixNano|YearDay/ } @subcompletions;
966
            push @completions, @subcompletions
967
                unless @is_time >= 3;
968
        }
969
    }
970
    close $podman_fh
971
        or warn "$ME: Error running podman __complete @_\n";
972
    return @completions;
973
}
974

975
# END   data gathering
976
###############################################################################
977
# BEGIN sanity checking of SEE ALSO links
978

979
##########################
980
#  _check_seealso_links  #  Check formatting and link validity.
981
##########################
982
sub _check_seealso_links {
983
    my $path = shift;
984
    my $line = shift;
985

986
    return if ! $line;
987

988
    # Line must be a comma-separated list of man page references, e.g.
989
    #    **foo(1)**, **[podman-bar(1)](podman-bar.1.md)**, **[xxx(8)](http...)**
990
  TOKEN:
991
    for my $token (split /,\s+/, $line) {
992
        # Elements must be separated by comma and space. (We don't do further
993
        # checks here, so it's possible for the dev to add the space and then
994
        # have us fail on the next iteration. I choose not to address that.)
995
        if ($token =~ /,/) {
996
            warn "$ME: $path: please add space after comma: '$token'\n";
997
            ++$Errs;
998
            next TOKEN;
999
        }
1000

1001
        # Each token must be of the form '**something**'
1002
        if ($token !~ s/^\*\*(.*)\*\*$/$1/) {
1003
            if ($token =~ /\*\*/) {
1004
                warn "$ME: $path: '$token' has asterisks in the wrong place\n";
1005
            }
1006
            else {
1007
                warn "$ME: $path: '$token' should be bracketed by '**'\n";
1008
            }
1009
            ++$Errs;
1010
            next TOKEN;
1011
        }
1012

1013
        # Is it a markdown link?
1014
        if ($token =~ /^\[(\S+)\]\((\S+)\)$/) {
1015
            my ($name, $link) = ($1, $2);
1016
            if ($name =~ /^(.*)\((\d)\)$/) {
1017
                my ($base, $section) = ($1, $2);
1018
                if (-e "$Markdown_Path/$base.$section.md") {
1019
                    if ($link ne "$base.$section.md") {
1020
                        warn "$ME: $path: inconsistent link $name -> $link, expected $base.$section.md\n";
1021
                        ++$Errs;
1022
                    }
1023
                }
1024
                else {
1025
                    if (! _is_valid_external_link($base, $section, $link)) {
1026
                        warn "$ME: $path: invalid link $name -> $link\n";
1027
                        ++$Errs;
1028
                    }
1029
                }
1030
            }
1031
            else {
1032
                warn "$ME: $path: could not parse '$name' as 'manpage(N)'\n";
1033
                ++$Errs;
1034
            }
1035
        }
1036

1037
        # Not a markdown link; it must be a plain man reference, e.g. 'foo(5)'
1038
        elsif ($token =~ m!^(\S+)\((\d+)\)$!) {
1039
            my ($base, $section) = ($1, $2);
1040

1041
            # Unadorned 'podman-foo(1)' must be a link.
1042
            if (-e "$Markdown_Path/$base.$section.md") {
1043
                warn "$ME: $path: '$token' should be '[$token]($base.$section.md)'\n";
1044
                ++$Errs;
1045
            }
1046

1047
            # Aliases (non-canonical command names): never link to these
1048
            if (-e "$Markdown_Path/links/$base.$section") {
1049
                warn "$ME: $path: '$token' refers to a command alias; please use the canonical command name instead\n";
1050
                ++$Errs;
1051
            }
1052

1053
            # Link to man page foo(5) but without a link. This is not an error
1054
            # but Ed may sometimes want to see those on a manual test run.
1055
            warn "$ME: $path: plain '$token' would be so much nicer as a link\n"
1056
                if $verbose;
1057
        }
1058
        else {
1059
            warn "$ME: $path: invalid token '$token'\n";
1060
            ++$Errs;
1061
        }
1062
    }
1063
}
1064

1065
#############################
1066
#  _is_valid_external_link  #  Tries to validate links to external man pages
1067
#############################
1068
#
1069
# This performs no actual fetches, so we can't actually check for 404.
1070
# All we do is ensure that links conform to standard patterns. This is
1071
# good for catching things like 'conmon(8)' pointing to a .5 URL, or
1072
# linking to .md instead of .html.
1073
#
1074
# FIXME: we could actually rewrite this so as to offer hints on what to fix.
1075
# That's a lot of work, and a lot of convoluted code, for questionable ROI.
1076
#
1077
sub _is_valid_external_link {
1078
    my ($base, $section, $link) = @_;
1079

1080
    return 1 if $link =~ m!^https://github\.com/\S+/blob/(main|master)(/.*)?/\Q$base\E\.$section\.md!;
1081

1082
    return 1 if $link =~ m!^https://.*unix\.com/man-page/(linux|redhat)/$section/$base$!;
1083
    return 1 if $link eq "https://man7\.org/linux/man-pages/man$section/$base\.$section\.html";
1084

1085
    if ($base =~ /systemd/) {
1086
        return 1 if $link eq "https://www.freedesktop.org/software/systemd/man/$base.html";
1087
    }
1088

1089
    return 1 if $link eq "https://passt.top/builds/latest/web/passt.1.html";
1090

1091
    return;
1092
}
1093

1094

1095

1096

1097
# END   sanity checking of SEE ALSO links
1098
###############################################################################
1099

1100
1;
1101