OpenSSL::config: Fix trivial bugs
[openssl.git] / util / mkerr.pl
1 #! /usr/bin/env perl
2 # Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved.
3 #
4 # Licensed under the Apache License 2.0 (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 use strict;
10 use warnings;
11
12 use File::Basename;
13 use File::Spec::Functions qw(abs2rel rel2abs);
14
15 use lib ".";
16 use configdata;
17
18 my $config       = "crypto/err/openssl.ec";
19 my $debug        = 0;
20 my $internal     = 0;
21 my $nowrite      = 0;
22 my $rebuild      = 0;
23 my $reindex      = 0;
24 my $static       = 0;
25 my $unref        = 0;
26 my %modules         = ();
27
28 my $errors       = 0;
29 my @t            = localtime();
30 my $YEAR         = $t[5] + 1900;
31
32 sub phase
33 {
34     my $text = uc(shift);
35     print STDERR "\n---\n$text\n" if $debug;
36 }
37
38 sub help
39 {
40     print STDERR <<"EOF";
41 mkerr.pl [options] [files...]
42
43 Options:
44
45     -conf FILE  Use the named config file FILE instead of the default.
46
47     -debug      Verbose output debugging on stderr.
48
49     -internal   Generate code that is to be built as part of OpenSSL itself.
50                 Also scans internal list of files.
51
52     -module M   Only useful with -internal!
53                 Only write files for library module M.  Whether files are
54                 actually written or not depends on other options, such as
55                 -rebuild.
56                 Note: this option is cumulative.  If not given at all, all
57                 internal modules will be considered.
58
59     -nowrite    Do not write the header/source files, even if changed.
60
61     -rebuild    Rebuild all header and C source files, even if there
62                 were no changes.
63
64     -reindex    Ignore previously assigned values (except for R records in
65                 the config file) and renumber everything starting at 100.
66
67     -static     Make the load/unload functions static.
68
69     -unref      List all unreferenced function and reason codes on stderr;
70                 implies -nowrite.
71
72     -help       Show this help text.
73
74     ...         Additional arguments are added to the file list to scan,
75                 if '-internal' was NOT specified on the command line.
76
77 EOF
78 }
79
80 while ( @ARGV ) {
81     my $arg = $ARGV[0];
82     last unless $arg =~ /-.*/;
83     $arg = $1 if $arg =~ /-(-.*)/;
84     if ( $arg eq "-conf" ) {
85         $config = $ARGV[1];
86         shift @ARGV;
87     } elsif ( $arg eq "-debug" ) {
88         $debug = 1;
89         $unref = 1;
90     } elsif ( $arg eq "-internal" ) {
91         $internal = 1;
92     } elsif ( $arg eq "-nowrite" ) {
93         $nowrite = 1;
94     } elsif ( $arg eq "-rebuild" ) {
95         $rebuild = 1;
96     } elsif ( $arg eq "-reindex" ) {
97         $reindex = 1;
98     } elsif ( $arg eq "-static" ) {
99         $static = 1;
100     } elsif ( $arg eq "-unref" ) {
101         $unref = 1;
102         $nowrite = 1;
103     } elsif ( $arg eq "-module" ) {
104         shift @ARGV;
105         $modules{uc $ARGV[0]} = 1;
106     } elsif ( $arg =~ /-*h(elp)?/ ) {
107         &help();
108         exit;
109     } elsif ( $arg =~ /-.*/ ) {
110         die "Unknown option $arg; use -h for help.\n";
111     }
112     shift @ARGV;
113 }
114
115 my @source;
116 if ( $internal ) {
117     die "Cannot mix -internal and -static\n" if $static;
118     die "Extra parameters given.\n" if @ARGV;
119     @source = ( glob('crypto/*.c'), glob('crypto/*/*.c'),
120                 glob('ssl/*.c'), glob('ssl/*/*.c'), glob('ssl/*/*/*.c'),
121                 glob('providers/*.c'), glob('providers/*/*.c'),
122                 glob('providers/*/*/*.c') );
123 } else {
124     die "-module isn't useful without -internal\n" if scalar keys %modules > 0;
125     @source = @ARGV;
126 }
127
128 # Data parsed out of the config and state files.
129 my %hpubinc;    # lib -> public header
130 my %libpubinc;  # public header -> lib
131 my %hprivinc;   # lib -> private header
132 my %libprivinc; # private header -> lib
133 my %cskip;      # error_file -> lib
134 my %errorfile;  # lib -> error file name
135 my %rmax;       # lib -> max assigned reason code
136 my %rassigned;  # lib -> colon-separated list of assigned reason codes
137 my %rnew;       # lib -> count of new reason codes
138 my %rextra;     # "extra" reason code -> lib
139 my %rcodes;     # reason-name -> value
140 my $statefile;  # state file with assigned reason and function codes
141 my %strings;    # define -> text
142
143 # Read and parse the config file
144 open(IN, "$config") || die "Can't open config file $config, $!,";
145 while ( <IN> ) {
146     next if /^#/ || /^$/;
147     if ( /^L\s+(\S+)\s+(\S+)\s+(\S+)(?:\s+(\S+))?\s+$/ ) {
148         my $lib = $1;
149         my $pubhdr = $2;
150         my $err = $3;
151         my $privhdr = $4 // 'NONE';
152         $hpubinc{$lib}   = $pubhdr;
153         $libpubinc{$pubhdr} = $lib;
154         $hprivinc{$lib}   = $privhdr;
155         $libprivinc{$privhdr} = $lib;
156         $cskip{$err}  = $lib;
157         $errorfile{$lib} = $err;
158         next if $err eq 'NONE';
159         $rmax{$lib}      = 100;
160         $rassigned{$lib} = ":";
161         $rnew{$lib}      = 0;
162         die "Public header file must be in include/openssl ($pubhdr is not)\n"
163             if ($internal
164                 && $pubhdr ne 'NONE'
165                 && $pubhdr !~ m|^include/openssl/|);
166         die "Private header file may only be specified with -internal ($privhdr given)\n"
167             unless ($privhdr eq 'NONE' || $internal);
168     } elsif ( /^R\s+(\S+)\s+(\S+)/ ) {
169         $rextra{$1} = $2;
170         $rcodes{$1} = $2;
171     } elsif ( /^S\s+(\S+)/ ) {
172         $statefile = $1;
173     } else {
174         die "Illegal config line $_\n";
175     }
176 }
177 close IN;
178
179 if ( ! $statefile ) {
180     $statefile = $config;
181     $statefile =~ s/.ec/.txt/;
182 }
183
184 # The statefile has all the previous assignments.
185 &phase("Reading state");
186 my $skippedstate = 0;
187 if ( ! $reindex && $statefile ) {
188     open(STATE, "<$statefile") || die "Can't open $statefile, $!";
189
190     # Scan function and reason codes and store them: keep a note of the
191     # maximum code used.
192     while ( <STATE> ) {
193         next if /^#/ || /^$/;
194         my $name;
195         my $code;
196         if ( /^(.+):(\d+):\\$/ ) {
197             $name = $1;
198             $code = $2;
199             my $next = <STATE>;
200             $next =~ s/^\s*(.*)\s*$/$1/;
201             die "Duplicate define $name" if exists $strings{$name};
202             $strings{$name} = $next;
203         } elsif ( /^(\S+):(\d+):(.*)$/ ) {
204             $name = $1;
205             $code = $2;
206             die "Duplicate define $name" if exists $strings{$name};
207             $strings{$name} = $3;
208         } else {
209             die "Bad line in $statefile:\n$_\n";
210         }
211         my $lib = $name;
212         $lib =~ s/^((?:OSSL_|OPENSSL_)?[^_]{2,}).*$/$1/;
213         $lib = "SSL" if $lib =~ /TLS/;
214         if ( !defined $errorfile{$lib} ) {
215             print "Skipping $_";
216             $skippedstate++;
217             next;
218         }
219         next if $errorfile{$lib} eq 'NONE';
220         if ( $name =~ /^(?:OSSL_|OPENSSL_)?[A-Z0-9]{2,}_R_/ ) {
221             die "$lib reason code $code collision at $name\n"
222                 if $rassigned{$lib} =~ /:$code:/;
223             $rassigned{$lib} .= "$code:";
224             if ( !exists $rextra{$name} ) {
225                 $rmax{$lib} = $code if $code > $rmax{$lib};
226             }
227             $rcodes{$name} = $code;
228         } elsif ( $name =~ /^(?:OSSL_|OPENSSL_)?[A-Z0-9]{2,}_F_/ ) {
229             # We do nothing with the function codes, just let them go away
230         } else {
231             die "Bad line in $statefile:\n$_\n";
232         }
233     }
234     close(STATE);
235
236     if ( $debug ) {
237         foreach my $lib ( sort keys %rmax ) {
238             print STDERR "Reason codes for ${lib}:\n";
239             if ( $rassigned{$lib} =~ m/^:(.*):$/ ) {
240                 my @rassigned = sort { $a <=> $b } split( ":", $1 );
241                 print STDERR "  ", join(' ', @rassigned), "\n";
242             } else {
243                 print STDERR "  --none--\n";
244             }
245         }
246     }
247 }
248
249 # Scan each C source file and look for reason codes.  This is done by
250 # looking for strings that "look like" reason codes: basically anything
251 # consisting of all upper case and numerics which _R_ in it and which has
252 # the name of an error library at the start.  Should there be anything else,
253 # such as a type name, we add exceptions here.
254 # If a code doesn't exist in list compiled from headers then mark it
255 # with the value "X" as a place holder to give it a value later.
256 # Store all reason codes found in and %usedreasons so all those unreferenced
257 # can be printed out.
258 &phase("Scanning source");
259 my %usedreasons;
260 foreach my $file ( @source ) {
261     # Don't parse the error source file.
262     next if exists $cskip{$file};
263     open( IN, "<$file" ) || die "Can't open $file, $!,";
264     my $func;
265     my $linenr = 0;
266     print STDERR "$file:\n" if $debug;
267     while ( <IN> ) {
268
269         # skip obsoleted source files entirely!
270         last if /^#error\s+obsolete/;
271         $linenr++;
272
273         if ( /(((?:OSSL_|OPENSSL_)?[A-Z0-9]{2,})_R_[A-Z0-9_]+)/ ) {
274             next unless exists $errorfile{$2};
275             next if $errorfile{$2} eq 'NONE';
276             $usedreasons{$1} = 1;
277             if ( !exists $rcodes{$1} ) {
278                 print STDERR "  New reason $1\n" if $debug;
279                 $rcodes{$1} = "X";
280                 $rnew{$2}++;
281             }
282             print STDERR "  Reason $1 = $rcodes{$1}\n" if $debug;
283         }
284     }
285     close IN;
286 }
287 print STDERR "\n" if $debug;
288
289 # Now process each library in turn.
290 &phase("Writing files");
291 my $newstate = 0;
292 foreach my $lib ( keys %errorfile ) {
293     next if ! $rnew{$lib} && ! $rebuild;
294     next if scalar keys %modules > 0 && !$modules{$lib};
295     next if $nowrite;
296     print STDERR "$lib: $rnew{$lib} new reasons\n" if $rnew{$lib};
297     $newstate = 1;
298
299     # If we get here then we have some new error codes so we
300     # need to rebuild the header file and C file.
301
302     # Make a sorted list of error and reason codes for later use.
303     my @reasons  = sort grep( /^${lib}_/, keys %rcodes );
304
305     # indent level for innermost preprocessor lines
306     my $indent = " ";
307
308     # Flag if the sub-library is disablable
309     # There are a few exceptions, where disabling the sub-library
310     # doesn't actually remove the whole sub-library, but rather implements
311     # it with a NULL backend.
312     my $disablable =
313         ($lib ne "SSL" && $lib ne "ASYNC" && $lib ne "DSO"
314          && (grep { $lib eq uc $_ } @disablables, @disablables_int));
315
316     # Rewrite the internal header file if there is one ($internal only!)
317
318     if ($hprivinc{$lib} ne 'NONE') {
319         my $hfile = $hprivinc{$lib};
320         my $guard = $hfile;
321
322         if ($guard =~ m|^include/|) {
323             $guard = $';
324         } else {
325             $guard = basename($guard);
326         }
327         $guard = "OSSL_" . join('_', split(m|[./]|, uc $guard));
328
329         open( OUT, ">$hfile" ) || die "Can't write to $hfile, $!,";
330         print OUT <<"EOF";
331 /*
332  * Generated by util/mkerr.pl DO NOT EDIT
333  * Copyright 2020-$YEAR The OpenSSL Project Authors. All Rights Reserved.
334  *
335  * Licensed under the Apache License 2.0 (the \"License\").  You may not use
336  * this file except in compliance with the License.  You can obtain a copy
337  * in the file LICENSE in the source distribution or at
338  * https://www.openssl.org/source/license.html
339  */
340
341 #ifndef $guard
342 # define $guard
343 # pragma once
344
345 # include <openssl/opensslconf.h>
346 # include <openssl/symhacks.h>
347
348 # ifdef  __cplusplus
349 extern \"C\" {
350 # endif
351
352 EOF
353         $indent = ' ';
354         if ($disablable) {
355             print OUT <<"EOF";
356 # ifndef OPENSSL_NO_${lib}
357
358 EOF
359             $indent = "  ";
360         }
361         print OUT <<"EOF";
362 int ossl_err_load_${lib}_strings(void);
363 EOF
364
365         # If this library doesn't have a public header file, we write all
366         # definitions that would end up there here instead
367         if ($hpubinc{$lib} eq 'NONE') {
368             print OUT "\n/*\n * $lib reason codes.\n */\n";
369             foreach my $i ( @reasons ) {
370                 my $z = 48 - length($i);
371                 $z = 0 if $z < 0;
372                 if ( $rcodes{$i} eq "X" ) {
373                     $rassigned{$lib} =~ m/^:([^:]*):/;
374                     my $findcode = $1;
375                     $findcode = $rmax{$lib} if !defined $findcode;
376                     while ( $rassigned{$lib} =~ m/:$findcode:/ ) {
377                         $findcode++;
378                     }
379                     $rcodes{$i} = $findcode;
380                     $rassigned{$lib} .= "$findcode:";
381                     print STDERR "New Reason code $i\n" if $debug;
382                 }
383                 printf OUT "#${indent}define $i%s $rcodes{$i}\n", " " x $z;
384             }
385             print OUT "\n";
386         }
387
388         # This doesn't go all the way down to zero, to allow for the ending
389         # brace for 'extern "C" {'.
390         while (length($indent) > 1) {
391             $indent = substr $indent, 0, -1;
392             print OUT "#${indent}endif\n";
393         }
394
395         print OUT <<"EOF";
396
397 # ifdef  __cplusplus
398 }
399 # endif
400 #endif
401 EOF
402         close OUT;
403     }
404
405     # Rewrite the public header file
406
407     if ($hpubinc{$lib} ne 'NONE') {
408         my $extra_include =
409             $internal
410             ? ($lib ne 'SSL'
411                ? "# include <openssl/cryptoerr_legacy.h>\n"
412                : "# include <openssl/sslerr_legacy.h>\n")
413             : '';
414         my $hfile = $hpubinc{$lib};
415         my $guard = $hfile;
416         $guard =~ s|^include/||;
417         $guard = join('_', split(m|[./]|, uc $guard));
418         $guard = "OSSL_" . $guard unless $internal;
419
420         open( OUT, ">$hfile" ) || die "Can't write to $hfile, $!,";
421         print OUT <<"EOF";
422 /*
423  * Generated by util/mkerr.pl DO NOT EDIT
424  * Copyright 1995-$YEAR The OpenSSL Project Authors. All Rights Reserved.
425  *
426  * Licensed under the Apache License 2.0 (the \"License\").  You may not use
427  * this file except in compliance with the License.  You can obtain a copy
428  * in the file LICENSE in the source distribution or at
429  * https://www.openssl.org/source/license.html
430  */
431
432 #ifndef $guard
433 # define $guard
434 # pragma once
435
436 # include <openssl/opensslconf.h>
437 # include <openssl/symhacks.h>
438 $extra_include
439
440 EOF
441         $indent = ' ';
442         if ( $internal ) {
443             if ($disablable) {
444                 print OUT <<"EOF";
445 # ifndef OPENSSL_NO_${lib}
446
447 EOF
448                 $indent .= ' ';
449             }
450         } else {
451             print OUT <<"EOF";
452 # define ${lib}err(f, r) ERR_${lib}_error(0, (r), OPENSSL_FILE, OPENSSL_LINE)
453
454 EOF
455             if ( ! $static ) {
456                 print OUT <<"EOF";
457
458 # ifdef  __cplusplus
459 extern \"C\" {
460 # endif
461 int ERR_load_${lib}_strings(void);
462 void ERR_unload_${lib}_strings(void);
463 void ERR_${lib}_error(int function, int reason, const char *file, int line);
464 # ifdef  __cplusplus
465 }
466 # endif
467 EOF
468             }
469         }
470
471         print OUT "\n/*\n * $lib reason codes.\n */\n";
472         foreach my $i ( @reasons ) {
473             my $z = 48 - length($i);
474             $z = 0 if $z < 0;
475             if ( $rcodes{$i} eq "X" ) {
476                 $rassigned{$lib} =~ m/^:([^:]*):/;
477                 my $findcode = $1;
478                 $findcode = $rmax{$lib} if !defined $findcode;
479                 while ( $rassigned{$lib} =~ m/:$findcode:/ ) {
480                     $findcode++;
481                 }
482                 $rcodes{$i} = $findcode;
483                 $rassigned{$lib} .= "$findcode:";
484                 print STDERR "New Reason code $i\n" if $debug;
485             }
486             printf OUT "#${indent}define $i%s $rcodes{$i}\n", " " x $z;
487         }
488         print OUT "\n";
489
490         while (length($indent) > 0) {
491             $indent = substr $indent, 0, -1;
492             print OUT "#${indent}endif\n";
493         }
494         close OUT;
495     }
496
497     # Rewrite the C source file containing the error details.
498
499     if ($errorfile{$lib} ne 'NONE') {
500         # First, read any existing reason string definitions:
501         my $cfile = $errorfile{$lib};
502         my $pack_lib = $internal ? "ERR_LIB_${lib}" : "0";
503         my $hpubincf = $hpubinc{$lib};
504         my $hprivincf = $hprivinc{$lib};
505         my $includes = '';
506         if ($internal) {
507             if ($hpubincf ne 'NONE') {
508                 $hpubincf =~ s|^include/||;
509                 $includes .= "#include <${hpubincf}>\n";
510             }
511             if ($hprivincf =~ m|^include/|) {
512                 $hprivincf = $';
513             } else {
514                 $hprivincf = abs2rel(rel2abs($hprivincf),
515                                      rel2abs(dirname($cfile)));
516             }
517             $includes .= "#include \"${hprivincf}\"\n";
518         } else {
519             $includes .= "#include \"${hpubincf}\"\n";
520         }
521
522         open( OUT, ">$cfile" )
523             || die "Can't open $cfile for writing, $!, stopped";
524
525         my $const = $internal ? 'const ' : '';
526
527         print OUT <<"EOF";
528 /*
529  * Generated by util/mkerr.pl DO NOT EDIT
530  * Copyright 1995-$YEAR The OpenSSL Project Authors. All Rights Reserved.
531  *
532  * Licensed under the Apache License 2.0 (the "License").  You may not use
533  * this file except in compliance with the License.  You can obtain a copy
534  * in the file LICENSE in the source distribution or at
535  * https://www.openssl.org/source/license.html
536  */
537
538 #include <openssl/err.h>
539 $includes
540 EOF
541         $indent = '';
542         if ( $internal ) {
543             if ($disablable) {
544                 print OUT <<"EOF";
545 #ifndef OPENSSL_NO_${lib}
546
547 EOF
548                 $indent .= ' ';
549             }
550         }
551         print OUT <<"EOF";
552 #${indent}ifndef OPENSSL_NO_ERR
553
554 static ${const}ERR_STRING_DATA ${lib}_str_reasons[] = {
555 EOF
556
557         # Add each reason code.
558         foreach my $i ( @reasons ) {
559             my $rn;
560             if ( exists $strings{$i} ) {
561                 $rn = $strings{$i};
562                 $rn = "" if $rn eq '*';
563             } else {
564                 $i =~ /^${lib}_R_(\S+)$/;
565                 $rn = $1;
566                 $rn =~ tr/_[A-Z]/ [a-z]/;
567                 $strings{$i} = $rn;
568             }
569             my $short = "    {ERR_PACK($pack_lib, 0, $i), \"$rn\"},";
570             if ( length($short) <= 80 ) {
571                 print OUT "$short\n";
572             } else {
573                 print OUT "    {ERR_PACK($pack_lib, 0, $i),\n    \"$rn\"},\n";
574             }
575         }
576         print OUT <<"EOF";
577     {0, NULL}
578 };
579
580 #${indent}endif
581 EOF
582         if ( $internal ) {
583             print OUT <<"EOF";
584
585 int ossl_err_load_${lib}_strings(void)
586 {
587 #${indent}ifndef OPENSSL_NO_ERR
588     if (ERR_reason_error_string(${lib}_str_reasons[0].error) == NULL)
589         ERR_load_strings_const(${lib}_str_reasons);
590 #${indent}endif
591     return 1;
592 }
593 EOF
594         } else {
595             my $st = $static ? "static " : "";
596             print OUT <<"EOF";
597
598 static int lib_code = 0;
599 static int error_loaded = 0;
600
601 ${st}int ERR_load_${lib}_strings(void)
602 {
603     if (lib_code == 0)
604         lib_code = ERR_get_next_error_library();
605
606     if (!error_loaded) {
607 #ifndef OPENSSL_NO_ERR
608         ERR_load_strings(lib_code, ${lib}_str_reasons);
609 #endif
610         error_loaded = 1;
611     }
612     return 1;
613 }
614
615 ${st}void ERR_unload_${lib}_strings(void)
616 {
617     if (error_loaded) {
618 #ifndef OPENSSL_NO_ERR
619         ERR_unload_strings(lib_code, ${lib}_str_reasons);
620 #endif
621         error_loaded = 0;
622     }
623 }
624
625 ${st}void ERR_${lib}_error(int function, int reason, const char *file, int line)
626 {
627     if (lib_code == 0)
628         lib_code = ERR_get_next_error_library();
629     ERR_raise(lib_code, reason);
630     ERR_set_debug(file, line, NULL);
631 }
632 EOF
633
634         }
635
636         while (length($indent) > 1) {
637             $indent = substr $indent, 0, -1;
638             print OUT "#${indent}endif\n";
639         }
640         if ($internal && $disablable) {
641             print OUT <<"EOF";
642 #else
643 NON_EMPTY_TRANSLATION_UNIT
644 #endif
645 EOF
646         }
647         close OUT;
648     }
649 }
650
651 &phase("Ending");
652 # Make a list of unreferenced reason codes
653 if ( $unref ) {
654     my @runref;
655     foreach ( keys %rcodes ) {
656         push( @runref, $_ ) unless exists $usedreasons{$_};
657     }
658     if ( @runref ) {
659         print STDERR "The following reason codes were not referenced:\n";
660         foreach ( sort @runref ) {
661             print STDERR "  $_\n";
662         }
663     }
664 }
665
666 die "Found $errors errors, quitting" if $errors;
667
668 # Update the state file
669 if ( $newstate )  {
670     open(OUT, ">$statefile.new")
671         || die "Can't write $statefile.new, $!";
672     print OUT <<"EOF";
673 # Copyright 1999-$YEAR The OpenSSL Project Authors. All Rights Reserved.
674 #
675 # Licensed under the Apache License 2.0 (the "License").  You may not use
676 # this file except in compliance with the License.  You can obtain a copy
677 # in the file LICENSE in the source distribution or at
678 # https://www.openssl.org/source/license.html
679 EOF
680     print OUT "\n#Reason codes\n";
681     foreach my $i ( sort keys %rcodes ) {
682         my $short = "$i:$rcodes{$i}:";
683         my $t = exists $strings{$i} ? "$strings{$i}" : "";
684         $t = "\\\n\t" . $t if length($short) + length($t) > 80;
685         print OUT "$short$t\n" if !exists $rextra{$i};
686     }
687     close(OUT);
688     if ( $skippedstate ) {
689         print "Skipped state, leaving update in $statefile.new";
690     } else {
691         rename "$statefile", "$statefile.old"
692             || die "Can't backup $statefile to $statefile.old, $!";
693         rename "$statefile.new", "$statefile"
694             || die "Can't rename $statefile to $statefile.new, $!";
695     }
696 }
697
698 exit;