xref: /openssl/util/mknum.pl (revision 6ee47412) 
1
2#! /usr/bin/env perl
3# Copyright 2018-2021 The OpenSSL Project Authors. All Rights Reserved.
4#
5# Licensed under the Apache License 2.0 (the "License").  You may not use
6# this file except in compliance with the License.  You can obtain a copy
7# in the file LICENSE in the source distribution or at
8# https://www.openssl.org/source/license.html
9
10use strict;
11use warnings;
12
13use Getopt::Long;
14use FindBin;
15use lib "$FindBin::Bin/perl";
16
17use OpenSSL::Ordinals;
18use OpenSSL::ParseC;
19
20my $ordinals_file = undef;      # the ordinals file to use
21my $symhacks_file = undef;      # a symbol hacking file (optional)
22my $version = undef;            # the version to use for added symbols
23my $checkexist = 0;             # (unsure yet)
24my $warnings = 1;
25my $renumber = 0;
26my $verbose = 0;
27my $debug = 0;
28
29GetOptions('ordinals=s' => \$ordinals_file,
30           'symhacks=s' => \$symhacks_file,
31           'version=s'  => \$version,
32           'exist'      => \$checkexist,
33           'renumber'   => \$renumber,
34           'warnings!'  => \$warnings,
35           'verbose'    => \$verbose,
36           'debug'      => \$debug)
37    or die "Error in command line arguments\n";
38
39die "Please supply ordinals file\n"
40    unless $ordinals_file;
41
42my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file,
43                                      warnings => $warnings,
44                                      verbose => $verbose,
45                                      debug => $debug);
46$ordinals->set_version($version);
47
48my %orig_names = ();
49%orig_names = map { $_->name() => 1 }
50    $ordinals->items(comparator => sub { $_[0] cmp $_[1] },
51                     filter => sub { $_->exists() })
52    if $checkexist;
53
54# Invalidate all entries, they get revalidated when we re-check below
55$ordinals->invalidate();
56
57foreach my $f (($symhacks_file // (), @ARGV)) {
58    print STDERR $f," ","-" x (69 - length($f)),"\n" if $verbose;
59    open IN, $f or die "Couldn't open $f: $!\n";
60    foreach (parse(<IN>, { filename => $f,
61                           warnings => $warnings,
62                           verbose => $verbose,
63                           debug => $debug })) {
64        $_->{value} = $_->{value}||"";
65        next if grep { $_ eq 'CONST_STRICT' } @{$_->{conds}};
66        printf STDERR "%s> %s%s : %s\n",
67            $_->{type},
68            $_->{name},
69            ($_->{type} eq 'M' && defined $symhacks_file && $f eq $symhacks_file
70             ? ' = ' . $_->{value}
71             : ''),
72            join(', ', @{$_->{conds}})
73            if $verbose;
74        if ($_->{type} eq 'M'
75                && defined $symhacks_file
76                && $f eq $symhacks_file
77                && $_->{value} =~ /^\w(?:\w|\d)*/) {
78            $ordinals->add_alias($f, $_->{value}, $_->{name}, @{$_->{conds}});
79        } else {
80            next if $_->{returntype} =~ /\b(?:ossl_)inline/;
81            my $type = {
82                F => 'FUNCTION',
83                V => 'VARIABLE',
84            } -> {$_->{type}};
85            if ($type) {
86                $ordinals->add($f, $_->{name}, $type, @{$_->{conds}});
87            }
88        }
89    }
90    close IN;
91}
92
93$ordinals->renumber() if $renumber;
94
95if ($checkexist) {
96    my %new_names = map { $_->name() => 1 }
97        $ordinals->items(comparator => sub { $_[0] cmp $_[1] },
98                         filter => sub { $_->exists() });
99    # Eliminate common names
100    foreach (keys %orig_names) {
101        next unless exists $new_names{$_};
102        delete $orig_names{$_};
103        delete $new_names{$_};
104    }
105    if (%orig_names) {
106        print "The following symbols do not seem to exist in code:\n";
107        foreach (sort keys %orig_names) {
108            print "\t$_\n";
109        }
110    }
111    if (%new_names) {
112        print "The following existing symbols are not in ordinals file:\n";
113        foreach (sort keys %new_names) {
114            print "\t$_\n";
115        }
116    }
117} else {
118    my $dropped = 0;
119    my $unassigned;
120    my $filter = sub {
121        my $item = shift;
122        my $result = $item->number() ne '?' || $item->exists();
123        $dropped++ unless $result;
124        return $result;
125    };
126    $ordinals->rewrite(filter => $filter);
127    my %stats = $ordinals->stats();
128    print STDERR
129        "${ordinals_file}: $stats{modified} old symbols have updated info\n"
130        if $stats{modified};
131    if ($stats{new}) {
132        print STDERR "${ordinals_file}: Added $stats{new} new symbols\n";
133    } else {
134        print STDERR "${ordinals_file}: No new symbols added\n";
135    }
136    if ($dropped) {
137        print STDERR "${ordinals_file}: Dropped $dropped new symbols\n";
138    }
139    $stats{unassigned} = 0 unless defined $stats{unassigned};
140    $unassigned = $stats{unassigned} - $dropped;
141    if ($unassigned) {
142        my $symbol = $unassigned == 1 ? "symbol" : "symbols";
143        my $is = $unassigned == 1 ? "is" : "are";
144        print STDERR "${ordinals_file}: $unassigned $symbol $is without ordinal number\n";
145    }
146}
147