]> git.ipfire.org Git - thirdparty/openssl.git/blob - util/mkerr.pl
Add {lib}_R_{lib}_LIB, for our engines and other "external" modules
[thirdparty/openssl.git] / util / mkerr.pl
1 #! /usr/bin/env perl
2 # Copyright 1999-2022 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 # define ERR_R_${lib}_LIB ERR_${lib}_lib()
454
455 EOF
456 if ( ! $static ) {
457 print OUT <<"EOF";
458
459 # ifdef __cplusplus
460 extern \"C\" {
461 # endif
462 int ERR_load_${lib}_strings(void);
463 void ERR_unload_${lib}_strings(void);
464 void ERR_${lib}_error(int function, int reason, const char *file, int line);
465 # ifdef __cplusplus
466 }
467 # endif
468 EOF
469 }
470 }
471
472 print OUT "\n/*\n * $lib reason codes.\n */\n";
473 foreach my $i ( @reasons ) {
474 my $z = 48 - length($i);
475 $z = 0 if $z < 0;
476 if ( $rcodes{$i} eq "X" ) {
477 $rassigned{$lib} =~ m/^:([^:]*):/;
478 my $findcode = $1;
479 $findcode = $rmax{$lib} if !defined $findcode;
480 while ( $rassigned{$lib} =~ m/:$findcode:/ ) {
481 $findcode++;
482 }
483 $rcodes{$i} = $findcode;
484 $rassigned{$lib} .= "$findcode:";
485 print STDERR "New Reason code $i\n" if $debug;
486 }
487 printf OUT "#${indent}define $i%s $rcodes{$i}\n", " " x $z;
488 }
489 print OUT "\n";
490
491 while (length($indent) > 0) {
492 $indent = substr $indent, 0, -1;
493 print OUT "#${indent}endif\n";
494 }
495 close OUT;
496 }
497
498 # Rewrite the C source file containing the error details.
499
500 if ($errorfile{$lib} ne 'NONE') {
501 # First, read any existing reason string definitions:
502 my $cfile = $errorfile{$lib};
503 my $pack_lib = $internal ? "ERR_LIB_${lib}" : "0";
504 my $hpubincf = $hpubinc{$lib};
505 my $hprivincf = $hprivinc{$lib};
506 my $includes = '';
507 if ($internal) {
508 if ($hpubincf ne 'NONE') {
509 $hpubincf =~ s|^include/||;
510 $includes .= "#include <${hpubincf}>\n";
511 }
512 if ($hprivincf =~ m|^include/|) {
513 $hprivincf = $';
514 } else {
515 $hprivincf = abs2rel(rel2abs($hprivincf),
516 rel2abs(dirname($cfile)));
517 }
518 $includes .= "#include \"${hprivincf}\"\n";
519 } else {
520 $includes .= "#include \"${hpubincf}\"\n";
521 }
522
523 open( OUT, ">$cfile" )
524 || die "Can't open $cfile for writing, $!, stopped";
525
526 my $const = $internal ? 'const ' : '';
527
528 print OUT <<"EOF";
529 /*
530 * Generated by util/mkerr.pl DO NOT EDIT
531 * Copyright 1995-$YEAR The OpenSSL Project Authors. All Rights Reserved.
532 *
533 * Licensed under the Apache License 2.0 (the "License"). You may not use
534 * this file except in compliance with the License. You can obtain a copy
535 * in the file LICENSE in the source distribution or at
536 * https://www.openssl.org/source/license.html
537 */
538
539 #include <openssl/err.h>
540 $includes
541 EOF
542 $indent = '';
543 if ( $internal ) {
544 if ($disablable) {
545 print OUT <<"EOF";
546 #ifndef OPENSSL_NO_${lib}
547
548 EOF
549 $indent .= ' ';
550 }
551 }
552 print OUT <<"EOF";
553 #${indent}ifndef OPENSSL_NO_ERR
554
555 static ${const}ERR_STRING_DATA ${lib}_str_reasons[] = {
556 EOF
557
558 # Add each reason code.
559 foreach my $i ( @reasons ) {
560 my $rn;
561 if ( exists $strings{$i} ) {
562 $rn = $strings{$i};
563 $rn = "" if $rn eq '*';
564 } else {
565 $i =~ /^${lib}_R_(\S+)$/;
566 $rn = $1;
567 $rn =~ tr/_[A-Z]/ [a-z]/;
568 $strings{$i} = $rn;
569 }
570 my $short = " {ERR_PACK($pack_lib, 0, $i), \"$rn\"},";
571 if ( length($short) <= 80 ) {
572 print OUT "$short\n";
573 } else {
574 print OUT " {ERR_PACK($pack_lib, 0, $i),\n \"$rn\"},\n";
575 }
576 }
577 print OUT <<"EOF";
578 {0, NULL}
579 };
580
581 #${indent}endif
582 EOF
583 if ( $internal ) {
584 print OUT <<"EOF";
585
586 int ossl_err_load_${lib}_strings(void)
587 {
588 #${indent}ifndef OPENSSL_NO_ERR
589 if (ERR_reason_error_string(${lib}_str_reasons[0].error) == NULL)
590 ERR_load_strings_const(${lib}_str_reasons);
591 #${indent}endif
592 return 1;
593 }
594 EOF
595 } else {
596 my $st = $static ? "static " : "";
597 print OUT <<"EOF";
598
599 static int lib_code = 0;
600 static int error_loaded = 0;
601
602 ${st}int ERR_load_${lib}_strings(void)
603 {
604 if (lib_code == 0)
605 lib_code = ERR_get_next_error_library();
606
607 if (!error_loaded) {
608 #ifndef OPENSSL_NO_ERR
609 ERR_load_strings(lib_code, ${lib}_str_reasons);
610 #endif
611 error_loaded = 1;
612 }
613 return 1;
614 }
615
616 ${st}void ERR_unload_${lib}_strings(void)
617 {
618 if (error_loaded) {
619 #ifndef OPENSSL_NO_ERR
620 ERR_unload_strings(lib_code, ${lib}_str_reasons);
621 #endif
622 error_loaded = 0;
623 }
624 }
625
626 ${st}void ERR_${lib}_error(int function, int reason, const char *file, int line)
627 {
628 if (lib_code == 0)
629 lib_code = ERR_get_next_error_library();
630 ERR_raise(lib_code, reason);
631 ERR_set_debug(file, line, NULL);
632 }
633
634 ${st}int ERR_${lib}_lib(void)
635 {
636 if (lib_code == 0)
637 lib_code = ERR_get_next_error_library();
638 return lib_code;
639 }
640 EOF
641
642 }
643
644 while (length($indent) > 1) {
645 $indent = substr $indent, 0, -1;
646 print OUT "#${indent}endif\n";
647 }
648 if ($internal && $disablable) {
649 print OUT <<"EOF";
650 #else
651 NON_EMPTY_TRANSLATION_UNIT
652 #endif
653 EOF
654 }
655 close OUT;
656 }
657 }
658
659 &phase("Ending");
660 # Make a list of unreferenced reason codes
661 if ( $unref ) {
662 my @runref;
663 foreach ( keys %rcodes ) {
664 push( @runref, $_ ) unless exists $usedreasons{$_};
665 }
666 if ( @runref ) {
667 print STDERR "The following reason codes were not referenced:\n";
668 foreach ( sort @runref ) {
669 print STDERR " $_\n";
670 }
671 }
672 }
673
674 die "Found $errors errors, quitting" if $errors;
675
676 # Update the state file
677 if ( $newstate ) {
678 open(OUT, ">$statefile.new")
679 || die "Can't write $statefile.new, $!";
680 print OUT <<"EOF";
681 # Copyright 1999-$YEAR The OpenSSL Project Authors. All Rights Reserved.
682 #
683 # Licensed under the Apache License 2.0 (the "License"). You may not use
684 # this file except in compliance with the License. You can obtain a copy
685 # in the file LICENSE in the source distribution or at
686 # https://www.openssl.org/source/license.html
687 EOF
688 print OUT "\n#Reason codes\n";
689 foreach my $i ( sort keys %rcodes ) {
690 my $short = "$i:$rcodes{$i}:";
691 my $t = exists $strings{$i} ? "$strings{$i}" : "";
692 $t = "\\\n\t" . $t if length($short) + length($t) > 80;
693 print OUT "$short$t\n" if !exists $rextra{$i};
694 }
695 close(OUT);
696 if ( $skippedstate ) {
697 print "Skipped state, leaving update in $statefile.new";
698 } else {
699 rename "$statefile", "$statefile.old"
700 || die "Can't backup $statefile to $statefile.old, $!";
701 rename "$statefile.new", "$statefile"
702 || die "Can't rename $statefile to $statefile.new, $!";
703 }
704 }
705
706 exit;