]>
Commit | Line | Data |
---|---|---|
e0a65194 | 1 | #! /usr/bin/env perl |
fd38836b | 2 | # Copyright 1995-2018 The OpenSSL Project Authors. All Rights Reserved. |
d02b48c6 | 3 | # |
9059ab42 | 4 | # Licensed under the Apache License 2.0 (the "License"). You may not use |
e0a65194 RS |
5 | # this file except in compliance with the License. You can obtain a copy |
6 | # in the file LICENSE in the source distribution or at | |
7 | # https://www.openssl.org/source/license.html | |
8 | ||
d02b48c6 RE |
9 | # This is just a quick script to scan for cases where the 'error' |
10 | # function name in a XXXerr() macro is wrong. | |
609b0852 | 11 | # |
d02b48c6 RE |
12 | # Run in the top level by going |
13 | # perl util/ck_errf.pl */*.c */*/*.c | |
14 | # | |
15 | ||
5038e325 RS |
16 | use strict; |
17 | use warnings; | |
18 | ||
b9def672 | 19 | my $config; |
3ed3603b | 20 | my $err_strict = 0; |
b9def672 RL |
21 | my $debug = 0; |
22 | my $internal = 0; | |
23 | ||
24 | sub help | |
25 | { | |
26 | print STDERR <<"EOF"; | |
27 | mkerr.pl [options] [files...] | |
28 | ||
29 | Options: | |
30 | ||
31 | -conf FILE Use the named config file FILE instead of the default. | |
32 | ||
33 | -debug Verbose output debugging on stderr. | |
34 | ||
35 | -internal Generate code that is to be built as part of OpenSSL itself. | |
36 | Also scans internal list of files. | |
37 | ||
38 | -strict If any error was found, fail with exit code 1, otherwise 0. | |
39 | ||
40 | -help Show this help text. | |
41 | ||
42 | ... Additional arguments are added to the file list to scan, | |
43 | if '-internal' was NOT specified on the command line. | |
44 | ||
45 | EOF | |
46 | } | |
47 | ||
48 | while ( @ARGV ) { | |
49 | my $arg = $ARGV[0]; | |
50 | last unless $arg =~ /-.*/; | |
51 | $arg = $1 if $arg =~ /-(-.*)/; | |
52 | if ( $arg eq "-conf" ) { | |
53 | $config = $ARGV[1]; | |
54 | shift @ARGV; | |
55 | } elsif ( $arg eq "-debug" ) { | |
56 | $debug = 1; | |
57 | } elsif ( $arg eq "-internal" ) { | |
58 | $internal = 1; | |
59 | } elsif ( $arg eq "-strict" ) { | |
60 | $err_strict = 1; | |
61 | } elsif ( $arg =~ /-*h(elp)?/ ) { | |
62 | &help(); | |
63 | exit; | |
64 | } elsif ( $arg =~ /-.*/ ) { | |
65 | die "Unknown option $arg; use -h for help.\n"; | |
66 | } | |
67 | shift @ARGV; | |
68 | } | |
69 | ||
70 | my @source; | |
71 | if ( $internal ) { | |
72 | die "Extra parameters given.\n" if @ARGV; | |
73 | $config = "crypto/err/openssl.ec" unless defined $config; | |
74 | @source = ( glob('crypto/*.c'), glob('crypto/*/*.c'), | |
6caf7f3a MC |
75 | glob('ssl/*.c'), glob('ssl/*/*.c'), glob('providers/*.c'), |
76 | glob('providers/*/*.c'), glob('providers/*/*/*.c') ); | |
b9def672 RL |
77 | } else { |
78 | die "Configuration file not given.\nSee '$0 -help' for information\n" | |
79 | unless defined $config; | |
80 | @source = @ARGV; | |
81 | } | |
5038e325 | 82 | |
a21180b7 RL |
83 | # To detect if there is any error generation for a libcrypto/libssl libs |
84 | # we don't know, we need to find out what libs we do know. That list is | |
85 | # readily available in crypto/err/openssl.ec, in form of lines starting | |
b9def672 RL |
86 | # with "L ". Note that we always rely on the modules SYS and ERR to be |
87 | # generally available. | |
88 | my %libs = ( SYS => 1, ERR => 1 ); | |
a21180b7 RL |
89 | open my $cfh, $config or die "Trying to read $config: $!\n"; |
90 | while (<$cfh>) { | |
91 | s|\R$||; # Better chomp | |
92 | next unless m|^L ([0-9A-Z_]+)\s|; | |
93 | next if $1 eq "NONE"; | |
94 | $libs{$1} = 1; | |
95 | } | |
96 | ||
b9def672 RL |
97 | my $bad = 0; |
98 | foreach my $file (@source) { | |
5038e325 RS |
99 | open( IN, "<$file" ) || die "Can't open $file, $!"; |
100 | my $func = ""; | |
101 | while (<IN>) { | |
102 | if ( !/;$/ && /^\**([a-zA-Z_].*[\s*])?([A-Za-z_0-9]+)\(.*([),]|$)/ ) { | |
103 | /^([^()]*(\([^()]*\)[^()]*)*)\(/; | |
104 | $1 =~ /([A-Za-z_0-9]*)$/; | |
105 | $func = $1; | |
106 | $func =~ tr/A-Z/a-z/; | |
107 | } | |
a21180b7 | 108 | if ( /([A-Z0-9_]+[A-Z0-9])err\(([^,]+)/ && !/ckerr_ignore/ ) { |
5038e325 RS |
109 | my $errlib = $1; |
110 | my $n = $2; | |
3ed3603b | 111 | |
a21180b7 | 112 | unless ( $libs{$errlib} ) { |
b9def672 RL |
113 | print "$file:$.:$errlib not listed in $config\n"; |
114 | $libs{$errlib} = 1; # To not display it again | |
a21180b7 RL |
115 | $bad = 1; |
116 | } | |
117 | ||
5038e325 RS |
118 | if ( $func eq "" ) { |
119 | print "$file:$.:???:$n\n"; | |
120 | $bad = 1; | |
121 | next; | |
122 | } | |
8afca8d9 | 123 | |
a21180b7 | 124 | if ( $n !~ /^(.+)_F_(.+)$/ ) { |
5038e325 RS |
125 | #print "check -$file:$.:$func:$n\n"; |
126 | next; | |
127 | } | |
128 | my $lib = $1; | |
129 | $n = $2; | |
8afca8d9 | 130 | |
5038e325 RS |
131 | if ( $lib ne $errlib ) { |
132 | print "$file:$.:$func:$n [${errlib}err]\n"; | |
133 | $bad = 1; | |
134 | next; | |
135 | } | |
d02b48c6 | 136 | |
5038e325 RS |
137 | $n =~ tr/A-Z/a-z/; |
138 | if ( $n ne $func && $errlib ne "SYS" ) { | |
139 | print "$file:$.:$func:$n\n"; | |
140 | $bad = 1; | |
141 | next; | |
142 | } | |
d02b48c6 | 143 | |
5038e325 | 144 | # print "$func:$1\n"; |
d02b48c6 | 145 | } |
5038e325 RS |
146 | } |
147 | close(IN); | |
148 | } | |
d02b48c6 | 149 | |
5038e325 RS |
150 | if ( $bad && $err_strict ) { |
151 | print STDERR "FATAL: error discrepancy\n"; | |
152 | exit 1; | |
153 | } |