1#! /usr/bin/env perl 2# Copyright 1995-2018 The OpenSSL Project Authors. All Rights Reserved. 3# 4# Licensed under the OpenSSL license (the "License"). You may not use 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 9# This is just a quick script to scan for cases where the 'error' 10# function name in a XXXerr() macro is wrong. 11# 12# Run in the top level by going 13# perl util/ck_errf.pl */*.c */*/*.c 14# 15 16use strict; 17use warnings; 18 19my $config; 20my $err_strict = 0; 21my $debug = 0; 22my $internal = 0; 23 24sub help 25{ 26 print STDERR <<"EOF"; 27mkerr.pl [options] [files...] 28 29Options: 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 45EOF 46} 47 48while ( @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 70my @source; 71if ( $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'), 75 glob('ssl/*.c'), glob('ssl/*/*.c') ); 76} else { 77 die "Configuration file not given.\nSee '$0 -help' for information\n" 78 unless defined $config; 79 @source = @ARGV; 80} 81 82# To detect if there is any error generation for a libcrypto/libssl libs 83# we don't know, we need to find out what libs we do know. That list is 84# readily available in crypto/err/openssl.ec, in form of lines starting 85# with "L ". Note that we always rely on the modules SYS and ERR to be 86# generally available. 87my %libs = ( SYS => 1, ERR => 1 ); 88open my $cfh, $config or die "Trying to read $config: $!\n"; 89while (<$cfh>) { 90 s|\R$||; # Better chomp 91 next unless m|^L ([0-9A-Z_]+)\s|; 92 next if $1 eq "NONE"; 93 $libs{$1} = 1; 94} 95 96my $bad = 0; 97foreach my $file (@source) { 98 open( IN, "<$file" ) || die "Can't open $file, $!"; 99 my $func = ""; 100 while (<IN>) { 101 if ( !/;$/ && /^\**([a-zA-Z_].*[\s*])?([A-Za-z_0-9]+)\(.*([),]|$)/ ) { 102 /^([^()]*(\([^()]*\)[^()]*)*)\(/; 103 $1 =~ /([A-Za-z_0-9]*)$/; 104 $func = $1; 105 $func =~ tr/A-Z/a-z/; 106 } 107 if ( /([A-Z0-9_]+[A-Z0-9])err\(([^,]+)/ && !/ckerr_ignore/ ) { 108 my $errlib = $1; 109 my $n = $2; 110 111 unless ( $libs{$errlib} ) { 112 print "$file:$.:$errlib not listed in $config\n"; 113 $libs{$errlib} = 1; # To not display it again 114 $bad = 1; 115 } 116 117 if ( $func eq "" ) { 118 print "$file:$.:???:$n\n"; 119 $bad = 1; 120 next; 121 } 122 123 if ( $n !~ /^(.+)_F_(.+)$/ ) { 124 #print "check -$file:$.:$func:$n\n"; 125 next; 126 } 127 my $lib = $1; 128 $n = $2; 129 130 if ( $lib ne $errlib ) { 131 print "$file:$.:$func:$n [${errlib}err]\n"; 132 $bad = 1; 133 next; 134 } 135 136 $n =~ tr/A-Z/a-z/; 137 if ( $n ne $func && $errlib ne "SYS" ) { 138 print "$file:$.:$func:$n\n"; 139 $bad = 1; 140 next; 141 } 142 143 # print "$func:$1\n"; 144 } 145 } 146 close(IN); 147} 148 149if ( $bad && $err_strict ) { 150 print STDERR "FATAL: error discrepancy\n"; 151 exit 1; 152} 153