mirror of
				https://github.com/containers/podman.git
				synced 2025-10-31 01:50:50 +08:00 
			
		
		
		
	 08a49389c8
			
		
	
	08a49389c8
	
	
	
		
			
			when listing images through the restful service, consumers want to know if the image they are listing is a manifest or not because the libpod endpoint returns both images and manifest lists. in addition, we now add `arch` and `os` as fields in the libpod endpoint for image listing as well. Fixes: #22184 Fixes: #22185 Signed-off-by: Brent Baude <bbaude@redhat.com>
		
			
				
	
	
		
			1101 lines
		
	
	
		
			42 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			1101 lines
		
	
	
		
			42 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/perl
 | |
| #
 | |
| # xref-helpmsgs-manpages - cross-reference --help options against man pages
 | |
| #
 | |
| package LibPod::CI::XrefHelpmsgsManpages;
 | |
| 
 | |
| use v5.14;
 | |
| use utf8;
 | |
| 
 | |
| use strict;
 | |
| use warnings;
 | |
| use Clone                       qw(clone);
 | |
| use FindBin;
 | |
| 
 | |
| (our $ME = $0) =~ s|.*/||;
 | |
| our $VERSION = '0.1';
 | |
| 
 | |
| # For debugging, show data structures using DumpTree($var)
 | |
| #use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
 | |
| 
 | |
| # unbuffer output
 | |
| $| = 1;
 | |
| 
 | |
| ###############################################################################
 | |
| # BEGIN user-customizable section
 | |
| 
 | |
| # Path to podman executable
 | |
| my $Default_Podman = "$FindBin::Bin/../bin/podman";
 | |
| my $PODMAN = $ENV{PODMAN} || $Default_Podman;
 | |
| 
 | |
| # Path to all doc files, including .rst and (down one level) markdown
 | |
| our $Docs_Path = 'docs/source';
 | |
| 
 | |
| # Path to podman markdown source files (of the form podman-*.1.md)
 | |
| our $Markdown_Path = "$Docs_Path/markdown";
 | |
| 
 | |
| # Global error count
 | |
| our $Errs = 0;
 | |
| 
 | |
| # Table of exceptions for documenting fields in '--format {{.Foo}}'
 | |
| #
 | |
| # Autocomplete is wonderful, and it's even better when we document the
 | |
| # existing options. Unfortunately, sometimes internal structures get
 | |
| # exposed that are of no use to anyone and cannot be guaranteed. Avoid
 | |
| # documenting those. This table lists those exceptions. Format is:
 | |
| #
 | |
| #      foo       .Bar
 | |
| #
 | |
| # ...such that "podman foo --format '{{.Bar}}'" will not be documented.
 | |
| #
 | |
| my $Format_Exceptions = <<'END_EXCEPTIONS';
 | |
| # Deep internal structs; pretty sure these are permanent exceptions
 | |
| events       .Details
 | |
| history      .ImageHistoryLayer
 | |
| images       .Arch .ImageSummary .Os .IsManifestList
 | |
| network-ls   .Network
 | |
| 
 | |
| # FIXME: this one, maybe? But someone needs to write the text
 | |
| machine-list    .Starting
 | |
| 
 | |
| # No clue what these are. Some are just different-case dups of others.
 | |
| pod-ps  .Containers .Id .InfraId .ListPodsReport .Namespace
 | |
| ps      .Cgroup .CGROUPNS .IPC .ListContainer .MNT .Namespaces .NET .PIDNS .User .USERNS .UTS
 | |
| 
 | |
| # I think .Destination is an internal struct, but .IsMachine maybe needs doc?
 | |
| system-connection-list .Destination .IsMachine
 | |
| END_EXCEPTIONS
 | |
| 
 | |
| my %Format_Exceptions;
 | |
| for my $line (split "\n", $Format_Exceptions) {
 | |
|     $line =~ s/#.*$//;                  # strip comments
 | |
|     next unless $line;                  # skip empty lines
 | |
|     my ($subcommand, @fields) = split(' ', $line);
 | |
|     $Format_Exceptions{"podman-$subcommand"} = \@fields;
 | |
| }
 | |
| 
 | |
| # Hardcoded list of podman commands for which '--format' does NOT mean
 | |
| # a Go format.
 | |
| #
 | |
| # I realize that it looks stupid to hardcode these: I could instead
 | |
| # check "--format ''" and look for completion strings, 'oci', 'json',
 | |
| # doesn't matter: if anything shows up, we excuse the missing '{{.'.
 | |
| # (We'd still have to make a special exception for 'podman inspect').
 | |
| #
 | |
| # My reason for hardcoding is that these should be rare exceptions
 | |
| # and we want to account for every single one. If a new command gets
 | |
| # added, with a --format option that does not autocomplete '{{.',
 | |
| # let's make sure it gets extra eyeballs.
 | |
| my %Format_Option_Is_Special = map { $_ => 1 } (
 | |
|     'build',  'farm build', 'image build',      # oci | docker
 | |
|     'commit', 'container commit',               #  "  "  " "
 | |
|     'diff',   'container diff', 'image diff',   # only supports "json"
 | |
|     'generate systemd',                         #  "    "  "      "
 | |
|     'mount',  'container mount', 'image mount', #  "    "  "      "
 | |
|     'push',   'image push', 'manifest push',    # oci | v2s*
 | |
|     'save',   'image save',                     # image formats (oci-*, ...)
 | |
|     'inspect',                                  # ambiguous (container/image)
 | |
|  );
 | |
| 
 | |
| # Hardcoded list of existing duplicate-except-for-case format codes,
 | |
| # with their associated subcommands. Let's not add any more.
 | |
| my %Format_Option_Dup_Allowed = (
 | |
|     'podman-images' => { '.id'     => 1 },
 | |
|     'podman-stats'  => { '.avgcpu' => 1, '.pids' => 1 },
 | |
| );
 | |
| 
 | |
| # Do not cross-reference these.
 | |
| my %Skip_Subcommand = map { $_ => 1 } (
 | |
|     "help",                     # has no man page
 | |
|     "completion",               # internal (hidden) subcommand
 | |
|     "compose",                  # external tool, outside of our control
 | |
| );
 | |
| 
 | |
| # END   user-customizable section
 | |
| ###############################################################################
 | |
| # BEGIN boilerplate args checking, usage messages
 | |
| 
 | |
| sub usage {
 | |
|     print  <<"END_USAGE";
 | |
| Usage: $ME [OPTIONS]
 | |
| 
 | |
| $ME recursively runs 'podman --help' against
 | |
| all subcommands; and recursively reads podman-*.1.md files
 | |
| in $Markdown_Path, then cross-references that each --help
 | |
| option is listed in the appropriate man page and vice-versa.
 | |
| 
 | |
| $ME invokes '\$PODMAN' (default: $Default_Podman).
 | |
| 
 | |
| In the spirit of shoehorning functionality where it wasn't intended,
 | |
| $ME also checks the SEE ALSO section of each man page
 | |
| to ensure that references and links are properly formatted
 | |
| and valid.
 | |
| 
 | |
| Exit status is zero if no inconsistencies found, one otherwise
 | |
| 
 | |
| OPTIONS:
 | |
| 
 | |
|   -v, --verbose  show verbose progress indicators
 | |
|   -n, --dry-run  make no actual changes
 | |
| 
 | |
|   --help         display this message
 | |
|   --version      display program name and version
 | |
| END_USAGE
 | |
| 
 | |
|     exit;
 | |
| }
 | |
| 
 | |
| # Command-line options.  Note that this operates directly on @ARGV !
 | |
| our $debug   = 0;
 | |
| our $verbose = 0;
 | |
| sub handle_opts {
 | |
|     use Getopt::Long;
 | |
|     GetOptions(
 | |
|         'debug!'     => \$debug,
 | |
|         'verbose|v'  => \$verbose,
 | |
| 
 | |
|         help         => \&usage,
 | |
|         version      => sub { print "$ME version $VERSION\n"; exit 0 },
 | |
|     ) or die "Try `$ME --help' for help\n";
 | |
| }
 | |
| 
 | |
| # END   boilerplate args checking, usage messages
 | |
| ###############################################################################
 | |
| 
 | |
| ############################## CODE BEGINS HERE ###############################
 | |
| 
 | |
| # The term is "modulino".
 | |
| __PACKAGE__->main()                                     unless caller();
 | |
| 
 | |
| # Main code.
 | |
| sub main {
 | |
|     # Note that we operate directly on @ARGV, not on function parameters.
 | |
|     # This is deliberate: it's because Getopt::Long only operates on @ARGV
 | |
|     # and there's no clean way to make it use @_.
 | |
|     handle_opts();                      # will set package globals
 | |
| 
 | |
|     # Fetch command-line arguments.  Barf if too many.
 | |
|     die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;
 | |
| 
 | |
|     chdir "$FindBin::Bin/.."
 | |
|         or die "$ME: FATAL: Cannot cd $FindBin::Bin/..: $!";
 | |
| 
 | |
|     my $help = podman_help();
 | |
|     my $man  = podman_man('podman');
 | |
|     my $rst  = podman_rst();
 | |
| 
 | |
|     xref_by_help($help, $man);
 | |
|     xref_by_man($help, $man);
 | |
| 
 | |
|     xref_rst($help, $rst);
 | |
| 
 | |
|     exit !!$Errs;
 | |
| }
 | |
| 
 | |
| ###############################################################################
 | |
| # BEGIN cross-referencing
 | |
| 
 | |
| ##################
 | |
| #  xref_by_help  #  Find keys in '--help' but not in man
 | |
| ##################
 | |
| sub xref_by_help {
 | |
|     my ($help, $man, @subcommand) = @_;
 | |
| 
 | |
|   OPTION:
 | |
|     for my $k (sort keys %$help) {
 | |
|         next if $k =~ /^_/;             # metadata ("_desc"). Ignore.
 | |
| 
 | |
|         if (! ref($man)) {
 | |
|             # Super-unlikely but I've seen it
 | |
|             warn "$ME: 'podman @subcommand' is not documented in man pages!\n";
 | |
|             ++$Errs;
 | |
|             next OPTION;
 | |
|         }
 | |
| 
 | |
|         if (exists $man->{$k}) {
 | |
|             if (ref $help->{$k}) {
 | |
|                 # This happens when 'podman foo --format' offers
 | |
|                 # autocompletion that looks like a Go template, but those
 | |
|                 # template options aren't documented in the man pages.
 | |
|                 if ($k eq '--format' && ! ref($man->{$k})) {
 | |
|                     # "podman inspect" tries to autodetect if it's being run
 | |
|                     # on an image or container. It cannot sanely be documented.
 | |
|                     unless ("@subcommand" eq "inspect") {
 | |
|                         warn "$ME: 'podman @subcommand': --format options are available through autocomplete, but are not documented in $man->{_path}\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                     next OPTION;
 | |
|                 }
 | |
| 
 | |
|                 xref_by_help($help->{$k}, $man->{$k}, @subcommand, $k);
 | |
|             }
 | |
| 
 | |
|             # Documenting --format fields is tricky! They can be scalars, structs,
 | |
|             # or functions. This is a complicated block because if help & man don't
 | |
|             # match, we want to give the most user-friendly message possible.
 | |
|             elsif (@subcommand && $subcommand[-1] eq '--format') {
 | |
|                 # '!' is one of the Format_Exceptions defined at top
 | |
|                 if (($man->{$k} ne '!') && ($man->{$k} ne $help->{$k})) {
 | |
|                     # Fallback message
 | |
|                     my $msg = "TELL ED TO HANDLE THIS: man='$man->{$k}' help='$help->{$k}'";
 | |
| 
 | |
|                     # Many different permutations of mismatches.
 | |
|                     my $combo = "$man->{$k}-$help->{$k}";
 | |
|                     if ($combo eq '0-...') {
 | |
|                         $msg = "is a nested structure. Please add '...' to man page.";
 | |
|                     }
 | |
|                     elsif ($combo =~ /^\d+-\.\.\.$/) {
 | |
|                         $msg = "is a nested structure, but the man page documents it as a function?!?";
 | |
|                     }
 | |
|                     elsif ($combo eq '...-0') {
 | |
|                         $msg = "is a simple value, not a nested structure. Please remove '...' from man page.";
 | |
|                     }
 | |
|                     elsif ($combo =~ /^0-[1-9]\d*$/) {
 | |
|                         $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*'";
 | |
|                     }
 | |
|                     elsif ($combo =~ /^\d+-[1-9]\d*$/) {
 | |
|                         $msg = "is a function that calls for $help->{$k} args; the man page lists $man->{$k}. Please fix the man page.";
 | |
|                     }
 | |
| 
 | |
|                     warn "$ME: 'podman @subcommand {{$k' $msg\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|         else {
 | |
|             # Not documented in man. However, handle '...' as a special case
 | |
|             # in formatting strings. E.g., 'podman info .Host' is documented
 | |
|             # in the man page as '.Host ...' to indicate that the subfields
 | |
|             # are way too many to list individually.
 | |
|             my $k_copy = $k;
 | |
|             while ($k_copy =~ s/\.[^.]+$//) {
 | |
|                 my $parent_man = $man->{$k_copy} // '';
 | |
|                 if (($parent_man eq '...') || ($parent_man eq '!')) {
 | |
|                     next OPTION;
 | |
|                 }
 | |
|             }
 | |
| 
 | |
|             # Nope, it's not that case.
 | |
|             my $man = $man->{_path} || 'man';
 | |
|             # The usual case is "podman ... --help"...
 | |
|             my $what = '--help';
 | |
|             # ...but for *options* (e.g. --filter), we're checking command completion
 | |
|             $what = '<TAB>' if @subcommand && $subcommand[-1] =~ /^--/;
 | |
|             warn "$ME: 'podman @subcommand $what' lists '$k', which is not in $man\n";
 | |
|             ++$Errs;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| #################
 | |
| #  xref_by_man  #  Find keys in man pages but not in --help
 | |
| #################
 | |
| #
 | |
| # In an ideal world we could share the functionality in one function; but
 | |
| # there are just too many special cases in man pages.
 | |
| #
 | |
| sub xref_by_man {
 | |
|     my ($help, $man, @subcommand) = @_;
 | |
| 
 | |
|     # FIXME: this generates way too much output
 | |
|   KEYWORD:
 | |
|     for my $k (grep { $_ ne '_path' } sort keys %$man) {
 | |
|         if ($k eq '--format' && ref($man->{$k}) && ! ref($help->{$k})) {
 | |
|             warn "$ME: 'podman @subcommand': --format options documented in man page, but not available via autocomplete\n";
 | |
|             next KEYWORD;
 | |
|         }
 | |
| 
 | |
|         if (exists $help->{$k}) {
 | |
|             if (ref $man->{$k}) {
 | |
|                 xref_by_man($help->{$k}, $man->{$k}, @subcommand, $k);
 | |
|             }
 | |
|             elsif ($k =~ /^-/) {
 | |
|                 # This is OK: we don't recurse into options
 | |
|             }
 | |
|             else {
 | |
|                 # FIXME: should never get here, but we do. Figure it out later.
 | |
|             }
 | |
|         }
 | |
|         elsif ($k ne '--help' && $k ne '-h') {
 | |
|             my $man = $man->{_path} || 'man';
 | |
| 
 | |
|             # Special case: podman-inspect serves dual purpose (image, ctr)
 | |
|             my %ignore = map { $_ => 1 } qw(-l -s -t --latest --size --type);
 | |
|             next if $man =~ /-inspect/ && $ignore{$k};
 | |
| 
 | |
|             # Special case: podman-diff serves dual purpose (image, ctr)
 | |
|             my %diffignore = map { $_ => 1 } qw(-l --latest );
 | |
|             next if $man =~ /-diff/ && $diffignore{$k};
 | |
| 
 | |
|             # Special case: the 'trust' man page is a mess
 | |
|             next if $man =~ /-trust/;
 | |
| 
 | |
|             # Special case: '--net' is an undocumented shortcut
 | |
|             next if $k eq '--net' && $help->{'--network'};
 | |
| 
 | |
|             # Special case: these are actually global options
 | |
|             next if $k =~ /^--(cni-config-dir|runtime)$/ && $man =~ /-build/;
 | |
| 
 | |
|             # Special case: weirdness with Cobra and global/local options
 | |
|             next if $k eq '--namespace' && $man =~ /-ps/;
 | |
| 
 | |
|             next if "@subcommand" eq 'system' && $k eq 'service';
 | |
| 
 | |
|             # Special case for hidden or external commands
 | |
|             next if $Skip_Subcommand{$k};
 | |
| 
 | |
|             # It's not always --help, sometimes we check <TAB> completion
 | |
|             my $what = '--help';
 | |
|             $what = 'command completion' if @subcommand && $subcommand[-1] =~ /^--/;
 | |
|             warn "$ME: 'podman @subcommand': '$k' in $man, but not in $what\n";
 | |
|             ++$Errs;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| ##############
 | |
| #  xref_rst  #  Cross-check *.rst files against help
 | |
| ##############
 | |
| #
 | |
| # This makes a pass over top-level commands only. There is no rst
 | |
| # documentation for any podman subcommands.
 | |
| #
 | |
| sub xref_rst {
 | |
|     my ($help, $rst) = @_;
 | |
| 
 | |
| 
 | |
|     # We key on $help because that is Absolute Truth: anything in podman --help
 | |
|     # must be referenced in an rst (the converse is not necessarily true)
 | |
|     for my $k (sort grep { $_ !~ /^[_-]/ } keys %$help) {
 | |
|         if (exists $rst->{$k}) {
 | |
|             # Descriptions must match
 | |
|             if ($rst->{$k}{_desc} ne $help->{$k}{_desc}) {
 | |
|                 warn "$ME: podman $k: inconsistent description in $rst->{$k}{_source}:\n";
 | |
|                 warn "   help: '$help->{$k}{_desc}'\n";
 | |
|                 warn "   rst:  '$rst->{$k}{_desc}'\n";
 | |
|                 ++$Errs;
 | |
|             }
 | |
|         }
 | |
|         else {
 | |
|             warn "$ME: Not found in rst: $k\n";
 | |
|             ++$Errs;
 | |
|          }
 | |
|     }
 | |
| 
 | |
|     # Now the other way around: look for anything in Commands.rst that is
 | |
|     # not in podman --help
 | |
|     for my $k (sort grep { $rst->{$_}{_source} =~ /Commands.rst/ } keys %$rst) {
 | |
|         if ($k ne 'Podman' && ! exists $help->{$k}) {
 | |
|             warn "$ME: 'podman $k' found in $rst->{$k}{_source} but not 'podman help'\n";
 | |
|             ++$Errs;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| # END   cross-referencing
 | |
| ###############################################################################
 | |
| # BEGIN data gathering
 | |
| 
 | |
| #################
 | |
| #  podman_help  #  Parse output of 'podman [subcommand] --help'
 | |
| #################
 | |
| sub podman_help {
 | |
|     my %help;
 | |
|     open my $fh, '-|', $PODMAN, @_, '--help'
 | |
|         or die "$ME: Cannot fork: $!\n";
 | |
|     my $section = '';
 | |
|     while (my $line = <$fh>) {
 | |
|         chomp $line;
 | |
| 
 | |
|         # First line of --help is a short command description. We compare it
 | |
|         # (in a later step) against the blurb in Commands.rst.
 | |
|         # FIXME: we should crossref against man pages, but as of 2024-03-18
 | |
|         # it would be way too much work to get those aligned.
 | |
|         $help{_desc} //= $line;
 | |
| 
 | |
|         # Cobra is blessedly consistent in its output:
 | |
|         #    [command blurb]
 | |
|         #    Description: ...
 | |
|         #    Usage: ...
 | |
|         #    Available Commands:
 | |
|         #       ....
 | |
|         #    Options:
 | |
|         #       ....
 | |
|         #
 | |
|         # Start by identifying the section we're in...
 | |
|         if ($line =~ /^Available\s+(Commands):/) {
 | |
|             $section = lc $1;
 | |
|         }
 | |
|         elsif ($line =~ /^(Options):/) {
 | |
|             $section = lc $1;
 | |
|         }
 | |
| 
 | |
|         # ...then track commands and options. For subcommands, recurse.
 | |
|         elsif ($section eq 'commands') {
 | |
|             if ($line =~ /^\s{1,4}(\S+)\s/) {
 | |
|                 my $subcommand = $1;
 | |
|                 print "> podman @_ $subcommand\n"               if $debug;
 | |
| 
 | |
|                 # check that the same subcommand is not listed twice (#12356)
 | |
|                 if (exists $help{$subcommand}) {
 | |
|                     warn "$ME: 'podman @_ help' lists '$subcommand' twice\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
| 
 | |
|                 $help{$subcommand} = podman_help(@_, $subcommand)
 | |
|                     unless $Skip_Subcommand{$subcommand};
 | |
|             }
 | |
|         }
 | |
|         elsif ($section eq 'options') {
 | |
|             my $opt = '';
 | |
| 
 | |
|             # Handle '--foo' or '-f, --foo'
 | |
|             if ($line =~ /^\s{1,10}(--\S+)\s/) {
 | |
|                 print "> podman @_ $1\n"                        if $debug;
 | |
|                 $opt = $1;
 | |
|                 $help{$opt} = 1;
 | |
|             }
 | |
|             elsif ($line =~ /^\s{1,10}(-\S),\s+(--\S+)\s/) {
 | |
|                 print "> podman @_ $1, $2\n"                    if $debug;
 | |
|                 $opt = $2;
 | |
|                 $help{$1} = $help{$opt} = 1;
 | |
|             }
 | |
| 
 | |
|             # Special case for --format: run podman with autocomplete.
 | |
|             # If that lists one or more '{{.Foo<something>' entries,
 | |
|             # convert our option data structure from scalar (indicating
 | |
|             # that we just cross-check for existence in the man page)
 | |
|             # to hashref (indicating that we recurse down and cross-check
 | |
|             # each individual param).
 | |
|             #
 | |
|             # There are three possibilities for <something>:
 | |
|             #    {{.Foo}}  (end braces)       | terminal node. Usual case.
 | |
|             #    {{.Foo.   (dot)              | deeper struct. Hard to handle.
 | |
|             #    {{.Foo This is a function... | function. Rare, and " " " "
 | |
|             #
 | |
|             if ($opt eq '--format') {
 | |
|                 my @completions = _completions(@_, '--format', '{{.');
 | |
|                 for my $c (@completions) {
 | |
|                     if ($c =~ /^\{\{(\.\S+)(\s+This.*\s(\d+)\s+arg.*)?$/) {
 | |
|                         my ($fmt, $n_args) = ($1, $3 || 0);
 | |
|                         # Strip off braces/dot, leaving just the name
 | |
|                         $fmt =~ s/(\.|\}\})$//;
 | |
|                         my $stripped = $1;
 | |
| 
 | |
|                         # First time through: convert to a hashref
 | |
|                         $help{$opt} = {}   if ! ref($help{$opt});
 | |
| 
 | |
|                         # Remember this param
 | |
|                         if ($stripped eq '}}') {
 | |
|                             $n_args = 0;
 | |
|                         }
 | |
|                         elsif ($stripped eq '.') {
 | |
|                             $n_args = '...';
 | |
|                         }
 | |
|                         $help{$opt}{$fmt} = $n_args;
 | |
|                     }
 | |
|                 }
 | |
| 
 | |
|                 # If subcommand supports '--format {{.x', it should also
 | |
|                 # support '--format json'
 | |
|                 if (ref $help{$opt}) {
 | |
|                     my @json = _completions(@_, '--format', 'json');
 | |
|                     if (! grep { $_ eq 'json' } @json) {
 | |
|                         warn "$ME: podman @_ --format json is unimplemented\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
| 
 | |
|                 else {
 | |
|                     # --format option for this subcommand does not support
 | |
|                     # completion for Go templates. This is OK for an
 | |
|                     # existing set of commands (see table at top of script)
 | |
|                     # but is a fatal error for any others, presumably a
 | |
|                     # new subcommand. Either the subcommand must be fixed
 | |
|                     # to support autocompletion, or the subcommand must be
 | |
|                     # added to our exclusion list at top.
 | |
|                     unless ($Format_Option_Is_Special{"@_"}) {
 | |
|                         warn "$ME: podman @_ --format '{{.' does not offer autocompletion\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             # Same thing, for --filter
 | |
|             elsif ($opt eq '--filter') {
 | |
|                 my @completions = _completions(@_, '--filter=');
 | |
|                 for my $c (@completions) {
 | |
|                     if ($c =~ /^(\S+)=/) {
 | |
|                         $help{$opt} = {} if ! ref($help{$opt});
 | |
|                         $help{$opt}{$1} = 1;
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     close $fh
 | |
|         or die "$ME: Error running 'podman @_ --help'\n";
 | |
| 
 | |
|     return \%help;
 | |
| }
 | |
| 
 | |
| 
 | |
| ################
 | |
| #  podman_man  #  Parse contents of podman-*.1.md
 | |
| ################
 | |
| our %Man_Seen;
 | |
| sub podman_man {
 | |
|     my $command = shift;
 | |
|     my $subpath = "$Markdown_Path/$command.1.md";
 | |
|     print "** $subpath \n"                              if $debug;
 | |
| 
 | |
|     my %man = (_path => $subpath);
 | |
| 
 | |
|     # We often get called multiple times on the same man page,
 | |
|     # because (e.g.) podman-container-list == podman-ps. It's the
 | |
|     # same man page text, though, and we don't know which subcommand
 | |
|     # we're being called for, so there's nothing to be gained by
 | |
|     # rereading the man page or by dumping yet more warnings
 | |
|     # at the user. So, keep a cache of what we've done.
 | |
|     if (my $seen = $Man_Seen{$subpath}) {
 | |
|         return clone($seen);
 | |
|     }
 | |
|     $Man_Seen{$subpath} = \%man;
 | |
| 
 | |
|     open my $fh, '<', $subpath
 | |
|         or die "$ME: Cannot read $subpath: $!\n";
 | |
|     my $section = '';
 | |
|     my @most_recent_flags;
 | |
|     my $previous_subcmd = '';
 | |
|     my $previous_flag = '';
 | |
|     my $previous_format = '';
 | |
|     my $previous_filter = '';
 | |
|   LINE:
 | |
|     while (my $line = <$fh>) {
 | |
|         chomp $line;
 | |
|         next LINE unless $line;		# skip empty lines
 | |
| 
 | |
|         # First line (page title) must match the command name.
 | |
|         if ($line =~ /^%\s+/) {
 | |
|             my $expect = "% $command 1";
 | |
|             if ($line ne $expect) {
 | |
|                 warn "$ME: $subpath:$.: wrong title line '$line'; should be '$expect'\n";
 | |
|                 ++$Errs;
 | |
|             }
 | |
|         }
 | |
| 
 | |
|         # .md files designate sections with leading double hash
 | |
|         if ($line =~ /^##\s*(GLOBAL\s+)?OPTIONS/) {
 | |
|             $section = 'flags';
 | |
|             $previous_flag = '';
 | |
|         }
 | |
|         elsif ($line =~ /^###\s+\w+\s+OPTIONS/) {
 | |
|             # podman image trust has sections for set & show
 | |
|             $section = 'flags';
 | |
|             $previous_flag = '';
 | |
|         }
 | |
|         elsif ($line =~ /^\#\#\s+(SUB)?COMMANDS/) {
 | |
|             $section = 'commands';
 | |
|         }
 | |
|         elsif ($line =~ /^\#\#\s+SEE\s+ALSO/) {
 | |
|             $section = 'see-also';
 | |
|         }
 | |
|         elsif ($line =~ /^\#\#[^#]/) {
 | |
|             $section = '';
 | |
|         }
 | |
| 
 | |
|         # This will be a table containing subcommand names, links to man pages.
 | |
|         # The format is slightly different between podman.1.md and subcommands.
 | |
|         elsif ($section eq 'commands') {
 | |
|             # In podman.1.md
 | |
|             if ($line =~ /^\|\s*\[podman-(\S+?)\(\d\)\]/) {
 | |
|                 # $1 will be changed by recursion _*BEFORE*_ left-hand assignment
 | |
|                 my $subcmd = $1;
 | |
|                 $man{$subcmd} = podman_man("podman-$subcmd");
 | |
|             }
 | |
| 
 | |
|             # In podman-<subcommand>.1.md
 | |
|             #                      1   1        2  3   3    4   4         2
 | |
|             elsif ($line =~ /^\|\s+(\S+)\s+\|\s+(\[(\S+)\]\((\S+)\.1\.md\))/) {
 | |
|                 my ($subcmd, $blob, $shown_name, $link_name) = ($1, $2, $3, $4);
 | |
|                 if ($previous_subcmd gt $subcmd) {
 | |
|                     warn "$ME: $subpath:$.: '$previous_subcmd' and '$subcmd' are out of order\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|                 if ($previous_subcmd eq $subcmd) {
 | |
|                     warn "$ME: $subpath:$.: duplicate subcommand '$subcmd'\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|                 $previous_subcmd = $subcmd;
 | |
|                 $man{$subcmd} = podman_man($link_name);
 | |
| 
 | |
|                 # Check for inconsistencies between the displayed man page name
 | |
|                 # and the actual man page name, e.g.
 | |
|                 #  '[podman-bar(1)](podman-baz.1.md)
 | |
|                 $shown_name =~ s/\(\d\)$//;
 | |
|                 $shown_name =~ s/\\//g;         # backslashed hyphens
 | |
|                 (my $should_be = $link_name) =~ s/\.1\.md$//;
 | |
|                 if ($shown_name ne $should_be) {
 | |
|                     warn "$ME: $subpath:$.: '$shown_name' should be '$should_be' in '$blob'\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
| 
 | |
|         # Options should always be of the form '**-f**' or '**\-\-flag**',
 | |
|         # possibly separated by comma-space.
 | |
|         elsif ($section eq 'flags') {
 | |
|             # e.g. 'podman run --ip6', documented in man page, but nonexistent
 | |
|             if ($line =~ /^not\s+implemented/i) {
 | |
|                 delete $man{$_} for @most_recent_flags;
 | |
|             }
 | |
| 
 | |
|             @most_recent_flags = ();
 | |
|             # As of PR #8292, all options are <h4> and anchored
 | |
|             if ($line =~ s/^\#{4}\s+//) {
 | |
|                 # If option has long and short form, long must come first.
 | |
|                 # This is a while-loop because there may be multiple long
 | |
|                 # option names, e.g. --net/--network
 | |
|                 my $is_first = 1;
 | |
|                 while ($line =~ s/^\*\*(--[a-z0-9-]+)\*\*(,\s+)?//g) {
 | |
|                     my $flag = $1;
 | |
|                     $man{$flag} = 1;
 | |
|                     if ($flag lt $previous_flag && $is_first) {
 | |
|                         warn "$ME: $subpath:$.: $flag should precede $previous_flag\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                     if ($flag eq $previous_flag) {
 | |
|                         warn "$ME: $subpath:$.: flag '$flag' is a dup\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                     $previous_flag = $flag if $is_first;
 | |
|                     push @most_recent_flags, $flag;
 | |
| 
 | |
|                     # Further iterations of /g are allowed to be out of order,
 | |
|                     # e.g., it's OK for "--namespace, -ns" to precede --nohead
 | |
|                     $is_first = 0;
 | |
|                 }
 | |
|                 # Short form
 | |
|                 if ($line =~ s/^\*\*(-[a-zA-Z0-9])\*\*//) {
 | |
|                     my $flag = $1;
 | |
|                     $man{$flag} = 1;
 | |
| 
 | |
|                     # Keep track of them, in case we see 'Not implemented' below
 | |
|                     push @most_recent_flags, $flag;
 | |
|                 }
 | |
| 
 | |
|                 # Options with no '=whatever'
 | |
|                 next LINE if !$line;
 | |
| 
 | |
|                 # Anything remaining *must* be of the form '=<possibilities>'
 | |
|                 if ($line !~ /^=/) {
 | |
|                     warn "$ME: $subpath:$.: could not parse '$line' in option description\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
| 
 | |
|                 # For some years it was traditional, albeit wrong, to write
 | |
|                 #     **--foo**=*bar*, **-f**
 | |
|                 # The correct way is to add =*bar* at the end.
 | |
|                 if ($line =~ s/,\s\*\*(-[a-zA-Z])\*\*//) {
 | |
|                     $man{$1} = 1;
 | |
|                     warn "$ME: $subpath:$.: please rewrite as ', **$1**$line'\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
| 
 | |
|                 # List of possibilities ('=*a* | *b*') must be space-separated
 | |
|                 if ($line =~ /\|/) {
 | |
|                     if ($line =~ /[^\s]\|[^\s]/) {
 | |
|                         # Sigh, except for this one special case
 | |
|                         if ($line !~ /SOURCE-VOLUME.*HOST-DIR.*CONTAINER-DIR/) {
 | |
|                             warn "$ME: $subpath:$.: values must be space-separated: '$line'\n";
 | |
|                             ++$Errs;
 | |
|                         }
 | |
|                     }
 | |
|                     my $copy = $line;
 | |
|                     if ($copy =~ s/\**true\**//) {
 | |
|                         if ($copy =~ s/\**false\**//) {
 | |
|                             if ($copy !~ /[a-z]/) {
 | |
|                                 warn "$ME: $subpath:$.: Do not enumerate true/false for boolean-only options\n";
 | |
|                                 ++$Errs;
 | |
|                             }
 | |
|                         }
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
| 
 | |
|             # --format does not always mean a Go format! E.g., push --format=oci
 | |
|             if ($previous_flag eq '--format') {
 | |
|                 # ...but if there's a table like '| .Foo | blah blah |'
 | |
|                 # then it's definitely a Go template. There are three cases:
 | |
|                 #     .Foo        - Scalar field. The usual case.
 | |
|                 #     .Foo ...    - Structure with subfields, e.g. .Foo.Xyz
 | |
|                 #     .Foo ARG(s) - Function requiring one or more arguments
 | |
|                 #
 | |
|                 #                   1     12   3        32
 | |
|                 if ($line =~ /^\|\s+(\.\S+)(\s+([^\|]+\S))?\s+\|/) {
 | |
|                     my ($format, $etc) = ($1, $3);
 | |
| 
 | |
|                     # Confirmed: we have a table with '.Foo' strings, so
 | |
|                     # this is a Go template. Override previous (scalar)
 | |
|                     # setting of the --format flag with a hash, indicating
 | |
|                     # that we will recursively cross-check each param.
 | |
|                     if (! ref($man{$previous_flag})) {
 | |
|                         $man{$previous_flag} = { _path => $subpath };
 | |
|                     }
 | |
| 
 | |
|                     # ...and document this format option. $etc, if set,
 | |
|                     # will indicate if this is a struct ("...") or a
 | |
|                     # function.
 | |
|                     if ($etc) {
 | |
|                         if ($etc eq '...') {    # ok
 | |
|                             ;
 | |
|                         }
 | |
|                         elsif ($etc =~ /^\*[a-z]+\*(\s+\*[a-z]+\*)*$/) {
 | |
|                             # a function. Preserve only the arg COUNT, not
 | |
|                             # their names. (command completion has no way
 | |
|                             # to give us arg names or types).
 | |
|                             $etc = scalar(split(' ', $etc));
 | |
|                         }
 | |
|                         else {
 | |
|                             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";
 | |
|                             ++$Errs;
 | |
|                         }
 | |
|                     }
 | |
| 
 | |
|                     $man{$previous_flag}{$format} = $etc || 0;
 | |
| 
 | |
|                     # Sort order check, case-insensitive
 | |
|                     if (lc($format) lt lc($previous_format)) {
 | |
|                         warn "$ME: $subpath:$.: format specifier '$format' should precede '$previous_format'\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
| 
 | |
|                     # Dup check, would've caught #19462.
 | |
|                     if (lc($format) eq lc($previous_format)) {
 | |
|                         # Sigh. Allow preexisting exceptions, but no new ones.
 | |
|                         unless ($Format_Option_Dup_Allowed{$command}{lc $format}) {
 | |
|                             warn "$ME: $subpath:$.: format specifier '$format' is a dup\n";
 | |
|                             ++$Errs;
 | |
|                         }
 | |
|                     }
 | |
|                     $previous_format = $format;
 | |
|                 }
 | |
|             }
 | |
|             # Same as above, but with --filter
 | |
|             elsif ($previous_flag eq '--filter') {
 | |
|                 if ($line =~ /^\|\s+(\S+)\s+\|/) {
 | |
|                     my $filter = $1;
 | |
| 
 | |
|                     # (Garbage: these are just table column titles & dividers)
 | |
|                     next LINE if $filter =~ /^\**Filter\**$/;
 | |
|                     next LINE if $filter =~ /---+/;
 | |
| 
 | |
|                     # Special case: treat slash-separated options
 | |
|                     # ("after/since") as identical, and require that
 | |
|                     # each be documented.
 | |
|                     for my $f (split '/', $filter) {
 | |
|                         # Special case for negated options ("label!="): allow,
 | |
|                         # but only immediately after the positive case.
 | |
|                         if ($f =~ s/!$//) {
 | |
|                             if ($f ne $previous_filter) {
 | |
|                                 warn "$ME: $subpath:$.: filter '$f!' only allowed immediately after its positive\n";
 | |
|                                 ++$Errs;
 | |
|                             }
 | |
|                             next LINE;
 | |
|                         }
 | |
| 
 | |
|                         if (! ref($man{$previous_flag})) {
 | |
|                             $man{$previous_flag} = { _path => $subpath };
 | |
|                         }
 | |
|                         $man{$previous_flag}{$f} = 1;
 | |
|                     }
 | |
| 
 | |
|                     # Sort order check, case-insensitive
 | |
|                     # FIXME FIXME! Disabled for now because it would make
 | |
|                     # this PR completely impossible to review (as opposed to
 | |
|                     # only mostly-impossible)
 | |
|                     #if (lc($filter) lt lc($previous_filter)) {
 | |
|                     #  warn "$ME: $subpath:$.: filter specifier '$filter' should precede '$previous_filter'\n";
 | |
|                     #  ++$Errs;
 | |
|                     #}
 | |
| 
 | |
|                     # Dup check. Yes, it happens.
 | |
|                     if (lc($filter) eq lc($previous_filter)) {
 | |
|                         warn "$ME: $subpath:$.: filter specifier '$filter' is a dup\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                     $previous_filter = $filter;
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
| 
 | |
|         # It's easy to make mistakes in the SEE ALSO elements.
 | |
|         elsif ($section eq 'see-also') {
 | |
|             _check_seealso_links( "$subpath:$.", $line );
 | |
|         }
 | |
|     }
 | |
|     close $fh;
 | |
| 
 | |
|     # Done reading man page. If there are any '--format' exceptions defined
 | |
|     # for this command, flag them as seen, and as '...' so we don't
 | |
|     # complain about any sub-fields.
 | |
|     if (my $fields = $Format_Exceptions{$command}) {
 | |
|         $man{"--format"}{$_} = '!' for @$fields;
 | |
|     }
 | |
| 
 | |
|     # Special case: the 'image trust' man page tries hard to cover both set
 | |
|     # and show, which means it ends up not being machine-readable.
 | |
|     if ($command eq 'podman-image-trust') {
 | |
|         my %set  = %man;
 | |
|         my %show = %man;
 | |
|         $show{$_} = 1 for qw(--raw -j --json);
 | |
|         return +{ set => \%set, show => \%show }
 | |
|     }
 | |
| 
 | |
|     return \%man;
 | |
| }
 | |
| 
 | |
| 
 | |
| ################
 | |
| #  podman_rst  #  Parse contents of docs/source/*.rst
 | |
| ################
 | |
| sub podman_rst {
 | |
|     my %rst;
 | |
| 
 | |
|     # Read all .rst files, looking for ":doc:`subcmd <target>` description"
 | |
|     for my $rst (glob "$Docs_Path/*.rst") {
 | |
|         open my $fh, '<', $rst
 | |
|             or die "$ME: Cannot read $rst: $!\n";
 | |
| 
 | |
|         # The basename of foo.rst is usually, but not always, the name of
 | |
|         # a podman subcommand. There are a few special cases:
 | |
|         (my $command = $rst) =~ s!^.*/(.*)\.rst!$1!;
 | |
| 
 | |
|         my $subcommand_href = \%rst;
 | |
|         if ($command eq 'Commands') {
 | |
|             ;
 | |
|         }
 | |
|         else {
 | |
|             $subcommand_href = $rst{$command} //= { _source => $rst };
 | |
|         }
 | |
| 
 | |
|         my $previous_subcommand = '';
 | |
|         while (my $line = <$fh>) {
 | |
|             if ($line =~ /^:doc:`(\S+)\s+<(.*?)>`\s+(.*)/) {
 | |
|                 my ($subcommand, $target, $desc) = ($1, $2, $3);
 | |
| 
 | |
|                 # Check that entries are in alphabetical order, and not dups
 | |
|                 if ($subcommand lt $previous_subcommand) {
 | |
|                     warn "$ME: $rst:$.: '$previous_subcommand' and '$subcommand' are out of order\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|                 if ($subcommand eq $previous_subcommand) {
 | |
|                     warn "$ME: $rst:$.: duplicate '$subcommand'\n";
 | |
|                     ++$Errs;
 | |
|                 }
 | |
|                 $previous_subcommand = $subcommand;
 | |
| 
 | |
|                 # Mark this subcommand as documented.
 | |
|                 $subcommand_href->{$subcommand}{_desc} = $desc;
 | |
|                 $subcommand_href->{$subcommand}{_source} = $rst;
 | |
| 
 | |
|                 # Check for invalid links. These will be one of two forms:
 | |
|                 #    <markdown/foo.1>     -> markdown/foo.1.md
 | |
|                 #    <foo>                -> foo.rst
 | |
|                 if ($target =~ m!^markdown/!) {
 | |
|                     if (! -e "$Docs_Path/$target.md") {
 | |
|                         warn "$ME: $rst:$.: '$subcommand' links to nonexistent $target\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
| 
 | |
|                     my $expect = "markdown/podman-$subcommand.1";
 | |
|                     if ($subcommand eq 'Podman') {
 | |
|                         $expect = "markdown/podman.1";
 | |
|                     }
 | |
|                     if ($target ne $expect) {
 | |
|                         warn "$ME: $rst:$.: '$subcommand' links to $target (expected '$expect')\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
|                 else {
 | |
|                     if (! -e "$Docs_Path/$target.rst") {
 | |
|                         warn "$ME: $rst:$.: '$subcommand' links to nonexistent $target.rst\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|         close $fh;
 | |
|     }
 | |
| 
 | |
|     # Special case: 'image trust set/show' are documented in image-trust.1
 | |
|     $rst{image}{trust}{$_} = { _desc => 'ok' } for (qw(set show));
 | |
| 
 | |
|     return \%rst;
 | |
| }
 | |
| 
 | |
| ##################
 | |
| #  _completions  #  run podman __complete, return list of completions
 | |
| ##################
 | |
| sub _completions {
 | |
|     my $kidpid = open my $podman_fh, '-|';
 | |
|     if (! defined $kidpid) {
 | |
|         die "$ME: Could not fork: $!\n";
 | |
|     }
 | |
| 
 | |
|     if ($kidpid == 0) {
 | |
|         # We are the child
 | |
|         close STDERR;
 | |
|         exec $PODMAN, '__complete', @_;
 | |
|         die "$ME: Could not exec: $!\n";
 | |
|     }
 | |
| 
 | |
|     # We are the parent
 | |
|     my @completions;
 | |
|     while (my $line = <$podman_fh>) {
 | |
|         chomp $line;
 | |
|         push @completions, $line;
 | |
| 
 | |
|         # Recursively expand Go templates, like '{{.Server.Os}}'
 | |
|         if ($line =~ /^\{\{\..*\.$/) {
 | |
|             my @cmd_copy = @_;          # clone of podman subcommands...
 | |
|             pop @cmd_copy;              # ...so we can recurse with new format
 | |
|             my @subcompletions = _completions(@cmd_copy, $line);
 | |
| 
 | |
|             # A huge number of deep fields are time-related. Don't document them.
 | |
|             my @is_time = grep { /Nanosecond|UnixNano|YearDay/ } @subcompletions;
 | |
|             push @completions, @subcompletions
 | |
|                 unless @is_time >= 3;
 | |
|         }
 | |
|     }
 | |
|     close $podman_fh
 | |
|         or warn "$ME: Error running podman __complete @_\n";
 | |
|     return @completions;
 | |
| }
 | |
| 
 | |
| # END   data gathering
 | |
| ###############################################################################
 | |
| # BEGIN sanity checking of SEE ALSO links
 | |
| 
 | |
| ##########################
 | |
| #  _check_seealso_links  #  Check formatting and link validity.
 | |
| ##########################
 | |
| sub _check_seealso_links {
 | |
|     my $path = shift;
 | |
|     my $line = shift;
 | |
| 
 | |
|     return if ! $line;
 | |
| 
 | |
|     # Line must be a comma-separated list of man page references, e.g.
 | |
|     #    **foo(1)**, **[podman-bar(1)](podman-bar.1.md)**, **[xxx(8)](http...)**
 | |
|   TOKEN:
 | |
|     for my $token (split /,\s+/, $line) {
 | |
|         # Elements must be separated by comma and space. (We don't do further
 | |
|         # checks here, so it's possible for the dev to add the space and then
 | |
|         # have us fail on the next iteration. I choose not to address that.)
 | |
|         if ($token =~ /,/) {
 | |
|             warn "$ME: $path: please add space after comma: '$token'\n";
 | |
|             ++$Errs;
 | |
|             next TOKEN;
 | |
|         }
 | |
| 
 | |
|         # Each token must be of the form '**something**'
 | |
|         if ($token !~ s/^\*\*(.*)\*\*$/$1/) {
 | |
|             if ($token =~ /\*\*/) {
 | |
|                 warn "$ME: $path: '$token' has asterisks in the wrong place\n";
 | |
|             }
 | |
|             else {
 | |
|                 warn "$ME: $path: '$token' should be bracketed by '**'\n";
 | |
|             }
 | |
|             ++$Errs;
 | |
|             next TOKEN;
 | |
|         }
 | |
| 
 | |
|         # Is it a markdown link?
 | |
|         if ($token =~ /^\[(\S+)\]\((\S+)\)$/) {
 | |
|             my ($name, $link) = ($1, $2);
 | |
|             if ($name =~ /^(.*)\((\d)\)$/) {
 | |
|                 my ($base, $section) = ($1, $2);
 | |
|                 if (-e "$Markdown_Path/$base.$section.md") {
 | |
|                     if ($link ne "$base.$section.md") {
 | |
|                         warn "$ME: $path: inconsistent link $name -> $link, expected $base.$section.md\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
|                 else {
 | |
|                     if (! _is_valid_external_link($base, $section, $link)) {
 | |
|                         warn "$ME: $path: invalid link $name -> $link\n";
 | |
|                         ++$Errs;
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             else {
 | |
|                 warn "$ME: $path: could not parse '$name' as 'manpage(N)'\n";
 | |
|                 ++$Errs;
 | |
|             }
 | |
|         }
 | |
| 
 | |
|         # Not a markdown link; it must be a plain man reference, e.g. 'foo(5)'
 | |
|         elsif ($token =~ m!^(\S+)\((\d+)\)$!) {
 | |
|             my ($base, $section) = ($1, $2);
 | |
| 
 | |
|             # Unadorned 'podman-foo(1)' must be a link.
 | |
|             if (-e "$Markdown_Path/$base.$section.md") {
 | |
|                 warn "$ME: $path: '$token' should be '[$token]($base.$section.md)'\n";
 | |
|                 ++$Errs;
 | |
|             }
 | |
| 
 | |
|             # Aliases (non-canonical command names): never link to these
 | |
|             if (-e "$Markdown_Path/links/$base.$section") {
 | |
|                 warn "$ME: $path: '$token' refers to a command alias; please use the canonical command name instead\n";
 | |
|                 ++$Errs;
 | |
|             }
 | |
| 
 | |
|             # Link to man page foo(5) but without a link. This is not an error
 | |
|             # but Ed may sometimes want to see those on a manual test run.
 | |
|             warn "$ME: $path: plain '$token' would be so much nicer as a link\n"
 | |
|                 if $verbose;
 | |
|         }
 | |
|         else {
 | |
|             warn "$ME: $path: invalid token '$token'\n";
 | |
|             ++$Errs;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| #############################
 | |
| #  _is_valid_external_link  #  Tries to validate links to external man pages
 | |
| #############################
 | |
| #
 | |
| # This performs no actual fetches, so we can't actually check for 404.
 | |
| # All we do is ensure that links conform to standard patterns. This is
 | |
| # good for catching things like 'conmon(8)' pointing to a .5 URL, or
 | |
| # linking to .md instead of .html.
 | |
| #
 | |
| # FIXME: we could actually rewrite this so as to offer hints on what to fix.
 | |
| # That's a lot of work, and a lot of convoluted code, for questionable ROI.
 | |
| #
 | |
| sub _is_valid_external_link {
 | |
|     my ($base, $section, $link) = @_;
 | |
| 
 | |
|     return 1 if $link =~ m!^https://github\.com/\S+/blob/(main|master)(/.*)?/\Q$base\E\.$section\.md!;
 | |
| 
 | |
|     return 1 if $link =~ m!^https://.*unix\.com/man-page/(linux|redhat)/$section/$base$!;
 | |
|     return 1 if $link eq "https://man7\.org/linux/man-pages/man$section/$base\.$section\.html";
 | |
| 
 | |
|     if ($base =~ /systemd/) {
 | |
|         return 1 if $link eq "https://www.freedesktop.org/software/systemd/man/$base.html";
 | |
|     }
 | |
| 
 | |
|     return 1 if $link eq "https://passt.top/builds/latest/web/passt.1.html";
 | |
| 
 | |
|     return;
 | |
| }
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| # END   sanity checking of SEE ALSO links
 | |
| ###############################################################################
 | |
| 
 | |
| 1;
 |