Commit ac858acc91 for openssl.org
commit ac858acc91e9ea6a923add569d340d178f637983
Author: Jakub Zelenka <jakub.zelenka@openssl.foundation>
Date: Thu Apr 30 21:27:21 2026 +0200
Add mkwraps script for generting wraps and expectations
This is a helper script that can be used to provide a boilerplate code.
Assisted-by: Claude:claude-opus-4-7
Reviewed-by: Richard Levitte <levitte@openssl.org>
Reviewed-by: Tomas Mraz <tomas@openssl.foundation>
MergeDate: Thu Jul 9 17:39:15 2026
(Merged from https://github.com/openssl/openssl/pull/30788)
diff --git a/util/mkwraps.pl b/util/mkwraps.pl
new file mode 100755
index 0000000000..d7e8bcb7db
--- /dev/null
+++ b/util/mkwraps.pl
@@ -0,0 +1,488 @@
+#! /usr/bin/env perl
+# Copyright 2026 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the Apache License 2.0 (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use File::Spec::Functions qw(catdir catfile file_name_is_absolute rel2abs);
+use File::Basename qw(dirname);
+
+my $build_info_file;
+my $target;
+my @extra_includes;
+my $output_file;
+my $mode = 'both';
+my $verbose = 0;
+my $help = 0;
+
+GetOptions('build-info=s' => \$build_info_file,
+ 'target=s' => \$target,
+ 'include=s' => \@extra_includes,
+ 'output=s' => \$output_file,
+ 'mode=s' => \$mode,
+ 'verbose' => \$verbose,
+ 'help' => \$help)
+ or die "Error in command line arguments\n";
+
+sub help
+{
+ print STDERR <<"EOF";
+mkwraps.pl [options]
+
+Options:
+
+ --build-info FILE build.info file containing a WRAP[<target>] entry.
+
+ --target NAME Test program name used as the WRAP[]/INCLUDE[] key.
+
+ --include DIR Extra include directory to search. Cumulative.
+
+ --output FILE Output file. Defaults to stdout.
+
+ --mode MODE What to emit: 'wraps', 'expects' or 'both'.
+ Defaults to 'both'.
+
+ --verbose Print progress to stderr.
+
+ --help Show this help text.
+
+For each function name listed in WRAP[<target>], the script searches
+the headers (*.h) under each directory in INCLUDE[<target>], resolved
+relative to the directory containing the build.info file, plus any
+extra --include directories. The search recurses into subdirectories,
+mirroring how the compiler resolves <subdir/header.h> via -I flags.
+The first header containing a matching declaration provides the
+prototype.
+
+The output is meant as a stub for further editing. Custom logic
+(out-parameters, variadic forwarding, side effects on globals) still
+needs to be written manually, and the emitted #include directives may
+need to be adjusted (e.g. to add internal headers for opaque types).
+Long lines in the output are not wrapped.
+EOF
+}
+
+if ($help) {
+ &help();
+ exit 0;
+}
+
+unless (defined $build_info_file && defined $target) {
+ &help();
+ exit 1;
+}
+
+die "--mode must be 'wraps', 'expects' or 'both'\n"
+ unless $mode =~ /^(?:wraps|expects|both)$/;
+
+my @t = localtime();
+my $YEAR = $t[5] + 1900;
+
+# Parse the build.info file. We are only interested in two directives,
+# WRAP[<target>] and INCLUDE[<target>], either of which may be split
+# across several physical lines using the usual backslash continuation.
+
+my @wraps;
+my @includes;
+
+open(IN, "<$build_info_file") || die "Can't open $build_info_file, $!,";
+my $content = do { local $/; <IN> };
+close IN;
+
+$content =~ s/\\\n\s*/ /g;
+
+foreach (split /\n/, $content) {
+ next if /^\s*#/ || /^\s*$/;
+ if (/^\s*WRAP\[\Q$target\E\]\s*=\s*(.+?)\s*$/) {
+ push @wraps, split(/\s+/, $1);
+ } elsif (/^\s*INCLUDE\[\Q$target\E\]\s*=\s*(.+?)\s*$/) {
+ push @includes, split(/\s+/, $1);
+ }
+}
+
+die "No WRAP[$target] entry found in $build_info_file\n" unless @wraps;
+
+my $bi_dir = dirname($build_info_file);
+my @search_dirs;
+foreach my $inc (@includes, @extra_includes) {
+ push @search_dirs,
+ file_name_is_absolute($inc) ? $inc : rel2abs(catdir($bi_dir, $inc));
+}
+
+print STDERR "Wraps:\n ", join("\n ", @wraps), "\n" if $verbose;
+print STDERR "Search dirs:\n ", join("\n ", @search_dirs), "\n" if $verbose;
+
+# Walk all search directories and get them in the order that level ones are
+# first followed by subdirs so if there are nested includes, we get the
+# shortest ones first searched.
+sub find_headers
+{
+ my (@bases) = @_;
+ my @found;
+ my @queue = map { [$_, ''] } @bases;
+
+ while (@queue) {
+ my @next;
+ my @level_files;
+ foreach my $entry (@queue) {
+ my ($dir, $rel) = @$entry;
+ next unless -d $dir;
+ opendir(my $dh, $dir) or next;
+ foreach my $name (readdir $dh) {
+ next if $name =~ /^\./;
+ my $full = catfile($dir, $name);
+ my $newrel = $rel eq '' ? $name : "$rel/$name";
+ if (-d $full) {
+ push @next, [$full, $newrel];
+ } elsif (-f $full && $name =~ /\.h$/) {
+ push @level_files, [$full, $newrel];
+ }
+ }
+ closedir $dh;
+ }
+ # Stable sort within a level for deterministic ordering.
+ push @found, sort { $a->[1] cmp $b->[1] } @level_files;
+ @queue = sort { $a->[1] cmp $b->[1] } @next;
+ }
+ return @found;
+}
+
+my @search_files = find_headers(@search_dirs);
+
+my %file_cache;
+
+sub strip_c_comments
+{
+ my $s = shift;
+ $s =~ s{/\*.*?\*/}{}sg;
+ $s =~ s{//[^\n]*}{}g;
+ return $s;
+}
+
+# Drop attribute and qualifier macros that should not appear in the
+# emitted return type.
+sub strip_attribute_macros
+{
+ my $s = shift;
+ foreach my $kw (qw(__owur __pure __malloc__ ossl_inline static inline
+ extern OSSL_DEPRECATEDIN_0_9_8
+ OSSL_DEPRECATEDIN_1_0_0 OSSL_DEPRECATEDIN_1_1_0
+ OSSL_DEPRECATEDIN_3_0 OSSL_DEPRECATEDIN_3_1
+ OSSL_DEPRECATEDIN_3_2 OSSL_DEPRECATEDIN_3_3
+ OSSL_DEPRECATEDIN_3_4 OSSL_DEPRECATEDIN_3_5)) {
+ $s =~ s/\b\Q$kw\E\b//g;
+ }
+ $s =~ s/\b__attribute__\s*\(\([^)]*\)\)//g;
+ $s =~ s/\s+/ /g;
+ $s =~ s/^\s+|\s+$//g;
+ return $s;
+}
+
+sub find_function_decl
+{
+ my ($funcname) = @_;
+
+ foreach my $entry (@search_files) {
+ my ($file, $relpath) = @$entry;
+ unless (exists $file_cache{$file}) {
+ my $text = '';
+ if (open(my $fh, '<', $file)) {
+ local $/;
+ $text = <$fh>;
+ close $fh;
+ }
+ $file_cache{$file} = strip_c_comments($text);
+ }
+ my $text = $file_cache{$file};
+
+ while ($text =~ /\b\Q$funcname\E\s*\(/g) {
+ my $name_start = $-[0];
+ my $paren_start = pos($text);
+
+ # Find matching closing paren, respecting nesting.
+ my $depth = 1;
+ my $cursor = $paren_start;
+ while ($cursor < length($text) && $depth > 0) {
+ my $c = substr($text, $cursor, 1);
+ $depth++ if $c eq '(';
+ $depth-- if $c eq ')';
+ $cursor++;
+ }
+ next if $depth != 0;
+ my $params_str =
+ substr($text, $paren_start, $cursor - $paren_start - 1);
+
+ # What follows must be ; for this to be a declaration.
+ my $after = substr($text, $cursor);
+ $after =~ s/^\s+//;
+ next unless $after =~ /^;/;
+
+ # Anything since the previous statement terminator is the return
+ # type expression.
+ my $pre = substr($text, 0, $name_start);
+ $pre =~ s/\s+$//;
+ my $ret_start = 0;
+ $ret_start = $-[2] if $pre =~ /([;}\n])([^;}\n]*)$/s;
+ my $rettype = strip_attribute_macros(substr($pre, $ret_start));
+
+ # Normalise to forward slashes for use as an #include path.
+ my $include_path = $relpath;
+ $include_path =~ s|\\|/|g;
+
+ return { name => $funcname,
+ rettype => $rettype,
+ params => $params_str,
+ file => $file,
+ include_path => $include_path };
+ }
+ }
+ return undef;
+}
+
+# Split a parameter list on top-level commas, respecting parentheses
+sub split_params
+{
+ my $str = shift;
+ $str =~ s/^\s+|\s+$//g;
+ return () if $str eq '' || $str eq 'void';
+
+ my @parts;
+ my $current = '';
+ my $depth = 0;
+ foreach my $c (split //, $str) {
+ if ($c eq '(') {
+ $depth++;
+ $current .= $c;
+ } elsif ($c eq ')') {
+ $depth--;
+ $current .= $c;
+ } elsif ($c eq ',' && $depth == 0) {
+ push @parts, $current;
+ $current = '';
+ } else {
+ $current .= $c;
+ }
+ }
+ push @parts, $current if $current ne '';
+ foreach my $p (@parts) {
+ $p =~ s/^\s+|\s+$//g;
+ }
+ return @parts;
+}
+
+sub parse_param
+{
+ my $param = shift;
+ return { type => '', name => '', is_variadic => 1, is_ptr => 0 }
+ if $param eq '...';
+
+ # Reduce TYPE NAME[size] to TYPE * NAME for our purposes.
+ my $is_array = 0;
+ $is_array = 1 if $param =~ s/\[\s*[^\]]*\s*\]\s*$//;
+
+ my ($type, $name);
+ if ($param =~ /^(.*?)([A-Za-z_]\w*)\s*$/) {
+ $type = $1;
+ $name = $2;
+ $type =~ s/\s+$//;
+ } else {
+ $type = $param;
+ $name = '';
+ }
+
+ return { type => $type,
+ name => $name,
+ is_ptr => (($type =~ /\*/) || $is_array) ? 1 : 0,
+ is_variadic => 0,
+ is_array => $is_array };
+}
+
+sub is_void_type
+{
+ my $t = shift;
+ $t =~ s/^\s+|\s+$//g;
+ $t =~ s/\s+/ /g;
+ return $t eq 'void';
+}
+
+sub is_ptr_type { return $_[0] =~ /\*/; }
+
+# Look up each WRAP entry's signature. Functions we cannot find are
+# skipped with a warning rather than aborting.
+my @signatures;
+my @found_includes;
+my %seen_include;
+foreach my $func (@wraps) {
+ my $info = find_function_decl($func);
+ unless (defined $info) {
+ warn "WARNING: $func: declaration not found in any include dir\n";
+ next;
+ }
+
+ my @params = map { parse_param($_) } split_params($info->{params});
+
+ my $idx = 0;
+ foreach my $p (@params) {
+ next if $p->{is_variadic};
+ $p->{name} = "arg$idx" if $p->{name} eq '';
+ $idx++;
+ }
+
+ push @signatures, { name => $func,
+ rettype => $info->{rettype},
+ params => \@params };
+
+ unless ($seen_include{$info->{include_path}}) {
+ $seen_include{$info->{include_path}} = 1;
+ push @found_includes, $info->{include_path};
+ }
+ print STDERR " found $func in $info->{file}\n" if $verbose;
+}
+
+die "No declarations found, nothing to emit\n" unless @signatures;
+
+my $out_fh;
+if (defined $output_file) {
+ open($out_fh, '>', $output_file) or die "$output_file: $!\n";
+} else {
+ $out_fh = \*STDOUT;
+}
+
+print $out_fh <<"EOF";
+/*
+ * Copyright $YEAR The OpenSSL Project Authors. All Rights Reserved.
+ *
+ * Licensed under the Apache License 2.0 (the "License"). You may not use
+ * this file except in compliance with the License. You can obtain a copy
+ * in the file LICENSE in the source distribution or at
+ * https://www.openssl.org/source/license.html
+ */
+
+EOF
+
+print $out_fh "#include <cmocka.h>\n";
+print $out_fh "\n";
+if (@found_includes) {
+ my @system;
+ my @local;
+ foreach my $inc (sort @found_includes) {
+ if ($inc =~ m|^openssl/|) {
+ push @system, $inc;
+ } else {
+ push @local, $inc;
+ }
+ }
+ foreach my $inc (@system) {
+ print $out_fh "#include <$inc>\n";
+ }
+ print $out_fh "\n" if @system && @local;
+ foreach my $inc (@local) {
+ print $out_fh "#include \"$inc\"\n";
+ }
+ print $out_fh "\n";
+}
+
+if ($mode eq 'wraps' || $mode eq 'both') {
+ print $out_fh "/* wraps */\n\n";
+ foreach my $f (@signatures) {
+ print $out_fh format_signature($f->{rettype},
+ "__wrap_$f->{name}",
+ $f->{params}), ";\n";
+ }
+ print $out_fh "\n";
+
+ foreach my $f (@signatures) {
+ emit_wrap($out_fh, $f);
+ print $out_fh "\n";
+ }
+}
+
+if ($mode eq 'expects' || $mode eq 'both') {
+ print $out_fh "/* expectations */\n\n";
+ foreach my $f (@signatures) {
+ emit_expect($out_fh, $f);
+ print $out_fh "\n";
+ }
+}
+
+close $out_fh if defined $output_file;
+
+exit 0;
+
+sub format_decl
+{
+ my ($type, $name) = @_;
+ return $type =~ /\*$/ ? "$type$name" : "$type $name";
+}
+
+sub format_param
+{
+ my $p = shift;
+ return '...' if $p->{is_variadic};
+ return format_decl($p->{type}, $p->{name});
+}
+
+sub format_signature
+{
+ my ($rettype, $name, $params) = @_;
+ my $param_str = @$params
+ ? join(', ', map { format_param($_) } @$params)
+ : 'void';
+ return format_decl($rettype, $name) . "($param_str)";
+}
+
+sub emit_wrap
+{
+ my ($fh, $f) = @_;
+ print $fh format_signature($f->{rettype}, "__wrap_$f->{name}",
+ $f->{params}), "\n{\n";
+ print $fh " function_called();\n";
+ foreach my $p (@{$f->{params}}) {
+ next if $p->{is_variadic};
+ if ($p->{is_ptr}) {
+ print $fh " check_expected_ptr($p->{name});\n";
+ } else {
+ print $fh " check_expected($p->{name});\n";
+ }
+ }
+ if ( ! is_void_type($f->{rettype})) {
+ if (is_ptr_type($f->{rettype})) {
+ print $fh "\n return mock_ptr_type($f->{rettype});\n";
+ } else {
+ print $fh "\n return mock_type($f->{rettype});\n";
+ }
+ }
+ print $fh "}\n";
+}
+
+sub emit_expect
+{
+ my ($fh, $f) = @_;
+ my $name = $f->{name};
+ my @params = @{$f->{params}};
+
+ my @sig_parts;
+ foreach my $p (@params) {
+ next if $p->{is_variadic};
+ push @sig_parts, format_param($p);
+ }
+
+ my $needs_rc = !is_void_type($f->{rettype});
+ push @sig_parts, format_decl($f->{rettype}, 'rc') if $needs_rc;
+
+ my $param_str = @sig_parts ? join(', ', @sig_parts) : 'void';
+ print $fh "static void expect_$name($param_str)\n{\n";
+ print $fh " expect_function_call(__wrap_$name);\n";
+ foreach my $p (@params) {
+ next if $p->{is_variadic};
+ print $fh " expect_value(__wrap_$name, $p->{name}, $p->{name});\n";
+ }
+ print $fh " will_return(__wrap_$name, rc);\n" if $needs_rc;
+ print $fh "}\n";
+}