xref-helpmsgs-manpages

#!/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;

(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 = './bin/podman';
my $PODMAN = $ENV{PODMAN} || $Default_Podman;

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

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

# Global error count
my $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       .ImageSummary
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',  '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)
 );

# END   user-customizable section
###############################################################################

use FindBin;

###############################################################################
# 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;

    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) {
        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})) {
                    warn "$ME: 'podman @subcommand': --format options are available through autocomplete, but are not documented in $man->{_path}\n";

                    # FIXME: don't make this an error... yet.
                    # ++$Errs;
                    next OPTION;
                }

                xref_by_help($help->{$k}, $man->{$k}, @subcommand, $k);
            }
            # Otherwise, non-ref is leaf node such as a --option
        }
        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/\.[^.]+$//) {
                if (($man->{$k_copy}||'') eq '...') {
                    next OPTION;
                }
            }

            # Nope, it's not that case.
            my $man = $man->{_path} || 'man';
            warn "$ME: 'podman @subcommand --help' 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: podman completion is a hidden command
            next if $k eq 'completion';

            warn "$ME: 'podman @subcommand': $k in $man, but not --help\n";
            ++$Errs;
        }
    }
}

##############
#  xref_rst  #  Cross-check *.rst files against help
##############
sub xref_rst {
    my ($help, $rst, @subcommand) = @_;

    # Cross-check against rst (but only subcommands, not options).
    # We key on $help because that is Absolute Truth: anything in podman --help
    # must be referenced in an rst (the converse is not true).
    for my $k (sort grep { $_ !~ /^-/ } keys %$help) {
        # Check for subcommands, if any (eg podman system -> connection -> add)
        if (ref $help->{$k}) {
            xref_rst($help->{$k}, $rst->{$k}, @subcommand, $k);
        }
    }
}

# 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>) {
        # Cobra is blessedly consistent in its output:
        #    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 $subcommand eq 'help';       # 'help' not in man
            }
        }
        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}}' or '{{.Foo.' entries
            # (indicating terminal or nonterminal nodes respectively)
            # 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).
            if ($opt eq '--format') {
                my @completions = _completions(@_, '--format', '{{.');
                for my $c (@completions) {
                    if ($c =~ /^\{\{(\.\S+)(\.|\}\})$/) {
                        # First time through: convert to a hashref
                        $help{$opt} = {}   if ! ref($help{$opt});

                        # Remember this param
                        $help{$opt}{$1} = 1;
                    }
                }

                # 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;
                    }
                }
           }
        }
    }
    close $fh
        or die "$ME: Error running 'podman @_ --help'\n";

    return \%help;
}


################
#  podman_man  #  Parse contents of podman-*.1.md
################
sub podman_man {
    my $command = shift;
    my $subpath = "$Markdown_Path/$command.1.md";
    my $manpath = "$FindBin::Bin/../$subpath";
    print "** $subpath \n"                              if $debug;

    my %man = (_path => $subpath);
    open my $fh, '<', $manpath
        or die "$ME: Cannot read $manpath: $!\n";
    my $section = '';
    my @most_recent_flags;
    my $previous_subcmd = '';
    my $previous_flag = '';
    my $previous_format = '';
    while (my $line = <$fh>) {
        chomp $line;
        next 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-$1");
            }

            # 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;
                }
                $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;
                    }
                    $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 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. '.Foo ...' (three dots)
                # indicates that .Foo includes a number of subfields .Foo.Xxx,
                # .Foo.Yyy too numerous to list individually in man pages.
                #                   1     12   3      32
                if ($line =~ /^\|\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 be '...' which indicates that $format has
                    # too many subformats to document individually.
                    $man{$previous_flag}{$format} = $etc || 1;

                    if (lc($format) lt lc($previous_format)) {
                        warn "$ME: $subpath:$.: format specifier '$format' should precede '$previous_format'\n";
                        ++$Errs;
                    }
                    $previous_format = $format;
                }
            }
        }

        # 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') {
            ;
        }
        elsif ($command eq 'managecontainers') {
            $subcommand_href = $rst{container} //= { };
        }
        elsif ($command eq 'connection') {
            $subcommand_href = $rst{system}{connection} //= { };
        }
        else {
            $subcommand_href = $rst{$command} //= { };
        }

        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
                if ($subcommand lt $previous_subcommand) {
                    warn "$ME: $rst:$.: '$previous_subcommand' and '$subcommand' are out of order\n";
                    ++$Errs;
                }
                $previous_subcommand = $subcommand;

                # Mark this subcommand as documented.
                $subcommand_href->{$subcommand}{_desc} = $desc;

                # 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;
                    }
                }
                else {
                    if (! -e "$Docs_Path/$target.rst") {
                        warn "$ME: $rst:$.: '$subcommand' links to nonexistent $target.rst\n";
                    }
                }
            }
        }
        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 __completeNoDesc, 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, '__completeNoDesc', @_;
        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 __completeNoDesc @_\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;