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