swagger-check: new CI tool to cross-check swagger

New script cross-references r.Handle() and r.HandleFunc()
calls against the preceding '// swagger:operation' comments,
and exits failure (with descriptive error messages) if any
comments do not match the code.

This script should not be necessary: the swagger comments
should be autogenerated from the source code.

Signed-off-by: Ed Santiago <santiago@redhat.com>

1 files changed, 317 insertions, 0 deletions

diff --git a/hack/swagger-check b/hack/swagger-check
new file mode 100755
index 000000000..d564b6554
--- /dev/null
+++ b/hack/swagger-check
@@ -0,0 +1,317 @@
+#!/usr/bin/perl
+#
+# swagger-check - Look for inconsistencies between swagger and source code
+#
+package LibPod::SwaggerCheck;
+
+use v5.14;
+use strict;
+use warnings;
+
+use File::Find;
+
+(our $ME = $0) =~ s|.*/||;
+(our $VERSION = '$Revision: 1.7 $ ') =~ tr/[0-9].//cd;
+
+# For debugging, show data structures using DumpTree($var)
+#use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
+
+###############################################################################
+# BEGIN user-customizable section
+
+our $Default_Dir =  'pkg/api/server';
+
+# END   user-customizable section
+###############################################################################
+
+###############################################################################
+# BEGIN boilerplate args checking, usage messages
+
+sub usage {
+    print  <<"END_USAGE";
+Usage: $ME [OPTIONS] DIRECTORY-TO-CHECK
+
+$ME scans all .go files under the given DIRECTORY-TO-CHECK
+(default: $Default_Dir), looking for lines of the form 'r.Handle(...)'
+or 'r.HandleFunc(...)'. For each such line, we check for a preceding
+swagger comment line and verify that the comment line matches the
+declarations in the r.Handle() invocation.
+
+For example, the following would be a correctly-matching pair of lines:
+
+    // swagger:operation GET /images/json compat getImages
+    r.Handle(VersionedPath("/images/json"), s.APIHandler(compat.GetImages)).Methods(http.MethodGet)
+
+...because http.MethodGet matches GET in the comment, the endpoint
+is /images/json in both cases, the APIHandler() says "compat" so
+that's the swagger tag, and the swagger operation name is the
+same as the APIHandler but with a lower-case first letter.
+
+The following is an inconsistency as reported by this script:
+
+pkg/api/server/register_info.go:
+-       // swagger:operation GET /info libpod libpodGetInfo
++       // ................. ... ..... compat
+        r.Handle(VersionedPath("/info"), s.APIHandler(compat.GetInfo)).Methods(http.MethodGet)
+
+...because APIHandler() says 'compat' but the swagger comment
+says 'libpod'.
+
+OPTIONS:
+
+  --pedantic     Compare operation names (the last part of swagger comment).
+                 There are far too many of these inconsistencies to allow us
+                 to enable this by default, but it still might be a useful
+                 check in some circumstances.
+
+  -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 $pedantic;
+our $debug   = 0;
+our $force   = 0;
+our $verbose = 0;
+our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
+sub handle_opts {
+    use Getopt::Long;
+    GetOptions(
+        'pedantic'   => \$pedantic,
+
+        'debug!'     => \$debug,
+        'dry-run|n!' => sub { $NOT = ' [NOT]' },
+        'force'      => \$force,
+        'verbose|v'  => \$verbose,
+
+        help         => \&usage,
+        man          => \&man,
+        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 ###############################
+
+my $exit_status = 0;
+
+# 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.
+    my $dir = shift(@ARGV) || $Default_Dir;
+    die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;
+
+    # Find and act upon all matching files
+    find { wanted => sub { finder(@_) }, no_chdir => 1 }, $dir;
+
+    exit $exit_status;
+}
+
+
+############
+#  finder  #  File::Find action - looks for 'r.Handle' or 'r.HandleFunc'
+############
+sub finder {
+    my $path = $File::Find::name;
+    return if     $path =~ m|/\.|;              # skip dotfiles
+    return unless $path =~ /\.go$/;             # Only want .go files
+
+    print $path, "\n"                           if $debug;
+
+    # Read each .go file. Keep a running tally of all '// comment' lines;
+    # if we see a 'r.Handle()' or 'r.HandleFunc()' line, pass it + comments
+    # to analysis function.
+    open my $in, '<', $path
+        or die "$ME: Cannot read $path: $!\n";
+    my @comments;
+    while (my $line = <$in>) {
+        if ($line =~ m!^\s*//!) {
+            push @comments, $line;
+        }
+        else {
+            # Not a comment line. If it's an r.Handle*() one, process it.
+            if ($line =~ m!^\s*r\.Handle(Func)?\(!) {
+                handle_handle($path, $line, @comments)
+                    or $exit_status = 1;
+            }
+
+            # Reset comments
+            @comments = ();
+        }
+    }
+    close $in;
+}
+
+
+###################
+#  handle_handle  #  Cross-check a 'r.Handle*' declaration against swagger
+###################
+#
+# Returns false if swagger comment is inconsistent with function call,
+# true if it matches or if there simply isn't a swagger comment.
+#
+sub handle_handle {
+    my $path     = shift;               # for error messages only
+    my $line     = shift;               # in: the r.Handle* line
+    my @comments = @_;                  # in: preceding comment lines
+
+    # Preserve the original line, so we can show it in comments
+    my $line_orig = $line;
+
+    # Strip off the 'r.Handle*(' and leading whitespace; preserve the latter
+    $line =~ s!^(\s*)r\.Handle(Func)?\(!!
+        or die "$ME: INTERNAL ERROR! Got '$line'!\n";
+    my $indent = $1;
+
+    # Some have VersionedPath, some don't. Doesn't seem to make a difference
+    # in terms of swagger, so let's just ignore it.
+    $line =~ s!^VersionedPath\(([^\)]+)\)!$1!;
+    $line =~ m!^"(/[^"]+)",!
+        or die "$ME: $path:$.: Cannot grok '$line'\n";
+    my $endpoint = $1;
+
+    # FIXME: in older code, '{name:..*}' meant 'nameOrID'. As of 2020-02
+    # it looks like most of the '{name:..*}' entries are gone, except for one.
+###FIXME-obsolete?    $endpoint =~ s|\{name:\.\.\*\}|{nameOrID}|;
+
+    # e.g. /auth, /containers/*/rename, /distribution, /monitor, /plugins
+    return 1 if $line =~ /\.UnsupportedHandler/;
+
+    #
+    # Determine the HTTP METHOD (GET, POST, DELETE, HEAD)
+    #
+    my $method;
+    if ($line =~ /generic.VersionHandler/) {
+        $method = 'GET';
+    }
+    elsif ($line =~ m!\.Methods\((.*)\)!) {
+        my $x = $1;
+
+        if ($x =~ /Method(Post|Get|Delete|Head)/) {
+            $method = uc $1;
+        }
+        elsif ($x =~ /\"(HEAD|GET|POST)"/) {
+            $method = $1;
+        }
+        else {
+            die "$ME: $path:$.: Cannot grok $x\n";
+        }
+    }
+    else {
+        warn "$ME: $path:$.: No Methods in '$line'\n";
+        return 1;
+    }
+
+    #
+    # Determine the SWAGGER TAG. Assume 'compat' unless we see libpod; but
+    # this can be overruled (see special case below)
+    #
+    my $tag = ($endpoint =~ /(libpod)/ ? $1 : 'compat');
+
+    #
+    # Determine the OPERATION. *** NOTE: This is mostly useless! ***
+    # In an ideal world the swagger comment would match actual function call;
+    # in reality there are over thirty mismatches. Use --pedantic to see.
+    #
+    my $operation = '';
+    if ($line =~ /(generic|handlers|compat)\.(\w+)/) {
+        $operation = lcfirst $2;
+        if ($endpoint =~ m!/libpod/! && $operation !~ /^libpod/) {
+            $operation = 'libpod' . ucfirst $operation;
+        }
+    }
+    elsif ($line =~ /(libpod)\.(\w+)/) {
+        $operation = "$1$2";
+    }
+
+    # Special case: the following endpoints all get a custom tag
+    if ($endpoint =~ m!/(volumes|pods|manifests)/!) {
+        $tag = $1;
+        $operation =~ s/^libpod//;
+        $operation = lcfirst $operation;
+    }
+
+    # Special case: anything related to 'events' gets a system tag
+    if ($endpoint =~ m!/events!) {
+        $tag = 'system';
+    }
+
+    # Special case: /changes is libpod even though it says compat
+    if ($endpoint =~ m!/changes!) {
+        $tag = 'libpod';
+    }
+
+    state $previous_path;                # Previous path name, to avoid dups
+
+    #
+    # Compare actual swagger comment to what we expect based on Handle call.
+    #
+    my $expect = " // swagger:operation $method $endpoint $tag $operation ";
+    my @actual = grep { /swagger:operation/ } @comments;
+
+    return 1 if !@actual;         # No swagger comment in file; oh well
+
+    my $actual = $actual[0];
+
+    # By default, don't compare the operation: there are far too many
+    # mismatches here.
+    if (! $pedantic) {
+        $actual =~ s/\s+\S+\s*$//;
+        $expect =~ s/\s+\S+\s*$//;
+    }
+
+    # (Ignore whitespace discrepancies)
+    (my $a_trimmed = $actual) =~ s/\s+/ /g;
+
+    return 1 if $a_trimmed eq $expect;
+
+    # Mismatch. Display it. Start with filename, if different from previous
+    print "\n";
+    if (!$previous_path || $previous_path ne $path) {
+        print $path, ":\n";
+    }
+    $previous_path = $path;
+
+    # Show the actual line, prefixed with '-' ...
+    print "- $actual[0]";
+    # ...then our generated ones, but use '...' as a way to ignore matches
+    print "+ $indent//";
+    my @actual_split = split ' ', $actual;
+    my @expect_split = split ' ', $expect;
+    for my $i (1 .. $#actual_split) {
+        print " ";
+        if ($actual_split[$i] eq ($expect_split[$i]||'')) {
+            print "." x length($actual_split[$i]);
+        }
+        else {
+            # Show the difference. Use terminal highlights if available.
+            print "\e[1;37m"            if -t *STDOUT;
+            print $expect_split[$i];
+            print "\e[m"                if -t *STDOUT;
+        }
+    }
+    print "\n";
+
+    # Show the r.Handle* code line itself
+    print "  ", $line_orig;
+
+    return;
+}
+
+1;