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