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