podman

1
#!/usr/bin/perl
2
#
3
# swagger-check - Look for inconsistencies between swagger and source code
4
#
5
package LibPod::SwaggerCheck;
6

7
use v5.14;
8
use strict;
9
use warnings;
10

11
use File::Find;
12

13
(our $ME = $0) =~ s|.*/||;
14
(our $VERSION = '$Revision: 1.7 $ ') =~ tr/[0-9].//cd;
15

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

19
###############################################################################
20
# BEGIN user-customizable section
21

22
our $Default_Dir =  'pkg/api/server';
23

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

27
###############################################################################
28
# BEGIN boilerplate args checking, usage messages
29

30
sub usage {
31
    print  <<"END_USAGE";
32
Usage: $ME [OPTIONS] DIRECTORY-TO-CHECK
33

34
$ME scans all .go files under the given DIRECTORY-TO-CHECK
35
(default: $Default_Dir), looking for lines of the form 'r.Handle(...)'
36
or 'r.HandleFunc(...)'. For each such line, we check for a preceding
37
swagger comment line and verify that the comment line matches the
38
declarations in the r.Handle() invocation.
39

40
For example, the following would be a correctly-matching pair of lines:
41

42
    // swagger:operation GET /images/json compat getImages
43
    r.Handle(VersionedPath("/images/json"), s.APIHandler(compat.GetImages)).Methods(http.MethodGet)
44

45
...because http.MethodGet matches GET in the comment, the endpoint
46
is /images/json in both cases, the APIHandler() says "compat" so
47
that's the swagger tag, and the swagger operation name is the
48
same as the APIHandler but with a lower-case first letter.
49

50
The following is an inconsistency as reported by this script:
51

52
pkg/api/server/register_info.go:
53
-       // swagger:operation GET /info libpod libpodGetInfo
54
+       // ................. ... ..... compat
55
        r.Handle(VersionedPath("/info"), s.APIHandler(compat.GetInfo)).Methods(http.MethodGet)
56

57
...because APIHandler() says 'compat' but the swagger comment
58
says 'libpod'.
59

60
OPTIONS:
61

62
  -v, --verbose  show verbose progress indicators
63
  -n, --dry-run  make no actual changes
64

65
  --help         display this message
66
  --version      display program name and version
67
END_USAGE
68

69
    exit;
70
}
71

72
# Command-line options.  Note that this operates directly on @ARGV !
73
our $debug   = 0;
74
our $force   = 0;
75
our $verbose = 0;
76
our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
77
sub handle_opts {
78
    use Getopt::Long;
79
    GetOptions(
80
        'debug!'     => \$debug,
81
        'dry-run|n!' => sub { $NOT = ' [NOT]' },
82
        'force'      => \$force,
83
        'verbose|v'  => \$verbose,
84

85
        help         => \&usage,
86
        man          => \&man,
87
        version      => sub { print "$ME version $VERSION\n"; exit 0 },
88
    ) or die "Try `$ME --help' for help\n";
89
}
90

91
# END   boilerplate args checking, usage messages
92
###############################################################################
93

94
############################## CODE BEGINS HERE ###############################
95

96
my $exit_status = 0;
97

98
# The term is "modulino".
99
__PACKAGE__->main()                                     unless caller();
100

101
# Main code.
102
sub main {
103
    # Note that we operate directly on @ARGV, not on function parameters.
104
    # This is deliberate: it's because Getopt::Long only operates on @ARGV
105
    # and there's no clean way to make it use @_.
106
    handle_opts();                      # will set package globals
107

108
    # Fetch command-line arguments.  Barf if too many.
109
    my $dir = shift(@ARGV) || $Default_Dir;
110
    die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;
111

112
    # Find and act upon all matching files
113
    find { wanted => sub { finder(@_) }, no_chdir => 1 }, $dir;
114

115
    exit $exit_status;
116
}
117

118

119
############
120
#  finder  #  File::Find action - looks for 'r.Handle' or 'r.HandleFunc'
121
############
122
sub finder {
123
    my $path = $File::Find::name;
124
    return if     $path =~ m|/\.|;              # skip dotfiles
125
    return unless $path =~ /\.go$/;             # Only want .go files
126

127
    print $path, "\n"                           if $debug;
128

129
    # Read each .go file. Keep a running tally of all '// comment' lines;
130
    # if we see a 'r.Handle()' or 'r.HandleFunc()' line, pass it + comments
131
    # to analysis function.
132
    open my $in, '<', $path
133
        or die "$ME: Cannot read $path: $!\n";
134
    my @comments;
135
    while (my $line = <$in>) {
136
        if ($line =~ m!^\s*//!) {
137
            push @comments, $line;
138
        }
139
        else {
140
            # Not a comment line. If it's an r.Handle*() one, process it.
141
            if ($line =~ m!^\s*r\.Handle(Func)?\(!) {
142
                handle_handle($path, $line, @comments)
143
                    or $exit_status = 1;
144
            }
145

146
            # Reset comments
147
            @comments = ();
148
        }
149
    }
150
    close $in;
151
}
152

153

154
###################
155
#  handle_handle  #  Cross-check a 'r.Handle*' declaration against swagger
156
###################
157
#
158
# Returns false if swagger comment is inconsistent with function call,
159
# true if it matches or if there simply isn't a swagger comment.
160
#
161
sub handle_handle {
162
    my $path     = shift;               # for error messages only
163
    my $line     = shift;               # in: the r.Handle* line
164
    my @comments = @_;                  # in: preceding comment lines
165

166
    # Preserve the original line, so we can show it in comments
167
    my $line_orig = $line;
168

169
    # Strip off the 'r.Handle*(' and leading whitespace; preserve the latter
170
    $line =~ s!^(\s*)r\.Handle(Func)?\(!!
171
        or die "$ME: INTERNAL ERROR! Got '$line'!\n";
172
    my $indent = $1;
173

174
    # Some have VersionedPath, some don't. Doesn't seem to make a difference
175
    # in terms of swagger, so let's just ignore it.
176
    $line =~ s!^VersionedPath\(([^\)]+)\)!$1!;
177
    $line =~ m!^"(/[^"]+)",!
178
        or die "$ME: $path:$.: Cannot grok '$line'\n";
179
    my $endpoint = $1;
180

181
    # Some function declarations require an argument of the form '{name:.*}'
182
    # but the swagger (which gets derived from the comments) should not
183
    # include them. Normalize all such args to just '{name}'.
184
    $endpoint =~ s/\{name:\.\*\}/\{name\}/;
185

186
    # e.g. /auth, /containers/*/rename, /distribution, /monitor, /plugins
187
    return 1 if $line =~ /\.UnsupportedHandler/;
188

189
    #
190
    # Determine the HTTP METHOD (GET, POST, DELETE, HEAD)
191
    #
192
    my $method;
193
    if ($line =~ /generic.VersionHandler/) {
194
        $method = 'GET';
195
    }
196
    elsif ($line =~ m!\.Methods\((.*)\)!) {
197
        my $x = $1;
198

199
        if ($x =~ /Method(Post|Get|Delete|Head)/) {
200
            $method = uc $1;
201
        }
202
        elsif ($x =~ /\"(HEAD|GET|POST)"/) {
203
            $method = $1;
204
        }
205
        else {
206
            die "$ME: $path:$.: Cannot grok $x\n";
207
        }
208
    }
209
    else {
210
        warn "$ME: $path:$.: No Methods in '$line'\n";
211
        return 1;
212
    }
213

214
    #
215
    # Determine the SWAGGER TAG. Assume 'compat' unless we see libpod; but
216
    # this can be overruled (see special case below)
217
    #
218
    my $tag = ($endpoint =~ /(libpod)/ ? $1 : 'compat');
219

220
    #
221
    # Determine the OPERATION. Done in a helper function because there
222
    # are a lot of complicated special cases.
223
    #
224
    my $operation = operation_name($method, $endpoint);
225

226
    # Special case: the following endpoints all get a custom tag
227
    if ($endpoint =~ m!/(pods|manifests)/!) {
228
        $tag = $1;
229
    }
230

231
    # Special case: anything related to 'events' gets a system tag
232
    if ($endpoint =~ m!/events!) {
233
        $tag = 'system';
234
    }
235

236
    state $previous_path;                # Previous path name, to avoid dups
237

238
    #
239
    # Compare actual swagger comment to what we expect based on Handle call.
240
    #
241
    my $expect = " // swagger:operation $method $endpoint $tag $operation ";
242
    my @actual = grep { /swagger:operation/ } @comments;
243

244
    return 1 if !@actual;         # No swagger comment in file; oh well
245

246
    my $actual = $actual[0];
247

248
    # (Ignore whitespace discrepancies)
249
    (my $a_trimmed = $actual) =~ s/\s+/ /g;
250

251
    return 1 if $a_trimmed eq $expect;
252

253
    # Mismatch. Display it. Start with filename, if different from previous
254
    print "\n";
255
    if (!$previous_path || $previous_path ne $path) {
256
        print $path, ":\n";
257
    }
258
    $previous_path = $path;
259

260
    # Show the actual line, prefixed with '-' ...
261
    print "- $actual[0]";
262
    # ...then our generated ones, but use '...' as a way to ignore matches
263
    print "+ $indent//";
264
    my @actual_split = split ' ', $actual;
265
    my @expect_split = split ' ', $expect;
266
    for my $i (1 .. $#actual_split) {
267
        print " ";
268
        if ($actual_split[$i] eq ($expect_split[$i]||'')) {
269
            print "." x length($actual_split[$i]);
270
        }
271
        else {
272
            # Show the difference. Use terminal highlights if available.
273
            print "\e[1;37m"            if -t *STDOUT;
274
            print $expect_split[$i];
275
            print "\e[m"                if -t *STDOUT;
276
        }
277
    }
278
    print "\n";
279

280
    # Show the r.Handle* code line itself
281
    print "  ", $line_orig;
282

283
    return;
284
}
285

286

287
####################
288
#  operation_name  #  Given a method + endpoint, return the swagger operation
289
####################
290
sub operation_name {
291
    my ($method, $endpoint) = @_;
292

293
    # /libpod/foo/bar -> (libpod, foo, bar)
294
    my @endpoints = grep { /\S/ } split '/', $endpoint;
295

296
    # /libpod endpoints -> add 'Libpod' to end, e.g. PodStatsLibpod
297
    my $Libpod = '';
298
    my $main = shift(@endpoints);
299
    if ($main eq 'libpod') {
300
        $Libpod = ucfirst($main);
301
        $main = shift(@endpoints);
302
    }
303
    $main =~ s/s$//;         # e.g. Volumes -> Volume
304

305
    # Next path component is an optional action:
306
    #    GET    /containers/json               -> ContainerList
307
    #    DELETE /libpod/containers/{name}      -> ContainerDelete
308
    #    GET    /libpod/containers/{name}/logs -> ContainerLogsLibpod
309
    my $action = shift(@endpoints) || 'list';
310
    $action = 'list'   if $action eq 'json';
311
    $action = 'delete' if $method eq 'DELETE';
312

313
    # Anything with {id}, {name}, {name:..} may have a following component
314
    if ($action =~ m!\{.*\}!) {
315
        $action = shift(@endpoints) || 'inspect';
316
        $action = 'inspect' if $action eq 'json';
317
    }
318

319
    # All sorts of special cases
320
    if ($action eq 'df') {
321
        $action = 'dataUsage';
322
    }
323
    elsif ($action eq "delete" && $endpoint eq "/libpod/play/kube") {
324
        $action = "KubeDown"
325
    }
326
    # Grrrrrr, this one is annoying: some operations get an extra 'All'
327
    elsif ($action =~ /^(delete|get|stats)$/ && $endpoint !~ /\{/) {
328
        $action .= "All";
329
        $main .= 's' if $main eq 'container';
330
    }
331
    # No real way to used MixedCase in an endpoint, so we have to hack it here
332
    elsif ($action eq 'showmounted') {
333
        $action = 'showMounted';
334
    }
335
    # Ping is a special endpoint, and even if /libpod/_ping, no 'Libpod'
336
    elsif ($main eq '_ping') {
337
        $main = 'system';
338
        $action = 'ping';
339
        $Libpod = '';
340
    }
341
    # Top-level compat endpoints
342
    elsif ($main =~ /^(build|commit)$/) {
343
        $main   = 'image';
344
        $action = $1;
345
    }
346
    # Top-level system endpoints
347
    elsif ($main =~ /^(auth|event|info|version)$/) {
348
        $main   = 'system';
349
        $action = $1;
350
        $action .= 's' if $action eq 'event';
351
    }
352

353
    return "\u${main}\u${action}$Libpod";
354
}
355

356

357
1;
358