github.com/containers/podman/v5@v5.1.0-rc1/hack/xref-helpmsgs-manpages (about)

     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;