Raise an error on syscall failure in tls_retry_write_records
[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('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.
128 my %hpubinc;    # lib -> public header
129 my %libpubinc;  # public header -> lib
130 my %hprivinc;   # lib -> private header
131 my %libprivinc; # private header -> lib
132 my %cskip;      # error_file -> lib
133 my %errorfile;  # lib -> error file name
134 my %rmax;       # lib -> max assigned reason code
135 my %rassigned;  # lib -> colon-separated list of assigned reason codes
136 my %rnew;       # lib -> count of new reason codes
137 my %rextra;     # "extra" reason code -> lib
138 my %rcodes;     # reason-name -> value
139 my $statefile;  # state file with assigned reason and function codes
140 my %strings;    # define -> text
141
142 # Read and parse the config file
143 open(IN, "$config") || die "Can't open config file $config, $!,";
144 while ( <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 }
176 close IN;
177
178 if ( ! $statefile ) {
179     $statefile = $config;
180     $statefile =~ s/.ec/.txt/;
181 }
182
183 # The statefile has all the previous assignments.
184 &phase("Reading state");
185 my $skippedstate = 0;
186 if ( ! $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");
258 my %usedreasons;
259 foreach 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 }
286 print STDERR "\n" if $debug;
287
288 # Now process each library in turn.
289 &phase("Writing files");
290 my $newstate = 0;
291 foreach 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
348 extern \"C\" {
349 # endif
350
351 EOF
352         $indent = ' ';
353         if ($disablable) {
354             print OUT <<"EOF";
355 # ifndef OPENSSL_NO_${lib}
356
357 EOF
358             $indent = "  ";
359         }
360         print OUT <<"EOF";
361 int err_load_${lib}_strings_int(void);
362 EOF
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
400 EOF
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
439 EOF
440         $indent = ' ';
441         if ( $internal ) {
442             if ($disablable) {
443                 print OUT <<"EOF";
444 # ifndef OPENSSL_NO_${lib}
445
446 EOF
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
453 EOF
454             if ( ! $static ) {
455                 print OUT <<"EOF";
456
457 # ifdef  __cplusplus
458 extern \"C\" {
459 # endif
460 int ERR_load_${lib}_strings(void);
461 void ERR_unload_${lib}_strings(void);
462 void ERR_${lib}_error(int function, int reason, char *file, int line);
463 # ifdef  __cplusplus
464 }
465 # endif
466 EOF
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
539 EOF
540         $indent = '';
541         if ( $internal ) {
542             if ($disablable) {
543                 print OUT <<"EOF";
544 #ifndef OPENSSL_NO_${lib}
545
546 EOF
547                 $indent .= ' ';
548             }
549         }
550         print OUT <<"EOF";
551 #${indent}ifndef OPENSSL_NO_ERR
552
553 static ${const}ERR_STRING_DATA ${lib}_str_reasons[] = {
554 EOF
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
580 EOF
581         if ( $internal ) {
582             print OUT <<"EOF";
583
584 int err_load_${lib}_strings_int(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 }
592 EOF
593         } else {
594             my $st = $static ? "static " : "";
595             print OUT <<"EOF";
596
597 static int lib_code = 0;
598 static 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, 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 }
631 EOF
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
642 NON_EMPTY_TRANSLATION_UNIT
643 #endif
644 EOF
645         }
646         close OUT;
647     }
648 }
649
650 &phase("Ending");
651 # Make a list of unreferenced reason codes
652 if ( $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
665 die "Found $errors errors, quitting" if $errors;
666
667 # Update the state file
668 if ( $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
678 EOF
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
697 exit;